summaryrefslogtreecommitdiffstats
path: root/win
diff options
context:
space:
mode:
Diffstat (limited to 'win')
-rw-r--r--win/Makefile.in340
-rw-r--r--win/README10
-rw-r--r--win/README.binary141
-rw-r--r--[-rwxr-xr-x]win/buildall.vc.bat95
-rw-r--r--win/cat.c7
-rw-r--r--win/coffbase.txt10
-rwxr-xr-xwin/configure5842
-rw-r--r--win/configure.in155
-rw-r--r--win/makefile.bc94
-rw-r--r--win/makefile.vc525
-rw-r--r--win/nmakehlp.c266
-rw-r--r--win/rules.vc231
-rw-r--r--win/stub16.c65
-rw-r--r--win/tcl.dsp56
-rw-r--r--win/tcl.hpj.in4
-rw-r--r--win/tcl.m491
-rw-r--r--win/tcl.rc8
-rw-r--r--win/tclAppInit.c286
-rw-r--r--win/tclWin32Dll.c760
-rw-r--r--win/tclWinChan.c942
-rw-r--r--win/tclWinConsole.c636
-rw-r--r--win/tclWinDde.c1896
-rw-r--r--win/tclWinFCmd.c1224
-rw-r--r--win/tclWinFile.c2918
-rw-r--r--win/tclWinInit.c667
-rw-r--r--win/tclWinInt.h89
-rw-r--r--win/tclWinLoad.c191
-rw-r--r--win/tclWinMtherr.c55
-rw-r--r--win/tclWinNotify.c286
-rw-r--r--win/tclWinPipe.c1447
-rw-r--r--win/tclWinPort.h163
-rw-r--r--win/tclWinReg.c546
-rw-r--r--win/tclWinSerial.c1994
-rw-r--r--win/tclWinSock.c1925
-rw-r--r--win/tclWinTest.c696
-rw-r--r--win/tclWinThrd.c708
-rw-r--r--win/tclWinTime.c1003
-rw-r--r--win/tclsh.rc10
38 files changed, 15532 insertions, 10850 deletions
diff --git a/win/Makefile.in b/win/Makefile.in
index f11ef53..d3c9c80 100644
--- a/win/Makefile.in
+++ b/win/Makefile.in
@@ -1,24 +1,21 @@
#
-# This file is a Makefile for Tcl. If it has the name "Makefile.in"
-# then it is a template for a Makefile; to generate the actual Makefile,
-# run "./configure", which is a configuration script generated by the
-# "autoconf" program (constructs like "@foo@" will get replaced in the
-# actual Makefile.
+# This file is a Makefile for Tcl. If it has the name "Makefile.in" then it
+# is a template for a Makefile; to generate the actual Makefile, run
+# "./configure", which is a configuration script generated by the "autoconf"
+# program (constructs like "@foo@" will get replaced in the actual Makefile.
VERSION = @TCL_VERSION@
-#----------------------------------------------------------------
-# Things you can change to personalize the Makefile for your own
-# site (you can make these changes in either Makefile.in or
-# Makefile, but changes to Makefile will get lost if you re-run
-# the configuration script).
-#----------------------------------------------------------------
+#--------------------------------------------------------------------------
+# Things you can change to personalize the Makefile for your own site (you can
+# make these changes in either Makefile.in or Makefile, but changes to
+# Makefile will get lost if you re-run the configuration script).
+#--------------------------------------------------------------------------
-# Default top-level directories in which to install architecture-
-# specific files (exec_prefix) and machine-independent files such
-# as scripts (prefix). The values specified here may be overridden
-# at configure-time with the --exec-prefix and --prefix options
-# to the "configure" script.
+# Default top-level directories in which to install architecture-specific
+# files (exec_prefix) and machine-independent files such as scripts (prefix).
+# The values specified here may be overridden at configure-time with the
+# --exec-prefix and --prefix options to the "configure" script.
prefix = @prefix@
exec_prefix = @exec_prefix@
@@ -27,16 +24,15 @@ libdir = @libdir@
includedir = @includedir@
mandir = @mandir@
-# The following definition can be set to non-null for special systems
-# like AFS with replication. It allows the pathnames used for installation
-# to be different than those used for actually reference files at
-# run-time. INSTALL_ROOT is prepended to $prefix and $exec_prefix
-# when installing files.
+# The following definition can be set to non-null for special systems like AFS
+# with replication. It allows the pathnames used for installation to be
+# different than those used for actually reference files at run-time.
+# INSTALL_ROOT is prepended to $prefix and $exec_prefix when installing files.
INSTALL_ROOT =
-# Directory from which applications will reference the library of Tcl
-# scripts (note: you can set the TCL_LIBRARY environment variable at
-# run-time to override this value):
+# Directory from which applications will reference the library of Tcl scripts
+# (note: you can set the TCL_LIBRARY environment variable at run-time to
+# override this value):
TCL_LIBRARY = $(prefix)/lib/tcl$(VERSION)
# Path to use at runtime to refer to LIB_INSTALL_DIR:
@@ -63,12 +59,10 @@ MAN_INSTALL_DIR = $(INSTALL_ROOT)$(mandir)
# Directory in which to install manual entry for tclsh:
MAN1_INSTALL_DIR = $(MAN_INSTALL_DIR)/man1
-# Directory in which to install manual entries for Tcl's C library
-# procedures:
+# Directory in which to install manual entries for Tcl's C library procedures:
MAN3_INSTALL_DIR = $(MAN_INSTALL_DIR)/man3
-# Directory in which to install manual entries for the built-in
-# Tcl commands:
+# Directory in which to install manual entries for the built-in Tcl commands:
MANN_INSTALL_DIR = $(MAN_INSTALL_DIR)/mann
# Libraries built with optimization switches have this additional extension
@@ -88,18 +82,19 @@ CFLAGS_OPTIMIZE = @CFLAGS_OPTIMIZE@
#CFLAGS = $(CFLAGS_DEBUG) $(CFLAGS_OPTIMIZE)
CFLAGS = @CFLAGS@ @CFLAGS_DEFAULT@
-# To enable compilation debugging reverse the comment characters on
-# one of the following lines.
+# To enable compilation debugging reverse the comment characters on one of the
+# following lines.
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@
+MAN2TCLFLAGS = @MAN2TCLFLAGS@
SRC_DIR = @srcdir@
ROOT_DIR = @srcdir@/..
GENERIC_DIR = @srcdir@/../generic
+TOMMATH_DIR = @srcdir@/../libtommath
WIN_DIR = @srcdir@
COMPAT_DIR = @srcdir@/../compat
@@ -107,15 +102,29 @@ COMPAT_DIR = @srcdir@/../compat
CYGPATH = @CYGPATH@
GENERIC_DIR_NATIVE = $(shell $(CYGPATH) '$(GENERIC_DIR)' | sed 's!\\!/!g')
+TOMMATH_DIR_NATIVE = $(shell $(CYGPATH) '$(TOMMATH_DIR)' | sed 's!\\!/!g')
WIN_DIR_NATIVE = $(shell $(CYGPATH) '$(WIN_DIR)' | sed 's!\\!/!g')
ROOT_DIR_NATIVE = $(shell $(CYGPATH) '$(ROOT_DIR)' | sed 's!\\!/!g')
-
-LIBRARY_DIR = $(ROOT_DIR_NATIVE)/library
-
+#GENERIC_DIR_NATIVE = $(GENERIC_DIR)
+#TOMMATH_DIR_NATIVE = $(TOMMATH_DIR)
+#WIN_DIR_NATIVE = $(WIN_DIR)
+#ROOT_DIR_NATIVE = $(ROOT_DIR)
+
+# Fully qualify library path so that `make test`
+# does not depend on the current directory.
+LIBRARY_DIR1 = $(shell cd '$(ROOT_DIR_NATIVE)/library' ; pwd)
+LIBRARY_DIR = $(shell $(CYGPATH) '$(LIBRARY_DIR1)' | sed 's!\\!/!g')
DLLSUFFIX = @DLLSUFFIX@
LIBSUFFIX = @LIBSUFFIX@
EXESUFFIX = @EXESUFFIX@
+VER = @TCL_MAJOR_VERSION@@TCL_MINOR_VERSION@
+DOTVER = @TCL_MAJOR_VERSION@.@TCL_MINOR_VERSION@
+DDEVER = @TCL_DDE_MAJOR_VERSION@@TCL_DDE_MINOR_VERSION@
+DDEDOTVER = @TCL_DDE_MAJOR_VERSION@.@TCL_DDE_MINOR_VERSION@
+REGVER = @TCL_REG_MAJOR_VERSION@@TCL_REG_MINOR_VERSION@
+REGDOTVER = @TCL_REG_MAJOR_VERSION@.@TCL_REG_MINOR_VERSION@
+
TCL_STUB_LIB_FILE = @TCL_STUB_LIB_FILE@
TCL_DLL_FILE = @TCL_DLL_FILE@
TCL_LIB_FILE = @TCL_LIB_FILE@
@@ -129,11 +138,10 @@ SHARED_LIBRARIES = $(TCL_DLL_FILE) $(TCL_STUB_LIB_FILE) \
$(DDE_DLL_FILE) $(REG_DLL_FILE) $(PIPE_DLL_FILE)
STATIC_LIBRARIES = $(TCL_LIB_FILE) $(REG_LIB_FILE) $(DDE_LIB_FILE)
-# 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 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}
@@ -143,11 +151,10 @@ MAN2TCL = man2tcl$(EXEEXT)
@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.
+# 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):$(WIN_DIR):$(COMPAT_DIR)
+VPATH = $(GENERIC_DIR):$(TOMMATH_DIR):$(WIN_DIR):$(COMPAT_DIR)
AR = @AR@
RANLIB = @RANLIB@
@@ -168,12 +175,6 @@ SHLIB_LD = @SHLIB_LD@
SHLIB_LD_LIBS = @SHLIB_LD_LIBS@ $(LIBS)
SHLIB_CFLAGS = @SHLIB_CFLAGS@
SHLIB_SUFFIX = @SHLIB_SUFFIX@
-VER = @TCL_MAJOR_VERSION@@TCL_MINOR_VERSION@
-DOTVER = @TCL_MAJOR_VERSION@.@TCL_MINOR_VERSION@
-DDEVER = @TCL_DDE_MAJOR_VERSION@@TCL_DDE_MINOR_VERSION@
-DDEDOTVER = @TCL_DDE_MAJOR_VERSION@.@TCL_DDE_MINOR_VERSION@
-REGVER = @TCL_REG_MAJOR_VERSION@@TCL_REG_MINOR_VERSION@
-REGDOTVER = @TCL_REG_MAJOR_VERSION@.@TCL_REG_MINOR_VERSION@
LIBS = @LIBS@
RMDIR = rm -rf
@@ -183,14 +184,16 @@ RM = rm -f
COPY = cp
CC_SWITCHES = ${CFLAGS} ${CFLAGS_WARNING} ${TCL_SHLIB_CFLAGS} \
--I"${GENERIC_DIR_NATIVE}" -I"${WIN_DIR_NATIVE}" ${AC_FLAGS} \
+-I"${GENERIC_DIR_NATIVE}" -DTCL_TOMMATH -DMP_PREC=4 -I"${TOMMATH_DIR_NATIVE}" \
+-I"${WIN_DIR_NATIVE}" ${AC_FLAGS} \
${COMPILE_DEBUG_FLAGS}
CC_OBJNAME = @CC_OBJNAME@
CC_EXENAME = @CC_EXENAME@
STUB_CC_SWITCHES = ${CFLAGS} ${CFLAGS_WARNING} ${SHLIB_CFLAGS} \
--I"${GENERIC_DIR_NATIVE}" -I"${WIN_DIR_NATIVE}" ${AC_FLAGS} \
+-I"${GENERIC_DIR_NATIVE}" -DTCL_TOMMATH -DMP_PREC=4 -I"${TOMMATH_DIR_NATIVE}" \
+-I"${WIN_DIR_NATIVE}" ${AC_FLAGS} \
${COMPILE_DEBUG_FLAGS}
TCLTEST_OBJS = \
@@ -218,7 +221,9 @@ GENERIC_OBJS = \
tclCompCmds.$(OBJEXT) \
tclCompExpr.$(OBJEXT) \
tclCompile.$(OBJEXT) \
+ tclConfig.$(OBJEXT) \
tclDate.$(OBJEXT) \
+ tclDictObj.$(OBJEXT) \
tclEncoding.$(OBJEXT) \
tclEnv.$(OBJEXT) \
tclEvent.$(OBJEXT) \
@@ -233,6 +238,7 @@ GENERIC_OBJS = \
tclIO.$(OBJEXT) \
tclIOCmd.$(OBJEXT) \
tclIOGT.$(OBJEXT) \
+ tclIORChan.$(OBJEXT) \
tclIOSock.$(OBJEXT) \
tclIOUtil.$(OBJEXT) \
tclLink.$(OBJEXT) \
@@ -245,9 +251,10 @@ GENERIC_OBJS = \
tclObj.$(OBJEXT) \
tclPanic.$(OBJEXT) \
tclParse.$(OBJEXT) \
- tclParseExpr.$(OBJEXT) \
+ tclPathObj.$(OBJEXT) \
tclPipe.$(OBJEXT) \
tclPkg.$(OBJEXT) \
+ tclPkgConfig.$(OBJEXT) \
tclPosixStr.$(OBJEXT) \
tclPreserve.$(OBJEXT) \
tclProc.$(OBJEXT) \
@@ -256,16 +263,87 @@ GENERIC_OBJS = \
tclResult.$(OBJEXT) \
tclScan.$(OBJEXT) \
tclStringObj.$(OBJEXT) \
+ tclStrToD.$(OBJEXT) \
tclStubInit.$(OBJEXT) \
tclStubLib.$(OBJEXT) \
tclThread.$(OBJEXT) \
tclThreadAlloc.$(OBJEXT) \
tclThreadJoin.$(OBJEXT) \
+ tclThreadStorage.$(OBJEXT) \
tclTimer.$(OBJEXT) \
+ tclTomMathInterface.$(OBJEXT) \
+ tclTrace.$(OBJEXT) \
tclUtf.$(OBJEXT) \
tclUtil.$(OBJEXT) \
tclVar.$(OBJEXT)
+TOMMATH_OBJS = \
+ bncore.${OBJEXT} \
+ bn_reverse.${OBJEXT} \
+ bn_fast_s_mp_mul_digs.${OBJEXT} \
+ bn_fast_s_mp_sqr.${OBJEXT} \
+ bn_mp_add.${OBJEXT} \
+ bn_mp_add_d.${OBJEXT} \
+ bn_mp_and.${OBJEXT} \
+ bn_mp_clamp.${OBJEXT} \
+ bn_mp_clear.${OBJEXT} \
+ bn_mp_clear_multi.${OBJEXT} \
+ bn_mp_cmp.${OBJEXT} \
+ bn_mp_cmp_d.${OBJEXT} \
+ bn_mp_cmp_mag.${OBJEXT} \
+ bn_mp_cnt_lsb.${OBJEXT} \
+ bn_mp_copy.${OBJEXT} \
+ bn_mp_count_bits.${OBJEXT} \
+ bn_mp_div.${OBJEXT} \
+ bn_mp_div_d.${OBJEXT} \
+ bn_mp_div_2.${OBJEXT} \
+ bn_mp_div_2d.${OBJEXT} \
+ bn_mp_div_3.${OBJEXT} \
+ bn_mp_exch.${OBJEXT} \
+ bn_mp_expt_d.${OBJEXT} \
+ bn_mp_grow.${OBJEXT} \
+ bn_mp_init.${OBJEXT} \
+ bn_mp_init_copy.${OBJEXT} \
+ bn_mp_init_multi.${OBJEXT} \
+ bn_mp_init_set.${OBJEXT} \
+ bn_mp_init_set_int.${OBJEXT} \
+ bn_mp_init_size.${OBJEXT} \
+ bn_mp_karatsuba_mul.${OBJEXT} \
+ bn_mp_karatsuba_sqr.$(OBJEXT) \
+ bn_mp_lshd.${OBJEXT} \
+ bn_mp_mod.${OBJEXT} \
+ bn_mp_mod_2d.${OBJEXT} \
+ bn_mp_mul.${OBJEXT} \
+ bn_mp_mul_2.${OBJEXT} \
+ bn_mp_mul_2d.${OBJEXT} \
+ bn_mp_mul_d.${OBJEXT} \
+ bn_mp_neg.${OBJEXT} \
+ bn_mp_or.${OBJEXT} \
+ bn_mp_radix_size.${OBJEXT} \
+ bn_mp_radix_smap.${OBJEXT} \
+ bn_mp_read_radix.${OBJEXT} \
+ bn_mp_rshd.${OBJEXT} \
+ bn_mp_set.${OBJEXT} \
+ bn_mp_set_int.${OBJEXT} \
+ bn_mp_shrink.${OBJEXT} \
+ bn_mp_sqr.${OBJEXT} \
+ bn_mp_sqrt.${OBJEXT} \
+ bn_mp_sub.${OBJEXT} \
+ bn_mp_sub_d.${OBJEXT} \
+ bn_mp_to_unsigned_bin.${OBJEXT} \
+ bn_mp_to_unsigned_bin_n.${OBJEXT} \
+ bn_mp_toom_mul.${OBJEXT} \
+ bn_mp_toom_sqr.${OBJEXT} \
+ bn_mp_toradix_n.${OBJEXT} \
+ bn_mp_unsigned_bin_size.${OBJEXT} \
+ bn_mp_xor.${OBJEXT} \
+ bn_mp_zero.${OBJEXT} \
+ bn_s_mp_add.${OBJEXT} \
+ bn_s_mp_mul_digs.${OBJEXT} \
+ bn_s_mp_sqr.${OBJEXT} \
+ bn_s_mp_sub.${OBJEXT}
+
+
WIN_OBJS = \
tclWin32Dll.$(OBJEXT) \
tclWinChan.$(OBJEXT) \
@@ -276,15 +354,11 @@ WIN_OBJS = \
tclWinFile.$(OBJEXT) \
tclWinInit.$(OBJEXT) \
tclWinLoad.$(OBJEXT) \
- tclWinMtherr.$(OBJEXT) \
tclWinNotify.$(OBJEXT) \
tclWinPipe.$(OBJEXT) \
tclWinSock.$(OBJEXT) \
tclWinThrd.$(OBJEXT) \
- tclWinTime.$(OBJEXT)
-
-COMPAT_OBJS = \
- strftime.$(OBJEXT) strtoll.$(OBJEXT) strtoull.$(OBJEXT)
+ tclWinTime.$(OBJEXT)
PIPE_OBJS = stub16.$(OBJEXT)
@@ -296,7 +370,7 @@ STUB_OBJS = tclStubLib.$(OBJEXT)
TCLSH_OBJS = tclAppInit.$(OBJEXT)
-TCL_OBJS = ${GENERIC_OBJS} ${WIN_OBJS} ${COMPAT_OBJS}
+TCL_OBJS = ${GENERIC_OBJS} $(TOMMATH_OBJS) ${WIN_OBJS}
TCL_DOCS = "$(ROOT_DIR_NATIVE)"/doc/*.[13n]
@@ -321,10 +395,12 @@ $(MAN2TCL): $(ROOT_DIR)/tools/man2tcl.c
$(TCLSH): $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE) $(TCLSH_OBJS) tclsh.$(RES)
$(CC) $(CFLAGS) $(TCLSH_OBJS) $(TCL_LIB_FILE) $(LIBS) \
tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE)
+ @VC_MANIFEST_EMBED_EXE@
$(TCLTEST): $(TCL_LIB_FILE) $(TCLTEST_OBJS) $(CAT32) tclsh.$(RES)
$(CC) $(CFLAGS) $(TCLTEST_OBJS) $(TCL_LIB_FILE) $(LIBS) \
tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE)
+ @VC_MANIFEST_EMBED_EXE@
cat32.$(OBJEXT): cat.c
$(CC) -c $(CC_SWITCHES) @DEPARG@ $(CC_OBJNAME)
@@ -332,8 +408,8 @@ cat32.$(OBJEXT): cat.c
$(CAT32): cat32.$(OBJEXT)
$(CC) $(CFLAGS) cat32.$(OBJEXT) $(CC_EXENAME) $(LIBS) $(LDFLAGS_CONSOLE)
-# The following targets are configured by autoconf to generate either
-# a shared library or static library
+# The following targets are configured by autoconf to generate either a shared
+# library or static library
${TCL_STUB_LIB_FILE}: ${STUB_OBJS}
@$(RM) ${TCL_STUB_LIB_FILE}
@@ -343,6 +419,7 @@ ${TCL_STUB_LIB_FILE}: ${STUB_OBJS}
${TCL_DLL_FILE}: ${TCL_OBJS} tcl.$(RES)
@$(RM) ${TCL_DLL_FILE}
@MAKE_DLL@ ${TCL_OBJS} tcl.$(RES) $(SHLIB_LD_LIBS)
+ @VC_MANIFEST_EMBED_DLL@
${TCL_LIB_FILE}: ${TCL_OBJS}
@$(RM) ${TCL_LIB_FILE}
@@ -365,14 +442,13 @@ ${REG_LIB_FILE}: ${REG_OBJS} ${TCL_LIB_FILE}
@$(RM) ${REG_LIB_FILE}
@MAKE_LIB@ ${REG_OBJS} ${TCL_LIB_FILE}
-# PIPE_DLL_FILE is actually an executable, don't build it
-# like a DLL.
+# PIPE_DLL_FILE is actually an executable, don't build it like a DLL.
${PIPE_DLL_FILE}: ${PIPE_OBJS}
@$(RM) ${PIPE_DLL_FILE}
@MAKE_EXE@ $(CFLAGS) ${PIPE_OBJS} $(LIBS) $(LDFLAGS_CONSOLE)
-# Add the object extension to the implicit rules. By default .obj is not
+# Add the object extension to the implicit rules. By default .obj is not
# automatically added.
.SUFFIXES: .${OBJEXT}
@@ -411,8 +487,32 @@ tclWinReg.${OBJEXT} : tclWinReg.c
tclWinDde.${OBJEXT} : tclWinDde.c
$(CC) -c $(CC_SWITCHES) -DUSE_TCL_STUBS @DEPARG@ $(CC_OBJNAME)
-# The following objects are part of the stub library and should not
-# be built as DLL objects but none of the symbols should be exported
+# TIP #59, embedding of configuration information into the binary library.
+#
+# Part of Tcl's configuration information are the paths where it was installed
+# and where it will look for its libraries (which can be different). We derive
+# this information from the variables which can be overridden by the user. As
+# every path can be configured separately we do not remember one general
+# prefix/exec_prefix but all the different paths individually.
+
+tclPkgConfig.${OBJEXT}: tclPkgConfig.c
+ $(CC) -c $(CC_SWITCHES) \
+ -DCFG_INSTALL_LIBDIR=\"$(LIB_INSTALL_DIR)\" \
+ -DCFG_INSTALL_BINDIR=\"$(BIN_INSTALL_DIR)\" \
+ -DCFG_INSTALL_SCRDIR=\"$(SCRIPT_INSTALL_DIR)\" \
+ -DCFG_INSTALL_INCDIR=\"$(INCLUDE_INSTALL_DIR)\" \
+ -DCFG_INSTALL_DOCDIR=\"$(MAN_INSTALL_DIR)\" \
+ \
+ -DCFG_RUNTIME_LIBDIR=\"$(libdir)\" \
+ -DCFG_RUNTIME_BINDIR=\"$(bindir)\" \
+ -DCFG_RUNTIME_SCRDIR=\"$(TCL_LIBRARY)\" \
+ -DCFG_RUNTIME_INCDIR=\"$(includedir)\" \
+ -DCFG_RUNTIME_DOCDIR=\"$(mandir)\" \
+ -DBUILD_tcl \
+ @DEPARG@ $(CC_OBJNAME)
+
+# The following objects are part of the stub library and should not be built
+# as DLL objects but none of the symbols should be exported
tclStubLib.${OBJEXT}: tclStubLib.c
$(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD @DEPARG@ $(CC_OBJNAME)
@@ -420,12 +520,32 @@ tclStubLib.${OBJEXT}: tclStubLib.c
# Implicit rule for all object files that will end up in the Tcl library
-.c.${OBJEXT}:
+%.${OBJEXT}: %.c
$(CC) -c $(CC_SWITCHES) -DBUILD_tcl @DEPARG@ $(CC_OBJNAME)
.rc.$(RES):
$(RC) @RC_OUT@ $@ @RC_TYPE@ @RC_DEFINES@ @RC_INCLUDE@ "$(GENERIC_DIR_NATIVE)" @RC_INCLUDE@ "$(WIN_DIR_NATIVE)" @DEPARG@
+# 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 so that make doesn't try to automatically regenerate
+# the .c file.
+
+gendate:
+ bison --output-file=$(GENERIC_DIR)/tclDate.c \
+ --name-prefix=TclDate \
+ --no-lines \
+ $(GENERIC_DIR)/tclGetDate.y
+
+# The following target generates the file generic/tclTomMath.h. It needs to be
+# run (and the results checked) after updating to a new release of libtommath.
+
+gentommath_h:
+ $(TCL_EXE) "$(ROOT_DIR_NATIVE)\tools\fix_tommath_h.tcl" \
+ "$(TOMMATH_DIR_NATIVE)\tommath.h" \
+ > "$(GENERIC_DIR_NATIVE)\tclTomMath.h"
+
install: all install-binaries install-libraries install-doc
install-binaries: binaries
@@ -438,7 +558,7 @@ install-binaries: binaries
else true; \
fi; \
done;
- @for i in dde1.2 reg1.1; \
+ @for i in dde1.3 reg1.2; \
do \
if [ ! -d $(LIB_INSTALL_DIR)/$$i ] ; then \
echo "Making directory $(LIB_INSTALL_DIR)/$$i"; \
@@ -462,26 +582,26 @@ install-binaries: binaries
done
@if [ -f $(DDE_DLL_FILE) ]; then \
echo installing $(DDE_DLL_FILE); \
- $(COPY) $(DDE_DLL_FILE) $(LIB_INSTALL_DIR)/dde1.2; \
+ $(COPY) $(DDE_DLL_FILE) $(LIB_INSTALL_DIR)/dde1.3; \
$(COPY) $(ROOT_DIR)/library/dde/pkgIndex.tcl \
- $(LIB_INSTALL_DIR)/dde1.2; \
+ $(LIB_INSTALL_DIR)/dde1.3; \
fi
@if [ -f $(DDE_LIB_FILE) ]; then \
echo installing $(DDE_LIB_FILE); \
- $(COPY) $(DDE_LIB_FILE) $(LIB_INSTALL_DIR)/dde1.2; \
+ $(COPY) $(DDE_LIB_FILE) $(LIB_INSTALL_DIR)/dde1.3; \
fi
@if [ -f $(REG_DLL_FILE) ]; then \
echo installing $(REG_DLL_FILE); \
- $(COPY) $(REG_DLL_FILE) $(LIB_INSTALL_DIR)/reg1.1; \
+ $(COPY) $(REG_DLL_FILE) $(LIB_INSTALL_DIR)/reg1.2; \
$(COPY) $(ROOT_DIR)/library/reg/pkgIndex.tcl \
- $(LIB_INSTALL_DIR)/reg1.1; \
+ $(LIB_INSTALL_DIR)/reg1.2; \
fi
@if [ -f $(REG_LIB_FILE) ]; then \
echo installing $(REG_LIB_FILE); \
- $(COPY) $(REG_LIB_FILE) $(LIB_INSTALL_DIR)/reg1.1; \
+ $(COPY) $(REG_LIB_FILE) $(LIB_INSTALL_DIR)/reg1.2; \
fi
-install-libraries: libraries
+install-libraries: libraries install-tzdata install-msgs
@for i in $(prefix)/lib $(INCLUDE_INSTALL_DIR) \
$(SCRIPT_INSTALL_DIR); \
do \
@@ -491,7 +611,7 @@ install-libraries: libraries
else true; \
fi; \
done;
- @for i in platform http1.0 http2.5 opt0.4 encoding msgcat1.3 tcltest2.2; \
+ @for i in http1.0 opt0.4 encoding ../tcl8 ../tcl8/8.4 ../tcl8/8.4/platform ../tcl8/8.5; \
do \
if [ ! -d $(SCRIPT_INSTALL_DIR)/$$i ] ; then \
echo "Making directory $(SCRIPT_INSTALL_DIR)/$$i"; \
@@ -501,7 +621,9 @@ install-libraries: libraries
done;
@echo "Installing header files";
@for i in "$(GENERIC_DIR)/tcl.h" "$(GENERIC_DIR)/tclDecls.h" \
- "$(GENERIC_DIR)/tclPlatDecls.h" ; \
+ "$(GENERIC_DIR)/tclPlatDecls.h" \
+ "$(GENERIC_DIR)/tclTomMath.h" \
+ "$(GENERIC_DIR)/tclTomMathDecls.h"; \
do \
$(COPY) "$$i" "$(INCLUDE_INSTALL_DIR)"; \
done;
@@ -510,41 +632,43 @@ install-libraries: libraries
do \
$(COPY) "$$i" "$(SCRIPT_INSTALL_DIR)"; \
done;
- @echo "Installing library platform directory";
- @for j in $(ROOT_DIR)/library/platform/*.tcl; \
- do \
- $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/platform"; \
- done;
@echo "Installing library http1.0 directory";
@for j in $(ROOT_DIR)/library/http1.0/*.tcl; \
do \
$(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/http1.0"; \
done;
- @echo "Installing library http2.5 directory";
- @for j in $(ROOT_DIR)/library/http/*.tcl; \
- do \
- $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/http2.5"; \
- 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 library opt0.4 directory";
@for j in $(ROOT_DIR)/library/opt/*.tcl; \
do \
$(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/opt0.4"; \
done;
- @echo "Installing library msgcat1.3 directory";
- @for j in $(ROOT_DIR)/library/msgcat/*.tcl; \
- do \
- $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/msgcat1.3"; \
- done;
- @echo "Installing library tcltest2.2 directory";
- @for j in $(ROOT_DIR)/library/tcltest/*.tcl; \
- do \
- $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/tcltest2.2"; \
- done;
+ @echo "Installing package msgcat 1.4.4 as a Tcl Module";
+ @$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/msgcat-1.4.4.tm;
+ @echo "Installing package tcltest 2.3.4 as a Tcl Module";
+ @$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/tcltest-2.3.4.tm;
+ @echo "Installing package platform 1.0.10 as a Tcl Module";
+ @$(COPY) $(ROOT_DIR)/library/platform/platform.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/platform-1.0.10.tm;
+ @echo "Installing package platform::shell 1.1.4 as a Tcl Module";
+ @$(COPY) $(ROOT_DIR)/library/platform/shell.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/platform/shell-1.1.4.tm;
@echo "Installing encodings";
@for i in $(ROOT_DIR)/library/encoding/*.enc ; do \
$(COPY) "$$i" "$(SCRIPT_INSTALL_DIR)/encoding"; \
done;
+install-tzdata:
+ @echo "Installing time zone data"
+ @TCL_LIBRARY="${LIBRARY_DIR}"; export TCL_LIBRARY; \
+ ./$(TCLSH) "$(ROOT_DIR)/tools/installData.tcl" \
+ "$(ROOT_DIR)/library/tzdata" "$(SCRIPT_INSTALL_DIR)/tzdata"
+
+install-msgs:
+ @echo "Installing message catalogs"
+ @TCL_LIBRARY="${LIBRARY_DIR}"; export TCL_LIBRARY; \
+ ./$(TCLSH) "$(ROOT_DIR)/tools/installData.tcl" \
+ "$(ROOT_DIR)/library/msgs" "$(SCRIPT_INSTALL_DIR)/msgs"
+
install-doc: doc
# Optional target to install private headers
@@ -554,11 +678,10 @@ install-private-headers: libraries
if [ ! -d $$i ] ; then \
echo "Making directory $$i"; \
$(MKDIR) $$i; \
- chmod 755 $$i; \
else true; \
fi; \
done;
- @echo "Installing private header files to $(PRIVATE_INCLUDE_INSTALL_DIR)/";
+ @echo "Installing private header files";
@for i in "$(GENERIC_DIR)/tclInt.h" "$(GENERIC_DIR)/tclIntDecls.h" \
"$(GENERIC_DIR)/tclIntPlatDecls.h" "$(GENERIC_DIR)/tclPort.h" \
"$(WIN_DIR)/tclWinPort.h" ; \
@@ -566,22 +689,24 @@ install-private-headers: libraries
$(COPY) "$$i" "$(PRIVATE_INCLUDE_INSTALL_DIR)"; \
done;
-# Specifying TESTFLAGS on the command line is the standard way to pass
-# args to tcltest, ie:
+# Specifying TESTFLAGS on the command line is the standard way to pass args to
+# tcltest, i.e.:
# % make test TESTFLAGS="-verbose bps -file fileName.test"
test: binaries $(TCLTEST)
TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \
./$(TCLTEST) "$(ROOT_DIR_NATIVE)/tests/all.tcl" $(TESTFLAGS) \
- | ./$(CAT32)
+ -load "set ::ddelib [file normalize ${DDE_DLL_FILE}]; \
+ set ::reglib [file normalize ${REG_DLL_FILE}]" | ./$(CAT32)
# Useful target to launch a built tcltest with the proper path,...
runtest: binaries $(TCLTEST)
@TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \
- ./$(TCLTEST) $(TESTFLAGS) $(SCRIPT)
+ ./$(TCLTEST) $(TESTFLAGS) -load "set ::ddelib [file normalize ${DDE_DLL_FILE}]; \
+ set ::reglib [file normalize ${REG_DLL_FILE}]" $(SCRIPT)
-# This target can be used to run tclsh from the build directory
-# via `make shell SCRIPT=foo.tcl`
+# This target can be used to run tclsh from the build directory via
+# `make shell SCRIPT=foo.tcl`
shell: binaries
@TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \
./$(TCLSH) $(SCRIPT)
@@ -589,7 +714,7 @@ shell: binaries
# This target can be used to run tclsh inside either gdb or insight
gdb: binaries
@echo "set env TCL_LIBRARY=$(LIBRARY_DIR)" > gdb.run
- gdb ./tclsh --command=gdb.run
+ gdb ./$(TCLSH) --command=gdb.run
rm gdb.run
depend:
@@ -607,7 +732,7 @@ clean: cleanhelp
distclean: clean
$(RM) Makefile config.status config.cache config.log tclConfig.sh \
- tcl.hpj
+ tcl.hpj config.status.lineno
#
# Regenerate the stubs files.
@@ -623,4 +748,5 @@ 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"
diff --git a/win/README b/win/README
index 5e3d00f..1929362 100644
--- a/win/README
+++ b/win/README
@@ -1,4 +1,4 @@
-Tcl 8.4 for Windows
+Tcl 8.5 for Windows
1. Introduction
---------------
@@ -16,7 +16,7 @@ The information in this file is maintained on the web at:
In order to compile Tcl for Windows, you need the following:
- Tcl 8.4 Source Distribution (plus any patches)
+ Tcl 8.5 Source Distribution (plus any patches)
and
@@ -51,9 +51,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 tclsh84.exe, you must ensure that tcl84.dll
-and tclpip84.dll are on your path, in the system directory, or in the
-directory containing tclsh84.exe.
+Note that in order to run tclsh85.exe, you must ensure that tcl85.dll is on
+your path, in the system directory, or in the directory containing
+tclsh85.exe.
Note: Tcl no longer provides support for Win32s.
diff --git a/win/README.binary b/win/README.binary
deleted file mode 100644
index 8388235..0000000
--- a/win/README.binary
+++ /dev/null
@@ -1,141 +0,0 @@
-Tcl/Tk 8.4 for Windows, Binary Distribution
-
-1. Introduction
----------------
-
-This directory contains the binary distribution of Tcl/Tk 8.4.19 for
-Windows. It was compiled with Microsoft Visual C++ 6.0 using Win32
-API, so that it will run under Windows NT, 95, 98 and 2000.
-
-Tcl provides a powerful platform for creating integration applications
-that tie together diverse applications, protocols, devices, and
-frameworks. When paired with the Tk toolkit, Tcl provides the fastest
-and most powerful way to create GUI applications that run on PCs, Unix,
-and the Macintosh. Tcl can also be used for a variety of web-related
-tasks and for creating powerful command languages for applications.
-
-Tcl is maintained, enhanced, and distributed freely by the Tcl community.
-
-2. Documentation
-----------------
-
-The home of Tcl and Tk sources and bug database on the Web is at:
- http://tcl.sourceforge.net/
-
-The home page for the Tcl Developer Xchange is at:
- http://www.tcl.tk/
-
-The home page for the Tcl/Tk 8.4 release is
- http://www.tcl.tk/software/tcltk/8.4.html
-
-Detailed release notes can be found at the file distributions page
-by clicking on the relevant version.
- http://sourceforge.net/project/showfiles.php?group_id=10894
-
-Information about Tcl itself can be found at
- http://www.tcl.tk/scripting/
-
-There are many Tcl books on the market. Most are listed at
- http://www.tcl.tk/resource/doc/books/
-
-There are notes about compiling Tcl at
- http://www.tcl.tk/doc/howto/compile.html
-
-3. Installation
----------------
-
-The binary release is distributed as a self-extracting archive called
-tcl<version>.exe. The setup program which will prompt you for an
-installation directory. It will create the installation heirarchy
-under the specified directory, and install a wish application icon
-under the program manager group of your choice.
-
-We are no longer supporting use of Tcl with 16-bit versions of
-Windows. Microsoft has completely dropped support of the Win32s
-subsystem.
-
-4. Linking against the binary release
---------------------------------------
-
-In order to link your applications against the .dll files shipped with
-this release, you will need to use the appropriate .lib file for your
-compiler. In the lib directory of the installation directory, there
-are library files for the Microsoft Visual C++ compiler:
-
- tcl84.lib
- tk84.lib
-
-5. Building dynamically loadable extensions
---------------------------------------------
-
-Please refer to the example dynamically loadable extension provided on
-our ftp site:
-
- ftp://ftp.scriptics.com/pub/tcl/misc/example.zip
-
-This archive contains a template that you can use for building
-extensions that will be loadable on Unix, Windows, and Macintosh
-systems.
-
-6. Reporting Bugs
------------------
-If you have comments or bug reports for the Windows version of Tcl,
-please use our online database at:
-
- http://tcl.sourceforge.net/
-
-or post them to the newsgroup comp.lang.tcl.
-
-7. Tcl newsgroup
------------------
-
-There is a network news group "comp.lang.tcl" intended for the exchange
-of information about Tcl, Tk, and related applications. Feel free to use
-the newsgroup both for general information questions and for bug reports.
-We read the newsgroup and will attempt to fix bugs and problems reported
-to it.
-
-When using comp.lang.tcl, please be sure that your e-mail return address
-is correctly set in your postings. This allows people to respond directly
-to you, rather than the entire newsgroup, for answers that are not of
-general interest. A bad e-mail return address may prevent you from
-getting answers to your questions. You may have to reconfigure your news
-reading software to ensure that it is supplying valid e-mail addresses.
-
-8. Tcl contributed archive
---------------------------
-
-Many people have created exciting packages and applications based on Tcl
-and/or Tk and made them freely available to the Tcl community. An archive
-of these contributions is kept on the machine ftp.neosoft.com. You
-can access the archive using anonymous FTP; the Tcl contributed archive is
-in the directory "/pub/tcl". The archive also contains several FAQ
-("frequently asked questions") documents that provide solutions to problems
-that are commonly encountered by TCL newcomers.
-
-9. Tcl Resource Center
-----------------------
-
-Visit http://www.tcl.tk/resource/ to see an annotated index of
-many Tcl resources available on the World Wide Web. This includes papers,
-books, and FAQs, as well as extensions, applications, binary releases, and
-patches. You can contribute patches by using the Tracker at
-
- http://tcl.sourceforge.net/
-
-You can also recommend more URLs for the resource center using the forms
-labeled "Add a Resource".
-
-10. Mailing lists
-----------------
-
-Several mailing lists are hosted at SourceForge to discuss development or
-use issues (like Macintosh and Windows topics). For more information and
-to subscribe, visit:
-
- http://sourceforge.net/projects/tcl/
-
-and go to the Mailing Lists page. There are also Special Interest Groups
-(SIGs) setup for these topics and more at:
-
- http://www.tcl.tk/
diff --git a/win/buildall.vc.bat b/win/buildall.vc.bat
index 383e774..55b29ae 100755..100644
--- a/win/buildall.vc.bat
+++ b/win/buildall.vc.bat
@@ -1,56 +1,123 @@
@echo off
-
:: This is an example batchfile for building everything. Please
:: edit this (or make your own) for your needs and wants using
:: the instructions for calling makefile.vc found in makefile.vc
+set SYMBOLS=
+
+:OPTIONS
+if "%1" == "/?" goto help
+if /i "%1" == "/help" goto help
+if %1.==symbols. goto SYMBOLS
+if %1.==debug. goto SYMBOLS
+goto OPTIONS_DONE
+
+:SYMBOLS
+ set SYMBOLS=symbols
+ shift
+ goto OPTIONS
+
+:OPTIONS_DONE
+
+:: reset errorlevel
+cd > nul
+
+:: 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.
+::
+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
+)
+
+
+echo.
echo Sit back and have a cup of coffee while this grinds through ;)
echo You asked for *everything*, remember?
echo.
-
title Building Tcl, please wait...
-if "%MSVCDir%" == "" call c:\dev\devstudio60\vc98\bin\vcvars32.bat
-::if "%MSVCDir%" == "" call "C:\Program Files\Microsoft Developer Studio\vc98\bin\vcvars32.bat"
-set INSTALLDIR=C:\Program Files\Tcl
+
+:: makefile.vc uses this for its default anyways, but show its use here
+:: just to be explicit and convey understanding to the user. Setting
+:: the INSTALLDIR envar prior to running this batchfile affects all builds.
+::
+if "%INSTALLDIR%" == "" set INSTALLDIR=C:\Program Files\Tcl
+
:: Build the normal stuff along with the help file.
::
-nmake -nologo -f makefile.vc release winhelp OPTS=none
+set OPTS=none
+if not %SYMBOLS%.==. set OPTS=symbols
+nmake -nologo -f makefile.vc release winhelp OPTS=%OPTS% %1
if errorlevel 1 goto error
:: Build the static core, dlls and shell.
::
-nmake -nologo -f makefile.vc release OPTS=static
+set OPTS=static
+if not %SYMBOLS%.==. set OPTS=symbols,static
+nmake -nologo -f makefile.vc release OPTS=%OPTS% %1
if errorlevel 1 goto error
:: Build the special static libraries that use the dynamic runtime.
::
-nmake -nologo -f makefile.vc core dlls OPTS=static,msvcrt
+set OPTS=static,msvcrt
+if not %SYMBOLS%.==. set OPTS=symbols,static,msvcrt
+nmake -nologo -f makefile.vc core dlls OPTS=%OPTS% %1
if errorlevel 1 goto error
:: Build the core and shell for thread support.
::
-nmake -nologo -f makefile.vc shell OPTS=threads
+set OPTS=threads
+if not %SYMBOLS%.==. set OPTS=symbols,threads
+nmake -nologo -f makefile.vc shell OPTS=%OPTS% %1
if errorlevel 1 goto error
-:: Build a static, thread support core library (no shell).
+:: Build a static, thread support core library with a shell.
::
-nmake -nologo -f makefile.vc core OPTS=static,threads
+set OPTS=static,threads
+if not %SYMBOLS%.==. set OPTS=symbols,static,threads
+nmake -nologo -f makefile.vc shell OPTS=%OPTS% %1
if errorlevel 1 goto error
-:: Build the special static libraries the use the dynamic runtime,
+:: Build the special static libraries that use the dynamic runtime,
:: but now with thread support.
::
-nmake -nologo -f makefile.vc core dlls OPTS=static,msvcrt,threads
+set OPTS=static,msvcrt,threads
+if not %SYMBOLS%.==. set OPTS=symbols,static,msvcrt,threads
+nmake -nologo -f makefile.vc core dlls OPTS=%OPTS% %1
if errorlevel 1 goto error
+set OPTS=
+set SYMBOLS=
goto end
:error
echo *** BOOM! ***
+goto end
+
+:no_vcvars
+echo vcvars32.bat not found. You'll need to edit this batch script.
+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 symbols install : install all the debug builds.
+echo.
+goto out
:end
-title Building Tcl, please wait...DONE!
+title Building Tcl, please wait... DONE!
echo DONE!
+goto out
+
+:out
pause
+title Command Prompt
diff --git a/win/cat.c b/win/cat.c
index 834461e..d413923 100644
--- a/win/cat.c
+++ b/win/cat.c
@@ -14,11 +14,11 @@
#include <string.h>
int
-main()
-{
+main(void)
+{
char buf[1024];
int n;
- char *err;
+ const char *err;
while (1) {
n = read(0, buf, sizeof(buf));
@@ -32,4 +32,3 @@ main()
return 0;
}
-
diff --git a/win/coffbase.txt b/win/coffbase.txt
index 35dac3d..8d3f84b 100644
--- a/win/coffbase.txt
+++ b/win/coffbase.txt
@@ -22,4 +22,12 @@ itk 0x10580000 0x00080000
bltlite 0x10600000 0x00080000
blt 0x10680000 0x00080000
iocpsock 0x10700000 0x00080000
-tls 0x10780000 0x00080000
+tls 0x10780000 0x00100000
+winico 0x10880000 0x00010000
+tile 0x10900000 0x00080000
+memchan 0x109D0000 0x00010000
+tdom 0x109E0000 0x00080000
+tkvideo 0x10B00000 0x00010000
+snack 0x1E000000 0x00400000
+sound 0x1E400000 0x00400000
+snackogg 0x1E800000 0x00200000
diff --git a/win/configure b/win/configure
index 062e8a4..fd09f73 100755
--- a/win/configure
+++ b/win/configure
@@ -1,38 +1,325 @@
#! /bin/sh
-
# Guess values for system-dependent variables and create Makefiles.
-# Generated automatically using autoconf version 2.13
-# Copyright (C) 1992, 93, 94, 95, 96 Free Software Foundation, Inc.
+# Generated by GNU Autoconf 2.59.
#
+# Copyright (C) 2003 Free Software Foundation, Inc.
# This configure script is free software; the Free Software Foundation
# gives unlimited permission to copy, distribute and modify it.
+## --------------------- ##
+## M4sh Initialization. ##
+## --------------------- ##
+
+# Be Bourne compatible
+if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then
+ emulate sh
+ NULLCMD=:
+ # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which
+ # is contrary to our usage. Disable this feature.
+ alias -g '${1+"$@"}'='"$@"'
+elif test -n "${BASH_VERSION+set}" && (set -o posix) >/dev/null 2>&1; then
+ set -o posix
+fi
+DUALCASE=1; export DUALCASE # for MKS sh
+
+# Support unset when possible.
+if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then
+ as_unset=unset
+else
+ as_unset=false
+fi
+
+
+# Work around bugs in pre-3.0 UWIN ksh.
+$as_unset ENV MAIL MAILPATH
+PS1='$ '
+PS2='> '
+PS4='+ '
+
+# NLS nuisances.
+for as_var in \
+ LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \
+ LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \
+ LC_TELEPHONE LC_TIME
+do
+ if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then
+ eval $as_var=C; export $as_var
+ else
+ $as_unset $as_var
+ fi
+done
+
+# Required to use basename.
+if expr a : '\(a\)' >/dev/null 2>&1; then
+ as_expr=expr
+else
+ as_expr=false
+fi
+
+if (basename /) >/dev/null 2>&1 && test "X`basename / 2>&1`" = "X/"; then
+ as_basename=basename
+else
+ as_basename=false
+fi
+
+
+# Name of the executable.
+as_me=`$as_basename "$0" ||
+$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \
+ X"$0" : 'X\(//\)$' \| \
+ X"$0" : 'X\(/\)$' \| \
+ . : '\(.\)' 2>/dev/null ||
+echo X/"$0" |
+ sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/; q; }
+ /^X\/\(\/\/\)$/{ s//\1/; q; }
+ /^X\/\(\/\).*/{ s//\1/; q; }
+ s/.*/./; q'`
+
+
+# PATH needs CR, and LINENO needs CR and PATH.
+# Avoid depending upon Character Ranges.
+as_cr_letters='abcdefghijklmnopqrstuvwxyz'
+as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ'
+as_cr_Letters=$as_cr_letters$as_cr_LETTERS
+as_cr_digits='0123456789'
+as_cr_alnum=$as_cr_Letters$as_cr_digits
+
+# The user is always right.
+if test "${PATH_SEPARATOR+set}" != set; then
+ echo "#! /bin/sh" >conf$$.sh
+ echo "exit 0" >>conf$$.sh
+ chmod +x conf$$.sh
+ if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then
+ PATH_SEPARATOR=';'
+ else
+ PATH_SEPARATOR=:
+ fi
+ rm -f conf$$.sh
+fi
+
+
+ as_lineno_1=$LINENO
+ as_lineno_2=$LINENO
+ as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null`
+ test "x$as_lineno_1" != "x$as_lineno_2" &&
+ test "x$as_lineno_3" = "x$as_lineno_2" || {
+ # Find who we are. Look in the path if we contain no path at all
+ # relative or not.
+ case $0 in
+ *[\\/]* ) as_myself=$0 ;;
+ *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break
+done
+
+ ;;
+ esac
+ # We did not find ourselves, most probably we were run as `sh COMMAND'
+ # in which case we are not to be found in the path.
+ if test "x$as_myself" = x; then
+ as_myself=$0
+ fi
+ if test ! -f "$as_myself"; then
+ { echo "$as_me: error: cannot find myself; rerun with an absolute path" >&2
+ { (exit 1); exit 1; }; }
+ fi
+ case $CONFIG_SHELL in
+ '')
+ as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for as_base in sh bash ksh sh5; do
+ case $as_dir in
+ /*)
+ if ("$as_dir/$as_base" -c '
+ as_lineno_1=$LINENO
+ as_lineno_2=$LINENO
+ as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null`
+ test "x$as_lineno_1" != "x$as_lineno_2" &&
+ test "x$as_lineno_3" = "x$as_lineno_2" ') 2>/dev/null; then
+ $as_unset BASH_ENV || test "${BASH_ENV+set}" != set || { BASH_ENV=; export BASH_ENV; }
+ $as_unset ENV || test "${ENV+set}" != set || { ENV=; export ENV; }
+ CONFIG_SHELL=$as_dir/$as_base
+ export CONFIG_SHELL
+ exec "$CONFIG_SHELL" "$0" ${1+"$@"}
+ fi;;
+ esac
+ done
+done
+;;
+ esac
+
+ # Create $as_me.lineno as a copy of $as_myself, but with $LINENO
+ # uniformly replaced by the line number. The first 'sed' inserts a
+ # line-number line before each line; the second 'sed' does the real
+ # work. The second script uses 'N' to pair each line-number line
+ # with the numbered line, and appends trailing '-' during
+ # substitution so that $LINENO is not a special case at line end.
+ # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the
+ # second 'sed' script. Blame Lee E. McMahon for sed's syntax. :-)
+ sed '=' <$as_myself |
+ sed '
+ N
+ s,$,-,
+ : loop
+ s,^\(['$as_cr_digits']*\)\(.*\)[$]LINENO\([^'$as_cr_alnum'_]\),\1\2\1\3,
+ t loop
+ s,-$,,
+ s,^['$as_cr_digits']*\n,,
+ ' >$as_me.lineno &&
+ chmod +x $as_me.lineno ||
+ { echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2
+ { (exit 1); exit 1; }; }
+
+ # Don't try to exec as it changes $[0], causing all sort of problems
+ # (the dirname of $[0] is not the place where we might find the
+ # original and so on. Autoconf is especially sensible to this).
+ . ./$as_me.lineno
+ # Exit status is that of the last command.
+ exit
+}
+
+
+case `echo "testing\c"; echo 1,2,3`,`echo -n testing; echo 1,2,3` in
+ *c*,-n*) ECHO_N= ECHO_C='
+' ECHO_T=' ' ;;
+ *c*,* ) ECHO_N=-n ECHO_C= ECHO_T= ;;
+ *) ECHO_N= ECHO_C='\c' ECHO_T= ;;
+esac
+
+if expr a : '\(a\)' >/dev/null 2>&1; then
+ as_expr=expr
+else
+ as_expr=false
+fi
+
+rm -f conf$$ conf$$.exe conf$$.file
+echo >conf$$.file
+if ln -s conf$$.file conf$$ 2>/dev/null; then
+ # We could just check for DJGPP; but this test a) works b) is more generic
+ # and c) will remain valid once DJGPP supports symlinks (DJGPP 2.04).
+ if test -f conf$$.exe; then
+ # Don't use ln at all; we don't have any links
+ as_ln_s='cp -p'
+ else
+ as_ln_s='ln -s'
+ fi
+elif ln conf$$.file conf$$ 2>/dev/null; then
+ as_ln_s=ln
+else
+ as_ln_s='cp -p'
+fi
+rm -f conf$$ conf$$.exe conf$$.file
+
+if mkdir -p . 2>/dev/null; then
+ as_mkdir_p=:
+else
+ test -d ./-p && rmdir ./-p
+ as_mkdir_p=false
+fi
+
+as_executable_p="test -f"
+
+# Sed expression to map a string onto a valid CPP name.
+as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"
+
+# Sed expression to map a string onto a valid variable name.
+as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'"
+
+
+# IFS
+# We need space, tab and new line, in precisely that order.
+as_nl='
+'
+IFS=" $as_nl"
+
+# CDPATH.
+$as_unset CDPATH
+
-# Defaults:
-ac_help=
+# Name of the host.
+# hostname on some systems (SVR3.2, Linux) returns a bogus exit status,
+# so uname gets run too.
+ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q`
+
+exec 6>&1
+
+#
+# Initializations.
+#
ac_default_prefix=/usr/local
-# Any additions from configure.in:
-ac_help="$ac_help
- --enable-threads build with threads"
-ac_help="$ac_help
- --enable-shared build and link with shared libraries [--enable-shared]"
-ac_help="$ac_help
- --enable-64bit enable 64bit support (where applicable)"
-ac_help="$ac_help
- --enable-wince enable Win/CE support (where applicable)"
-ac_help="$ac_help
- --with-celib=DIR use Windows/CE support library from DIR"
-ac_help="$ac_help
- --enable-symbols build with debugging symbols [--disable-symbols]"
+ac_config_libobj_dir=.
+cross_compiling=no
+subdirs=
+MFLAGS=
+MAKEFLAGS=
+SHELL=${CONFIG_SHELL-/bin/sh}
+
+# Maximum number of lines to put in a shell here document.
+# This variable seems obsolete. It should probably be removed, and
+# only ac_max_sed_lines should be used.
+: ${ac_max_here_lines=38}
+
+# Identity of this package.
+PACKAGE_NAME=
+PACKAGE_TARNAME=
+PACKAGE_VERSION=
+PACKAGE_STRING=
+PACKAGE_BUGREPORT=
+
+ac_unique_file="../generic/tcl.h"
+# Factoring default headers for most tests.
+ac_includes_default="\
+#include <stdio.h>
+#if HAVE_SYS_TYPES_H
+# include <sys/types.h>
+#endif
+#if HAVE_SYS_STAT_H
+# include <sys/stat.h>
+#endif
+#if STDC_HEADERS
+# include <stdlib.h>
+# include <stddef.h>
+#else
+# if HAVE_STDLIB_H
+# include <stdlib.h>
+# endif
+#endif
+#if HAVE_STRING_H
+# if !STDC_HEADERS && HAVE_MEMORY_H
+# include <memory.h>
+# endif
+# include <string.h>
+#endif
+#if HAVE_STRINGS_H
+# include <strings.h>
+#endif
+#if HAVE_INTTYPES_H
+# include <inttypes.h>
+#else
+# if HAVE_STDINT_H
+# include <stdint.h>
+# endif
+#endif
+#if HAVE_UNISTD_H
+# 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_files=''
# Initialize some variables set by options.
+ac_init_help=
+ac_init_version=false
# The variables have the same names as the options, with
# dashes changed to underlines.
-build=NONE
-cache_file=./config.cache
+cache_file=/dev/null
exec_prefix=NONE
-host=NONE
no_create=
-nonopt=NONE
no_recursion=
prefix=NONE
program_prefix=NONE
@@ -41,10 +328,15 @@ program_transform_name=s,x,x,
silent=
site=
srcdir=
-target=NONE
verbose=
x_includes=NONE
x_libraries=NONE
+
+# Installation directory options.
+# These are left unexpanded so users can "make install exec_prefix=/foo"
+# and all the variables that are supposed to be based on exec_prefix
+# by default will actually change.
+# Use braces instead of parens because sh, perl, etc. also accept them.
bindir='${exec_prefix}/bin'
sbindir='${exec_prefix}/sbin'
libexecdir='${exec_prefix}/libexec'
@@ -58,17 +350,9 @@ oldincludedir='/usr/include'
infodir='${prefix}/info'
mandir='${prefix}/man'
-# Initialize some other variables.
-subdirs=
-MFLAGS= MAKEFLAGS=
-SHELL=${CONFIG_SHELL-/bin/sh}
-# Maximum number of lines to put in a shell here document.
-ac_max_here_lines=12
-
ac_prev=
for ac_option
do
-
# If the previous option needs an argument, assign it.
if test -n "$ac_prev"; then
eval "$ac_prev=\$ac_option"
@@ -76,59 +360,59 @@ do
continue
fi
- case "$ac_option" in
- -*=*) ac_optarg=`echo "$ac_option" | sed 's/[-_a-zA-Z0-9]*=//'` ;;
- *) ac_optarg= ;;
- esac
+ ac_optarg=`expr "x$ac_option" : 'x[^=]*=\(.*\)'`
# Accept the important Cygnus configure options, so we can diagnose typos.
- case "$ac_option" in
+ case $ac_option in
-bindir | --bindir | --bindi | --bind | --bin | --bi)
ac_prev=bindir ;;
-bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*)
- bindir="$ac_optarg" ;;
+ bindir=$ac_optarg ;;
-build | --build | --buil | --bui | --bu)
- ac_prev=build ;;
+ ac_prev=build_alias ;;
-build=* | --build=* | --buil=* | --bui=* | --bu=*)
- build="$ac_optarg" ;;
+ build_alias=$ac_optarg ;;
-cache-file | --cache-file | --cache-fil | --cache-fi \
| --cache-f | --cache- | --cache | --cach | --cac | --ca | --c)
ac_prev=cache_file ;;
-cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \
| --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*)
- cache_file="$ac_optarg" ;;
+ cache_file=$ac_optarg ;;
+
+ --config-cache | -C)
+ cache_file=config.cache ;;
-datadir | --datadir | --datadi | --datad | --data | --dat | --da)
ac_prev=datadir ;;
-datadir=* | --datadir=* | --datadi=* | --datad=* | --data=* | --dat=* \
| --da=*)
- datadir="$ac_optarg" ;;
+ datadir=$ac_optarg ;;
-disable-* | --disable-*)
- ac_feature=`echo $ac_option|sed -e 's/-*disable-//'`
+ ac_feature=`expr "x$ac_option" : 'x-*disable-\(.*\)'`
# Reject names that are not valid shell variable names.
- if test -n "`echo $ac_feature| sed 's/[-a-zA-Z0-9_]//g'`"; then
- { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; }
- fi
- ac_feature=`echo $ac_feature| sed 's/-/_/g'`
- eval "enable_${ac_feature}=no" ;;
+ expr "x$ac_feature" : ".*[^-_$as_cr_alnum]" >/dev/null &&
+ { echo "$as_me: error: invalid feature name: $ac_feature" >&2
+ { (exit 1); exit 1; }; }
+ ac_feature=`echo $ac_feature | sed 's/-/_/g'`
+ eval "enable_$ac_feature=no" ;;
-enable-* | --enable-*)
- ac_feature=`echo $ac_option|sed -e 's/-*enable-//' -e 's/=.*//'`
+ ac_feature=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'`
# Reject names that are not valid shell variable names.
- if test -n "`echo $ac_feature| sed 's/[-_a-zA-Z0-9]//g'`"; then
- { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; }
- fi
- ac_feature=`echo $ac_feature| sed 's/-/_/g'`
- case "$ac_option" in
- *=*) ;;
+ expr "x$ac_feature" : ".*[^-_$as_cr_alnum]" >/dev/null &&
+ { echo "$as_me: error: invalid feature name: $ac_feature" >&2
+ { (exit 1); exit 1; }; }
+ ac_feature=`echo $ac_feature | sed 's/-/_/g'`
+ case $ac_option in
+ *=*) ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`;;
*) ac_optarg=yes ;;
esac
- eval "enable_${ac_feature}='$ac_optarg'" ;;
+ eval "enable_$ac_feature='$ac_optarg'" ;;
-exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \
| --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \
@@ -137,95 +421,47 @@ do
-exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \
| --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \
| --exec=* | --exe=* | --ex=*)
- exec_prefix="$ac_optarg" ;;
+ exec_prefix=$ac_optarg ;;
-gas | --gas | --ga | --g)
# Obsolete; use --with-gas.
with_gas=yes ;;
- -help | --help | --hel | --he)
- # Omit some internal or obsolete options to make the list less imposing.
- # This message is too long to be a string in the A/UX 3.1 sh.
- cat << EOF
-Usage: configure [options] [host]
-Options: [defaults in brackets after descriptions]
-Configuration:
- --cache-file=FILE cache test results in FILE
- --help print this message
- --no-create do not create output files
- --quiet, --silent do not print \`checking...' messages
- --version print the version of autoconf that created configure
-Directory and file names:
- --prefix=PREFIX install architecture-independent files in PREFIX
- [$ac_default_prefix]
- --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX
- [same as prefix]
- --bindir=DIR user executables in DIR [EPREFIX/bin]
- --sbindir=DIR system admin executables in DIR [EPREFIX/sbin]
- --libexecdir=DIR program executables in DIR [EPREFIX/libexec]
- --datadir=DIR read-only architecture-independent data in DIR
- [PREFIX/share]
- --sysconfdir=DIR read-only single-machine data in DIR [PREFIX/etc]
- --sharedstatedir=DIR modifiable architecture-independent data in DIR
- [PREFIX/com]
- --localstatedir=DIR modifiable single-machine data in DIR [PREFIX/var]
- --libdir=DIR object code libraries in DIR [EPREFIX/lib]
- --includedir=DIR C header files in DIR [PREFIX/include]
- --oldincludedir=DIR C header files for non-gcc in DIR [/usr/include]
- --infodir=DIR info documentation in DIR [PREFIX/info]
- --mandir=DIR man documentation in DIR [PREFIX/man]
- --srcdir=DIR find the sources in DIR [configure dir or ..]
- --program-prefix=PREFIX prepend PREFIX to installed program names
- --program-suffix=SUFFIX append SUFFIX to installed program names
- --program-transform-name=PROGRAM
- run sed PROGRAM on installed program names
-EOF
- cat << EOF
-Host type:
- --build=BUILD configure for building on BUILD [BUILD=HOST]
- --host=HOST configure for HOST [guessed]
- --target=TARGET configure for TARGET [TARGET=HOST]
-Features and packages:
- --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no)
- --enable-FEATURE[=ARG] include FEATURE [ARG=yes]
- --with-PACKAGE[=ARG] use PACKAGE [ARG=yes]
- --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no)
- --x-includes=DIR X include files are in DIR
- --x-libraries=DIR X library files are in DIR
-EOF
- if test -n "$ac_help"; then
- echo "--enable and --with options recognized:$ac_help"
- fi
- exit 0 ;;
+ -help | --help | --hel | --he | -h)
+ ac_init_help=long ;;
+ -help=r* | --help=r* | --hel=r* | --he=r* | -hr*)
+ ac_init_help=recursive ;;
+ -help=s* | --help=s* | --hel=s* | --he=s* | -hs*)
+ ac_init_help=short ;;
-host | --host | --hos | --ho)
- ac_prev=host ;;
+ ac_prev=host_alias ;;
-host=* | --host=* | --hos=* | --ho=*)
- host="$ac_optarg" ;;
+ host_alias=$ac_optarg ;;
-includedir | --includedir | --includedi | --included | --include \
| --includ | --inclu | --incl | --inc)
ac_prev=includedir ;;
-includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \
| --includ=* | --inclu=* | --incl=* | --inc=*)
- includedir="$ac_optarg" ;;
+ includedir=$ac_optarg ;;
-infodir | --infodir | --infodi | --infod | --info | --inf)
ac_prev=infodir ;;
-infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*)
- infodir="$ac_optarg" ;;
+ infodir=$ac_optarg ;;
-libdir | --libdir | --libdi | --libd)
ac_prev=libdir ;;
-libdir=* | --libdir=* | --libdi=* | --libd=*)
- libdir="$ac_optarg" ;;
+ libdir=$ac_optarg ;;
-libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \
| --libexe | --libex | --libe)
ac_prev=libexecdir ;;
-libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \
| --libexe=* | --libex=* | --libe=*)
- libexecdir="$ac_optarg" ;;
+ libexecdir=$ac_optarg ;;
-localstatedir | --localstatedir | --localstatedi | --localstated \
| --localstate | --localstat | --localsta | --localst \
@@ -234,19 +470,19 @@ EOF
-localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \
| --localstate=* | --localstat=* | --localsta=* | --localst=* \
| --locals=* | --local=* | --loca=* | --loc=* | --lo=*)
- localstatedir="$ac_optarg" ;;
+ localstatedir=$ac_optarg ;;
-mandir | --mandir | --mandi | --mand | --man | --ma | --m)
ac_prev=mandir ;;
-mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*)
- mandir="$ac_optarg" ;;
+ mandir=$ac_optarg ;;
-nfp | --nfp | --nf)
# Obsolete; use --without-fp.
with_fp=no ;;
-no-create | --no-create | --no-creat | --no-crea | --no-cre \
- | --no-cr | --no-c)
+ | --no-cr | --no-c | -n)
no_create=yes ;;
-no-recursion | --no-recursion | --no-recursio | --no-recursi \
@@ -260,26 +496,26 @@ EOF
-oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \
| --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \
| --oldin=* | --oldi=* | --old=* | --ol=* | --o=*)
- oldincludedir="$ac_optarg" ;;
+ oldincludedir=$ac_optarg ;;
-prefix | --prefix | --prefi | --pref | --pre | --pr | --p)
ac_prev=prefix ;;
-prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*)
- prefix="$ac_optarg" ;;
+ prefix=$ac_optarg ;;
-program-prefix | --program-prefix | --program-prefi | --program-pref \
| --program-pre | --program-pr | --program-p)
ac_prev=program_prefix ;;
-program-prefix=* | --program-prefix=* | --program-prefi=* \
| --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*)
- program_prefix="$ac_optarg" ;;
+ program_prefix=$ac_optarg ;;
-program-suffix | --program-suffix | --program-suffi | --program-suff \
| --program-suf | --program-su | --program-s)
ac_prev=program_suffix ;;
-program-suffix=* | --program-suffix=* | --program-suffi=* \
| --program-suff=* | --program-suf=* | --program-su=* | --program-s=*)
- program_suffix="$ac_optarg" ;;
+ program_suffix=$ac_optarg ;;
-program-transform-name | --program-transform-name \
| --program-transform-nam | --program-transform-na \
@@ -296,7 +532,7 @@ EOF
| --program-transfo=* | --program-transf=* \
| --program-trans=* | --program-tran=* \
| --progr-tra=* | --program-tr=* | --program-t=*)
- program_transform_name="$ac_optarg" ;;
+ program_transform_name=$ac_optarg ;;
-q | -quiet | --quiet | --quie | --qui | --qu | --q \
| -silent | --silent | --silen | --sile | --sil)
@@ -306,7 +542,7 @@ EOF
ac_prev=sbindir ;;
-sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \
| --sbi=* | --sb=*)
- sbindir="$ac_optarg" ;;
+ sbindir=$ac_optarg ;;
-sharedstatedir | --sharedstatedir | --sharedstatedi \
| --sharedstated | --sharedstate | --sharedstat | --sharedsta \
@@ -317,58 +553,57 @@ EOF
| --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \
| --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \
| --sha=* | --sh=*)
- sharedstatedir="$ac_optarg" ;;
+ sharedstatedir=$ac_optarg ;;
-site | --site | --sit)
ac_prev=site ;;
-site=* | --site=* | --sit=*)
- site="$ac_optarg" ;;
+ site=$ac_optarg ;;
-srcdir | --srcdir | --srcdi | --srcd | --src | --sr)
ac_prev=srcdir ;;
-srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*)
- srcdir="$ac_optarg" ;;
+ srcdir=$ac_optarg ;;
-sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \
| --syscon | --sysco | --sysc | --sys | --sy)
ac_prev=sysconfdir ;;
-sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \
| --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*)
- sysconfdir="$ac_optarg" ;;
+ sysconfdir=$ac_optarg ;;
-target | --target | --targe | --targ | --tar | --ta | --t)
- ac_prev=target ;;
+ ac_prev=target_alias ;;
-target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*)
- target="$ac_optarg" ;;
+ target_alias=$ac_optarg ;;
-v | -verbose | --verbose | --verbos | --verbo | --verb)
verbose=yes ;;
- -version | --version | --versio | --versi | --vers)
- echo "configure generated by autoconf version 2.13"
- exit 0 ;;
+ -version | --version | --versio | --versi | --vers | -V)
+ ac_init_version=: ;;
-with-* | --with-*)
- ac_package=`echo $ac_option|sed -e 's/-*with-//' -e 's/=.*//'`
+ ac_package=`expr "x$ac_option" : 'x-*with-\([^=]*\)'`
# Reject names that are not valid shell variable names.
- if test -n "`echo $ac_package| sed 's/[-_a-zA-Z0-9]//g'`"; then
- { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; }
- fi
+ expr "x$ac_package" : ".*[^-_$as_cr_alnum]" >/dev/null &&
+ { echo "$as_me: error: invalid package name: $ac_package" >&2
+ { (exit 1); exit 1; }; }
ac_package=`echo $ac_package| sed 's/-/_/g'`
- case "$ac_option" in
- *=*) ;;
+ case $ac_option in
+ *=*) ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`;;
*) ac_optarg=yes ;;
esac
- eval "with_${ac_package}='$ac_optarg'" ;;
+ eval "with_$ac_package='$ac_optarg'" ;;
-without-* | --without-*)
- ac_package=`echo $ac_option|sed -e 's/-*without-//'`
+ ac_package=`expr "x$ac_option" : 'x-*without-\(.*\)'`
# Reject names that are not valid shell variable names.
- if test -n "`echo $ac_package| sed 's/[-a-zA-Z0-9_]//g'`"; then
- { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; }
- fi
- ac_package=`echo $ac_package| sed 's/-/_/g'`
- eval "with_${ac_package}=no" ;;
+ expr "x$ac_package" : ".*[^-_$as_cr_alnum]" >/dev/null &&
+ { echo "$as_me: error: invalid package name: $ac_package" >&2
+ { (exit 1); exit 1; }; }
+ ac_package=`echo $ac_package | sed 's/-/_/g'`
+ eval "with_$ac_package=no" ;;
--x)
# Obsolete; use --with-x.
@@ -379,99 +614,110 @@ EOF
ac_prev=x_includes ;;
-x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \
| --x-incl=* | --x-inc=* | --x-in=* | --x-i=*)
- x_includes="$ac_optarg" ;;
+ x_includes=$ac_optarg ;;
-x-libraries | --x-libraries | --x-librarie | --x-librari \
| --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l)
ac_prev=x_libraries ;;
-x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \
| --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*)
- x_libraries="$ac_optarg" ;;
+ x_libraries=$ac_optarg ;;
- -*) { echo "configure: error: $ac_option: invalid option; use --help to show usage" 1>&2; exit 1; }
+ -*) { echo "$as_me: error: unrecognized option: $ac_option
+Try \`$0 --help' for more information." >&2
+ { (exit 1); exit 1; }; }
;;
+ *=*)
+ ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='`
+ # Reject names that are not valid shell variable names.
+ expr "x$ac_envvar" : ".*[^_$as_cr_alnum]" >/dev/null &&
+ { echo "$as_me: error: invalid variable name: $ac_envvar" >&2
+ { (exit 1); exit 1; }; }
+ ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`
+ eval "$ac_envvar='$ac_optarg'"
+ export $ac_envvar ;;
+
*)
- if test -n "`echo $ac_option| sed 's/[-a-z0-9.]//g'`"; then
- echo "configure: warning: $ac_option: invalid host type" 1>&2
- fi
- if test "x$nonopt" != xNONE; then
- { echo "configure: error: can only configure for one host and one target at a time" 1>&2; exit 1; }
- fi
- nonopt="$ac_option"
+ # FIXME: should be removed in autoconf 3.0.
+ echo "$as_me: WARNING: you should use --build, --host, --target" >&2
+ expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null &&
+ echo "$as_me: WARNING: invalid host type: $ac_option" >&2
+ : ${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option}
;;
esac
done
if test -n "$ac_prev"; then
- { echo "configure: error: missing argument to --`echo $ac_prev | sed 's/_/-/g'`" 1>&2; exit 1; }
-fi
-
-trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15
-
-# File descriptor usage:
-# 0 standard input
-# 1 file creation
-# 2 errors and warnings
-# 3 some systems may open it to /dev/tty
-# 4 used on the Kubota Titan
-# 6 checking for... messages and results
-# 5 compiler messages saved in config.log
-if test "$silent" = yes; then
- exec 6>/dev/null
-else
- exec 6>&1
+ ac_option=--`echo $ac_prev | sed 's/_/-/g'`
+ { echo "$as_me: error: missing argument to $ac_option" >&2
+ { (exit 1); exit 1; }; }
fi
-exec 5>./config.log
-echo "\
-This file contains any messages produced by compilers while
-running configure, to aid debugging if configure makes a mistake.
-" 1>&5
+# Be sure to have absolute paths.
+for ac_var in exec_prefix prefix
+do
+ eval ac_val=$`echo $ac_var`
+ case $ac_val in
+ [\\/$]* | ?:[\\/]* | NONE | '' ) ;;
+ *) { echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2
+ { (exit 1); exit 1; }; };;
+ esac
+done
-# Strip out --no-create and --no-recursion so they do not pile up.
-# Also quote any args containing shell metacharacters.
-ac_configure_args=
-for ac_arg
+# Be sure to have absolute paths.
+for ac_var in bindir sbindir libexecdir datadir sysconfdir sharedstatedir \
+ localstatedir libdir includedir oldincludedir infodir mandir
do
- case "$ac_arg" in
- -no-create | --no-create | --no-creat | --no-crea | --no-cre \
- | --no-cr | --no-c) ;;
- -no-recursion | --no-recursion | --no-recursio | --no-recursi \
- | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) ;;
- *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?]*)
- ac_configure_args="$ac_configure_args '$ac_arg'" ;;
- *) ac_configure_args="$ac_configure_args $ac_arg" ;;
+ eval ac_val=$`echo $ac_var`
+ case $ac_val in
+ [\\/$]* | ?:[\\/]* ) ;;
+ *) { echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2
+ { (exit 1); exit 1; }; };;
esac
done
-# NLS nuisances.
-# Only set these to C if already set. These must not be set unconditionally
-# because not all systems understand e.g. LANG=C (notably SCO).
-# Fixing LC_MESSAGES prevents Solaris sh from translating var values in `set'!
-# Non-C LC_CTYPE values break the ctype check.
-if test "${LANG+set}" = set; then LANG=C; export LANG; fi
-if test "${LC_ALL+set}" = set; then LC_ALL=C; export LC_ALL; fi
-if test "${LC_MESSAGES+set}" = set; then LC_MESSAGES=C; export LC_MESSAGES; fi
-if test "${LC_CTYPE+set}" = set; then LC_CTYPE=C; export LC_CTYPE; fi
+# There might be people who depend on the old broken behavior: `$host'
+# used to hold the argument of --host etc.
+# FIXME: To remove some day.
+build=$build_alias
+host=$host_alias
+target=$target_alias
+
+# FIXME: To remove some day.
+if test "x$host_alias" != x; then
+ if test "x$build_alias" = x; then
+ cross_compiling=maybe
+ echo "$as_me: WARNING: If you wanted to set the --build type, don't use --host.
+ If a cross compiler is detected then cross compile mode will be used." >&2
+ elif test "x$build_alias" != "x$host_alias"; then
+ cross_compiling=yes
+ fi
+fi
-# confdefs.h avoids OS command line length limits that DEFS can exceed.
-rm -rf conftest* confdefs.h
-# AIX cpp loses on an empty file, so make sure it contains at least a newline.
-echo > confdefs.h
+ac_tool_prefix=
+test -n "$host_alias" && ac_tool_prefix=$host_alias-
+
+test "$silent" = yes && exec 6>/dev/null
-# A filename unique to this package, relative to the directory that
-# configure is in, which we can look for to find out if srcdir is correct.
-ac_unique_file=../generic/tcl.h
# Find the source files, if location was not specified.
if test -z "$srcdir"; then
ac_srcdir_defaulted=yes
# Try the directory containing this script, then its parent.
- ac_prog=$0
- ac_confdir=`echo $ac_prog|sed 's%/[^/][^/]*$%%'`
- test "x$ac_confdir" = "x$ac_prog" && ac_confdir=.
+ ac_confdir=`(dirname "$0") 2>/dev/null ||
+$as_expr X"$0" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
+ X"$0" : 'X\(//\)[^/]' \| \
+ X"$0" : 'X\(//\)$' \| \
+ X"$0" : 'X\(/\)' \| \
+ . : '\(.\)' 2>/dev/null ||
+echo X"$0" |
+ sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; }
+ /^X\(\/\/\)[^/].*/{ s//\1/; q; }
+ /^X\(\/\/\)$/{ s//\1/; q; }
+ /^X\(\/\).*/{ s//\1/; q; }
+ s/.*/./; q'`
srcdir=$ac_confdir
if test ! -r $srcdir/$ac_unique_file; then
srcdir=..
@@ -481,13 +727,471 @@ else
fi
if test ! -r $srcdir/$ac_unique_file; then
if test "$ac_srcdir_defaulted" = yes; then
- { echo "configure: error: can not find sources in $ac_confdir or .." 1>&2; exit 1; }
+ { echo "$as_me: error: cannot find sources ($ac_unique_file) in $ac_confdir or .." >&2
+ { (exit 1); exit 1; }; }
else
- { echo "configure: error: can not find sources in $srcdir" 1>&2; exit 1; }
+ { echo "$as_me: error: cannot find sources ($ac_unique_file) in $srcdir" >&2
+ { (exit 1); exit 1; }; }
fi
fi
-srcdir=`echo "${srcdir}" | sed 's%\([^/]\)/*$%\1%'`
+(cd $srcdir && test -r ./$ac_unique_file) 2>/dev/null ||
+ { echo "$as_me: error: sources are in $srcdir, but \`cd $srcdir' does not work" >&2
+ { (exit 1); exit 1; }; }
+srcdir=`echo "$srcdir" | sed 's%\([^\\/]\)[\\/]*$%\1%'`
+ac_env_build_alias_set=${build_alias+set}
+ac_env_build_alias_value=$build_alias
+ac_cv_env_build_alias_set=${build_alias+set}
+ac_cv_env_build_alias_value=$build_alias
+ac_env_host_alias_set=${host_alias+set}
+ac_env_host_alias_value=$host_alias
+ac_cv_env_host_alias_set=${host_alias+set}
+ac_cv_env_host_alias_value=$host_alias
+ac_env_target_alias_set=${target_alias+set}
+ac_env_target_alias_value=$target_alias
+ac_cv_env_target_alias_set=${target_alias+set}
+ac_cv_env_target_alias_value=$target_alias
+ac_env_CC_set=${CC+set}
+ac_env_CC_value=$CC
+ac_cv_env_CC_set=${CC+set}
+ac_cv_env_CC_value=$CC
+ac_env_CFLAGS_set=${CFLAGS+set}
+ac_env_CFLAGS_value=$CFLAGS
+ac_cv_env_CFLAGS_set=${CFLAGS+set}
+ac_cv_env_CFLAGS_value=$CFLAGS
+ac_env_LDFLAGS_set=${LDFLAGS+set}
+ac_env_LDFLAGS_value=$LDFLAGS
+ac_cv_env_LDFLAGS_set=${LDFLAGS+set}
+ac_cv_env_LDFLAGS_value=$LDFLAGS
+ac_env_CPPFLAGS_set=${CPPFLAGS+set}
+ac_env_CPPFLAGS_value=$CPPFLAGS
+ac_cv_env_CPPFLAGS_set=${CPPFLAGS+set}
+ac_cv_env_CPPFLAGS_value=$CPPFLAGS
+ac_env_CPP_set=${CPP+set}
+ac_env_CPP_value=$CPP
+ac_cv_env_CPP_set=${CPP+set}
+ac_cv_env_CPP_value=$CPP
+
+#
+# Report the --help message.
+#
+if test "$ac_init_help" = "long"; then
+ # Omit some internal or obsolete options to make the list less imposing.
+ # This message is too long to be a string in the A/UX 3.1 sh.
+ cat <<_ACEOF
+\`configure' configures this package to adapt to many kinds of systems.
+
+Usage: $0 [OPTION]... [VAR=VALUE]...
+
+To assign environment variables (e.g., CC, CFLAGS...), specify them as
+VAR=VALUE. See below for descriptions of some of the useful variables.
+Defaults for the options are specified in brackets.
+
+Configuration:
+ -h, --help display this help and exit
+ --help=short display options specific to this package
+ --help=recursive display the short help of all the included packages
+ -V, --version display version information and exit
+ -q, --quiet, --silent do not print \`checking...' messages
+ --cache-file=FILE cache test results in FILE [disabled]
+ -C, --config-cache alias for \`--cache-file=config.cache'
+ -n, --no-create do not create output files
+ --srcdir=DIR find the sources in DIR [configure dir or \`..']
+
+_ACEOF
+
+ cat <<_ACEOF
+Installation directories:
+ --prefix=PREFIX install architecture-independent files in PREFIX
+ [$ac_default_prefix]
+ --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX
+ [PREFIX]
+
+By default, \`make install' will install all the files in
+\`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc. You can specify
+an installation prefix other than \`$ac_default_prefix' using \`--prefix',
+for instance \`--prefix=\$HOME'.
+
+For better control, use the options below.
+
+Fine tuning of the installation directories:
+ --bindir=DIR user executables [EPREFIX/bin]
+ --sbindir=DIR system admin executables [EPREFIX/sbin]
+ --libexecdir=DIR program executables [EPREFIX/libexec]
+ --datadir=DIR read-only architecture-independent data [PREFIX/share]
+ --sysconfdir=DIR read-only single-machine data [PREFIX/etc]
+ --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com]
+ --localstatedir=DIR modifiable single-machine data [PREFIX/var]
+ --libdir=DIR object code libraries [EPREFIX/lib]
+ --includedir=DIR C header files [PREFIX/include]
+ --oldincludedir=DIR C header files for non-gcc [/usr/include]
+ --infodir=DIR info documentation [PREFIX/info]
+ --mandir=DIR man documentation [PREFIX/man]
+_ACEOF
+
+ cat <<\_ACEOF
+_ACEOF
+fi
+
+if test -n "$ac_init_help"; then
+
+ cat <<\_ACEOF
+
+Optional Features:
+ --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no)
+ --enable-FEATURE[=ARG] include FEATURE [ARG=yes]
+ --enable-threads build with threads
+ --enable-shared build and link with shared libraries --enable-shared
+ --enable-64bit enable 64bit support (where applicable)
+ --enable-wince enable Win/CE support (where applicable)
+ --enable-symbols build with debugging symbols --disable-symbols
+ --enable-embedded-manifest
+ embed manifest if possible (default: yes)
+
+Optional Packages:
+ --with-PACKAGE[=ARG] use PACKAGE [ARG=yes]
+ --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no)
+ --with-encoding encoding for configuration values
+ --with-celib=DIR use Windows/CE support library from DIR
+
+Some influential environment variables:
+ CC C compiler command
+ CFLAGS C compiler flags
+ LDFLAGS linker flags, e.g. -L<lib dir> if you have libraries in a
+ nonstandard directory <lib dir>
+ CPPFLAGS C/C++ preprocessor flags, e.g. -I<include dir> if you have
+ headers in a nonstandard directory <include dir>
+ CPP C preprocessor
+
+Use these variables to override the choices made by `configure' or to help
+it to find libraries and programs with nonstandard names/locations.
+
+_ACEOF
+fi
+
+if test "$ac_init_help" = "recursive"; then
+ # If there are subdirs, report their specific --help.
+ ac_popdir=`pwd`
+ for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue
+ test -d $ac_dir || continue
+ ac_builddir=.
+
+if test "$ac_dir" != .; then
+ ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'`
+ # A "../" for each directory in $ac_dir_suffix.
+ ac_top_builddir=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,../,g'`
+else
+ ac_dir_suffix= ac_top_builddir=
+fi
+
+case $srcdir in
+ .) # No --srcdir option. We are building in place.
+ ac_srcdir=.
+ if test -z "$ac_top_builddir"; then
+ ac_top_srcdir=.
+ else
+ ac_top_srcdir=`echo $ac_top_builddir | sed 's,/$,,'`
+ fi ;;
+ [\\/]* | ?:[\\/]* ) # Absolute path.
+ ac_srcdir=$srcdir$ac_dir_suffix;
+ ac_top_srcdir=$srcdir ;;
+ *) # Relative path.
+ ac_srcdir=$ac_top_builddir$srcdir$ac_dir_suffix
+ ac_top_srcdir=$ac_top_builddir$srcdir ;;
+esac
+
+# Do not use `cd foo && pwd` to compute absolute paths, because
+# the directories may not exist.
+case `pwd` in
+.) ac_abs_builddir="$ac_dir";;
+*)
+ case "$ac_dir" in
+ .) ac_abs_builddir=`pwd`;;
+ [\\/]* | ?:[\\/]* ) ac_abs_builddir="$ac_dir";;
+ *) ac_abs_builddir=`pwd`/"$ac_dir";;
+ esac;;
+esac
+case $ac_abs_builddir in
+.) ac_abs_top_builddir=${ac_top_builddir}.;;
+*)
+ case ${ac_top_builddir}. in
+ .) ac_abs_top_builddir=$ac_abs_builddir;;
+ [\\/]* | ?:[\\/]* ) ac_abs_top_builddir=${ac_top_builddir}.;;
+ *) ac_abs_top_builddir=$ac_abs_builddir/${ac_top_builddir}.;;
+ esac;;
+esac
+case $ac_abs_builddir in
+.) ac_abs_srcdir=$ac_srcdir;;
+*)
+ case $ac_srcdir in
+ .) ac_abs_srcdir=$ac_abs_builddir;;
+ [\\/]* | ?:[\\/]* ) ac_abs_srcdir=$ac_srcdir;;
+ *) ac_abs_srcdir=$ac_abs_builddir/$ac_srcdir;;
+ esac;;
+esac
+case $ac_abs_builddir in
+.) ac_abs_top_srcdir=$ac_top_srcdir;;
+*)
+ case $ac_top_srcdir in
+ .) ac_abs_top_srcdir=$ac_abs_builddir;;
+ [\\/]* | ?:[\\/]* ) ac_abs_top_srcdir=$ac_top_srcdir;;
+ *) ac_abs_top_srcdir=$ac_abs_builddir/$ac_top_srcdir;;
+ esac;;
+esac
+
+ cd $ac_dir
+ # Check for guested configure; otherwise get Cygnus style configure.
+ if test -f $ac_srcdir/configure.gnu; then
+ echo
+ $SHELL $ac_srcdir/configure.gnu --help=recursive
+ elif test -f $ac_srcdir/configure; then
+ echo
+ $SHELL $ac_srcdir/configure --help=recursive
+ elif test -f $ac_srcdir/configure.ac ||
+ test -f $ac_srcdir/configure.in; then
+ echo
+ $ac_configure --help
+ else
+ echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2
+ fi
+ cd $ac_popdir
+ done
+fi
+
+test -n "$ac_init_help" && exit 0
+if $ac_init_version; then
+ cat <<\_ACEOF
+
+Copyright (C) 2003 Free Software Foundation, Inc.
+This configure script is free software; the Free Software Foundation
+gives unlimited permission to copy, distribute and modify it.
+_ACEOF
+ exit 0
+fi
+exec 5>config.log
+cat >&5 <<_ACEOF
+This file contains any messages produced by compilers while
+running configure, to aid debugging if configure makes a mistake.
+
+It was created by $as_me, which was
+generated by GNU Autoconf 2.59. Invocation command line was
+
+ $ $0 $@
+
+_ACEOF
+{
+cat <<_ASUNAME
+## --------- ##
+## Platform. ##
+## --------- ##
+
+hostname = `(hostname || uname -n) 2>/dev/null | sed 1q`
+uname -m = `(uname -m) 2>/dev/null || echo unknown`
+uname -r = `(uname -r) 2>/dev/null || echo unknown`
+uname -s = `(uname -s) 2>/dev/null || echo unknown`
+uname -v = `(uname -v) 2>/dev/null || echo unknown`
+
+/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown`
+/bin/uname -X = `(/bin/uname -X) 2>/dev/null || echo unknown`
+
+/bin/arch = `(/bin/arch) 2>/dev/null || echo unknown`
+/usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null || echo unknown`
+/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown`
+hostinfo = `(hostinfo) 2>/dev/null || echo unknown`
+/bin/machine = `(/bin/machine) 2>/dev/null || echo unknown`
+/usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null || echo unknown`
+/bin/universe = `(/bin/universe) 2>/dev/null || echo unknown`
+
+_ASUNAME
+
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ echo "PATH: $as_dir"
+done
+
+} >&5
+
+cat >&5 <<_ACEOF
+
+
+## ----------- ##
+## Core tests. ##
+## ----------- ##
+
+_ACEOF
+
+
+# Keep a trace of the command line.
+# Strip out --no-create and --no-recursion so they do not pile up.
+# Strip out --silent because we don't want to record it for future runs.
+# Also quote any args containing shell meta-characters.
+# Make two passes to allow for proper duplicate-argument suppression.
+ac_configure_args=
+ac_configure_args0=
+ac_configure_args1=
+ac_sep=
+ac_must_keep_next=false
+for ac_pass in 1 2
+do
+ for ac_arg
+ do
+ case $ac_arg in
+ -no-create | --no-c* | -n | -no-recursion | --no-r*) continue ;;
+ -q | -quiet | --quiet | --quie | --qui | --qu | --q \
+ | -silent | --silent | --silen | --sile | --sil)
+ continue ;;
+ *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?\"\']*)
+ ac_arg=`echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;;
+ esac
+ case $ac_pass in
+ 1) ac_configure_args0="$ac_configure_args0 '$ac_arg'" ;;
+ 2)
+ ac_configure_args1="$ac_configure_args1 '$ac_arg'"
+ if test $ac_must_keep_next = true; then
+ ac_must_keep_next=false # Got value, back to normal.
+ else
+ case $ac_arg in
+ *=* | --config-cache | -C | -disable-* | --disable-* \
+ | -enable-* | --enable-* | -gas | --g* | -nfp | --nf* \
+ | -q | -quiet | --q* | -silent | --sil* | -v | -verb* \
+ | -with-* | --with-* | -without-* | --without-* | --x)
+ case "$ac_configure_args0 " in
+ "$ac_configure_args1"*" '$ac_arg' "* ) continue ;;
+ esac
+ ;;
+ -* ) ac_must_keep_next=true ;;
+ esac
+ fi
+ ac_configure_args="$ac_configure_args$ac_sep'$ac_arg'"
+ # Get rid of the leading space.
+ ac_sep=" "
+ ;;
+ esac
+ done
+done
+$as_unset ac_configure_args0 || test "${ac_configure_args0+set}" != set || { ac_configure_args0=; export ac_configure_args0; }
+$as_unset ac_configure_args1 || test "${ac_configure_args1+set}" != set || { ac_configure_args1=; export ac_configure_args1; }
+
+# When interrupted or exit'd, cleanup temporary files, and complete
+# config.log. We remove comments because anyway the quotes in there
+# would cause problems or look ugly.
+# WARNING: Be sure not to use single quotes in there, as some shells,
+# such as our DU 5.0 friend, will then `close' the trap.
+trap 'exit_status=$?
+ # Save into config.log some information that might help in debugging.
+ {
+ echo
+
+ cat <<\_ASBOX
+## ---------------- ##
+## Cache variables. ##
+## ---------------- ##
+_ASBOX
+ echo
+ # The following way of writing the cache mishandles newlines in values,
+{
+ (set) 2>&1 |
+ case `(ac_space='"'"' '"'"'; set | grep ac_space) 2>&1` in
+ *ac_space=\ *)
+ sed -n \
+ "s/'"'"'/'"'"'\\\\'"'"''"'"'/g;
+ s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='"'"'\\2'"'"'/p"
+ ;;
+ *)
+ sed -n \
+ "s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1=\\2/p"
+ ;;
+ esac;
+}
+ echo
+
+ cat <<\_ASBOX
+## ----------------- ##
+## Output variables. ##
+## ----------------- ##
+_ASBOX
+ echo
+ for ac_var in $ac_subst_vars
+ do
+ eval ac_val=$`echo $ac_var`
+ echo "$ac_var='"'"'$ac_val'"'"'"
+ done | sort
+ echo
+
+ if test -n "$ac_subst_files"; then
+ cat <<\_ASBOX
+## ------------- ##
+## Output files. ##
+## ------------- ##
+_ASBOX
+ echo
+ for ac_var in $ac_subst_files
+ do
+ eval ac_val=$`echo $ac_var`
+ echo "$ac_var='"'"'$ac_val'"'"'"
+ done | sort
+ echo
+ fi
+
+ if test -s confdefs.h; then
+ cat <<\_ASBOX
+## ----------- ##
+## confdefs.h. ##
+## ----------- ##
+_ASBOX
+ echo
+ sed "/^$/d" confdefs.h | sort
+ echo
+ fi
+ test "$ac_signal" != 0 &&
+ echo "$as_me: caught signal $ac_signal"
+ echo "$as_me: exit $exit_status"
+ } >&5
+ rm -f core *.core &&
+ rm -rf conftest* confdefs* conf$$* $ac_clean_files &&
+ exit $exit_status
+ ' 0
+for ac_signal in 1 2 13 15; do
+ trap 'ac_signal='$ac_signal'; { (exit 1); exit 1; }' $ac_signal
+done
+ac_signal=0
+
+# confdefs.h avoids OS command line length limits that DEFS can exceed.
+rm -rf conftest* confdefs.h
+# AIX cpp loses on an empty file, so make sure it contains at least a newline.
+echo >confdefs.h
+
+# Predefined preprocessor variables.
+
+cat >>confdefs.h <<_ACEOF
+#define PACKAGE_NAME "$PACKAGE_NAME"
+_ACEOF
+
+
+cat >>confdefs.h <<_ACEOF
+#define PACKAGE_TARNAME "$PACKAGE_TARNAME"
+_ACEOF
+
+
+cat >>confdefs.h <<_ACEOF
+#define PACKAGE_VERSION "$PACKAGE_VERSION"
+_ACEOF
+
+
+cat >>confdefs.h <<_ACEOF
+#define PACKAGE_STRING "$PACKAGE_STRING"
+_ACEOF
+
+
+cat >>confdefs.h <<_ACEOF
+#define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT"
+_ACEOF
+
+
+# Let the site file select an alternate cache file if it wants to.
# Prefer explicitly selected file to automatically selected ones.
if test -z "$CONFIG_SITE"; then
if test "x$prefix" != xNONE; then
@@ -498,57 +1202,128 @@ if test -z "$CONFIG_SITE"; then
fi
for ac_site_file in $CONFIG_SITE; do
if test -r "$ac_site_file"; then
- echo "loading site script $ac_site_file"
+ { echo "$as_me:$LINENO: loading site script $ac_site_file" >&5
+echo "$as_me: loading site script $ac_site_file" >&6;}
+ sed 's/^/| /' "$ac_site_file" >&5
. "$ac_site_file"
fi
done
if test -r "$cache_file"; then
- echo "loading cache $cache_file"
- . $cache_file
+ # Some versions of bash will fail to source /dev/null (special
+ # files actually), so we avoid doing that.
+ if test -f "$cache_file"; then
+ { echo "$as_me:$LINENO: loading cache $cache_file" >&5
+echo "$as_me: loading cache $cache_file" >&6;}
+ case $cache_file in
+ [\\/]* | ?:[\\/]* ) . $cache_file;;
+ *) . ./$cache_file;;
+ esac
+ fi
else
- echo "creating cache $cache_file"
- > $cache_file
+ { echo "$as_me:$LINENO: creating cache $cache_file" >&5
+echo "$as_me: creating cache $cache_file" >&6;}
+ >$cache_file
fi
-ac_ext=c
-# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
-ac_cpp='$CPP $CPPFLAGS'
-ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
-ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
-cross_compiling=$ac_cv_prog_cc_cross
-
-ac_exeext=
-ac_objext=o
-if (echo "testing\c"; echo 1,2,3) | grep c >/dev/null; then
- # Stardent Vistra SVR4 grep lacks -e, says ghazi@caip.rutgers.edu.
- if (echo -n testing; echo 1,2,3) | sed s/-n/xn/ | grep xn >/dev/null; then
- ac_n= ac_c='
-' ac_t=' '
- else
- ac_n=-n ac_c= ac_t=
+# Check that the precious variables saved in the cache have kept the same
+# value.
+ac_cache_corrupted=false
+for ac_var in `(set) 2>&1 |
+ sed -n 's/^ac_env_\([a-zA-Z_0-9]*\)_set=.*/\1/p'`; do
+ eval ac_old_set=\$ac_cv_env_${ac_var}_set
+ eval ac_new_set=\$ac_env_${ac_var}_set
+ eval ac_old_val="\$ac_cv_env_${ac_var}_value"
+ eval ac_new_val="\$ac_env_${ac_var}_value"
+ case $ac_old_set,$ac_new_set in
+ set,)
+ { echo "$as_me:$LINENO: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5
+echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;}
+ ac_cache_corrupted=: ;;
+ ,set)
+ { echo "$as_me:$LINENO: error: \`$ac_var' was not set in the previous run" >&5
+echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;}
+ ac_cache_corrupted=: ;;
+ ,);;
+ *)
+ if test "x$ac_old_val" != "x$ac_new_val"; then
+ { echo "$as_me:$LINENO: error: \`$ac_var' has changed since the previous run:" >&5
+echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;}
+ { echo "$as_me:$LINENO: former value: $ac_old_val" >&5
+echo "$as_me: former value: $ac_old_val" >&2;}
+ { echo "$as_me:$LINENO: current value: $ac_new_val" >&5
+echo "$as_me: current value: $ac_new_val" >&2;}
+ ac_cache_corrupted=:
+ fi;;
+ esac
+ # Pass precious variables to config.status.
+ if test "$ac_new_set" = set; then
+ case $ac_new_val in
+ *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?\"\']*)
+ ac_arg=$ac_var=`echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;;
+ *) ac_arg=$ac_var=$ac_new_val ;;
+ esac
+ case " $ac_configure_args " in
+ *" '$ac_arg' "*) ;; # Avoid dups. Use of quotes ensures accuracy.
+ *) ac_configure_args="$ac_configure_args '$ac_arg'" ;;
+ esac
fi
-else
- ac_n= ac_c='\c' ac_t=
+done
+if $ac_cache_corrupted; then
+ { echo "$as_me:$LINENO: error: changes in the environment can compromise the build" >&5
+echo "$as_me: error: changes in the environment can compromise the build" >&2;}
+ { { echo "$as_me:$LINENO: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&5
+echo "$as_me: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&2;}
+ { (exit 1); exit 1; }; }
fi
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+
-TCL_VERSION=8.4
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+# The following define is needed when building with Cygwin since newer
+# versions of autoconf incorrectly set SHELL to /bin/bash instead of
+# /bin/sh. The bash shell seems to suffer from some strange failures.
+SHELL=/bin/sh
+
+TCL_VERSION=8.5
TCL_MAJOR_VERSION=8
-TCL_MINOR_VERSION=4
-TCL_PATCH_LEVEL=".19"
+TCL_MINOR_VERSION=5
+TCL_PATCH_LEVEL=".11"
VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION
-TCL_DDE_VERSION=1.2
+TCL_DDE_VERSION=1.3
TCL_DDE_MAJOR_VERSION=1
-TCL_DDE_MINOR_VERSION=2
+TCL_DDE_MINOR_VERSION=3
+TCL_DDE_PATCH_LEVEL="2"
DDEVER=$TCL_DDE_MAJOR_VERSION$TCL_DDE_MINOR_VERSION
-TCL_REG_VERSION=1.1
+TCL_REG_VERSION=1.2
TCL_REG_MAJOR_VERSION=1
-TCL_REG_MINOR_VERSION=1
+TCL_REG_MINOR_VERSION=2
+TCL_REG_PATCH_LEVEL="1"
REGVER=$TCL_REG_MAJOR_VERSION$TCL_REG_MINOR_VERSION
#------------------------------------------------------------------------
@@ -574,214 +1349,659 @@ if test "${CFLAGS+set}" != "set" ; then
CFLAGS=""
fi
-# Extract the first word of "gcc", so it can be a program name with args.
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+if test -n "$ac_tool_prefix"; then
+ # Extract the first word of "${ac_tool_prefix}gcc", so it can be a program name with args.
+set dummy ${ac_tool_prefix}gcc; ac_word=$2
+echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
+if test "${ac_cv_prog_CC+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ if test -n "$CC"; then
+ ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_prog_CC="${ac_tool_prefix}gcc"
+ echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+done
+
+fi
+fi
+CC=$ac_cv_prog_CC
+if test -n "$CC"; then
+ echo "$as_me:$LINENO: result: $CC" >&5
+echo "${ECHO_T}$CC" >&6
+else
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
+fi
+
+fi
+if test -z "$ac_cv_prog_CC"; then
+ ac_ct_CC=$CC
+ # Extract the first word of "gcc", so it can be a program name with args.
set dummy gcc; ac_word=$2
-echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
-echo "configure:581: checking for $ac_word" >&5
-if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&6
+echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
+if test "${ac_cv_prog_ac_ct_CC+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ if test -n "$ac_ct_CC"; then
+ ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_prog_ac_ct_CC="gcc"
+ echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+done
+
+fi
+fi
+ac_ct_CC=$ac_cv_prog_ac_ct_CC
+if test -n "$ac_ct_CC"; then
+ echo "$as_me:$LINENO: result: $ac_ct_CC" >&5
+echo "${ECHO_T}$ac_ct_CC" >&6
+else
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
+fi
+
+ CC=$ac_ct_CC
+else
+ CC="$ac_cv_prog_CC"
+fi
+
+if test -z "$CC"; then
+ if test -n "$ac_tool_prefix"; then
+ # Extract the first word of "${ac_tool_prefix}cc", so it can be a program name with args.
+set dummy ${ac_tool_prefix}cc; ac_word=$2
+echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
+if test "${ac_cv_prog_CC+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
else
if test -n "$CC"; then
ac_cv_prog_CC="$CC" # Let the user override the test.
else
- IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
- ac_dummy="$PATH"
- for ac_dir in $ac_dummy; do
- test -z "$ac_dir" && ac_dir=.
- if test -f $ac_dir/$ac_word; then
- ac_cv_prog_CC="gcc"
- break
- fi
- done
- IFS="$ac_save_ifs"
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_prog_CC="${ac_tool_prefix}cc"
+ echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+done
+
fi
fi
-CC="$ac_cv_prog_CC"
+CC=$ac_cv_prog_CC
if test -n "$CC"; then
- echo "$ac_t""$CC" 1>&6
+ echo "$as_me:$LINENO: result: $CC" >&5
+echo "${ECHO_T}$CC" >&6
else
- echo "$ac_t""no" 1>&6
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
fi
+fi
+if test -z "$ac_cv_prog_CC"; then
+ ac_ct_CC=$CC
+ # Extract the first word of "cc", so it can be a program name with args.
+set dummy cc; ac_word=$2
+echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
+if test "${ac_cv_prog_ac_ct_CC+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ if test -n "$ac_ct_CC"; then
+ ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_prog_ac_ct_CC="cc"
+ echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+done
+
+fi
+fi
+ac_ct_CC=$ac_cv_prog_ac_ct_CC
+if test -n "$ac_ct_CC"; then
+ echo "$as_me:$LINENO: result: $ac_ct_CC" >&5
+echo "${ECHO_T}$ac_ct_CC" >&6
+else
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
+fi
+
+ CC=$ac_ct_CC
+else
+ CC="$ac_cv_prog_CC"
+fi
+
+fi
if test -z "$CC"; then
# Extract the first word of "cc", so it can be a program name with args.
set dummy cc; ac_word=$2
-echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
-echo "configure:611: checking for $ac_word" >&5
-if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&6
+echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
+if test "${ac_cv_prog_CC+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
else
if test -n "$CC"; then
ac_cv_prog_CC="$CC" # Let the user override the test.
else
- IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
ac_prog_rejected=no
- ac_dummy="$PATH"
- for ac_dir in $ac_dummy; do
- test -z "$ac_dir" && ac_dir=.
- if test -f $ac_dir/$ac_word; then
- if test "$ac_dir/$ac_word" = "/usr/ucb/cc"; then
- ac_prog_rejected=yes
- continue
- fi
- ac_cv_prog_CC="cc"
- break
- fi
- done
- IFS="$ac_save_ifs"
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ if test "$as_dir/$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then
+ ac_prog_rejected=yes
+ continue
+ fi
+ ac_cv_prog_CC="cc"
+ echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+done
+
if test $ac_prog_rejected = yes; then
# We found a bogon in the path, so make sure we never use it.
set dummy $ac_cv_prog_CC
shift
- if test $# -gt 0; then
+ if test $# != 0; then
# We chose a different compiler from the bogus one.
# However, it has the same basename, so the bogon will be chosen
# first if we set CC to just the basename; use the full file name.
shift
- set dummy "$ac_dir/$ac_word" "$@"
- shift
- ac_cv_prog_CC="$@"
+ ac_cv_prog_CC="$as_dir/$ac_word${1+' '}$@"
fi
fi
fi
fi
-CC="$ac_cv_prog_CC"
+CC=$ac_cv_prog_CC
if test -n "$CC"; then
- echo "$ac_t""$CC" 1>&6
+ echo "$as_me:$LINENO: result: $CC" >&5
+echo "${ECHO_T}$CC" >&6
else
- echo "$ac_t""no" 1>&6
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
fi
- if test -z "$CC"; then
- case "`uname -s`" in
- *win32* | *WIN32*)
- # Extract the first word of "cl", so it can be a program name with args.
-set dummy cl; ac_word=$2
-echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
-echo "configure:662: checking for $ac_word" >&5
-if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&6
+fi
+if test -z "$CC"; then
+ if test -n "$ac_tool_prefix"; then
+ for ac_prog in cl
+ do
+ # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args.
+set dummy $ac_tool_prefix$ac_prog; ac_word=$2
+echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
+if test "${ac_cv_prog_CC+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
else
if test -n "$CC"; then
ac_cv_prog_CC="$CC" # Let the user override the test.
else
- IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
- ac_dummy="$PATH"
- for ac_dir in $ac_dummy; do
- test -z "$ac_dir" && ac_dir=.
- if test -f $ac_dir/$ac_word; then
- ac_cv_prog_CC="cl"
- break
- fi
- done
- IFS="$ac_save_ifs"
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_prog_CC="$ac_tool_prefix$ac_prog"
+ echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+done
+
fi
fi
-CC="$ac_cv_prog_CC"
+CC=$ac_cv_prog_CC
if test -n "$CC"; then
- echo "$ac_t""$CC" 1>&6
+ echo "$as_me:$LINENO: result: $CC" >&5
+echo "${ECHO_T}$CC" >&6
else
- echo "$ac_t""no" 1>&6
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
fi
- ;;
- esac
+
+ test -n "$CC" && break
+ done
+fi
+if test -z "$CC"; then
+ ac_ct_CC=$CC
+ for ac_prog in cl
+do
+ # Extract the first word of "$ac_prog", so it can be a program name with args.
+set dummy $ac_prog; ac_word=$2
+echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
+if test "${ac_cv_prog_ac_ct_CC+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ if test -n "$ac_ct_CC"; then
+ ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_prog_ac_ct_CC="$ac_prog"
+ echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
fi
- test -z "$CC" && { echo "configure: error: no acceptable cc found in \$PATH" 1>&2; exit 1; }
+done
+done
+
+fi
+fi
+ac_ct_CC=$ac_cv_prog_ac_ct_CC
+if test -n "$ac_ct_CC"; then
+ echo "$as_me:$LINENO: result: $ac_ct_CC" >&5
+echo "${ECHO_T}$ac_ct_CC" >&6
+else
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
fi
-echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works""... $ac_c" 1>&6
-echo "configure:694: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works" >&5
+ test -n "$ac_ct_CC" && break
+done
-ac_ext=c
-# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
-ac_cpp='$CPP $CPPFLAGS'
-ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
-ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
-cross_compiling=$ac_cv_prog_cc_cross
-
-cat > conftest.$ac_ext << EOF
-
-#line 705 "configure"
-#include "confdefs.h"
-
-main(){return(0);}
-EOF
-if { (eval echo configure:710: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
- ac_cv_prog_cc_works=yes
- # If we can't run a trivial program, we are probably using a cross compiler.
- if (./conftest; exit) 2>/dev/null; then
- ac_cv_prog_cc_cross=no
+ CC=$ac_ct_CC
+fi
+
+fi
+
+
+test -z "$CC" && { { echo "$as_me:$LINENO: error: no acceptable C compiler found in \$PATH
+See \`config.log' for more details." >&5
+echo "$as_me: error: no acceptable C compiler found in \$PATH
+See \`config.log' for more details." >&2;}
+ { (exit 1); exit 1; }; }
+
+# Provide some information about the compiler.
+echo "$as_me:$LINENO:" \
+ "checking for C compiler version" >&5
+ac_compiler=`set X $ac_compile; echo $2`
+{ (eval echo "$as_me:$LINENO: \"$ac_compiler --version </dev/null >&5\"") >&5
+ (eval $ac_compiler --version </dev/null >&5) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }
+{ (eval echo "$as_me:$LINENO: \"$ac_compiler -v </dev/null >&5\"") >&5
+ (eval $ac_compiler -v </dev/null >&5) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }
+{ (eval echo "$as_me:$LINENO: \"$ac_compiler -V </dev/null >&5\"") >&5
+ (eval $ac_compiler -V </dev/null >&5) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }
+
+cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+
+int
+main ()
+{
+
+ ;
+ return 0;
+}
+_ACEOF
+ac_clean_files_save=$ac_clean_files
+ac_clean_files="$ac_clean_files a.out a.exe b.out"
+# Try to create an executable without -o first, disregard a.out.
+# It will help us diagnose broken compilers, and finding out an intuition
+# of exeext.
+echo "$as_me:$LINENO: checking for C compiler default output file name" >&5
+echo $ECHO_N "checking for C compiler default output file name... $ECHO_C" >&6
+ac_link_default=`echo "$ac_link" | sed 's/ -o *conftest[^ ]*//'`
+if { (eval echo "$as_me:$LINENO: \"$ac_link_default\"") >&5
+ (eval $ac_link_default) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; then
+ # Find the output, starting from the most likely. This scheme is
+# not robust to junk in `.', hence go to wildcards (a.*) only as a last
+# resort.
+
+# Be careful to initialize this variable, since it used to be cached.
+# Otherwise an old cache value of `no' led to `EXEEXT = no' in a Makefile.
+ac_cv_exeext=
+# b.out is created by i960 compilers.
+for ac_file in a_out.exe a.exe conftest.exe a.out conftest a.* conftest.* b.out
+do
+ test -f "$ac_file" || continue
+ case $ac_file in
+ *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.o | *.obj )
+ ;;
+ conftest.$ac_ext )
+ # This is the source file.
+ ;;
+ [ab].out )
+ # We found the default executable, but exeext='' is most
+ # certainly right.
+ break;;
+ *.* )
+ ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'`
+ # FIXME: I believe we export ac_cv_exeext for Libtool,
+ # but it would be cool to find out if it's true. Does anybody
+ # maintain Libtool? --akim.
+ export ac_cv_exeext
+ break;;
+ * )
+ break;;
+ esac
+done
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+{ { echo "$as_me:$LINENO: error: C compiler cannot create executables
+See \`config.log' for more details." >&5
+echo "$as_me: error: C compiler cannot create executables
+See \`config.log' for more details." >&2;}
+ { (exit 77); exit 77; }; }
+fi
+
+ac_exeext=$ac_cv_exeext
+echo "$as_me:$LINENO: result: $ac_file" >&5
+echo "${ECHO_T}$ac_file" >&6
+
+# Check the compiler produces executables we can run. If not, either
+# the compiler is broken, or we cross compile.
+echo "$as_me:$LINENO: checking whether the C compiler works" >&5
+echo $ECHO_N "checking whether the C compiler works... $ECHO_C" >&6
+# FIXME: These cross compiler hacks should be removed for Autoconf 3.0
+# If not cross compiling, check that we can run a simple program.
+if test "$cross_compiling" != yes; then
+ if { ac_try='./$ac_file'
+ { (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
+ cross_compiling=no
else
- ac_cv_prog_cc_cross=yes
+ if test "$cross_compiling" = maybe; then
+ cross_compiling=yes
+ else
+ { { echo "$as_me:$LINENO: error: cannot run C compiled programs.
+If you meant to cross compile, use \`--host'.
+See \`config.log' for more details." >&5
+echo "$as_me: error: cannot run C compiled programs.
+If you meant to cross compile, use \`--host'.
+See \`config.log' for more details." >&2;}
+ { (exit 1); exit 1; }; }
+ fi
fi
-else
- echo "configure: failed program was:" >&5
- cat conftest.$ac_ext >&5
- ac_cv_prog_cc_works=no
fi
-rm -fr conftest*
-ac_ext=c
-# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
-ac_cpp='$CPP $CPPFLAGS'
-ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
-ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
-cross_compiling=$ac_cv_prog_cc_cross
-
-echo "$ac_t""$ac_cv_prog_cc_works" 1>&6
-if test $ac_cv_prog_cc_works = no; then
- { echo "configure: error: installation or configuration problem: C compiler cannot create executables." 1>&2; exit 1; }
-fi
-echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler""... $ac_c" 1>&6
-echo "configure:736: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler" >&5
-echo "$ac_t""$ac_cv_prog_cc_cross" 1>&6
-cross_compiling=$ac_cv_prog_cc_cross
-
-echo $ac_n "checking whether we are using GNU C""... $ac_c" 1>&6
-echo "configure:741: checking whether we are using GNU C" >&5
-if eval "test \"`echo '$''{'ac_cv_prog_gcc'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&6
-else
- cat > conftest.c <<EOF
-#ifdef __GNUC__
- yes;
-#endif
-EOF
-if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:750: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then
- ac_cv_prog_gcc=yes
+echo "$as_me:$LINENO: result: yes" >&5
+echo "${ECHO_T}yes" >&6
+
+rm -f a.out a.exe conftest$ac_cv_exeext b.out
+ac_clean_files=$ac_clean_files_save
+# Check the compiler produces executables we can run. If not, either
+# the compiler is broken, or we cross compile.
+echo "$as_me:$LINENO: checking whether we are cross compiling" >&5
+echo $ECHO_N "checking whether we are cross compiling... $ECHO_C" >&6
+echo "$as_me:$LINENO: result: $cross_compiling" >&5
+echo "${ECHO_T}$cross_compiling" >&6
+
+echo "$as_me:$LINENO: checking for suffix of executables" >&5
+echo $ECHO_N "checking for suffix of executables... $ECHO_C" >&6
+if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
+ (eval $ac_link) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; then
+ # If both `conftest.exe' and `conftest' are `present' (well, observable)
+# catch `conftest.exe'. For instance with Cygwin, `ls conftest' will
+# work properly (i.e., refer to `conftest.exe'), while it won't with
+# `rm'.
+for ac_file in conftest.exe conftest conftest.*; do
+ test -f "$ac_file" || continue
+ case $ac_file in
+ *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.o | *.obj ) ;;
+ *.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'`
+ export ac_cv_exeext
+ break;;
+ * ) break;;
+ esac
+done
else
- ac_cv_prog_gcc=no
-fi
+ { { echo "$as_me:$LINENO: error: cannot compute suffix of executables: cannot compile and link
+See \`config.log' for more details." >&5
+echo "$as_me: error: cannot compute suffix of executables: cannot compile and link
+See \`config.log' for more details." >&2;}
+ { (exit 1); exit 1; }; }
fi
-echo "$ac_t""$ac_cv_prog_gcc" 1>&6
+rm -f conftest$ac_cv_exeext
+echo "$as_me:$LINENO: result: $ac_cv_exeext" >&5
+echo "${ECHO_T}$ac_cv_exeext" >&6
-if test $ac_cv_prog_gcc = yes; then
- GCC=yes
+rm -f conftest.$ac_ext
+EXEEXT=$ac_cv_exeext
+ac_exeext=$EXEEXT
+echo "$as_me:$LINENO: checking for suffix of object files" >&5
+echo $ECHO_N "checking for suffix of object files... $ECHO_C" >&6
+if test "${ac_cv_objext+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. */
+
+int
+main ()
+{
+
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.o conftest.obj
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; then
+ for ac_file in `(ls conftest.o conftest.obj; ls conftest.*) 2>/dev/null`; do
+ case $ac_file in
+ *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg ) ;;
+ *) ac_cv_objext=`expr "$ac_file" : '.*\.\(.*\)'`
+ break;;
+ esac
+done
else
- GCC=
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+{ { echo "$as_me:$LINENO: error: cannot compute suffix of object files: cannot compile
+See \`config.log' for more details." >&5
+echo "$as_me: error: cannot compute suffix of object files: cannot compile
+See \`config.log' for more details." >&2;}
+ { (exit 1); exit 1; }; }
fi
-ac_test_CFLAGS="${CFLAGS+set}"
-ac_save_CFLAGS="$CFLAGS"
-CFLAGS=
-echo $ac_n "checking whether ${CC-cc} accepts -g""... $ac_c" 1>&6
-echo "configure:769: checking whether ${CC-cc} accepts -g" >&5
-if eval "test \"`echo '$''{'ac_cv_prog_cc_g'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&6
+rm -f conftest.$ac_cv_objext conftest.$ac_ext
+fi
+echo "$as_me:$LINENO: result: $ac_cv_objext" >&5
+echo "${ECHO_T}$ac_cv_objext" >&6
+OBJEXT=$ac_cv_objext
+ac_objext=$OBJEXT
+echo "$as_me:$LINENO: checking whether we are using the GNU C compiler" >&5
+echo $ECHO_N "checking whether we are using the GNU C compiler... $ECHO_C" >&6
+if test "${ac_cv_c_compiler_gnu+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
else
- echo 'void f(){}' > conftest.c
-if test -z "`${CC-cc} -g -c conftest.c 2>&1`"; then
- ac_cv_prog_cc_g=yes
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+
+int
+main ()
+{
+#ifndef __GNUC__
+ choke me
+#endif
+
+ ;
+ 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_compiler_gnu=yes
else
- ac_cv_prog_cc_g=no
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ac_compiler_gnu=no
fi
-rm -f conftest*
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+ac_cv_c_compiler_gnu=$ac_compiler_gnu
fi
+echo "$as_me:$LINENO: result: $ac_cv_c_compiler_gnu" >&5
+echo "${ECHO_T}$ac_cv_c_compiler_gnu" >&6
+GCC=`test $ac_compiler_gnu = yes && echo yes`
+ac_test_CFLAGS=${CFLAGS+set}
+ac_save_CFLAGS=$CFLAGS
+CFLAGS="-g"
+echo "$as_me:$LINENO: checking whether $CC accepts -g" >&5
+echo $ECHO_N "checking whether $CC accepts -g... $ECHO_C" >&6
+if test "${ac_cv_prog_cc_g+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. */
+
+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_prog_cc_g=yes
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
-echo "$ac_t""$ac_cv_prog_cc_g" 1>&6
+ac_cv_prog_cc_g=no
+fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+echo "$as_me:$LINENO: result: $ac_cv_prog_cc_g" >&5
+echo "${ECHO_T}$ac_cv_prog_cc_g" >&6
if test "$ac_test_CFLAGS" = set; then
- CFLAGS="$ac_save_CFLAGS"
+ CFLAGS=$ac_save_CFLAGS
elif test $ac_cv_prog_cc_g = yes; then
if test "$GCC" = yes; then
CFLAGS="-g -O2"
@@ -795,269 +2015,1036 @@ else
CFLAGS=
fi
fi
+echo "$as_me:$LINENO: checking for $CC option to accept ANSI C" >&5
+echo $ECHO_N "checking for $CC option to accept ANSI C... $ECHO_C" >&6
+if test "${ac_cv_prog_cc_stdc+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ ac_cv_prog_cc_stdc=no
+ac_save_CC=$CC
+cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+#include <stdarg.h>
+#include <stdio.h>
+#include <sys/types.h>
+#include <sys/stat.h>
+/* Most of the following tests are stolen from RCS 5.7's src/conf.sh. */
+struct buf { int x; };
+FILE * (*rcsopen) (struct buf *, struct stat *, int);
+static char *e (p, i)
+ char **p;
+ int i;
+{
+ return p[i];
+}
+static char *f (char * (*g) (char **, int), char **p, ...)
+{
+ char *s;
+ va_list v;
+ va_start (v,p);
+ s = g (p, va_arg (v,int));
+ va_end (v);
+ return s;
+}
+
+/* OSF 4.0 Compaq cc is some sort of almost-ANSI by default. It has
+ function prototypes and stuff, but not '\xHH' hex character constants.
+ These don't provoke an error unfortunately, instead are silently treated
+ as 'x'. The following induces an error, until -std1 is added to get
+ proper ANSI mode. Curiously '\x00'!='x' always comes out true, for an
+ array size at least. It's necessary to write '\x00'==0 to get something
+ that's true only with -std1. */
+int osf4_cc_array ['\x00' == 0 ? 1 : -1];
+
+int test (int i, double x);
+struct s1 {int (*f) (int a);};
+struct s2 {int (*f) (double a);};
+int pairnames (int, char **, FILE *(*)(struct buf *, struct stat *, int), int, int);
+int argc;
+char **argv;
+int
+main ()
+{
+return f (e, argv, 0) != argv[0] || f (e, argv, 1) != argv[1];
+ ;
+ return 0;
+}
+_ACEOF
+# Don't try gcc -ansi; that turns off useful extensions and
+# breaks some systems' header files.
+# AIX -qlanglvl=ansi
+# Ultrix and OSF/1 -std1
+# HP-UX 10.20 and later -Ae
+# HP-UX older versions -Aa -D_HPUX_SOURCE
+# SVR4 -Xc -D__EXTENSIONS__
+for ac_arg in "" -qlanglvl=ansi -std1 -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__"
+do
+ CC="$ac_save_CC $ac_arg"
+ 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_prog_cc_stdc=$ac_arg
+break
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+fi
+rm -f conftest.err conftest.$ac_objext
+done
+rm -f conftest.$ac_ext conftest.$ac_objext
+CC=$ac_save_CC
-# To properly support cross-compilation, one would
-# need to use these tool checks instead of
-# the ones below and reconfigure with
-# autoconf 2.50. You can also just set
-# the CC, AR, RANLIB, and RC environment
-# variables if you want to cross compile.
+fi
-if test "${GCC}" = "yes" ; then
- # Extract the first word of "ar", so it can be a program name with args.
-set dummy ar; ac_word=$2
-echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
-echo "configure:812: checking for $ac_word" >&5
-if eval "test \"`echo '$''{'ac_cv_prog_AR'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&6
+case "x$ac_cv_prog_cc_stdc" in
+ x|xno)
+ echo "$as_me:$LINENO: result: none needed" >&5
+echo "${ECHO_T}none needed" >&6 ;;
+ *)
+ echo "$as_me:$LINENO: result: $ac_cv_prog_cc_stdc" >&5
+echo "${ECHO_T}$ac_cv_prog_cc_stdc" >&6
+ CC="$CC $ac_cv_prog_cc_stdc" ;;
+esac
+
+# Some people use a C++ compiler to compile C. Since we use `exit',
+# in C++ we need to declare it. In case someone uses the same compiler
+# for both compiling C and C++ we need to have the C++ compiler decide
+# the declaration of exit, since it's the most demanding environment.
+cat >conftest.$ac_ext <<_ACEOF
+#ifndef __cplusplus
+ choke me
+#endif
+_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
+ for ac_declaration in \
+ '' \
+ 'extern "C" void std::exit (int) throw (); using std::exit;' \
+ 'extern "C" void std::exit (int); using std::exit;' \
+ 'extern "C" void exit (int) throw ();' \
+ 'extern "C" void exit (int);' \
+ 'void exit (int);'
+do
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+$ac_declaration
+#include <stdlib.h>
+int
+main ()
+{
+exit (42);
+ ;
+ 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
+ :
else
- if test -n "$AR"; then
- ac_cv_prog_AR="$AR" # Let the user override the test.
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+continue
+fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+$ac_declaration
+int
+main ()
+{
+exit (42);
+ ;
+ 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
+ break
else
- IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
- ac_dummy="$PATH"
- for ac_dir in $ac_dummy; do
- test -z "$ac_dir" && ac_dir=.
- if test -f $ac_dir/$ac_word; then
- ac_cv_prog_AR="ar"
- break
- fi
- done
- IFS="$ac_save_ifs"
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+done
+rm -f conftest*
+if test -n "$ac_declaration"; then
+ echo '#ifdef __cplusplus' >>confdefs.h
+ echo $ac_declaration >>confdefs.h
+ echo '#endif' >>confdefs.h
fi
-AR="$ac_cv_prog_AR"
-if test -n "$AR"; then
- echo "$ac_t""$AR" 1>&6
+
else
- echo "$ac_t""no" 1>&6
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
- # Extract the first word of "ranlib", so it can be a program name with args.
-set dummy ranlib; ac_word=$2
-echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
-echo "configure:841: checking for $ac_word" >&5
-if eval "test \"`echo '$''{'ac_cv_prog_RANLIB'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&6
+
+echo "$as_me:$LINENO: checking for inline" >&5
+echo $ECHO_N "checking for inline... $ECHO_C" >&6
+if test "${ac_cv_c_inline+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
else
- if test -n "$RANLIB"; then
- ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test.
+ ac_cv_c_inline=no
+for ac_kw in inline __inline__ __inline; do
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+#ifndef __cplusplus
+typedef int foo_t;
+static $ac_kw foo_t static_foo () {return 0; }
+$ac_kw foo_t foo () {return 0; }
+#endif
+
+_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_c_inline=$ac_kw; break
else
- IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
- ac_dummy="$PATH"
- for ac_dir in $ac_dummy; do
- test -z "$ac_dir" && ac_dir=.
- if test -f $ac_dir/$ac_word; then
- ac_cv_prog_RANLIB="ranlib"
- break
- fi
- done
- IFS="$ac_save_ifs"
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+done
+
fi
-RANLIB="$ac_cv_prog_RANLIB"
-if test -n "$RANLIB"; then
- echo "$ac_t""$RANLIB" 1>&6
+echo "$as_me:$LINENO: result: $ac_cv_c_inline" >&5
+echo "${ECHO_T}$ac_cv_c_inline" >&6
+
+
+case $ac_cv_c_inline in
+ inline | yes) ;;
+ *)
+ case $ac_cv_c_inline in
+ no) ac_val=;;
+ *) ac_val=$ac_cv_c_inline;;
+ esac
+ cat >>confdefs.h <<_ACEOF
+#ifndef __cplusplus
+#define inline $ac_val
+#endif
+_ACEOF
+ ;;
+esac
+
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+echo "$as_me:$LINENO: checking how to run the C preprocessor" >&5
+echo $ECHO_N "checking how to run the C preprocessor... $ECHO_C" >&6
+# On Suns, sometimes $CPP names a directory.
+if test -n "$CPP" && test -d "$CPP"; then
+ CPP=
+fi
+if test -z "$CPP"; then
+ if test "${ac_cv_prog_CPP+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ # Double quotes because CPP needs to be expanded
+ for CPP in "$CC -E" "$CC -E -traditional-cpp" "/lib/cpp"
+ do
+ ac_preproc_ok=false
+for ac_c_preproc_warn_flag in '' yes
+do
+ # Use a header file that comes with gcc, so configuring glibc
+ # with a fresh cross-compiler works.
+ # Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
+ # <limits.h> exists even on freestanding compilers.
+ # On the NeXT, cc -E runs the code through the compiler's parser,
+ # not just through cpp. "Syntax error" is here to catch this case.
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+#ifdef __STDC__
+# include <limits.h>
+#else
+# include <assert.h>
+#endif
+ Syntax error
+_ACEOF
+if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5
+ (eval $ac_cpp conftest.$ac_ext) 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); } >/dev/null; then
+ if test -s conftest.err; then
+ ac_cpp_err=$ac_c_preproc_warn_flag
+ ac_cpp_err=$ac_cpp_err$ac_c_werror_flag
+ else
+ ac_cpp_err=
+ fi
else
- echo "$ac_t""no" 1>&6
+ ac_cpp_err=yes
fi
+if test -z "$ac_cpp_err"; then
+ :
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
- # Extract the first word of "windres", so it can be a program name with args.
-set dummy windres; ac_word=$2
-echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
-echo "configure:870: checking for $ac_word" >&5
-if eval "test \"`echo '$''{'ac_cv_prog_RC'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&6
+ # Broken: fails on valid input.
+continue
+fi
+rm -f conftest.err conftest.$ac_ext
+
+ # OK, works on sane cases. Now check whether non-existent headers
+ # can be detected and how.
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+#include <ac_nonexistent.h>
+_ACEOF
+if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5
+ (eval $ac_cpp conftest.$ac_ext) 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); } >/dev/null; then
+ if test -s conftest.err; then
+ ac_cpp_err=$ac_c_preproc_warn_flag
+ ac_cpp_err=$ac_cpp_err$ac_c_werror_flag
+ else
+ ac_cpp_err=
+ fi
else
- if test -n "$RC"; then
- ac_cv_prog_RC="$RC" # Let the user override the test.
+ ac_cpp_err=yes
+fi
+if test -z "$ac_cpp_err"; then
+ # Broken: success on invalid input.
+continue
else
- IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
- ac_dummy="$PATH"
- for ac_dir in $ac_dummy; do
- test -z "$ac_dir" && ac_dir=.
- if test -f $ac_dir/$ac_word; then
- ac_cv_prog_RC="windres"
- break
- fi
- done
- IFS="$ac_save_ifs"
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ # Passes both tests.
+ac_preproc_ok=:
+break
fi
+rm -f conftest.err conftest.$ac_ext
+
+done
+# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped.
+rm -f conftest.err conftest.$ac_ext
+if $ac_preproc_ok; then
+ break
fi
-RC="$ac_cv_prog_RC"
-if test -n "$RC"; then
- echo "$ac_t""$RC" 1>&6
+
+ done
+ ac_cv_prog_CPP=$CPP
+
+fi
+ CPP=$ac_cv_prog_CPP
else
- echo "$ac_t""no" 1>&6
+ ac_cv_prog_CPP=$CPP
fi
+echo "$as_me:$LINENO: result: $CPP" >&5
+echo "${ECHO_T}$CPP" >&6
+ac_preproc_ok=false
+for ac_c_preproc_warn_flag in '' yes
+do
+ # Use a header file that comes with gcc, so configuring glibc
+ # with a fresh cross-compiler works.
+ # Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
+ # <limits.h> exists even on freestanding compilers.
+ # On the NeXT, cc -E runs the code through the compiler's parser,
+ # not just through cpp. "Syntax error" is here to catch this case.
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+#ifdef __STDC__
+# include <limits.h>
+#else
+# include <assert.h>
+#endif
+ Syntax error
+_ACEOF
+if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5
+ (eval $ac_cpp conftest.$ac_ext) 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); } >/dev/null; then
+ if test -s conftest.err; then
+ ac_cpp_err=$ac_c_preproc_warn_flag
+ ac_cpp_err=$ac_cpp_err$ac_c_werror_flag
+ else
+ ac_cpp_err=
+ fi
+else
+ ac_cpp_err=yes
+fi
+if test -z "$ac_cpp_err"; then
+ :
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+ # Broken: fails on valid input.
+continue
+fi
+rm -f conftest.err conftest.$ac_ext
+
+ # OK, works on sane cases. Now check whether non-existent headers
+ # can be detected and how.
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+#include <ac_nonexistent.h>
+_ACEOF
+if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5
+ (eval $ac_cpp conftest.$ac_ext) 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); } >/dev/null; then
+ if test -s conftest.err; then
+ ac_cpp_err=$ac_c_preproc_warn_flag
+ ac_cpp_err=$ac_cpp_err$ac_c_werror_flag
+ else
+ ac_cpp_err=
+ fi
+else
+ ac_cpp_err=yes
+fi
+if test -z "$ac_cpp_err"; then
+ # Broken: success on invalid input.
+continue
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
- if test "${AR}" = "" ; then
- { echo "configure: error: Required archive tool 'ar' not found on PATH." 1>&2; exit 1; }
- fi
- if test "${RANLIB}" = "" ; then
- { echo "configure: error: Required archive index tool 'ranlib' not found on PATH." 1>&2; exit 1; }
- fi
- if test "${RC}" = "" ; then
- { echo "configure: error: Required resource tool 'windres' not found on PATH." 1>&2; exit 1; }
+ # Passes both tests.
+ac_preproc_ok=:
+break
+fi
+rm -f conftest.err conftest.$ac_ext
+
+done
+# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped.
+rm -f conftest.err conftest.$ac_ext
+if $ac_preproc_ok; then
+ :
+else
+ { { echo "$as_me:$LINENO: error: C preprocessor \"$CPP\" fails sanity check
+See \`config.log' for more details." >&5
+echo "$as_me: error: C preprocessor \"$CPP\" fails sanity check
+See \`config.log' for more details." >&2;}
+ { (exit 1); exit 1; }; }
+fi
+
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+
+
+echo "$as_me:$LINENO: checking for egrep" >&5
+echo $ECHO_N "checking for egrep... $ECHO_C" >&6
+if test "${ac_cv_prog_egrep+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ if echo a | (grep -E '(a|b)') >/dev/null 2>&1
+ then ac_cv_prog_egrep='grep -E'
+ else ac_cv_prog_egrep='egrep'
fi
fi
+echo "$as_me:$LINENO: result: $ac_cv_prog_egrep" >&5
+echo "${ECHO_T}$ac_cv_prog_egrep" >&6
+ EGREP=$ac_cv_prog_egrep
-#--------------------------------------------------------------------
-# Checks to see if the make program sets the $MAKE variable.
-#--------------------------------------------------------------------
-echo $ac_n "checking whether ${MAKE-make} sets \${MAKE}""... $ac_c" 1>&6
-echo "configure:913: checking whether ${MAKE-make} sets \${MAKE}" >&5
-set dummy ${MAKE-make}; ac_make=`echo "$2" | sed 'y%./+-%__p_%'`
-if eval "test \"`echo '$''{'ac_cv_prog_make_${ac_make}_set'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&6
+echo "$as_me:$LINENO: checking for ANSI C header files" >&5
+echo $ECHO_N "checking for ANSI C header files... $ECHO_C" >&6
+if test "${ac_cv_header_stdc+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
else
- cat > conftestmake <<\EOF
-all:
- @echo 'ac_maketemp="${MAKE}"'
-EOF
-# GNU make sometimes prints "make[1]: Entering...", which would confuse us.
-eval `${MAKE-make} -f conftestmake 2>/dev/null | grep temp=`
-if test -n "$ac_maketemp"; then
- eval ac_cv_prog_make_${ac_make}_set=yes
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+#include <stdlib.h>
+#include <stdarg.h>
+#include <string.h>
+#include <float.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
+ ac_cv_header_stdc=yes
else
- eval ac_cv_prog_make_${ac_make}_set=no
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ac_cv_header_stdc=no
+fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+
+if test $ac_cv_header_stdc = yes; then
+ # SunOS 4.x string.h does not declare mem*, contrary to ANSI.
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+#include <string.h>
+
+_ACEOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ $EGREP "memchr" >/dev/null 2>&1; then
+ :
+else
+ ac_cv_header_stdc=no
fi
-rm -f conftestmake
+rm -f conftest*
+
fi
-if eval "test \"`echo '$ac_cv_prog_make_'${ac_make}_set`\" = yes"; then
- echo "$ac_t""yes" 1>&6
- SET_MAKE=
+
+if test $ac_cv_header_stdc = yes; then
+ # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI.
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+#include <stdlib.h>
+
+_ACEOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ $EGREP "free" >/dev/null 2>&1; then
+ :
else
- echo "$ac_t""no" 1>&6
- SET_MAKE="MAKE=${MAKE-make}"
+ ac_cv_header_stdc=no
fi
+rm -f conftest*
+fi
-#--------------------------------------------------------------------
-# Determines the correct binary file extension (.o, .obj, .exe etc.)
-#--------------------------------------------------------------------
+if test $ac_cv_header_stdc = yes; then
+ # /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi.
+ if test "$cross_compiling" = yes; then
+ :
+else
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+#include <ctype.h>
+#if ((' ' & 0x0FF) == 0x020)
+# define ISLOWER(c) ('a' <= (c) && (c) <= 'z')
+# define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c))
+#else
+# define ISLOWER(c) \
+ (('a' <= (c) && (c) <= 'i') \
+ || ('j' <= (c) && (c) <= 'r') \
+ || ('s' <= (c) && (c) <= 'z'))
+# define TOUPPER(c) (ISLOWER(c) ? ((c) | 0x40) : (c))
+#endif
-echo $ac_n "checking for object suffix""... $ac_c" 1>&6
-echo "configure:945: checking for object suffix" >&5
-if eval "test \"`echo '$''{'ac_cv_objext'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&6
-else
- rm -f conftest*
-echo 'int i = 1;' > conftest.$ac_ext
-if { (eval echo configure:951: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
- for ac_file in conftest.*; do
- case $ac_file in
- *.c) ;;
- *) ac_cv_objext=`echo $ac_file | sed -e s/conftest.//` ;;
- esac
- done
+#define XOR(e, f) (((e) && !(f)) || (!(e) && (f)))
+int
+main ()
+{
+ int i;
+ for (i = 0; i < 256; i++)
+ if (XOR (islower (i), ISLOWER (i))
+ || toupper (i) != TOUPPER (i))
+ exit(2);
+ exit (0);
+}
+_ACEOF
+rm -f conftest$ac_exeext
+if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
+ (eval $ac_link) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } && { ac_try='./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
+ :
else
- { echo "configure: error: installation or configuration problem; compiler does not work" 1>&2; exit 1; }
+ echo "$as_me: program exited with status $ac_status" >&5
+echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+( exit $ac_status )
+ac_cv_header_stdc=no
+fi
+rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext
fi
-rm -f conftest*
fi
+fi
+echo "$as_me:$LINENO: result: $ac_cv_header_stdc" >&5
+echo "${ECHO_T}$ac_cv_header_stdc" >&6
+if test $ac_cv_header_stdc = yes; then
-echo "$ac_t""$ac_cv_objext" 1>&6
-OBJEXT=$ac_cv_objext
-ac_objext=$ac_cv_objext
+cat >>confdefs.h <<\_ACEOF
+#define STDC_HEADERS 1
+_ACEOF
+
+fi
+
+
+if test -n "$ac_tool_prefix"; then
+ # Extract the first word of "${ac_tool_prefix}ar", so it can be a program name with args.
+set dummy ${ac_tool_prefix}ar; ac_word=$2
+echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
+if test "${ac_cv_prog_AR+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ if test -n "$AR"; then
+ ac_cv_prog_AR="$AR" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_prog_AR="${ac_tool_prefix}ar"
+ echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+done
-echo $ac_n "checking for Cygwin environment""... $ac_c" 1>&6
-echo "configure:969: checking for Cygwin environment" >&5
-if eval "test \"`echo '$''{'ac_cv_cygwin'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&6
+fi
+fi
+AR=$ac_cv_prog_AR
+if test -n "$AR"; then
+ echo "$as_me:$LINENO: result: $AR" >&5
+echo "${ECHO_T}$AR" >&6
else
- cat > conftest.$ac_ext <<EOF
-#line 974 "configure"
-#include "confdefs.h"
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
+fi
-int main() {
+fi
+if test -z "$ac_cv_prog_AR"; then
+ ac_ct_AR=$AR
+ # Extract the first word of "ar", so it can be a program name with args.
+set dummy ar; ac_word=$2
+echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
+if test "${ac_cv_prog_ac_ct_AR+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ if test -n "$ac_ct_AR"; then
+ ac_cv_prog_ac_ct_AR="$ac_ct_AR" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_prog_ac_ct_AR="ar"
+ echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+done
-#ifndef __CYGWIN__
-#define __CYGWIN__ __CYGWIN32__
-#endif
-return __CYGWIN__;
-; return 0; }
-EOF
-if { (eval echo configure:985: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
- rm -rf conftest*
- ac_cv_cygwin=yes
-else
- echo "configure: failed program was:" >&5
- cat conftest.$ac_ext >&5
- rm -rf conftest*
- ac_cv_cygwin=no
fi
-rm -f conftest*
-rm -f conftest*
+fi
+ac_ct_AR=$ac_cv_prog_ac_ct_AR
+if test -n "$ac_ct_AR"; then
+ echo "$as_me:$LINENO: result: $ac_ct_AR" >&5
+echo "${ECHO_T}$ac_ct_AR" >&6
+else
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
fi
-echo "$ac_t""$ac_cv_cygwin" 1>&6
-CYGWIN=
-test "$ac_cv_cygwin" = yes && CYGWIN=yes
-echo $ac_n "checking for mingw32 environment""... $ac_c" 1>&6
-echo "configure:1002: checking for mingw32 environment" >&5
-if eval "test \"`echo '$''{'ac_cv_mingw32'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&6
+ AR=$ac_ct_AR
else
- cat > conftest.$ac_ext <<EOF
-#line 1007 "configure"
-#include "confdefs.h"
+ AR="$ac_cv_prog_AR"
+fi
-int main() {
-return __MINGW32__;
-; return 0; }
-EOF
-if { (eval echo configure:1014: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
- rm -rf conftest*
- ac_cv_mingw32=yes
+if test -n "$ac_tool_prefix"; then
+ # Extract the first word of "${ac_tool_prefix}ranlib", so it can be a program name with args.
+set dummy ${ac_tool_prefix}ranlib; ac_word=$2
+echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
+if test "${ac_cv_prog_RANLIB+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
else
- echo "configure: failed program was:" >&5
- cat conftest.$ac_ext >&5
- rm -rf conftest*
- ac_cv_mingw32=no
+ if test -n "$RANLIB"; then
+ ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_prog_RANLIB="${ac_tool_prefix}ranlib"
+ echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+done
+
fi
-rm -f conftest*
-rm -f conftest*
fi
+RANLIB=$ac_cv_prog_RANLIB
+if test -n "$RANLIB"; then
+ echo "$as_me:$LINENO: result: $RANLIB" >&5
+echo "${ECHO_T}$RANLIB" >&6
+else
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
+fi
+
+fi
+if test -z "$ac_cv_prog_RANLIB"; then
+ ac_ct_RANLIB=$RANLIB
+ # Extract the first word of "ranlib", so it can be a program name with args.
+set dummy ranlib; ac_word=$2
+echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
+if test "${ac_cv_prog_ac_ct_RANLIB+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ if test -n "$ac_ct_RANLIB"; then
+ ac_cv_prog_ac_ct_RANLIB="$ac_ct_RANLIB" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_prog_ac_ct_RANLIB="ranlib"
+ echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+done
-echo "$ac_t""$ac_cv_mingw32" 1>&6
-MINGW32=
-test "$ac_cv_mingw32" = yes && MINGW32=yes
+fi
+fi
+ac_ct_RANLIB=$ac_cv_prog_ac_ct_RANLIB
+if test -n "$ac_ct_RANLIB"; then
+ echo "$as_me:$LINENO: result: $ac_ct_RANLIB" >&5
+echo "${ECHO_T}$ac_ct_RANLIB" >&6
+else
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
+fi
+ RANLIB=$ac_ct_RANLIB
+else
+ RANLIB="$ac_cv_prog_RANLIB"
+fi
-echo $ac_n "checking for executable suffix""... $ac_c" 1>&6
-echo "configure:1033: checking for executable suffix" >&5
-if eval "test \"`echo '$''{'ac_cv_exeext'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&6
+if test -n "$ac_tool_prefix"; then
+ # Extract the first word of "${ac_tool_prefix}windres", so it can be a program name with args.
+set dummy ${ac_tool_prefix}windres; ac_word=$2
+echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
+if test "${ac_cv_prog_RC+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
else
- if test "$CYGWIN" = yes || test "$MINGW32" = yes; then
- ac_cv_exeext=.exe
+ if test -n "$RC"; then
+ ac_cv_prog_RC="$RC" # Let the user override the test.
else
- rm -f conftest*
- echo 'int main () { return 0; }' > conftest.$ac_ext
- ac_cv_exeext=
- if { (eval echo configure:1043: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; }; then
- for file in conftest.*; do
- case $file in
- *.c | *.o | *.obj) ;;
- *) ac_cv_exeext=`echo $file | sed -e s/conftest//` ;;
- esac
- done
- else
- { echo "configure: error: installation or configuration problem: compiler cannot create executables." 1>&2; exit 1; }
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_prog_RC="${ac_tool_prefix}windres"
+ echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
fi
- rm -f conftest*
- test x"${ac_cv_exeext}" = x && ac_cv_exeext=no
+done
+done
+
fi
fi
+RC=$ac_cv_prog_RC
+if test -n "$RC"; then
+ echo "$as_me:$LINENO: result: $RC" >&5
+echo "${ECHO_T}$RC" >&6
+else
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
+fi
+
+fi
+if test -z "$ac_cv_prog_RC"; then
+ ac_ct_RC=$RC
+ # Extract the first word of "windres", so it can be a program name with args.
+set dummy windres; ac_word=$2
+echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
+if test "${ac_cv_prog_ac_ct_RC+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ if test -n "$ac_ct_RC"; then
+ ac_cv_prog_ac_ct_RC="$ac_ct_RC" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_prog_ac_ct_RC="windres"
+ echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+done
+
+fi
+fi
+ac_ct_RC=$ac_cv_prog_ac_ct_RC
+if test -n "$ac_ct_RC"; then
+ echo "$as_me:$LINENO: result: $ac_ct_RC" >&5
+echo "${ECHO_T}$ac_ct_RC" >&6
+else
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
+fi
+
+ RC=$ac_ct_RC
+else
+ RC="$ac_cv_prog_RC"
+fi
+
+
+#--------------------------------------------------------------------
+# Checks to see if the make program sets the $MAKE variable.
+#--------------------------------------------------------------------
+
+echo "$as_me:$LINENO: checking whether ${MAKE-make} sets \$(MAKE)" >&5
+echo $ECHO_N "checking whether ${MAKE-make} sets \$(MAKE)... $ECHO_C" >&6
+set dummy ${MAKE-make}; ac_make=`echo "$2" | sed 'y,:./+-,___p_,'`
+if eval "test \"\${ac_cv_prog_make_${ac_make}_set+set}\" = set"; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ cat >conftest.make <<\_ACEOF
+all:
+ @echo 'ac_maketemp="$(MAKE)"'
+_ACEOF
+# GNU make sometimes prints "make[1]: Entering...", which would confuse us.
+eval `${MAKE-make} -f conftest.make 2>/dev/null | grep temp=`
+if test -n "$ac_maketemp"; then
+ eval ac_cv_prog_make_${ac_make}_set=yes
+else
+ eval ac_cv_prog_make_${ac_make}_set=no
+fi
+rm -f conftest.make
+fi
+if eval "test \"`echo '$ac_cv_prog_make_'${ac_make}_set`\" = yes"; then
+ echo "$as_me:$LINENO: result: yes" >&5
+echo "${ECHO_T}yes" >&6
+ SET_MAKE=
+else
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
+ SET_MAKE="MAKE=${MAKE-make}"
+fi
+
+
+#--------------------------------------------------------------------
+# Determines the correct binary file extension (.o, .obj, .exe etc.)
+#--------------------------------------------------------------------
+
-EXEEXT=""
-test x"${ac_cv_exeext}" != xno && EXEEXT=${ac_cv_exeext}
-echo "$ac_t""${ac_cv_exeext}" 1>&6
-ac_exeext=$EXEEXT
#--------------------------------------------------------------------
@@ -1065,35 +3052,62 @@ ac_exeext=$EXEEXT
#--------------------------------------------------------------------
- echo $ac_n "checking for building with threads""... $ac_c" 1>&6
-echo "configure:1070: checking for building with threads" >&5
+ echo "$as_me:$LINENO: checking for building with threads" >&5
+echo $ECHO_N "checking for building with threads... $ECHO_C" >&6
# Check whether --enable-threads or --disable-threads was given.
if test "${enable_threads+set}" = set; then
enableval="$enable_threads"
tcl_ok=$enableval
else
tcl_ok=no
-fi
-
+fi;
if test "$tcl_ok" = "yes"; then
- echo "$ac_t""yes" 1>&6
+ echo "$as_me:$LINENO: result: yes" >&5
+echo "${ECHO_T}yes" >&6
TCL_THREADS=1
- cat >> confdefs.h <<\EOF
+ cat >>confdefs.h <<\_ACEOF
#define TCL_THREADS 1
-EOF
+_ACEOF
# USE_THREAD_ALLOC tells us to try the special thread-based
# allocator that significantly reduces lock contention
- cat >> confdefs.h <<\EOF
+ cat >>confdefs.h <<\_ACEOF
#define USE_THREAD_ALLOC 1
-EOF
+_ACEOF
else
TCL_THREADS=0
- echo "$ac_t""no (default)" 1>&6
+ echo "$as_me:$LINENO: result: no (default)" >&5
+echo "${ECHO_T}no (default)" >&6
+ fi
+
+
+
+#------------------------------------------------------------------------
+# Embedded configuration information, encoding to use for the values, TIP #59
+#------------------------------------------------------------------------
+
+
+
+# Check whether --with-encoding or --without-encoding was given.
+if test "${with_encoding+set}" = set; then
+ withval="$with_encoding"
+ with_tcencoding=${withval}
+fi;
+
+ if test x"${with_tcencoding}" != x ; then
+ cat >>confdefs.h <<_ACEOF
+#define TCL_CFGVAL_ENCODING "${with_tcencoding}"
+_ACEOF
+
+ else
+ # Default encoding on windows is not "iso8859-1"
+ cat >>confdefs.h <<\_ACEOF
+#define TCL_CFGVAL_ENCODING "cp1252"
+_ACEOF
+
fi
-
#--------------------------------------------------------------------
@@ -1102,16 +3116,15 @@ EOF
#--------------------------------------------------------------------
- echo $ac_n "checking how to build libraries""... $ac_c" 1>&6
-echo "configure:1107: checking how to build libraries" >&5
+ echo "$as_me:$LINENO: checking how to build libraries" >&5
+echo $ECHO_N "checking how to build libraries... $ECHO_C" >&6
# Check whether --enable-shared or --disable-shared was given.
if test "${enable_shared+set}" = set; then
enableval="$enable_shared"
tcl_ok=$enableval
else
tcl_ok=yes
-fi
-
+fi;
if test "${enable_shared+set}" = set; then
enableval="$enable_shared"
@@ -1121,14 +3134,16 @@ fi
fi
if test "$tcl_ok" = "yes" ; then
- echo "$ac_t""shared" 1>&6
+ echo "$as_me:$LINENO: result: shared" >&5
+echo "${ECHO_T}shared" >&6
SHARED_BUILD=1
else
- echo "$ac_t""static" 1>&6
+ echo "$as_me:$LINENO: result: static" >&5
+echo "${ECHO_T}static" >&6
SHARED_BUILD=0
- cat >> confdefs.h <<\EOF
+ cat >>confdefs.h <<\_ACEOF
#define STATIC_BUILD 1
-EOF
+_ACEOF
fi
@@ -1139,79 +3154,158 @@ EOF
# after SC_ENABLE_SHARED checks the configure switches.
#--------------------------------------------------------------------
+# On IRIX 5.3, sys/types and inttypes.h are conflicting.
+
+
+
+
+
+
+
+
+
+for ac_header in sys/types.h sys/stat.h stdlib.h string.h memory.h strings.h \
+ inttypes.h stdint.h unistd.h
+do
+as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh`
+echo "$as_me:$LINENO: checking for $ac_header" >&5
+echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6
+if eval "test \"\${$as_ac_Header+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. */
+$ac_includes_default
+
+#include <$ac_header>
+_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
+ eval "$as_ac_Header=yes"
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+eval "$as_ac_Header=no"
+fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5
+echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6
+if test `eval echo '${'$as_ac_Header'}'` = yes; then
+ cat >>confdefs.h <<_ACEOF
+#define `echo "HAVE_$ac_header" | $as_tr_cpp` 1
+_ACEOF
+
+fi
+
+done
+
+
# Step 0: Enable 64 bit support?
- echo $ac_n "checking if 64bit support is requested""... $ac_c" 1>&6
-echo "configure:1148: checking if 64bit support is requested" >&5
+ echo "$as_me:$LINENO: checking if 64bit support is requested" >&5
+echo $ECHO_N "checking if 64bit support is requested... $ECHO_C" >&6
# Check whether --enable-64bit or --disable-64bit was given.
if test "${enable_64bit+set}" = set; then
enableval="$enable_64bit"
do64bit=$enableval
else
do64bit=no
-fi
-
- echo "$ac_t""$do64bit" 1>&6
+fi;
+ echo "$as_me:$LINENO: result: $do64bit" >&5
+echo "${ECHO_T}$do64bit" >&6
# Cross-compiling options for Windows/CE builds
- echo $ac_n "checking if Windows/CE build is requested""... $ac_c" 1>&6
-echo "configure:1162: checking if Windows/CE build is requested" >&5
+ echo "$as_me:$LINENO: checking if Windows/CE build is requested" >&5
+echo $ECHO_N "checking if Windows/CE build is requested... $ECHO_C" >&6
# Check whether --enable-wince or --disable-wince was given.
if test "${enable_wince+set}" = set; then
enableval="$enable_wince"
doWince=$enableval
else
doWince=no
-fi
+fi;
+ echo "$as_me:$LINENO: result: $doWince" >&5
+echo "${ECHO_T}$doWince" >&6
- echo "$ac_t""$doWince" 1>&6
+ echo "$as_me:$LINENO: checking for Windows/CE celib directory" >&5
+echo $ECHO_N "checking for Windows/CE celib directory... $ECHO_C" >&6
- echo $ac_n "checking for Windows/CE celib directory""... $ac_c" 1>&6
-echo "configure:1174: checking for Windows/CE celib directory" >&5
- # Check whether --with-celib or --without-celib was given.
+# Check whether --with-celib or --without-celib was given.
if test "${with_celib+set}" = set; then
withval="$with_celib"
CELIB_DIR=$withval
else
CELIB_DIR=NO_CELIB
-fi
-
- echo "$ac_t""$CELIB_DIR" 1>&6
+fi;
+ echo "$as_me:$LINENO: result: $CELIB_DIR" >&5
+echo "${ECHO_T}$CELIB_DIR" >&6
# Set some defaults (may get changed below)
EXTRA_CFLAGS=""
# Extract the first word of "cygpath", so it can be a program name with args.
set dummy cygpath; ac_word=$2
-echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
-echo "configure:1191: checking for $ac_word" >&5
-if eval "test \"`echo '$''{'ac_cv_prog_CYGPATH'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&6
+echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
+if test "${ac_cv_prog_CYGPATH+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
else
if test -n "$CYGPATH"; then
ac_cv_prog_CYGPATH="$CYGPATH" # Let the user override the test.
else
- IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
- ac_dummy="$PATH"
- for ac_dir in $ac_dummy; do
- test -z "$ac_dir" && ac_dir=.
- if test -f $ac_dir/$ac_word; then
- ac_cv_prog_CYGPATH="cygpath -w"
- break
- fi
- done
- IFS="$ac_save_ifs"
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_prog_CYGPATH="cygpath -w"
+ echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+done
+
test -z "$ac_cv_prog_CYGPATH" && ac_cv_prog_CYGPATH="echo"
fi
fi
-CYGPATH="$ac_cv_prog_CYGPATH"
+CYGPATH=$ac_cv_prog_CYGPATH
if test -n "$CYGPATH"; then
- echo "$ac_t""$CYGPATH" 1>&6
+ echo "$as_me:$LINENO: result: $CYGPATH" >&5
+echo "${ECHO_T}$CYGPATH" >&6
else
- echo "$ac_t""no" 1>&6
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
fi
@@ -1223,37 +3317,64 @@ fi
if test "$GCC" = "yes"; then
- echo $ac_n "checking for cross-compile version of gcc""... $ac_c" 1>&6
-echo "configure:1228: checking for cross-compile version of gcc" >&5
-if eval "test \"`echo '$''{'ac_cv_cross'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&6
+ echo "$as_me:$LINENO: checking for cross-compile version of gcc" >&5
+echo $ECHO_N "checking for cross-compile version of gcc... $ECHO_C" >&6
+if test "${ac_cv_cross+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
else
- cat > conftest.$ac_ext <<EOF
-#line 1233 "configure"
-#include "confdefs.h"
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
#ifndef __WIN32__
#error cross-compiler
#endif
-
-int main() {
-; return 0; }
-EOF
-if { (eval echo configure:1244: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
- rm -rf conftest*
+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_cross=no
else
- echo "configure: failed program was:" >&5
- cat conftest.$ac_ext >&5
- rm -rf conftest*
- ac_cv_cross=yes
-fi
-rm -f conftest*
-
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ac_cv_cross=yes
fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
-echo "$ac_t""$ac_cv_cross" 1>&6
+fi
+echo "$as_me:$LINENO: result: $ac_cv_cross" >&5
+echo "${ECHO_T}$ac_cv_cross" >&6
if test "$ac_cv_cross" = "yes"; then
case "$do64bit" in
@@ -1288,13 +3409,20 @@ echo "$ac_t""$ac_cv_cross" 1>&6
echo "101 \"name\"" >> $conftest
echo "END" >> $conftest
- echo $ac_n "checking for Windows native path bug in windres""... $ac_c" 1>&6
-echo "configure:1293: checking for Windows native path bug in windres" >&5
+ echo "$as_me:$LINENO: checking for Windows native path bug in windres" >&5
+echo $ECHO_N "checking for Windows native path bug in windres... $ECHO_C" >&6
cyg_conftest=`$CYGPATH $conftest`
- if { ac_try='$RC -o conftest.res.o $cyg_conftest'; { (eval echo configure:1295: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } ; then
- echo "$ac_t""no" 1>&6
+ if { ac_try='$RC -o conftest.res.o $cyg_conftest'
+ { (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
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
else
- echo "$ac_t""yes" 1>&6
+ echo "$as_me:$LINENO: result: yes" >&5
+echo "${ECHO_T}yes" >&6
CYGPATH=echo
fi
conftest=
@@ -1310,49 +3438,79 @@ echo "configure:1293: checking for Windows native path bug in windres" >&5
# set various compiler flags depending on whether we are using gcc or cl
if test "${GCC}" = "yes" ; then
- echo $ac_n "checking for mingw32 version of gcc""... $ac_c" 1>&6
-echo "configure:1315: checking for mingw32 version of gcc" >&5
-if eval "test \"`echo '$''{'ac_cv_win32'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&6
+ echo "$as_me:$LINENO: checking for mingw32 version of gcc" >&5
+echo $ECHO_N "checking for mingw32 version of gcc... $ECHO_C" >&6
+if test "${ac_cv_win32+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
else
- cat > conftest.$ac_ext <<EOF
-#line 1320 "configure"
-#include "confdefs.h"
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
#ifdef __WIN32__
#error win32
#endif
-
-int main() {
-; return 0; }
-EOF
-if { (eval echo configure:1331: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
- rm -rf conftest*
+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_win32=no
else
- echo "configure: failed program was:" >&5
- cat conftest.$ac_ext >&5
- rm -rf conftest*
- ac_cv_win32=yes
-fi
-rm -f conftest*
-
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ac_cv_win32=yes
fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
-echo "$ac_t""$ac_cv_win32" 1>&6
+fi
+echo "$as_me:$LINENO: result: $ac_cv_win32" >&5
+echo "${ECHO_T}$ac_cv_win32" >&6
if test "$ac_cv_win32" != "yes"; then
- { echo "configure: error: ${CC} cannot produce win32 executables." 1>&2; exit 1; }
+ { { echo "$as_me:$LINENO: error: ${CC} cannot produce win32 executables." >&5
+echo "$as_me: error: ${CC} cannot produce win32 executables." >&2;}
+ { (exit 1); exit 1; }; }
fi
fi
- echo $ac_n "checking compiler flags""... $ac_c" 1>&6
-echo "configure:1351: checking compiler flags" >&5
+ echo "$as_me:$LINENO: checking compiler flags" >&5
+echo $ECHO_N "checking compiler flags... $ECHO_C" >&6
if test "${GCC}" = "yes" ; then
SHLIB_LD=""
SHLIB_LD_LIBS=""
- LIBS=""
- LIBS_GUI="-lgdi32 -lcomdlg32 -limm32 -lcomctl32 -lshell32"
+ LIBS="-lws2_32"
+ # mingw needs to link ole32 and oleaut32 for [send], but MSVC doesn't
+ LIBS_GUI="-lgdi32 -lcomdlg32 -limm32 -lcomctl32 -lshell32 -luuid -lole32 -loleaut32"
STLIB_LD='${AR} cr'
RC_OUT=-o
RC_TYPE=
@@ -1369,7 +3527,8 @@ echo "configure:1351: checking compiler flags" >&5
if test "${SHARED_BUILD}" = "0" ; then
# static
- echo "$ac_t""using static flags" 1>&6
+ echo "$as_me:$LINENO: result: using static flags" >&5
+echo "${ECHO_T}using static flags" >&6
runtime=
MAKE_DLL="echo "
LIBSUFFIX="s\${DBGX}.a"
@@ -1378,12 +3537,16 @@ echo "configure:1351: checking compiler flags" >&5
EXESUFFIX="s\${DBGX}.exe"
else
# dynamic
- echo "$ac_t""using shared flags" 1>&6
+ echo "$as_me:$LINENO: result: using shared flags" >&5
+echo "${ECHO_T}using shared flags" >&6
# ad-hoc check to see if CC supports -shared.
if "${CC}" -shared 2>&1 | egrep ': -shared not supported' >/dev/null; then
- { echo "configure: error: ${CC} does not support the -shared option.
- You will need to upgrade to a newer version of the toolchain." 1>&2; exit 1; }
+ { { echo "$as_me:$LINENO: error: ${CC} does not support the -shared option.
+ You will need to upgrade to a newer version of the toolchain." >&5
+echo "$as_me: error: ${CC} does not support the -shared option.
+ You will need to upgrade to a newer version of the toolchain." >&2;}
+ { (exit 1); exit 1; }; }
fi
runtime=
@@ -1410,7 +3573,7 @@ echo "configure:1351: checking compiler flags" >&5
CFLAGS_DEBUG=-g
CFLAGS_OPTIMIZE="-O2 -fomit-frame-pointer"
- CFLAGS_WARNING="-Wall -fno-strict-aliasing"
+ CFLAGS_WARNING="-Wall"
LDFLAGS_DEBUG=
LDFLAGS_OPTIMIZE=
@@ -1438,47 +3601,78 @@ echo "configure:1351: checking compiler flags" >&5
case "$do64bit" in
amd64|x64|yes)
MACHINE="AMD64" ; # assume AMD64 as default 64-bit build
- echo "$ac_t"" Using 64-bit $MACHINE mode" 1>&6
+ echo "$as_me:$LINENO: result: Using 64-bit $MACHINE mode" >&5
+echo "${ECHO_T} Using 64-bit $MACHINE mode" >&6
;;
ia64)
MACHINE="IA64"
- echo "$ac_t"" Using 64-bit $MACHINE mode" 1>&6
+ echo "$as_me:$LINENO: result: Using 64-bit $MACHINE mode" >&5
+echo "${ECHO_T} Using 64-bit $MACHINE mode" >&6
;;
*)
- cat > conftest.$ac_ext <<EOF
-#line 1450 "configure"
-#include "confdefs.h"
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
#ifndef _WIN64
#error 32-bit
#endif
-
-int main() {
-; return 0; }
-EOF
-if { (eval echo configure:1461: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
- rm -rf conftest*
+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_win_64bit=yes
else
- echo "configure: failed program was:" >&5
- cat conftest.$ac_ext >&5
- rm -rf conftest*
- tcl_win_64bit=no
-
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+tcl_win_64bit=no
+
fi
-rm -f conftest*
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
if test "$tcl_win_64bit" = "yes" ; then
do64bit=amd64
MACHINE="AMD64"
- echo "$ac_t"" Using 64-bit $MACHINE mode" 1>&6
+ echo "$as_me:$LINENO: result: Using 64-bit $MACHINE mode" >&5
+echo "${ECHO_T} Using 64-bit $MACHINE mode" >&6
fi
;;
esac
else
if test "${SHARED_BUILD}" = "0" ; then
# static
- echo "$ac_t""using static flags" 1>&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"
@@ -1488,7 +3682,8 @@ rm -f conftest*
SHLIB_LD_LIBS=""
else
# dynamic
- echo "$ac_t""using shared flags" 1>&6
+ 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:\$@"
@@ -1522,21 +3717,88 @@ rm -f conftest*
;;
esac
if test ! -d "${PATH64}" ; then
- echo "configure: warning: Could not find 64-bit $MACHINE SDK to enable 64bit mode" 1>&2
- echo "configure: warning: Ensure latest Platform SDK is installed" 1>&2
+ { echo "$as_me:$LINENO: WARNING: Could not find 64-bit $MACHINE SDK to enable 64bit mode" >&5
+echo "$as_me: WARNING: Could not find 64-bit $MACHINE SDK to enable 64bit mode" >&2;}
+ { echo "$as_me:$LINENO: WARNING: Ensure latest Platform SDK is installed" >&5
+echo "$as_me: WARNING: Ensure latest Platform SDK is installed" >&2;}
do64bit="no"
else
- echo "$ac_t"" Using 64-bit $MACHINE mode" 1>&6
+ echo "$as_me:$LINENO: result: Using 64-bit $MACHINE mode" >&5
+echo "${ECHO_T} Using 64-bit $MACHINE mode" >&6
fi
fi
- LIBS="user32.lib advapi32.lib"
+ LIBS="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
# TEA_PATH_NOSPACE to avoid this issue.
- CC="\"${PATH64}/cl.exe\" -I\"${MSSDK}/Include\" \
- -I\"${MSSDK}/Include/crt\" -I\"${MSSDK}/Include/crt/sys\""
+ # Check if _WIN64 is already recognized, and if so we don't
+ # need to modify CC.
+ echo "$as_me:$LINENO: checking whether _WIN64 is declared" >&5
+echo $ECHO_N "checking whether _WIN64 is declared... $ECHO_C" >&6
+if test "${ac_cv_have_decl__WIN64+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. */
+$ac_includes_default
+int
+main ()
+{
+#ifndef _WIN64
+ char *p = (char *) _WIN64;
+#endif
+
+ ;
+ 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_have_decl__WIN64=yes
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ac_cv_have_decl__WIN64=no
+fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+echo "$as_me:$LINENO: result: $ac_cv_have_decl__WIN64" >&5
+echo "${ECHO_T}$ac_cv_have_decl__WIN64" >&6
+if test $ac_cv_have_decl__WIN64 = yes; then
+ :
+else
+ CC="\"${PATH64}/cl.exe\" -I\"${MSSDK}/Include\" \
+ -I\"${MSSDK}/Include/crt\" \
+ -I\"${MSSDK}/Include/crt/sys\""
+fi
+
RC="\"${MSSDK}/bin/rc.exe\""
CFLAGS_DEBUG="-nologo -Zi -Od ${runtime}d"
# Do not use -O2 for Win64 - this has proved buggy in code gen.
@@ -1598,11 +3860,15 @@ rm -f conftest*
SDKROOT=`echo "$SDKROOT" | sed -e 's!\\\!/!g'`
CELIB_DIR=`echo "$CELIB_DIR" | sed -e 's!\\\!/!g'`
if test ! -d "${CELIB_DIR}/inc"; then
- { echo "configure: error: Invalid celib directory "${CELIB_DIR}"" 1>&2; exit 1; }
+ { { echo "$as_me:$LINENO: error: Invalid celib directory \"${CELIB_DIR}\"" >&5
+echo "$as_me: error: Invalid celib directory \"${CELIB_DIR}\"" >&2;}
+ { (exit 1); exit 1; }; }
fi
if test ! -d "${SDKROOT}/${OSVERSION}/${PLATFORM}/Lib/${TARGETCPU}"\
-o ! -d "${WCEROOT}/EVC/${OSVERSION}/bin"; then
- { echo "configure: error: could not find PocketPC SDK or target compiler to enable WinCE mode $CEVERSION,$TARGETCPU,$ARCH,$PLATFORM" 1>&2; exit 1; }
+ { { echo "$as_me:$LINENO: error: could not find PocketPC SDK or target compiler to enable WinCE mode $CEVERSION,$TARGETCPU,$ARCH,$PLATFORM" >&5
+echo "$as_me: error: could not find PocketPC SDK or target compiler to enable WinCE mode $CEVERSION,$TARGETCPU,$ARCH,$PLATFORM" >&2;}
+ { (exit 1); exit 1; }; }
else
CEINCLUDE="${SDKROOT}/${OSVERSION}/${PLATFORM}/include"
if test -d "${CEINCLUDE}/${TARGETCPU}" ; then
@@ -1624,28 +3890,28 @@ rm -f conftest*
arch=`echo ${ARCH} | awk '{print tolower($0)}'`
defs="${ARCH} _${ARCH}_ ${arch} PALM_SIZE _MT _DLL _WINDOWS"
for i in $defs ; do
- cat >> confdefs.h <<EOF
+ cat >>confdefs.h <<_ACEOF
#define $i 1
-EOF
+_ACEOF
done
# if test "${ARCH}" = "X86EM"; then
# AC_DEFINE_UNQUOTED(_WIN32_WCE_EMULATION)
# fi
- cat >> confdefs.h <<EOF
+ cat >>confdefs.h <<_ACEOF
#define _WIN32_WCE $CEVERSION
-EOF
+_ACEOF
- cat >> confdefs.h <<EOF
+ cat >>confdefs.h <<_ACEOF
#define UNDER_CE $CEVERSION
-EOF
+_ACEOF
CFLAGS_DEBUG="-nologo -Zi -Od"
CFLAGS_OPTIMIZE="-nologo -O2"
lversion=`echo ${CEVERSION} | sed -e 's/\(.\)\(..\)/\1\.\2/'`
lflags="-nodefaultlib -MACHINE:${ARCH} -LIBPATH:\"${CELIBPATH}\" -subsystem:windowsce,${lversion} -nologo"
LINKBIN="\"${CEBINROOT}/link.exe\""
-
+
if test "${CEVERSION}" -lt 400 ; then
LIBS="coredll.lib corelibc.lib winsock.lib"
else
@@ -1656,7 +3922,7 @@ EOF
LIBS="$LIBS \"\${CELIB_DIR}/wince-${ARCH}-pocket-wce300-release/celib.lib\""
LIBS_GUI="commctrl.lib commdlg.lib"
else
- LIBS_GUI="gdi32.lib comdlg32.lib imm32.lib comctl32.lib shell32.lib"
+ LIBS_GUI="gdi32.lib comdlg32.lib imm32.lib comctl32.lib shell32.lib uuid.lib"
fi
SHLIB_LD="${LINKBIN} -dll -incremental:no ${lflags}"
@@ -1695,18 +3961,28 @@ EOF
fi
fi
+ if test "$do64bit" != "no" ; then
+ cat >>confdefs.h <<\_ACEOF
+#define TCL_CFG_DO64BIT 1
+_ACEOF
+
+ fi
+
if test "${GCC}" = "yes" ; then
- echo $ac_n "checking for SEH support in compiler""... $ac_c" 1>&6
-echo "configure:1701: checking for SEH support in compiler" >&5
-if eval "test \"`echo '$''{'tcl_cv_seh'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&6
+ 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
+ echo $ECHO_N "(cached) $ECHO_C" >&6
else
if test "$cross_compiling" = yes; then
tcl_cv_seh=no
else
- cat > conftest.$ac_ext <<EOF
-#line 1709 "configure"
-#include "confdefs.h"
+ 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>
@@ -1722,28 +3998,39 @@ else
}
return 1;
}
-
-EOF
-if { (eval echo configure:1728: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
-then
+
+_ACEOF
+rm -f conftest$ac_exeext
+if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
+ (eval $ac_link) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } && { ac_try='./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_seh=yes
else
- echo "configure: failed program was:" >&5
- cat conftest.$ac_ext >&5
- rm -fr conftest*
- tcl_cv_seh=no
+ echo "$as_me: program exited with status $ac_status" >&5
+echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+( exit $ac_status )
+tcl_cv_seh=no
fi
-rm -fr conftest*
+rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext
fi
-
fi
-
-echo "$ac_t""$tcl_cv_seh" 1>&6
+echo "$as_me:$LINENO: result: $tcl_cv_seh" >&5
+echo "${ECHO_T}$tcl_cv_seh" >&6
if test "$tcl_cv_seh" = "no" ; then
- cat >> confdefs.h <<\EOF
+
+cat >>confdefs.h <<\_ACEOF
#define HAVE_NO_SEH 1
-EOF
+_ACEOF
fi
@@ -1753,43 +4040,71 @@ EOF
# with Cygwin's version as of 2002-04-10, define it to be int,
# sufficient for getting the current code to work.
#
- echo $ac_n "checking for EXCEPTION_DISPOSITION support in include files""... $ac_c" 1>&6
-echo "configure:1758: checking for EXCEPTION_DISPOSITION support in include files" >&5
-if eval "test \"`echo '$''{'tcl_cv_eh_disposition'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&6
+ echo "$as_me:$LINENO: checking for EXCEPTION_DISPOSITION support in include files" >&5
+echo $ECHO_N "checking for EXCEPTION_DISPOSITION support in include files... $ECHO_C" >&6
+if test "${tcl_cv_eh_disposition+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
else
- cat > conftest.$ac_ext <<EOF
-#line 1763 "configure"
-#include "confdefs.h"
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
# define WIN32_LEAN_AND_MEAN
# include <windows.h>
# undef WIN32_LEAN_AND_MEAN
-
-int main() {
+
+int
+main ()
+{
EXCEPTION_DISPOSITION x;
-
-; return 0; }
-EOF
-if { (eval echo configure:1776: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
- rm -rf conftest*
+
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
tcl_cv_eh_disposition=yes
else
- echo "configure: failed program was:" >&5
- cat conftest.$ac_ext >&5
- rm -rf conftest*
- tcl_cv_eh_disposition=no
-fi
-rm -f conftest*
-
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+tcl_cv_eh_disposition=no
fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
-echo "$ac_t""$tcl_cv_eh_disposition" 1>&6
+fi
+echo "$as_me:$LINENO: result: $tcl_cv_eh_disposition" >&5
+echo "${ECHO_T}$tcl_cv_eh_disposition" >&6
if test "$tcl_cv_eh_disposition" = "no" ; then
- cat >> confdefs.h <<\EOF
+
+cat >>confdefs.h <<\_ACEOF
#define EXCEPTION_DISPOSITION int
-EOF
+_ACEOF
fi
@@ -1797,46 +4112,74 @@ EOF
# even if VOID has already been #defined. The win32api
# used by mingw and cygwin is known to do this.
- echo $ac_n "checking for winnt.h that ignores VOID define""... $ac_c" 1>&6
-echo "configure:1802: checking for winnt.h that ignores VOID define" >&5
-if eval "test \"`echo '$''{'tcl_cv_winnt_ignore_void'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&6
+ echo "$as_me:$LINENO: checking for winnt.h that ignores VOID define" >&5
+echo $ECHO_N "checking for winnt.h that ignores VOID define... $ECHO_C" >&6
+if test "${tcl_cv_winnt_ignore_void+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
else
- cat > conftest.$ac_ext <<EOF
-#line 1807 "configure"
-#include "confdefs.h"
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
#define VOID void
#define WIN32_LEAN_AND_MEAN
#include <windows.h>
#undef WIN32_LEAN_AND_MEAN
-
-int main() {
+
+int
+main ()
+{
CHAR c;
SHORT s;
LONG l;
-
-; return 0; }
-EOF
-if { (eval echo configure:1823: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
- rm -rf conftest*
+
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
tcl_cv_winnt_ignore_void=yes
else
- echo "configure: failed program was:" >&5
- cat conftest.$ac_ext >&5
- rm -rf conftest*
- tcl_cv_winnt_ignore_void=no
-fi
-rm -f conftest*
-
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+tcl_cv_winnt_ignore_void=no
fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
-echo "$ac_t""$tcl_cv_winnt_ignore_void" 1>&6
+fi
+echo "$as_me:$LINENO: result: $tcl_cv_winnt_ignore_void" >&5
+echo "${ECHO_T}$tcl_cv_winnt_ignore_void" >&6
if test "$tcl_cv_winnt_ignore_void" = "yes" ; then
- cat >> confdefs.h <<\EOF
+
+cat >>confdefs.h <<\_ACEOF
#define HAVE_WINNT_IGNORE_VOID 1
-EOF
+_ACEOF
fi
@@ -1844,152 +4187,426 @@ EOF
# This is used to stop gcc from printing a compiler
# warning when initializing a union member.
- echo $ac_n "checking for cast to union support""... $ac_c" 1>&6
-echo "configure:1849: checking for cast to union support" >&5
-if eval "test \"`echo '$''{'tcl_cv_cast_to_union'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&6
+ echo "$as_me:$LINENO: checking for cast to union support" >&5
+echo $ECHO_N "checking for cast to union support... $ECHO_C" >&6
+if test "${tcl_cv_cast_to_union+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
else
- cat > conftest.$ac_ext <<EOF
-#line 1854 "configure"
-#include "confdefs.h"
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
-int main() {
+int
+main ()
+{
union foo { int i; double d; };
union foo f = (union foo) (int) 0;
-
-; return 0; }
-EOF
-if { (eval echo configure:1864: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
- rm -rf conftest*
+
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
tcl_cv_cast_to_union=yes
else
- echo "configure: failed program was:" >&5
- cat conftest.$ac_ext >&5
- rm -rf conftest*
- tcl_cv_cast_to_union=no
-fi
-rm -f conftest*
-
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+tcl_cv_cast_to_union=no
fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
-echo "$ac_t""$tcl_cv_cast_to_union" 1>&6
+fi
+echo "$as_me:$LINENO: result: $tcl_cv_cast_to_union" >&5
+echo "${ECHO_T}$tcl_cv_cast_to_union" >&6
if test "$tcl_cv_cast_to_union" = "yes"; then
- cat >> confdefs.h <<\EOF
+
+cat >>confdefs.h <<\_ACEOF
#define HAVE_CAST_TO_UNION 1
-EOF
+_ACEOF
fi
fi
# DL_LIBS is empty, but then we match the Unix version
-
-
-
-
-#--------------------------------------------------------------------
-# Perform additinal compiler tests.
-#--------------------------------------------------------------------
-if test "${GCC}" = "yes" ; then
-# Check to see if the winsock2.h include file provided contains
-# typedefs like LPFN_ACCEPT and friends.
-#
-echo $ac_n "checking for LPFN_ACCEPT support in winsock2.h""... $ac_c" 1>&6
-echo "configure:1902: checking for LPFN_ACCEPT support in winsock2.h" >&5
-if eval "test \"`echo '$''{'tcl_cv_lpfn_decls'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&6
+
+
+
+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
+ echo $ECHO_N "(cached) $ECHO_C" >&6
else
- cat > conftest.$ac_ext <<EOF
-#line 1907 "configure"
-#include "confdefs.h"
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+$ac_includes_default
+int
+main ()
+{
+if ((intptr_t *) 0)
+ return 0;
+if (sizeof (intptr_t))
+ return 0;
+ ;
+ 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_type_intptr_t=yes
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ac_cv_type_intptr_t=no
+fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+echo "$as_me:$LINENO: result: $ac_cv_type_intptr_t" >&5
+echo "${ECHO_T}$ac_cv_type_intptr_t" >&6
+if test $ac_cv_type_intptr_t = yes; then
-#define WIN32_LEAN_AND_MEAN
-#include <windows.h>
-#undef WIN32_LEAN_AND_MEAN
-#include <winsock2.h>
-int main() {
+cat >>confdefs.h <<\_ACEOF
+#define HAVE_INTPTR_T 1
+_ACEOF
+
+else
- LPFN_ACCEPT accept;
+ echo "$as_me:$LINENO: checking for pointer-size signed integer type" >&5
+echo $ECHO_N "checking for pointer-size signed integer type... $ECHO_C" >&6
+if test "${tcl_cv_intptr_t+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
-; return 0; }
-EOF
-if { (eval echo configure:1921: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
- rm -rf conftest*
- tcl_cv_lpfn_decls=yes
+ for tcl_cv_intptr_t in "int" "long" "long long" none; do
+ if test "$tcl_cv_intptr_t" != none; then
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+$ac_includes_default
+int
+main ()
+{
+static int test_array [1 - 2 * !(sizeof (void *) <= sizeof ($tcl_cv_intptr_t))];
+test_array [0] = 0
+
+ ;
+ 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_ok=yes
else
- echo "configure: failed program was:" >&5
- cat conftest.$ac_ext >&5
- rm -rf conftest*
- tcl_cv_lpfn_decls=no
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+tcl_ok=no
fi
-rm -f conftest*
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+ test "$tcl_ok" = yes && break; fi
+ done
+fi
+echo "$as_me:$LINENO: result: $tcl_cv_intptr_t" >&5
+echo "${ECHO_T}$tcl_cv_intptr_t" >&6
+ if test "$tcl_cv_intptr_t" != none; then
+
+cat >>confdefs.h <<_ACEOF
+#define intptr_t $tcl_cv_intptr_t
+_ACEOF
+
+ fi
fi
-echo "$ac_t""$tcl_cv_lpfn_decls" 1>&6
-if test "$tcl_cv_lpfn_decls" = "no" ; then
- cat >> confdefs.h <<\EOF
-#define HAVE_NO_LPFN_DECLS 1
-EOF
+echo "$as_me:$LINENO: checking for uintptr_t" >&5
+echo $ECHO_N "checking for uintptr_t... $ECHO_C" >&6
+if test "${ac_cv_type_uintptr_t+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. */
+$ac_includes_default
+int
+main ()
+{
+if ((uintptr_t *) 0)
+ return 0;
+if (sizeof (uintptr_t))
+ return 0;
+ ;
+ 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_type_uintptr_t=yes
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+ac_cv_type_uintptr_t=no
fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+echo "$as_me:$LINENO: result: $ac_cv_type_uintptr_t" >&5
+echo "${ECHO_T}$ac_cv_type_uintptr_t" >&6
+if test $ac_cv_type_uintptr_t = yes; then
+
+
+cat >>confdefs.h <<\_ACEOF
+#define HAVE_UINTPTR_T 1
+_ACEOF
+
+else
-# Check to see if malloc.h is missing the alloca function
-# declaration. This is known to be a problem with Mingw.
-# If we compiled without the function declaration, it
-# would work but we would get a warning message from gcc.
-# If we add the function declaration ourselves, it
-# would not compile correctly because the _alloca
-# function expects the argument to be passed in a
-# register and not on the stack. Instead, we just
-# call it from inline asm code.
+ echo "$as_me:$LINENO: checking for pointer-size unsigned integer type" >&5
+echo $ECHO_N "checking for pointer-size unsigned integer type... $ECHO_C" >&6
+if test "${tcl_cv_uintptr_t+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
-echo $ac_n "checking for alloca declaration in malloc.h""... $ac_c" 1>&6
-echo "configure:1953: checking for alloca declaration in malloc.h" >&5
-if eval "test \"`echo '$''{'tcl_cv_malloc_decl_alloca'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&6
+ for tcl_cv_uintptr_t in "unsigned int" "unsigned long" "unsigned long long" \
+ none; do
+ if test "$tcl_cv_uintptr_t" != none; then
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+$ac_includes_default
+int
+main ()
+{
+static int test_array [1 - 2 * !(sizeof (void *) <= sizeof ($tcl_cv_uintptr_t))];
+test_array [0] = 0
+
+ ;
+ 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_ok=yes
else
- cat > conftest.$ac_ext <<EOF
-#line 1958 "configure"
-#include "confdefs.h"
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+tcl_ok=no
+fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+ test "$tcl_ok" = yes && break; fi
+ done
+fi
+echo "$as_me:$LINENO: result: $tcl_cv_uintptr_t" >&5
+echo "${ECHO_T}$tcl_cv_uintptr_t" >&6
+ if test "$tcl_cv_uintptr_t" != none; then
+
+cat >>confdefs.h <<_ACEOF
+#define uintptr_t $tcl_cv_uintptr_t
+_ACEOF
+
+ fi
+
+fi
-#include <malloc.h>
+#--------------------------------------------------------------------
+# Perform additinal compiler tests.
+#--------------------------------------------------------------------
-int main() {
+# See if declarations like FINDEX_INFO_LEVELS are
+# missing from winbase.h. This is known to be
+# a problem with VC++ 5.2.
- size_t arg = 0;
- void* ptr;
- ptr = alloca;
- ptr = alloca(arg);
+echo "$as_me:$LINENO: checking for FINDEX_INFO_LEVELS in winbase.h" >&5
+echo $ECHO_N "checking for FINDEX_INFO_LEVELS in winbase.h... $ECHO_C" >&6
+if test "${tcl_cv_findex_enums+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
-; return 0; }
-EOF
-if { (eval echo configure:1972: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
- rm -rf conftest*
- tcl_cv_malloc_decl_alloca=yes
+#define WIN32_LEAN_AND_MEAN
+#include <windows.h>
+#undef WIN32_LEAN_AND_MEAN
+
+int
+main ()
+{
+
+ FINDEX_INFO_LEVELS i;
+ FINDEX_SEARCH_OPS j;
+
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ tcl_cv_findex_enums=yes
else
- echo "configure: failed program was:" >&5
- cat conftest.$ac_ext >&5
- rm -rf conftest*
- tcl_cv_malloc_decl_alloca=no
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+tcl_cv_findex_enums=no
fi
-rm -f conftest*
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
fi
+echo "$as_me:$LINENO: result: $tcl_cv_findex_enums" >&5
+echo "${ECHO_T}$tcl_cv_findex_enums" >&6
+if test "$tcl_cv_findex_enums" = "no"; then
-echo "$ac_t""$tcl_cv_malloc_decl_alloca" 1>&6
-if test "$tcl_cv_malloc_decl_alloca" = "no" &&
- test "${GCC}" = "yes" ; then
- cat >> confdefs.h <<\EOF
-#define HAVE_ALLOCA_GCC_INLINE 1
-EOF
+cat >>confdefs.h <<\_ACEOF
+#define HAVE_NO_FINDEX_ENUMS 1
+_ACEOF
fi
-fi
#--------------------------------------------------------------------
# Set the default compiler switches based on the --enable-symbols
@@ -1998,60 +4615,72 @@ fi
#--------------------------------------------------------------------
- echo $ac_n "checking for build with symbols""... $ac_c" 1>&6
-echo "configure:2003: checking for build with symbols" >&5
+ echo "$as_me:$LINENO: checking for build with symbols" >&5
+echo $ECHO_N "checking for build with symbols... $ECHO_C" >&6
# Check whether --enable-symbols or --disable-symbols was given.
if test "${enable_symbols+set}" = set; then
enableval="$enable_symbols"
tcl_ok=$enableval
else
tcl_ok=no
-fi
-
+fi;
# FIXME: Currently, LDFLAGS_DEFAULT is not used, it should work like CFLAGS_DEFAULT.
if test "$tcl_ok" = "no"; then
CFLAGS_DEFAULT='$(CFLAGS_OPTIMIZE)'
LDFLAGS_DEFAULT='$(LDFLAGS_OPTIMIZE)'
DBGX=""
- cat >> confdefs.h <<\EOF
+
+cat >>confdefs.h <<\_ACEOF
#define NDEBUG 1
-EOF
+_ACEOF
+
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
+
+ cat >>confdefs.h <<\_ACEOF
+#define TCL_CFG_OPTIMIZED 1
+_ACEOF
- echo "$ac_t""no" 1>&6
else
CFLAGS_DEFAULT='$(CFLAGS_DEBUG)'
LDFLAGS_DEFAULT='$(LDFLAGS_DEBUG)'
DBGX=g
if test "$tcl_ok" = "yes"; then
- echo "$ac_t""yes (standard debugging)" 1>&6
+ echo "$as_me:$LINENO: result: yes (standard debugging)" >&5
+echo "${ECHO_T}yes (standard debugging)" >&6
fi
fi
-
-
+
+
if test "$tcl_ok" = "mem" -o "$tcl_ok" = "all"; then
- cat >> confdefs.h <<\EOF
+
+cat >>confdefs.h <<\_ACEOF
#define TCL_MEM_DEBUG 1
-EOF
+_ACEOF
fi
if test "$tcl_ok" = "compile" -o "$tcl_ok" = "all"; then
- cat >> confdefs.h <<\EOF
+
+cat >>confdefs.h <<\_ACEOF
#define TCL_COMPILE_DEBUG 1
-EOF
+_ACEOF
- cat >> confdefs.h <<\EOF
+
+cat >>confdefs.h <<\_ACEOF
#define TCL_COMPILE_STATS 1
-EOF
+_ACEOF
fi
if test "$tcl_ok" != "yes" -a "$tcl_ok" != "no"; then
if test "$tcl_ok" = "all"; then
- echo "$ac_t""enabled symbols mem compile debugging" 1>&6
+ echo "$as_me:$LINENO: result: enabled symbols mem compile debugging" >&5
+echo "${ECHO_T}enabled symbols mem compile debugging" >&6
else
- echo "$ac_t""enabled $tcl_ok debugging" 1>&6
+ echo "$as_me:$LINENO: result: enabled $tcl_ok debugging" >&5
+echo "${ECHO_T}enabled $tcl_ok debugging" >&6
fi
fi
@@ -2059,122 +4688,61 @@ EOF
TCL_DBGX=${DBGX}
#--------------------------------------------------------------------
-# man2tcl needs this so that it can use errno.h
+# Embed the manifest if we can determine how
#--------------------------------------------------------------------
-echo $ac_n "checking how to run the C preprocessor""... $ac_c" 1>&6
-echo "configure:2067: checking how to run the C preprocessor" >&5
-# On Suns, sometimes $CPP names a directory.
-if test -n "$CPP" && test -d "$CPP"; then
- CPP=
-fi
-if test -z "$CPP"; then
-if eval "test \"`echo '$''{'ac_cv_prog_CPP'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&6
-else
- # This must be in double quotes, not single quotes, because CPP may get
- # substituted into the Makefile and "${CC-cc}" will confuse make.
- CPP="${CC-cc} -E"
- # On the NeXT, cc -E runs the code through the compiler's parser,
- # not just through cpp.
- cat > conftest.$ac_ext <<EOF
-#line 2082 "configure"
-#include "confdefs.h"
-#include <assert.h>
-Syntax Error
-EOF
-ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:2088: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
-ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
-if test -z "$ac_err"; then
- :
-else
- echo "$ac_err" >&5
- echo "configure: failed program was:" >&5
- cat conftest.$ac_ext >&5
- rm -rf conftest*
- CPP="${CC-cc} -E -traditional-cpp"
- cat > conftest.$ac_ext <<EOF
-#line 2099 "configure"
-#include "confdefs.h"
-#include <assert.h>
-Syntax Error
-EOF
-ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:2105: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
-ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
-if test -z "$ac_err"; then
- :
-else
- echo "$ac_err" >&5
- echo "configure: failed program was:" >&5
- cat conftest.$ac_ext >&5
- rm -rf conftest*
- CPP="${CC-cc} -nologo -E"
- cat > conftest.$ac_ext <<EOF
-#line 2116 "configure"
-#include "confdefs.h"
-#include <assert.h>
-Syntax Error
-EOF
-ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:2122: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
-ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
-if test -z "$ac_err"; then
- :
+
+ echo "$as_me:$LINENO: checking whether to embed manifest" >&5
+echo $ECHO_N "checking whether to embed manifest... $ECHO_C" >&6
+ # Check whether --enable-embedded-manifest or --disable-embedded-manifest was given.
+if test "${enable_embedded_manifest+set}" = set; then
+ enableval="$enable_embedded_manifest"
+ embed_ok=$enableval
else
- echo "$ac_err" >&5
- echo "configure: failed program was:" >&5
- cat conftest.$ac_ext >&5
- rm -rf conftest*
- CPP=/lib/cpp
-fi
-rm -f conftest*
-fi
-rm -f conftest*
-fi
-rm -f conftest*
- ac_cv_prog_CPP="$CPP"
-fi
- CPP="$ac_cv_prog_CPP"
-else
- ac_cv_prog_CPP="$CPP"
-fi
-echo "$ac_t""$CPP" 1>&6
-
-ac_safe=`echo "errno.h" | sed 'y%./+-%__p_%'`
-echo $ac_n "checking for errno.h""... $ac_c" 1>&6
-echo "configure:2148: checking for errno.h" >&5
-if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&6
-else
- cat > conftest.$ac_ext <<EOF
-#line 2153 "configure"
-#include "confdefs.h"
-#include <errno.h>
-EOF
-ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:2158: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
-ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
-if test -z "$ac_err"; then
- rm -rf conftest*
- eval "ac_cv_header_$ac_safe=yes"
-else
- echo "$ac_err" >&5
- echo "configure: failed program was:" >&5
- cat conftest.$ac_ext >&5
- rm -rf conftest*
- eval "ac_cv_header_$ac_safe=no"
+ embed_ok=yes
+fi;
+
+ VC_MANIFEST_EMBED_DLL=
+ VC_MANIFEST_EMBED_EXE=
+ result=no
+ if test "$embed_ok" = "yes" -a "${SHARED_BUILD}" = "1" \
+ -a "$GCC" != "yes" ; then
+ # Add the magic to embed the manifest into the dll/exe
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+
+#if defined(_MSC_VER) && _MSC_VER >= 1400
+print("manifest needed")
+#endif
+
+_ACEOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ $EGREP "manifest needed" >/dev/null 2>&1; then
+
+ # Could do a CHECK_PROG for mt, but should always be with MSVC8+
+ # Could add 'if test -f' check, but manifest should be created
+ # in this compiler case
+ # Add in a manifest argument that may be specified
+ # XXX Needs improvement so that the test for existence accounts
+ # XXX for a provided (known) manifest
+ VC_MANIFEST_EMBED_DLL="if test -f \$@.manifest ; then mt.exe -nologo -manifest \$@.manifest -outputresource:\$@\;2 ; fi"
+ VC_MANIFEST_EMBED_EXE="if test -f \$@.manifest ; then mt.exe -nologo -manifest \$@.manifest -outputresource:\$@\;1 ; fi"
+ result=yes
+ if test "x" != x ; then
+ result="yes ()"
+ fi
+
fi
rm -f conftest*
-fi
-if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then
- echo "$ac_t""yes" 1>&6
- :
-else
- echo "$ac_t""no" 1>&6
-MAN2TCLFLAGS="-DNO_ERRNO_H"
-fi
+
+ fi
+ echo "$as_me:$LINENO: result: $result" >&5
+echo "${ECHO_T}$result" >&6
+
@@ -2325,7 +4893,6 @@ fi
-
# win only
@@ -2342,338 +4909,1001 @@ fi
-trap '' 1 2 15
-cat > confcache <<\EOF
+
+
+ ac_config_files="$ac_config_files Makefile tclConfig.sh tcl.hpj"
+cat >confcache <<\_ACEOF
# This file is a shell script that caches the results of configure
# tests run on this system so they can be shared between configure
-# scripts and configure runs. It is not useful on other systems.
-# If it contains results you don't want to keep, you may remove or edit it.
+# scripts and configure runs, see configure's option --config-cache.
+# It is not useful on other systems. If it contains results you don't
+# want to keep, you may remove or edit it.
#
-# By default, configure uses ./config.cache as the cache file,
-# creating it if it does not exist already. You can give configure
-# the --cache-file=FILE option to use a different cache file; that is
-# what configure does when it calls configure scripts in
-# subdirectories, so they share the cache.
-# Giving --cache-file=/dev/null disables caching, for debugging configure.
-# config.status only pays attention to the cache file if you give it the
-# --recheck option to rerun configure.
+# config.status only pays attention to the cache file if you give it
+# the --recheck option to rerun configure.
#
-EOF
+# `ac_cv_env_foo' variables (set or unset) will be overridden when
+# loading this file, other *unset* `ac_cv_foo' will be assigned the
+# following values.
+
+_ACEOF
+
# The following way of writing the cache mishandles newlines in values,
# but we know of no workaround that is simple, portable, and efficient.
# So, don't put newlines in cache variables' values.
# Ultrix sh set writes to stderr and can't be redirected directly,
# and sets the high bit in the cache file unless we assign to the vars.
-(set) 2>&1 |
- case `(ac_space=' '; set | grep ac_space) 2>&1` in
- *ac_space=\ *)
- # `set' does not quote correctly, so add quotes (double-quote substitution
- # turns \\\\ into \\, and sed turns \\ into \).
- sed -n \
- -e "s/'/'\\\\''/g" \
- -e "s/^\\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\\)=\\(.*\\)/\\1=\${\\1='\\2'}/p"
- ;;
- *)
- # `set' quotes correctly as required by POSIX, so do not add quotes.
- sed -n -e 's/^\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\)=\(.*\)/\1=${\1=\2}/p'
- ;;
- esac >> confcache
-if cmp -s $cache_file confcache; then
- :
-else
+{
+ (set) 2>&1 |
+ case `(ac_space=' '; set | grep ac_space) 2>&1` in
+ *ac_space=\ *)
+ # `set' does not quote correctly, so add quotes (double-quote
+ # substitution turns \\\\ into \\, and sed turns \\ into \).
+ sed -n \
+ "s/'/'\\\\''/g;
+ s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p"
+ ;;
+ *)
+ # `set' quotes correctly as required by POSIX, so do not add quotes.
+ sed -n \
+ "s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1=\\2/p"
+ ;;
+ esac;
+} |
+ sed '
+ t clear
+ : clear
+ s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/
+ t end
+ /^ac_cv_env/!s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/
+ : end' >>confcache
+if diff $cache_file confcache >/dev/null 2>&1; then :; else
if test -w $cache_file; then
- echo "updating cache $cache_file"
- cat confcache > $cache_file
+ test "x$cache_file" != "x/dev/null" && echo "updating cache $cache_file"
+ cat confcache >$cache_file
else
echo "not updating unwritable cache $cache_file"
fi
fi
rm -f confcache
-trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15
-
test "x$prefix" = xNONE && prefix=$ac_default_prefix
# Let make expand exec_prefix.
test "x$exec_prefix" = xNONE && exec_prefix='${prefix}'
-# Any assignment to VPATH causes Sun make to only execute
-# the first set of double-colon rules, so remove it if not needed.
-# If there is a colon in the path, we need to keep it.
+# VPATH may cause trouble with some makes, so we remove $(srcdir),
+# ${srcdir} and @srcdir@ from VPATH if srcdir is ".", strip leading and
+# trailing colons and then remove the whole line if VPATH becomes empty
+# (actually we leave an empty line to preserve line numbers).
if test "x$srcdir" = x.; then
- ac_vpsub='/^[ ]*VPATH[ ]*=[^:]*$/d'
+ ac_vpsub='/^[ ]*VPATH[ ]*=/{
+s/:*\$(srcdir):*/:/;
+s/:*\${srcdir}:*/:/;
+s/:*@srcdir@:*/:/;
+s/^\([^=]*=[ ]*\):*/\1/;
+s/:*$//;
+s/^[^=]*=[ ]*$//;
+}'
fi
-trap 'rm -f $CONFIG_STATUS conftest*; exit 1' 1 2 15
-
# Transform confdefs.h into DEFS.
# Protect against shell expansion while executing Makefile rules.
# Protect against Makefile macro expansion.
-cat > conftest.defs <<\EOF
-s%#define \([A-Za-z_][A-Za-z0-9_]*\) *\(.*\)%-D\1=\2%g
-s%[ `~#$^&*(){}\\|;'"<>?]%\\&%g
-s%\[%\\&%g
-s%\]%\\&%g
-s%\$%$$%g
-EOF
-DEFS=`sed -f conftest.defs confdefs.h | tr '\012' ' '`
-rm -f conftest.defs
-
-
-# Without the "./", some shells look in PATH for config.status.
-: ${CONFIG_STATUS=./config.status}
+#
+# If the first sed substitution is executed (which looks for macros that
+# take arguments), then we branch to the quote section. Otherwise,
+# look for a macro that doesn't take arguments.
+cat >confdef2opt.sed <<\_ACEOF
+t clear
+: clear
+s,^[ ]*#[ ]*define[ ][ ]*\([^ (][^ (]*([^)]*)\)[ ]*\(.*\),-D\1=\2,g
+t quote
+s,^[ ]*#[ ]*define[ ][ ]*\([^ ][^ ]*\)[ ]*\(.*\),-D\1=\2,g
+t quote
+d
+: quote
+s,[ `~#$^&*(){}\\|;'"<>?],\\&,g
+s,\[,\\&,g
+s,\],\\&,g
+s,\$,$$,g
+p
+_ACEOF
+# We use echo to avoid assuming a particular line-breaking character.
+# The extra dot is to prevent the shell from consuming trailing
+# line-breaks from the sub-command output. A line-break within
+# single-quotes doesn't work because, if this script is created in a
+# platform that uses two characters for line-breaks (e.g., DOS), tr
+# would break.
+ac_LF_and_DOT=`echo; echo .`
+DEFS=`sed -n -f confdef2opt.sed confdefs.h | tr "$ac_LF_and_DOT" ' .'`
+rm -f confdef2opt.sed
+
+
+ac_libobjs=
+ac_ltlibobjs=
+for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue
+ # 1. Remove the extension, and $U if already installed.
+ ac_i=`echo "$ac_i" |
+ sed 's/\$U\././;s/\.o$//;s/\.obj$//'`
+ # 2. Add them.
+ ac_libobjs="$ac_libobjs $ac_i\$U.$ac_objext"
+ ac_ltlibobjs="$ac_ltlibobjs $ac_i"'$U.lo'
+done
+LIBOBJS=$ac_libobjs
-echo creating $CONFIG_STATUS
-rm -f $CONFIG_STATUS
-cat > $CONFIG_STATUS <<EOF
-#! /bin/sh
-# Generated automatically by configure.
+LTLIBOBJS=$ac_ltlibobjs
+
+
+
+: ${CONFIG_STATUS=./config.status}
+ac_clean_files_save=$ac_clean_files
+ac_clean_files="$ac_clean_files $CONFIG_STATUS"
+{ echo "$as_me:$LINENO: creating $CONFIG_STATUS" >&5
+echo "$as_me: creating $CONFIG_STATUS" >&6;}
+cat >$CONFIG_STATUS <<_ACEOF
+#! $SHELL
+# Generated by $as_me.
# Run this file to recreate the current configuration.
-# This directory was configured as follows,
-# on host `(hostname || uname -n) 2>/dev/null | sed 1q`:
-#
-# $0 $ac_configure_args
-#
# Compiler output produced by configure, useful for debugging
-# configure, is in ./config.log if it exists.
+# configure, is in config.log if it exists.
+
+debug=false
+ac_cs_recheck=false
+ac_cs_silent=false
+SHELL=\${CONFIG_SHELL-$SHELL}
+_ACEOF
+
+cat >>$CONFIG_STATUS <<\_ACEOF
+## --------------------- ##
+## M4sh Initialization. ##
+## --------------------- ##
+
+# Be Bourne compatible
+if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then
+ emulate sh
+ NULLCMD=:
+ # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which
+ # is contrary to our usage. Disable this feature.
+ alias -g '${1+"$@"}'='"$@"'
+elif test -n "${BASH_VERSION+set}" && (set -o posix) >/dev/null 2>&1; then
+ set -o posix
+fi
+DUALCASE=1; export DUALCASE # for MKS sh
-ac_cs_usage="Usage: $CONFIG_STATUS [--recheck] [--version] [--help]"
-for ac_option
+# Support unset when possible.
+if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then
+ as_unset=unset
+else
+ as_unset=false
+fi
+
+
+# Work around bugs in pre-3.0 UWIN ksh.
+$as_unset ENV MAIL MAILPATH
+PS1='$ '
+PS2='> '
+PS4='+ '
+
+# NLS nuisances.
+for as_var in \
+ LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \
+ LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \
+ LC_TELEPHONE LC_TIME
do
- case "\$ac_option" in
- -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r)
- echo "running \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion"
- exec \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion ;;
- -version | --version | --versio | --versi | --vers | --ver | --ve | --v)
- echo "$CONFIG_STATUS generated by autoconf version 2.13"
- exit 0 ;;
- -help | --help | --hel | --he | --h)
- echo "\$ac_cs_usage"; exit 0 ;;
- *) echo "\$ac_cs_usage"; exit 1 ;;
- esac
+ if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then
+ eval $as_var=C; export $as_var
+ else
+ $as_unset $as_var
+ fi
done
-ac_given_srcdir=$srcdir
+# Required to use basename.
+if expr a : '\(a\)' >/dev/null 2>&1; then
+ as_expr=expr
+else
+ as_expr=false
+fi
-trap 'rm -fr `echo "Makefile tclConfig.sh tcl.hpj" | sed "s/:[^ ]*//g"` conftest*; exit 1' 1 2 15
-EOF
-cat >> $CONFIG_STATUS <<EOF
+if (basename /) >/dev/null 2>&1 && test "X`basename / 2>&1`" = "X/"; then
+ as_basename=basename
+else
+ as_basename=false
+fi
-# Protect against being on the right side of a sed subst in config.status.
-sed 's/%@/@@/; s/@%/@@/; s/%g\$/@g/; /@g\$/s/[\\\\&%]/\\\\&/g;
- s/@@/%@/; s/@@/@%/; s/@g\$/%g/' > conftest.subs <<\\CEOF
-$ac_vpsub
-$extrasub
-s%@SHELL@%$SHELL%g
-s%@CFLAGS@%$CFLAGS%g
-s%@CPPFLAGS@%$CPPFLAGS%g
-s%@CXXFLAGS@%$CXXFLAGS%g
-s%@FFLAGS@%$FFLAGS%g
-s%@DEFS@%$DEFS%g
-s%@LDFLAGS@%$LDFLAGS%g
-s%@LIBS@%$LIBS%g
-s%@exec_prefix@%$exec_prefix%g
-s%@prefix@%$prefix%g
-s%@program_transform_name@%$program_transform_name%g
-s%@bindir@%$bindir%g
-s%@sbindir@%$sbindir%g
-s%@libexecdir@%$libexecdir%g
-s%@datadir@%$datadir%g
-s%@sysconfdir@%$sysconfdir%g
-s%@sharedstatedir@%$sharedstatedir%g
-s%@localstatedir@%$localstatedir%g
-s%@libdir@%$libdir%g
-s%@includedir@%$includedir%g
-s%@oldincludedir@%$oldincludedir%g
-s%@infodir@%$infodir%g
-s%@mandir@%$mandir%g
-s%@CC@%$CC%g
-s%@AR@%$AR%g
-s%@RANLIB@%$RANLIB%g
-s%@RC@%$RC%g
-s%@SET_MAKE@%$SET_MAKE%g
-s%@OBJEXT@%$OBJEXT%g
-s%@EXEEXT@%$EXEEXT%g
-s%@TCL_THREADS@%$TCL_THREADS%g
-s%@CYGPATH@%$CYGPATH%g
-s%@CELIB_DIR@%$CELIB_DIR%g
-s%@DL_LIBS@%$DL_LIBS%g
-s%@CFLAGS_DEBUG@%$CFLAGS_DEBUG%g
-s%@CFLAGS_OPTIMIZE@%$CFLAGS_OPTIMIZE%g
-s%@CFLAGS_WARNING@%$CFLAGS_WARNING%g
-s%@CFLAGS_DEFAULT@%$CFLAGS_DEFAULT%g
-s%@LDFLAGS_DEFAULT@%$LDFLAGS_DEFAULT%g
-s%@CPP@%$CPP%g
-s%@MAN2TCLFLAGS@%$MAN2TCLFLAGS%g
-s%@TCL_VERSION@%$TCL_VERSION%g
-s%@TCL_MAJOR_VERSION@%$TCL_MAJOR_VERSION%g
-s%@TCL_MINOR_VERSION@%$TCL_MINOR_VERSION%g
-s%@TCL_PATCH_LEVEL@%$TCL_PATCH_LEVEL%g
-s%@TCL_LIB_FILE@%$TCL_LIB_FILE%g
-s%@TCL_LIB_FLAG@%$TCL_LIB_FLAG%g
-s%@TCL_LIB_SPEC@%$TCL_LIB_SPEC%g
-s%@TCL_STUB_LIB_FILE@%$TCL_STUB_LIB_FILE%g
-s%@TCL_STUB_LIB_FLAG@%$TCL_STUB_LIB_FLAG%g
-s%@TCL_STUB_LIB_SPEC@%$TCL_STUB_LIB_SPEC%g
-s%@TCL_STUB_LIB_PATH@%$TCL_STUB_LIB_PATH%g
-s%@TCL_INCLUDE_SPEC@%$TCL_INCLUDE_SPEC%g
-s%@TCL_BUILD_STUB_LIB_SPEC@%$TCL_BUILD_STUB_LIB_SPEC%g
-s%@TCL_BUILD_STUB_LIB_PATH@%$TCL_BUILD_STUB_LIB_PATH%g
-s%@TCL_DLL_FILE@%$TCL_DLL_FILE%g
-s%@TCL_SRC_DIR@%$TCL_SRC_DIR%g
-s%@TCL_BIN_DIR@%$TCL_BIN_DIR%g
-s%@TCL_DBGX@%$TCL_DBGX%g
-s%@CFG_TCL_SHARED_LIB_SUFFIX@%$CFG_TCL_SHARED_LIB_SUFFIX%g
-s%@CFG_TCL_UNSHARED_LIB_SUFFIX@%$CFG_TCL_UNSHARED_LIB_SUFFIX%g
-s%@CFG_TCL_EXPORT_FILE_SUFFIX@%$CFG_TCL_EXPORT_FILE_SUFFIX%g
-s%@EXTRA_CFLAGS@%$EXTRA_CFLAGS%g
-s%@DEPARG@%$DEPARG%g
-s%@CC_OBJNAME@%$CC_OBJNAME%g
-s%@CC_EXENAME@%$CC_EXENAME%g
-s%@LDFLAGS_DEBUG@%$LDFLAGS_DEBUG%g
-s%@LDFLAGS_OPTIMIZE@%$LDFLAGS_OPTIMIZE%g
-s%@LDFLAGS_CONSOLE@%$LDFLAGS_CONSOLE%g
-s%@LDFLAGS_WINDOW@%$LDFLAGS_WINDOW%g
-s%@STLIB_LD@%$STLIB_LD%g
-s%@SHLIB_LD@%$SHLIB_LD%g
-s%@SHLIB_LD_LIBS@%$SHLIB_LD_LIBS%g
-s%@SHLIB_CFLAGS@%$SHLIB_CFLAGS%g
-s%@SHLIB_SUFFIX@%$SHLIB_SUFFIX%g
-s%@TCL_SHARED_BUILD@%$TCL_SHARED_BUILD%g
-s%@LIBS_GUI@%$LIBS_GUI%g
-s%@DLLSUFFIX@%$DLLSUFFIX%g
-s%@LIBPREFIX@%$LIBPREFIX%g
-s%@LIBSUFFIX@%$LIBSUFFIX%g
-s%@EXESUFFIX@%$EXESUFFIX%g
-s%@LIBRARIES@%$LIBRARIES%g
-s%@MAKE_LIB@%$MAKE_LIB%g
-s%@POST_MAKE_LIB@%$POST_MAKE_LIB%g
-s%@MAKE_DLL@%$MAKE_DLL%g
-s%@MAKE_EXE@%$MAKE_EXE%g
-s%@TCL_BUILD_LIB_SPEC@%$TCL_BUILD_LIB_SPEC%g
-s%@TCL_LD_SEARCH_FLAGS@%$TCL_LD_SEARCH_FLAGS%g
-s%@TCL_NEEDS_EXP_FILE@%$TCL_NEEDS_EXP_FILE%g
-s%@TCL_BUILD_EXP_FILE@%$TCL_BUILD_EXP_FILE%g
-s%@TCL_EXP_FILE@%$TCL_EXP_FILE%g
-s%@LIBOBJS@%$LIBOBJS%g
-s%@TCL_LIB_VERSIONS_OK@%$TCL_LIB_VERSIONS_OK%g
-s%@TCL_PACKAGE_PATH@%$TCL_PACKAGE_PATH%g
-s%@TCL_DDE_VERSION@%$TCL_DDE_VERSION%g
-s%@TCL_DDE_MAJOR_VERSION@%$TCL_DDE_MAJOR_VERSION%g
-s%@TCL_DDE_MINOR_VERSION@%$TCL_DDE_MINOR_VERSION%g
-s%@TCL_REG_VERSION@%$TCL_REG_VERSION%g
-s%@TCL_REG_MAJOR_VERSION@%$TCL_REG_MAJOR_VERSION%g
-s%@TCL_REG_MINOR_VERSION@%$TCL_REG_MINOR_VERSION%g
-s%@RC_OUT@%$RC_OUT%g
-s%@RC_TYPE@%$RC_TYPE%g
-s%@RC_INCLUDE@%$RC_INCLUDE%g
-s%@RC_DEFINE@%$RC_DEFINE%g
-s%@RC_DEFINES@%$RC_DEFINES%g
-s%@RES@%$RES%g
-CEOF
-EOF
-
-cat >> $CONFIG_STATUS <<\EOF
-
-# Split the substitutions into bite-sized pieces for seds with
-# small command number limits, like on Digital OSF/1 and HP-UX.
-ac_max_sed_cmds=90 # Maximum number of lines to put in a sed script.
-ac_file=1 # Number of current file.
-ac_beg=1 # First line for current file.
-ac_end=$ac_max_sed_cmds # Line after last line for current file.
-ac_more_lines=:
-ac_sed_cmds=""
-while $ac_more_lines; do
- if test $ac_beg -gt 1; then
- sed "1,${ac_beg}d; ${ac_end}q" conftest.subs > conftest.s$ac_file
+# Name of the executable.
+as_me=`$as_basename "$0" ||
+$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \
+ X"$0" : 'X\(//\)$' \| \
+ X"$0" : 'X\(/\)$' \| \
+ . : '\(.\)' 2>/dev/null ||
+echo X/"$0" |
+ sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/; q; }
+ /^X\/\(\/\/\)$/{ s//\1/; q; }
+ /^X\/\(\/\).*/{ s//\1/; q; }
+ s/.*/./; q'`
+
+
+# PATH needs CR, and LINENO needs CR and PATH.
+# Avoid depending upon Character Ranges.
+as_cr_letters='abcdefghijklmnopqrstuvwxyz'
+as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ'
+as_cr_Letters=$as_cr_letters$as_cr_LETTERS
+as_cr_digits='0123456789'
+as_cr_alnum=$as_cr_Letters$as_cr_digits
+
+# The user is always right.
+if test "${PATH_SEPARATOR+set}" != set; then
+ echo "#! /bin/sh" >conf$$.sh
+ echo "exit 0" >>conf$$.sh
+ chmod +x conf$$.sh
+ if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then
+ PATH_SEPARATOR=';'
else
- sed "${ac_end}q" conftest.subs > conftest.s$ac_file
+ PATH_SEPARATOR=:
fi
- if test ! -s conftest.s$ac_file; then
- ac_more_lines=false
- rm -f conftest.s$ac_file
+ rm -f conf$$.sh
+fi
+
+
+ as_lineno_1=$LINENO
+ as_lineno_2=$LINENO
+ as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null`
+ test "x$as_lineno_1" != "x$as_lineno_2" &&
+ test "x$as_lineno_3" = "x$as_lineno_2" || {
+ # Find who we are. Look in the path if we contain no path at all
+ # relative or not.
+ case $0 in
+ *[\\/]* ) as_myself=$0 ;;
+ *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break
+done
+
+ ;;
+ esac
+ # We did not find ourselves, most probably we were run as `sh COMMAND'
+ # in which case we are not to be found in the path.
+ if test "x$as_myself" = x; then
+ as_myself=$0
+ fi
+ if test ! -f "$as_myself"; then
+ { { echo "$as_me:$LINENO: error: cannot find myself; rerun with an absolute path" >&5
+echo "$as_me: error: cannot find myself; rerun with an absolute path" >&2;}
+ { (exit 1); exit 1; }; }
+ fi
+ case $CONFIG_SHELL in
+ '')
+ as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for as_base in sh bash ksh sh5; do
+ case $as_dir in
+ /*)
+ if ("$as_dir/$as_base" -c '
+ as_lineno_1=$LINENO
+ as_lineno_2=$LINENO
+ as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null`
+ test "x$as_lineno_1" != "x$as_lineno_2" &&
+ test "x$as_lineno_3" = "x$as_lineno_2" ') 2>/dev/null; then
+ $as_unset BASH_ENV || test "${BASH_ENV+set}" != set || { BASH_ENV=; export BASH_ENV; }
+ $as_unset ENV || test "${ENV+set}" != set || { ENV=; export ENV; }
+ CONFIG_SHELL=$as_dir/$as_base
+ export CONFIG_SHELL
+ exec "$CONFIG_SHELL" "$0" ${1+"$@"}
+ fi;;
+ esac
+ done
+done
+;;
+ esac
+
+ # Create $as_me.lineno as a copy of $as_myself, but with $LINENO
+ # uniformly replaced by the line number. The first 'sed' inserts a
+ # line-number line before each line; the second 'sed' does the real
+ # work. The second script uses 'N' to pair each line-number line
+ # with the numbered line, and appends trailing '-' during
+ # substitution so that $LINENO is not a special case at line end.
+ # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the
+ # second 'sed' script. Blame Lee E. McMahon for sed's syntax. :-)
+ sed '=' <$as_myself |
+ sed '
+ N
+ s,$,-,
+ : loop
+ s,^\(['$as_cr_digits']*\)\(.*\)[$]LINENO\([^'$as_cr_alnum'_]\),\1\2\1\3,
+ t loop
+ s,-$,,
+ s,^['$as_cr_digits']*\n,,
+ ' >$as_me.lineno &&
+ chmod +x $as_me.lineno ||
+ { { echo "$as_me:$LINENO: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&5
+echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2;}
+ { (exit 1); exit 1; }; }
+
+ # Don't try to exec as it changes $[0], causing all sort of problems
+ # (the dirname of $[0] is not the place where we might find the
+ # original and so on. Autoconf is especially sensible to this).
+ . ./$as_me.lineno
+ # Exit status is that of the last command.
+ exit
+}
+
+
+case `echo "testing\c"; echo 1,2,3`,`echo -n testing; echo 1,2,3` in
+ *c*,-n*) ECHO_N= ECHO_C='
+' ECHO_T=' ' ;;
+ *c*,* ) ECHO_N=-n ECHO_C= ECHO_T= ;;
+ *) ECHO_N= ECHO_C='\c' ECHO_T= ;;
+esac
+
+if expr a : '\(a\)' >/dev/null 2>&1; then
+ as_expr=expr
+else
+ as_expr=false
+fi
+
+rm -f conf$$ conf$$.exe conf$$.file
+echo >conf$$.file
+if ln -s conf$$.file conf$$ 2>/dev/null; then
+ # We could just check for DJGPP; but this test a) works b) is more generic
+ # and c) will remain valid once DJGPP supports symlinks (DJGPP 2.04).
+ if test -f conf$$.exe; then
+ # Don't use ln at all; we don't have any links
+ as_ln_s='cp -p'
else
- if test -z "$ac_sed_cmds"; then
- ac_sed_cmds="sed -f conftest.s$ac_file"
- else
- ac_sed_cmds="$ac_sed_cmds | sed -f conftest.s$ac_file"
- fi
- ac_file=`expr $ac_file + 1`
- ac_beg=$ac_end
- ac_end=`expr $ac_end + $ac_max_sed_cmds`
+ as_ln_s='ln -s'
fi
+elif ln conf$$.file conf$$ 2>/dev/null; then
+ as_ln_s=ln
+else
+ as_ln_s='cp -p'
+fi
+rm -f conf$$ conf$$.exe conf$$.file
+
+if mkdir -p . 2>/dev/null; then
+ as_mkdir_p=:
+else
+ test -d ./-p && rmdir ./-p
+ as_mkdir_p=false
+fi
+
+as_executable_p="test -f"
+
+# Sed expression to map a string onto a valid CPP name.
+as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"
+
+# Sed expression to map a string onto a valid variable name.
+as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'"
+
+
+# IFS
+# We need space, tab and new line, in precisely that order.
+as_nl='
+'
+IFS=" $as_nl"
+
+# CDPATH.
+$as_unset CDPATH
+
+exec 6>&1
+
+# Open the log real soon, to keep \$[0] and so on meaningful, and to
+# report actual input values of CONFIG_FILES etc. instead of their
+# values after options handling. Logging --version etc. is OK.
+exec 5>>config.log
+{
+ echo
+ sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX
+## Running $as_me. ##
+_ASBOX
+} >&5
+cat >&5 <<_CSEOF
+
+This file was extended by $as_me, which was
+generated by GNU Autoconf 2.59. Invocation command line was
+
+ CONFIG_FILES = $CONFIG_FILES
+ CONFIG_HEADERS = $CONFIG_HEADERS
+ CONFIG_LINKS = $CONFIG_LINKS
+ CONFIG_COMMANDS = $CONFIG_COMMANDS
+ $ $0 $@
+
+_CSEOF
+echo "on `(hostname || uname -n) 2>/dev/null | sed 1q`" >&5
+echo >&5
+_ACEOF
+
+# Files that config.status was made for.
+if test -n "$ac_config_files"; then
+ echo "config_files=\"$ac_config_files\"" >>$CONFIG_STATUS
+fi
+
+if test -n "$ac_config_headers"; then
+ echo "config_headers=\"$ac_config_headers\"" >>$CONFIG_STATUS
+fi
+
+if test -n "$ac_config_links"; then
+ echo "config_links=\"$ac_config_links\"" >>$CONFIG_STATUS
+fi
+
+if test -n "$ac_config_commands"; then
+ echo "config_commands=\"$ac_config_commands\"" >>$CONFIG_STATUS
+fi
+
+cat >>$CONFIG_STATUS <<\_ACEOF
+
+ac_cs_usage="\
+\`$as_me' instantiates files from templates according to the
+current configuration.
+
+Usage: $0 [OPTIONS] [FILE]...
+
+ -h, --help print this help, then exit
+ -V, --version print version number, then exit
+ -q, --quiet do not print progress messages
+ -d, --debug don't remove temporary files
+ --recheck update $as_me by reconfiguring in the same conditions
+ --file=FILE[:TEMPLATE]
+ instantiate the configuration file FILE
+
+Configuration files:
+$config_files
+
+Report bugs to <bug-autoconf@gnu.org>."
+_ACEOF
+
+cat >>$CONFIG_STATUS <<_ACEOF
+ac_cs_version="\\
+config.status
+configured by $0, generated by GNU Autoconf 2.59,
+ with options \\"`echo "$ac_configure_args" | sed 's/[\\""\`\$]/\\\\&/g'`\\"
+
+Copyright (C) 2003 Free Software Foundation, Inc.
+This config.status script is free software; the Free Software Foundation
+gives unlimited permission to copy, distribute and modify it."
+srcdir=$srcdir
+_ACEOF
+
+cat >>$CONFIG_STATUS <<\_ACEOF
+# If no file are specified by the user, then we need to provide default
+# value. By we need to know if files were specified by the user.
+ac_need_defaults=:
+while test $# != 0
+do
+ case $1 in
+ --*=*)
+ ac_option=`expr "x$1" : 'x\([^=]*\)='`
+ ac_optarg=`expr "x$1" : 'x[^=]*=\(.*\)'`
+ ac_shift=:
+ ;;
+ -*)
+ ac_option=$1
+ ac_optarg=$2
+ ac_shift=shift
+ ;;
+ *) # This is not an option, so the user has probably given explicit
+ # arguments.
+ ac_option=$1
+ ac_need_defaults=false;;
+ esac
+
+ case $ac_option in
+ # Handling of the options.
+_ACEOF
+cat >>$CONFIG_STATUS <<\_ACEOF
+ -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r)
+ ac_cs_recheck=: ;;
+ --version | --vers* | -V )
+ echo "$ac_cs_version"; exit 0 ;;
+ --he | --h)
+ # Conflict between --help and --header
+ { { echo "$as_me:$LINENO: error: ambiguous option: $1
+Try \`$0 --help' for more information." >&5
+echo "$as_me: error: ambiguous option: $1
+Try \`$0 --help' for more information." >&2;}
+ { (exit 1); exit 1; }; };;
+ --help | --hel | -h )
+ echo "$ac_cs_usage"; exit 0 ;;
+ --debug | --d* | -d )
+ debug=: ;;
+ --file | --fil | --fi | --f )
+ $ac_shift
+ CONFIG_FILES="$CONFIG_FILES $ac_optarg"
+ ac_need_defaults=false;;
+ --header | --heade | --head | --hea )
+ $ac_shift
+ CONFIG_HEADERS="$CONFIG_HEADERS $ac_optarg"
+ ac_need_defaults=false;;
+ -q | -quiet | --quiet | --quie | --qui | --qu | --q \
+ | -silent | --silent | --silen | --sile | --sil | --si | --s)
+ ac_cs_silent=: ;;
+
+ # This is an error.
+ -*) { { echo "$as_me:$LINENO: error: unrecognized option: $1
+Try \`$0 --help' for more information." >&5
+echo "$as_me: error: unrecognized option: $1
+Try \`$0 --help' for more information." >&2;}
+ { (exit 1); exit 1; }; } ;;
+
+ *) ac_config_targets="$ac_config_targets $1" ;;
+
+ esac
+ shift
done
-if test -z "$ac_sed_cmds"; then
- ac_sed_cmds=cat
+
+ac_configure_extra_args=
+
+if $ac_cs_silent; then
+ exec 6>/dev/null
+ ac_configure_extra_args="$ac_configure_extra_args --silent"
fi
-EOF
-cat >> $CONFIG_STATUS <<EOF
+_ACEOF
+cat >>$CONFIG_STATUS <<_ACEOF
+if \$ac_cs_recheck; then
+ echo "running $SHELL $0 " $ac_configure_args \$ac_configure_extra_args " --no-create --no-recursion" >&6
+ exec $SHELL $0 $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion
+fi
-CONFIG_FILES=\${CONFIG_FILES-"Makefile tclConfig.sh tcl.hpj"}
-EOF
-cat >> $CONFIG_STATUS <<\EOF
-for ac_file in .. $CONFIG_FILES; do if test "x$ac_file" != x..; then
- # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in".
- case "$ac_file" in
- *:*) ac_file_in=`echo "$ac_file"|sed 's%[^:]*:%%'`
- ac_file=`echo "$ac_file"|sed 's%:.*%%'` ;;
- *) ac_file_in="${ac_file}.in" ;;
+_ACEOF
+
+
+
+
+
+cat >>$CONFIG_STATUS <<\_ACEOF
+for ac_config_target in $ac_config_targets
+do
+ case "$ac_config_target" in
+ # Handling of arguments.
+ "Makefile" ) CONFIG_FILES="$CONFIG_FILES Makefile" ;;
+ "tclConfig.sh" ) CONFIG_FILES="$CONFIG_FILES tclConfig.sh" ;;
+ "tcl.hpj" ) CONFIG_FILES="$CONFIG_FILES tcl.hpj" ;;
+ *) { { echo "$as_me:$LINENO: error: invalid argument: $ac_config_target" >&5
+echo "$as_me: error: invalid argument: $ac_config_target" >&2;}
+ { (exit 1); exit 1; }; };;
esac
+done
- # Adjust a relative srcdir, top_srcdir, and INSTALL for subdirectories.
+# If the user did not use the arguments to specify the items to instantiate,
+# then the envvar interface is used. Set only those that are not.
+# We use the long form for the default assignment because of an extremely
+# bizarre bug on SunOS 4.1.3.
+if $ac_need_defaults; then
+ test "${CONFIG_FILES+set}" = set || CONFIG_FILES=$config_files
+fi
- # Remove last slash and all that follows it. Not all systems have dirname.
- ac_dir=`echo $ac_file|sed 's%/[^/][^/]*$%%'`
- if test "$ac_dir" != "$ac_file" && test "$ac_dir" != .; then
- # The file is in a subdirectory.
- test ! -d "$ac_dir" && mkdir "$ac_dir"
- ac_dir_suffix="/`echo $ac_dir|sed 's%^\./%%'`"
- # A "../" for each directory in $ac_dir_suffix.
- ac_dots=`echo $ac_dir_suffix|sed 's%/[^/]*%../%g'`
- else
- ac_dir_suffix= ac_dots=
+# Have a temporary directory for convenience. Make it in the build tree
+# simply because there is no reason to put it here, and in addition,
+# creating and moving files from /tmp can sometimes cause problems.
+# Create a temporary directory, and hook for its removal unless debugging.
+$debug ||
+{
+ trap 'exit_status=$?; rm -rf $tmp && exit $exit_status' 0
+ trap '{ (exit 1); exit 1; }' 1 2 13 15
+}
+
+# Create a (secure) tmp directory for tmp files.
+
+{
+ tmp=`(umask 077 && mktemp -d -q "./confstatXXXXXX") 2>/dev/null` &&
+ test -n "$tmp" && test -d "$tmp"
+} ||
+{
+ tmp=./confstat$$-$RANDOM
+ (umask 077 && mkdir $tmp)
+} ||
+{
+ echo "$me: cannot create a temporary directory in ." >&2
+ { (exit 1); exit 1; }
+}
+
+_ACEOF
+
+cat >>$CONFIG_STATUS <<_ACEOF
+
+#
+# CONFIG_FILES section.
+#
+
+# No need to generate the scripts if there are no CONFIG_FILES.
+# This happens for instance when ./config.status config.h
+if test -n "\$CONFIG_FILES"; then
+ # Protect against being on the right side of a sed subst in config.status.
+ sed 's/,@/@@/; s/@,/@@/; s/,;t t\$/@;t t/; /@;t t\$/s/[\\\\&,]/\\\\&/g;
+ s/@@/,@/; s/@@/@,/; s/@;t t\$/,;t t/' >\$tmp/subs.sed <<\\CEOF
+s,@SHELL@,$SHELL,;t t
+s,@PATH_SEPARATOR@,$PATH_SEPARATOR,;t t
+s,@PACKAGE_NAME@,$PACKAGE_NAME,;t t
+s,@PACKAGE_TARNAME@,$PACKAGE_TARNAME,;t t
+s,@PACKAGE_VERSION@,$PACKAGE_VERSION,;t t
+s,@PACKAGE_STRING@,$PACKAGE_STRING,;t t
+s,@PACKAGE_BUGREPORT@,$PACKAGE_BUGREPORT,;t t
+s,@exec_prefix@,$exec_prefix,;t t
+s,@prefix@,$prefix,;t t
+s,@program_transform_name@,$program_transform_name,;t t
+s,@bindir@,$bindir,;t t
+s,@sbindir@,$sbindir,;t t
+s,@libexecdir@,$libexecdir,;t t
+s,@datadir@,$datadir,;t t
+s,@sysconfdir@,$sysconfdir,;t t
+s,@sharedstatedir@,$sharedstatedir,;t t
+s,@localstatedir@,$localstatedir,;t t
+s,@libdir@,$libdir,;t t
+s,@includedir@,$includedir,;t t
+s,@oldincludedir@,$oldincludedir,;t t
+s,@infodir@,$infodir,;t t
+s,@mandir@,$mandir,;t t
+s,@build_alias@,$build_alias,;t t
+s,@host_alias@,$host_alias,;t t
+s,@target_alias@,$target_alias,;t t
+s,@DEFS@,$DEFS,;t t
+s,@ECHO_C@,$ECHO_C,;t t
+s,@ECHO_N@,$ECHO_N,;t t
+s,@ECHO_T@,$ECHO_T,;t t
+s,@LIBS@,$LIBS,;t t
+s,@CC@,$CC,;t t
+s,@CFLAGS@,$CFLAGS,;t t
+s,@LDFLAGS@,$LDFLAGS,;t t
+s,@CPPFLAGS@,$CPPFLAGS,;t t
+s,@ac_ct_CC@,$ac_ct_CC,;t t
+s,@EXEEXT@,$EXEEXT,;t t
+s,@OBJEXT@,$OBJEXT,;t t
+s,@CPP@,$CPP,;t t
+s,@EGREP@,$EGREP,;t t
+s,@AR@,$AR,;t t
+s,@ac_ct_AR@,$ac_ct_AR,;t t
+s,@RANLIB@,$RANLIB,;t t
+s,@ac_ct_RANLIB@,$ac_ct_RANLIB,;t t
+s,@RC@,$RC,;t t
+s,@ac_ct_RC@,$ac_ct_RC,;t t
+s,@SET_MAKE@,$SET_MAKE,;t t
+s,@TCL_THREADS@,$TCL_THREADS,;t t
+s,@CYGPATH@,$CYGPATH,;t t
+s,@CELIB_DIR@,$CELIB_DIR,;t t
+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,@CFLAGS_DEFAULT@,$CFLAGS_DEFAULT,;t t
+s,@LDFLAGS_DEFAULT@,$LDFLAGS_DEFAULT,;t t
+s,@VC_MANIFEST_EMBED_DLL@,$VC_MANIFEST_EMBED_DLL,;t t
+s,@VC_MANIFEST_EMBED_EXE@,$VC_MANIFEST_EMBED_EXE,;t t
+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,@TCL_LIB_FILE@,$TCL_LIB_FILE,;t t
+s,@TCL_LIB_FLAG@,$TCL_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
+s,@TCL_STUB_LIB_SPEC@,$TCL_STUB_LIB_SPEC,;t t
+s,@TCL_STUB_LIB_PATH@,$TCL_STUB_LIB_PATH,;t t
+s,@TCL_INCLUDE_SPEC@,$TCL_INCLUDE_SPEC,;t t
+s,@TCL_BUILD_STUB_LIB_SPEC@,$TCL_BUILD_STUB_LIB_SPEC,;t t
+s,@TCL_BUILD_STUB_LIB_PATH@,$TCL_BUILD_STUB_LIB_PATH,;t t
+s,@TCL_DLL_FILE@,$TCL_DLL_FILE,;t t
+s,@TCL_SRC_DIR@,$TCL_SRC_DIR,;t t
+s,@TCL_BIN_DIR@,$TCL_BIN_DIR,;t t
+s,@TCL_DBGX@,$TCL_DBGX,;t t
+s,@CFG_TCL_SHARED_LIB_SUFFIX@,$CFG_TCL_SHARED_LIB_SUFFIX,;t t
+s,@CFG_TCL_UNSHARED_LIB_SUFFIX@,$CFG_TCL_UNSHARED_LIB_SUFFIX,;t t
+s,@CFG_TCL_EXPORT_FILE_SUFFIX@,$CFG_TCL_EXPORT_FILE_SUFFIX,;t t
+s,@EXTRA_CFLAGS@,$EXTRA_CFLAGS,;t t
+s,@DEPARG@,$DEPARG,;t t
+s,@CC_OBJNAME@,$CC_OBJNAME,;t t
+s,@CC_EXENAME@,$CC_EXENAME,;t t
+s,@LDFLAGS_DEBUG@,$LDFLAGS_DEBUG,;t t
+s,@LDFLAGS_OPTIMIZE@,$LDFLAGS_OPTIMIZE,;t t
+s,@LDFLAGS_CONSOLE@,$LDFLAGS_CONSOLE,;t t
+s,@LDFLAGS_WINDOW@,$LDFLAGS_WINDOW,;t t
+s,@STLIB_LD@,$STLIB_LD,;t t
+s,@SHLIB_LD@,$SHLIB_LD,;t t
+s,@SHLIB_LD_LIBS@,$SHLIB_LD_LIBS,;t t
+s,@SHLIB_CFLAGS@,$SHLIB_CFLAGS,;t t
+s,@SHLIB_SUFFIX@,$SHLIB_SUFFIX,;t t
+s,@TCL_SHARED_BUILD@,$TCL_SHARED_BUILD,;t t
+s,@LIBS_GUI@,$LIBS_GUI,;t t
+s,@DLLSUFFIX@,$DLLSUFFIX,;t t
+s,@LIBPREFIX@,$LIBPREFIX,;t t
+s,@LIBSUFFIX@,$LIBSUFFIX,;t t
+s,@EXESUFFIX@,$EXESUFFIX,;t t
+s,@LIBRARIES@,$LIBRARIES,;t t
+s,@MAKE_LIB@,$MAKE_LIB,;t t
+s,@POST_MAKE_LIB@,$POST_MAKE_LIB,;t t
+s,@MAKE_DLL@,$MAKE_DLL,;t t
+s,@MAKE_EXE@,$MAKE_EXE,;t t
+s,@TCL_BUILD_LIB_SPEC@,$TCL_BUILD_LIB_SPEC,;t t
+s,@TCL_LD_SEARCH_FLAGS@,$TCL_LD_SEARCH_FLAGS,;t t
+s,@TCL_NEEDS_EXP_FILE@,$TCL_NEEDS_EXP_FILE,;t t
+s,@TCL_BUILD_EXP_FILE@,$TCL_BUILD_EXP_FILE,;t t
+s,@TCL_EXP_FILE@,$TCL_EXP_FILE,;t t
+s,@TCL_LIB_VERSIONS_OK@,$TCL_LIB_VERSIONS_OK,;t t
+s,@TCL_PACKAGE_PATH@,$TCL_PACKAGE_PATH,;t t
+s,@TCL_DDE_VERSION@,$TCL_DDE_VERSION,;t t
+s,@TCL_DDE_MAJOR_VERSION@,$TCL_DDE_MAJOR_VERSION,;t t
+s,@TCL_DDE_MINOR_VERSION@,$TCL_DDE_MINOR_VERSION,;t t
+s,@TCL_DDE_PATCH_LEVEL@,$TCL_DDE_PATCH_LEVEL,;t t
+s,@TCL_REG_VERSION@,$TCL_REG_VERSION,;t t
+s,@TCL_REG_MAJOR_VERSION@,$TCL_REG_MAJOR_VERSION,;t t
+s,@TCL_REG_MINOR_VERSION@,$TCL_REG_MINOR_VERSION,;t t
+s,@TCL_REG_PATCH_LEVEL@,$TCL_REG_PATCH_LEVEL,;t t
+s,@RC_OUT@,$RC_OUT,;t t
+s,@RC_TYPE@,$RC_TYPE,;t t
+s,@RC_INCLUDE@,$RC_INCLUDE,;t t
+s,@RC_DEFINE@,$RC_DEFINE,;t t
+s,@RC_DEFINES@,$RC_DEFINES,;t t
+s,@RES@,$RES,;t t
+s,@LIBOBJS@,$LIBOBJS,;t t
+s,@LTLIBOBJS@,$LTLIBOBJS,;t t
+CEOF
+
+_ACEOF
+
+ cat >>$CONFIG_STATUS <<\_ACEOF
+ # Split the substitutions into bite-sized pieces for seds with
+ # small command number limits, like on Digital OSF/1 and HP-UX.
+ ac_max_sed_lines=48
+ ac_sed_frag=1 # Number of current file.
+ ac_beg=1 # First line for current file.
+ ac_end=$ac_max_sed_lines # Line after last line for current file.
+ ac_more_lines=:
+ ac_sed_cmds=
+ while $ac_more_lines; do
+ if test $ac_beg -gt 1; then
+ sed "1,${ac_beg}d; ${ac_end}q" $tmp/subs.sed >$tmp/subs.frag
+ else
+ sed "${ac_end}q" $tmp/subs.sed >$tmp/subs.frag
+ fi
+ if test ! -s $tmp/subs.frag; then
+ ac_more_lines=false
+ else
+ # The purpose of the label and of the branching condition is to
+ # speed up the sed processing (if there are no `@' at all, there
+ # is no need to browse any of the substitutions).
+ # These are the two extra sed commands mentioned above.
+ (echo ':t
+ /@[a-zA-Z_][a-zA-Z_0-9]*@/!b' && cat $tmp/subs.frag) >$tmp/subs-$ac_sed_frag.sed
+ if test -z "$ac_sed_cmds"; then
+ ac_sed_cmds="sed -f $tmp/subs-$ac_sed_frag.sed"
+ else
+ ac_sed_cmds="$ac_sed_cmds | sed -f $tmp/subs-$ac_sed_frag.sed"
+ fi
+ ac_sed_frag=`expr $ac_sed_frag + 1`
+ ac_beg=$ac_end
+ ac_end=`expr $ac_end + $ac_max_sed_lines`
+ fi
+ done
+ if test -z "$ac_sed_cmds"; then
+ ac_sed_cmds=cat
fi
+fi # test -n "$CONFIG_FILES"
- case "$ac_given_srcdir" in
- .) srcdir=.
- if test -z "$ac_dots"; then top_srcdir=.
- else top_srcdir=`echo $ac_dots|sed 's%/$%%'`; fi ;;
- /*) srcdir="$ac_given_srcdir$ac_dir_suffix"; top_srcdir="$ac_given_srcdir" ;;
- *) # Relative path.
- srcdir="$ac_dots$ac_given_srcdir$ac_dir_suffix"
- top_srcdir="$ac_dots$ac_given_srcdir" ;;
+_ACEOF
+cat >>$CONFIG_STATUS <<\_ACEOF
+for ac_file in : $CONFIG_FILES; do test "x$ac_file" = x: && continue
+ # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in".
+ case $ac_file in
+ - | *:- | *:-:* ) # input from stdin
+ cat >$tmp/stdin
+ ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'`
+ ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;;
+ *:* ) ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'`
+ ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;;
+ * ) ac_file_in=$ac_file.in ;;
esac
+ # Compute @srcdir@, @top_srcdir@, and @INSTALL@ for subdirectories.
+ ac_dir=`(dirname "$ac_file") 2>/dev/null ||
+$as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
+ X"$ac_file" : 'X\(//\)[^/]' \| \
+ X"$ac_file" : 'X\(//\)$' \| \
+ X"$ac_file" : 'X\(/\)' \| \
+ . : '\(.\)' 2>/dev/null ||
+echo X"$ac_file" |
+ sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; }
+ /^X\(\/\/\)[^/].*/{ s//\1/; q; }
+ /^X\(\/\/\)$/{ s//\1/; q; }
+ /^X\(\/\).*/{ s//\1/; q; }
+ s/.*/./; q'`
+ { if $as_mkdir_p; then
+ mkdir -p "$ac_dir"
+ else
+ as_dir="$ac_dir"
+ as_dirs=
+ while test ! -d "$as_dir"; do
+ as_dirs="$as_dir $as_dirs"
+ as_dir=`(dirname "$as_dir") 2>/dev/null ||
+$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
+ X"$as_dir" : 'X\(//\)[^/]' \| \
+ X"$as_dir" : 'X\(//\)$' \| \
+ X"$as_dir" : 'X\(/\)' \| \
+ . : '\(.\)' 2>/dev/null ||
+echo X"$as_dir" |
+ sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; }
+ /^X\(\/\/\)[^/].*/{ s//\1/; q; }
+ /^X\(\/\/\)$/{ s//\1/; q; }
+ /^X\(\/\).*/{ s//\1/; q; }
+ s/.*/./; q'`
+ done
+ test ! -n "$as_dirs" || mkdir $as_dirs
+ fi || { { echo "$as_me:$LINENO: error: cannot create directory \"$ac_dir\"" >&5
+echo "$as_me: error: cannot create directory \"$ac_dir\"" >&2;}
+ { (exit 1); exit 1; }; }; }
- echo creating "$ac_file"
- rm -f "$ac_file"
- configure_input="Generated automatically from `echo $ac_file_in|sed 's%.*/%%'` by configure."
- case "$ac_file" in
- *Makefile*) ac_comsub="1i\\
-# $configure_input" ;;
- *) ac_comsub= ;;
- esac
+ ac_builddir=.
- ac_file_inputs=`echo $ac_file_in|sed -e "s%^%$ac_given_srcdir/%" -e "s%:% $ac_given_srcdir/%g"`
- sed -e "$ac_comsub
-s%@configure_input@%$configure_input%g
-s%@srcdir@%$srcdir%g
-s%@top_srcdir@%$top_srcdir%g
-" $ac_file_inputs | (eval "$ac_sed_cmds") > $ac_file
-fi; done
-rm -f conftest.s*
+if test "$ac_dir" != .; then
+ ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'`
+ # A "../" for each directory in $ac_dir_suffix.
+ ac_top_builddir=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,../,g'`
+else
+ ac_dir_suffix= ac_top_builddir=
+fi
+
+case $srcdir in
+ .) # No --srcdir option. We are building in place.
+ ac_srcdir=.
+ if test -z "$ac_top_builddir"; then
+ ac_top_srcdir=.
+ else
+ ac_top_srcdir=`echo $ac_top_builddir | sed 's,/$,,'`
+ fi ;;
+ [\\/]* | ?:[\\/]* ) # Absolute path.
+ ac_srcdir=$srcdir$ac_dir_suffix;
+ ac_top_srcdir=$srcdir ;;
+ *) # Relative path.
+ ac_srcdir=$ac_top_builddir$srcdir$ac_dir_suffix
+ ac_top_srcdir=$ac_top_builddir$srcdir ;;
+esac
+
+# Do not use `cd foo && pwd` to compute absolute paths, because
+# the directories may not exist.
+case `pwd` in
+.) ac_abs_builddir="$ac_dir";;
+*)
+ case "$ac_dir" in
+ .) ac_abs_builddir=`pwd`;;
+ [\\/]* | ?:[\\/]* ) ac_abs_builddir="$ac_dir";;
+ *) ac_abs_builddir=`pwd`/"$ac_dir";;
+ esac;;
+esac
+case $ac_abs_builddir in
+.) ac_abs_top_builddir=${ac_top_builddir}.;;
+*)
+ case ${ac_top_builddir}. in
+ .) ac_abs_top_builddir=$ac_abs_builddir;;
+ [\\/]* | ?:[\\/]* ) ac_abs_top_builddir=${ac_top_builddir}.;;
+ *) ac_abs_top_builddir=$ac_abs_builddir/${ac_top_builddir}.;;
+ esac;;
+esac
+case $ac_abs_builddir in
+.) ac_abs_srcdir=$ac_srcdir;;
+*)
+ case $ac_srcdir in
+ .) ac_abs_srcdir=$ac_abs_builddir;;
+ [\\/]* | ?:[\\/]* ) ac_abs_srcdir=$ac_srcdir;;
+ *) ac_abs_srcdir=$ac_abs_builddir/$ac_srcdir;;
+ esac;;
+esac
+case $ac_abs_builddir in
+.) ac_abs_top_srcdir=$ac_top_srcdir;;
+*)
+ case $ac_top_srcdir in
+ .) ac_abs_top_srcdir=$ac_abs_builddir;;
+ [\\/]* | ?:[\\/]* ) ac_abs_top_srcdir=$ac_top_srcdir;;
+ *) ac_abs_top_srcdir=$ac_abs_builddir/$ac_top_srcdir;;
+ esac;;
+esac
+
+
+
+ if test x"$ac_file" != x-; then
+ { echo "$as_me:$LINENO: creating $ac_file" >&5
+echo "$as_me: creating $ac_file" >&6;}
+ rm -f "$ac_file"
+ fi
+ # Let's still pretend it is `configure' which instantiates (i.e., don't
+ # use $as_me), people would be surprised to read:
+ # /* config.h. Generated by config.status. */
+ if test x"$ac_file" = x-; then
+ configure_input=
+ else
+ configure_input="$ac_file. "
+ fi
+ configure_input=$configure_input"Generated from `echo $ac_file_in |
+ sed 's,.*/,,'` by configure."
+
+ # First look for the input files in the build tree, otherwise in the
+ # src tree.
+ ac_file_inputs=`IFS=:
+ for f in $ac_file_in; do
+ case $f in
+ -) echo $tmp/stdin ;;
+ [\\/$]*)
+ # Absolute (can't be DOS-style, as IFS=:)
+ test -f "$f" || { { echo "$as_me:$LINENO: error: cannot find input file: $f" >&5
+echo "$as_me: error: cannot find input file: $f" >&2;}
+ { (exit 1); exit 1; }; }
+ echo "$f";;
+ *) # Relative
+ if test -f "$f"; then
+ # Build tree
+ echo "$f"
+ elif test -f "$srcdir/$f"; then
+ # Source tree
+ echo "$srcdir/$f"
+ else
+ # /dev/null tree
+ { { echo "$as_me:$LINENO: error: cannot find input file: $f" >&5
+echo "$as_me: error: cannot find input file: $f" >&2;}
+ { (exit 1); exit 1; }; }
+ fi;;
+ esac
+ done` || { (exit 1); exit 1; }
+_ACEOF
+cat >>$CONFIG_STATUS <<_ACEOF
+ sed "$ac_vpsub
+$extrasub
+_ACEOF
+cat >>$CONFIG_STATUS <<\_ACEOF
+:t
+/@[a-zA-Z_][a-zA-Z_0-9]*@/!b
+s,@configure_input@,$configure_input,;t t
+s,@srcdir@,$ac_srcdir,;t t
+s,@abs_srcdir@,$ac_abs_srcdir,;t t
+s,@top_srcdir@,$ac_top_srcdir,;t t
+s,@abs_top_srcdir@,$ac_abs_top_srcdir,;t t
+s,@builddir@,$ac_builddir,;t t
+s,@abs_builddir@,$ac_abs_builddir,;t t
+s,@top_builddir@,$ac_top_builddir,;t t
+s,@abs_top_builddir@,$ac_abs_top_builddir,;t t
+" $ac_file_inputs | (eval "$ac_sed_cmds") >$tmp/out
+ rm -f $tmp/stdin
+ if test x"$ac_file" != x-; then
+ mv $tmp/out $ac_file
+ else
+ cat $tmp/out
+ rm -f $tmp/out
+ fi
-EOF
-cat >> $CONFIG_STATUS <<EOF
+done
+_ACEOF
-EOF
-cat >> $CONFIG_STATUS <<\EOF
+cat >>$CONFIG_STATUS <<\_ACEOF
-exit 0
-EOF
+{ (exit 0); exit 0; }
+_ACEOF
chmod +x $CONFIG_STATUS
-rm -fr confdefs* $ac_clean_files
-test "$no_create" = yes || ${CONFIG_SHELL-/bin/sh} $CONFIG_STATUS || exit 1
+ac_clean_files=$ac_clean_files_save
+
+
+# configure is writing to config.log, and then calls config.status.
+# config.status does its own redirection, appending to config.log.
+# Unfortunately, on DOS this fails, as config.log is still kept open
+# by configure, so config.status won't be able to write to it; its
+# output is simply discarded. So we exec the FD to /dev/null,
+# effectively closing config.log, so it can be properly (re)opened and
+# appended to by config.status. When coming back to configure, we
+# need to make the FD available again.
+if test "$no_create" != yes; then
+ ac_cs_success=:
+ ac_config_status_args=
+ test "$silent" = yes &&
+ ac_config_status_args="$ac_config_status_args --quiet"
+ exec 5>/dev/null
+ $SHELL $CONFIG_STATUS $ac_config_status_args || ac_cs_success=false
+ exec 5>>config.log
+ # Use ||, not &&, to avoid exiting from the if with $? = 1, which
+ # would make configure fail if this is the last instruction.
+ $ac_cs_success || { (exit 1); exit 1; }
+fi
diff --git a/win/configure.in b/win/configure.in
index f839521..dd1f745 100644
--- a/win/configure.in
+++ b/win/configure.in
@@ -4,22 +4,29 @@
# to configure the system for the local environment.
AC_INIT(../generic/tcl.h)
-AC_PREREQ(2.13)
+AC_PREREQ(2.59)
-TCL_VERSION=8.4
+# The following define is needed when building with Cygwin since newer
+# versions of autoconf incorrectly set SHELL to /bin/bash instead of
+# /bin/sh. The bash shell seems to suffer from some strange failures.
+SHELL=/bin/sh
+
+TCL_VERSION=8.5
TCL_MAJOR_VERSION=8
-TCL_MINOR_VERSION=4
-TCL_PATCH_LEVEL=".19"
+TCL_MINOR_VERSION=5
+TCL_PATCH_LEVEL=".11"
VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION
-TCL_DDE_VERSION=1.2
+TCL_DDE_VERSION=1.3
TCL_DDE_MAJOR_VERSION=1
-TCL_DDE_MINOR_VERSION=2
+TCL_DDE_MINOR_VERSION=3
+TCL_DDE_PATCH_LEVEL="2"
DDEVER=$TCL_DDE_MAJOR_VERSION$TCL_DDE_MINOR_VERSION
-TCL_REG_VERSION=1.1
+TCL_REG_VERSION=1.2
TCL_REG_MAJOR_VERSION=1
-TCL_REG_MINOR_VERSION=1
+TCL_REG_MINOR_VERSION=2
+TCL_REG_PATCH_LEVEL="1"
REGVER=$TCL_REG_MAJOR_VERSION$TCL_REG_MINOR_VERSION
#------------------------------------------------------------------------
@@ -46,32 +53,12 @@ if test "${CFLAGS+set}" != "set" ; then
fi
AC_PROG_CC
+AC_C_INLINE
+AC_HEADER_STDC
-# To properly support cross-compilation, one would
-# need to use these tool checks instead of
-# the ones below and reconfigure with
-# autoconf 2.50. You can also just set
-# the CC, AR, RANLIB, and RC environment
-# variables if you want to cross compile.
-dnl AC_CHECK_TOOL(AR, ar)
-dnl AC_CHECK_TOOL(RANLIB, ranlib)
-dnl AC_CHECK_TOOL(RC, windres)
-
-if test "${GCC}" = "yes" ; then
- AC_CHECK_PROG(AR, ar, ar)
- AC_CHECK_PROG(RANLIB, ranlib, ranlib)
- AC_CHECK_PROG(RC, windres, windres)
-
- if test "${AR}" = "" ; then
- AC_MSG_ERROR([Required archive tool 'ar' not found on PATH.])
- fi
- if test "${RANLIB}" = "" ; then
- AC_MSG_ERROR([Required archive index tool 'ranlib' not found on PATH.])
- fi
- if test "${RC}" = "" ; then
- AC_MSG_ERROR([Required resource tool 'windres' not found on PATH.])
- fi
-fi
+AC_CHECK_TOOL(AR, ar)
+AC_CHECK_TOOL(RANLIB, ranlib)
+AC_CHECK_TOOL(RC, windres)
#--------------------------------------------------------------------
# Checks to see if the make program sets the $MAKE variable.
@@ -92,6 +79,12 @@ AC_EXEEXT
SC_ENABLE_THREADS
+#------------------------------------------------------------------------
+# Embedded configuration information, encoding to use for the values, TIP #59
+#------------------------------------------------------------------------
+
+SC_TCL_CFG_ENCODING
+
#--------------------------------------------------------------------
# The statements below define a collection of symbols related to
# building libtcl as a shared library instead of a static library.
@@ -107,62 +100,62 @@ SC_ENABLE_SHARED
SC_CONFIG_CFLAGS
+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, [
+ for tcl_cv_intptr_t in "int" "long" "long long" none; do
+ if test "$tcl_cv_intptr_t" != none; then
+ AC_COMPILE_IFELSE([AC_LANG_BOOL_COMPILE_TRY([AC_INCLUDES_DEFAULT],
+ [[sizeof (void *) <= sizeof ($tcl_cv_intptr_t)]])],
+ [tcl_ok=yes], [tcl_ok=no])
+ test "$tcl_ok" = yes && break; fi
+ done])
+ if test "$tcl_cv_intptr_t" != none; then
+ AC_DEFINE_UNQUOTED([intptr_t], [$tcl_cv_intptr_t], [Signed integer
+ type wide enough to hold a pointer.])
+ fi
+])
+AC_CHECK_TYPE([uintptr_t], [
+ AC_DEFINE([HAVE_UINTPTR_T], 1, [Do we have the uintptr_t type?])], [
+ AC_CACHE_CHECK([for pointer-size unsigned integer type], tcl_cv_uintptr_t, [
+ for tcl_cv_uintptr_t in "unsigned int" "unsigned long" "unsigned long long" \
+ none; do
+ if test "$tcl_cv_uintptr_t" != none; then
+ AC_COMPILE_IFELSE([AC_LANG_BOOL_COMPILE_TRY([AC_INCLUDES_DEFAULT],
+ [[sizeof (void *) <= sizeof ($tcl_cv_uintptr_t)]])],
+ [tcl_ok=yes], [tcl_ok=no])
+ test "$tcl_ok" = yes && break; fi
+ done])
+ if test "$tcl_cv_uintptr_t" != none; then
+ AC_DEFINE_UNQUOTED([uintptr_t], [$tcl_cv_uintptr_t], [Unsigned integer
+ type wide enough to hold a pointer.])
+ fi
+])
#--------------------------------------------------------------------
# Perform additinal compiler tests.
#--------------------------------------------------------------------
-if test "${GCC}" = "yes" ; then
-# Check to see if the winsock2.h include file provided contains
-# typedefs like LPFN_ACCEPT and friends.
-#
-AC_CACHE_CHECK(for LPFN_ACCEPT support in winsock2.h,
- tcl_cv_lpfn_decls,
+# See if declarations like FINDEX_INFO_LEVELS are
+# missing from winbase.h. This is known to be
+# a problem with VC++ 5.2.
+
+AC_CACHE_CHECK(for FINDEX_INFO_LEVELS in winbase.h,
+ tcl_cv_findex_enums,
AC_TRY_COMPILE([
#define WIN32_LEAN_AND_MEAN
#include <windows.h>
#undef WIN32_LEAN_AND_MEAN
-#include <winsock2.h>
-],
-[
- LPFN_ACCEPT accept;
-],
- tcl_cv_lpfn_decls=yes,
- tcl_cv_lpfn_decls=no)
-)
-if test "$tcl_cv_lpfn_decls" = "no" ; then
- AC_DEFINE(HAVE_NO_LPFN_DECLS, 1,
- [Defined when cygwin/mingw does not support LPFN_ACCEPT and friends.])
-fi
-
-# Check to see if malloc.h is missing the alloca function
-# declaration. This is known to be a problem with Mingw.
-# If we compiled without the function declaration, it
-# would work but we would get a warning message from gcc.
-# If we add the function declaration ourselves, it
-# would not compile correctly because the _alloca
-# function expects the argument to be passed in a
-# register and not on the stack. Instead, we just
-# call it from inline asm code.
-
-AC_CACHE_CHECK(for alloca declaration in malloc.h,
- tcl_cv_malloc_decl_alloca,
-AC_TRY_COMPILE([
-#include <malloc.h>
],
[
- size_t arg = 0;
- void* ptr;
- ptr = alloca;
- ptr = alloca(arg);
+ FINDEX_INFO_LEVELS i;
+ FINDEX_SEARCH_OPS j;
],
- tcl_cv_malloc_decl_alloca=yes,
- tcl_cv_malloc_decl_alloca=no)
+ tcl_cv_findex_enums=yes,
+ tcl_cv_findex_enums=no)
)
-if test "$tcl_cv_malloc_decl_alloca" = "no" &&
- test "${GCC}" = "yes" ; then
- AC_DEFINE(HAVE_ALLOCA_GCC_INLINE, 1,
- [Defined when gcc should use inline ASM to call alloca.])
-fi
+if test "$tcl_cv_findex_enums" = "no"; then
+ AC_DEFINE(HAVE_NO_FINDEX_ENUMS, 1,
+ [Defined when enums are missing from winbase.h])
fi
#--------------------------------------------------------------------
@@ -176,11 +169,10 @@ SC_ENABLE_SYMBOLS
TCL_DBGX=${DBGX}
#--------------------------------------------------------------------
-# man2tcl needs this so that it can use errno.h
+# Embed the manifest if we can determine how
#--------------------------------------------------------------------
-AC_CHECK_HEADER(errno.h, , MAN2TCLFLAGS="-DNO_ERRNO_H")
-AC_SUBST(MAN2TCLFLAGS)
+SC_EMBED_MANIFEST
#------------------------------------------------------------------------
# tclConfig.sh refers to this by a different name
@@ -326,7 +318,6 @@ AC_SUBST(TCL_NEEDS_EXP_FILE)
AC_SUBST(TCL_BUILD_EXP_FILE)
AC_SUBST(TCL_EXP_FILE)
AC_SUBST(DL_LIBS)
-AC_SUBST(LIBOBJS)
AC_SUBST(TCL_LIB_VERSIONS_OK)
AC_SUBST(TCL_PACKAGE_PATH)
@@ -334,9 +325,11 @@ AC_SUBST(TCL_PACKAGE_PATH)
AC_SUBST(TCL_DDE_VERSION)
AC_SUBST(TCL_DDE_MAJOR_VERSION)
AC_SUBST(TCL_DDE_MINOR_VERSION)
+AC_SUBST(TCL_DDE_PATCH_LEVEL)
AC_SUBST(TCL_REG_VERSION)
AC_SUBST(TCL_REG_MAJOR_VERSION)
AC_SUBST(TCL_REG_MINOR_VERSION)
+AC_SUBST(TCL_REG_PATCH_LEVEL)
AC_SUBST(RC)
AC_SUBST(RC_OUT)
diff --git a/win/makefile.bc b/win/makefile.bc
index 3c0ea73..2faf415 100644
--- a/win/makefile.bc
+++ b/win/makefile.bc
@@ -7,7 +7,17 @@
#
# Copyright (c) 1995-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
+
+# TIP #59 information.
+#
+# This makefile does not set the following configuration cpp
+# defines. Behind the defines are the makefile variables listed to set
+# to -D... when that feature is enabled.
#
+# - TCL_CFG_PROFILED PROFDEFINES
+# - TCL_CFG_OPTIMIZED OPTDEFINES
+# - TCL_CFG_DO64BIT SIXFOURDEFINES
+
# Have a look at the complete description on how to build and test Tcl with
# the current Borland compilers at www.ratiosoft.com/tcl/borland.
#
@@ -88,6 +98,13 @@ libpath32 = -L"$(TOOLS32)\lib"
NODEBUG = 1
!endif
+# CFG_ENCODING=encoding
+# name of encoding for configuration information. Defaults
+# to cp1252
+!if !defined(CFG_ENCODING)
+CFG_ENCODING = \"cp1252\"
+!endif
+
# The following defines can be used to control the amount of debugging
# code that is added to the compilation.
#
@@ -107,23 +124,25 @@ NODEBUG = 1
NAMEPREFIX = tcl
STUBPREFIX = $(NAMEPREFIX)stub
-DOTVERSION = 8.4
-VERSION = 84
+DOTVERSION = 8.5
+VERSION = 85
-DDEVERSION = 12
-DDEDOTVERSION = 1.2
+DDEVERSION = 13
+DDEDOTVERSION = 1.3
-REGVERSION = 11
-REGDOTVERSION = 1.1
+REGVERSION = 12
+REGDOTVERSION = 1.2
BINROOT = ..
!IF "$(NODEBUG)" == "1"
TMPDIRNAME = Release
DBGX =
+SYMDEFINES = -DNDEBUG
!ELSE
TMPDIRNAME = Debug
#DBGX = d
DBGX =
+SYMDEFINES = -DTCL_CFG_DEBUG
!ENDIF
TMPDIR = $(BINROOT)\$(TMPDIRNAME)
OUTDIRNAME = $(TMPDIRNAME)
@@ -174,9 +193,6 @@ TCLOBJS = \
$(TMPDIR)\regexec.obj \
$(TMPDIR)\regfree.obj \
$(TMPDIR)\regerror.obj \
- $(TMPDIR)\strftime.obj \
- $(TMPDIR)\strtoll.obj \
- $(TMPDIR)\strtoull.obj \
$(TMPDIR)\tclAlloc.obj \
$(TMPDIR)\tclAsync.obj \
$(TMPDIR)\tclBasic.obj \
@@ -189,7 +205,9 @@ TCLOBJS = \
$(TMPDIR)\tclCompCmds.obj \
$(TMPDIR)\tclCompExpr.obj \
$(TMPDIR)\tclCompile.obj \
+ $(TMPDIR)\tclConfig.obj \
$(TMPDIR)\tclDate.obj \
+ $(TMPDIR)\tclDictObj.obj \
$(TMPDIR)\tclEncoding.obj \
$(TMPDIR)\tclEnv.obj \
$(TMPDIR)\tclEvent.obj \
@@ -216,9 +234,9 @@ TCLOBJS = \
$(TMPDIR)\tclObj.obj \
$(TMPDIR)\tclPanic.obj \
$(TMPDIR)\tclParse.obj \
- $(TMPDIR)\tclParseExpr.obj \
$(TMPDIR)\tclPipe.obj \
$(TMPDIR)\tclPkg.obj \
+ $(TMPDIR)\tclPkgConfig.obj \
$(TMPDIR)\tclPosixStr.obj \
$(TMPDIR)\tclPreserve.obj \
$(TMPDIR)\tclProc.obj \
@@ -232,6 +250,7 @@ TCLOBJS = \
$(TMPDIR)\tclThread.obj \
$(TMPDIR)\tclThreadJoin.obj \
$(TMPDIR)\tclTimer.obj \
+ $(TMPDIR)\tclTrace.obj \
$(TMPDIR)\tclUtf.obj \
$(TMPDIR)\tclUtil.obj \
$(TMPDIR)\tclVar.obj \
@@ -244,7 +263,6 @@ TCLOBJS = \
$(TMPDIR)\tclWinFile.obj \
$(TMPDIR)\tclWinInit.obj \
$(TMPDIR)\tclWinLoad.obj \
- $(TMPDIR)\tclWinMtherr.obj \
$(TMPDIR)\tclWinNotify.obj \
$(TMPDIR)\tclWinPipe.obj \
$(TMPDIR)\tclWinSock.obj \
@@ -257,7 +275,9 @@ WINDIR = $(ROOT)\win
GENERICDIR = $(ROOT)\generic
TCL_INCLUDES = -I"$(WINDIR)" -I"$(GENERICDIR)"
-TCL_DEFINES = $(DEBUGDEFINES) $(THREADDEFINES)
+TCL_DEFINES = $(DEBUGDEFINES) $(THREADDEFINES) $(SYMDEFINES) \
+ $(PROFDEFINES) $(OPTDEFINES) $(SIXFOURDEFINES) \
+ -DTCL_CFGVAL_ENCODING=${CFG_ENCODING}
######################################################################
# Compiler flags
@@ -400,30 +420,35 @@ 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.5
- -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\http2.5"
- -@copy "$(ROOT)\library\http\http.tcl" "$(SCRIPT_INSTALL_DIR)\http2.5"
- -@copy "$(ROOT)\library\http\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\http2.5"
+ @echo installing http2.7
+ -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\http2.7"
+ -@copy "$(ROOT)\library\http\http.tcl" "$(SCRIPT_INSTALL_DIR)\http2.7"
+ -@copy "$(ROOT)\library\http\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\http2.7"
@echo installing opt0.4
-@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\opt0.4"
-@copy "$(ROOT)\library\opt\optparse.tcl" "$(SCRIPT_INSTALL_DIR)\opt0.4"
-@copy "$(ROOT)\library\opt\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\opt0.4"
- @echo installing msgcat1.3
- -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\msgcat1.3"
- -@copy "$(ROOT)\library\msgcat\msgcat.tcl" "$(SCRIPT_INSTALL_DIR)\msgcat1.3"
- -@copy "$(ROOT)\library\msgcat\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\msgcat1.3"
- @echo installing tcltest2.2
- -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\tcltest2.2"
- -@copy "$(ROOT)\library\tcltest\tcltest.tcl" "$(SCRIPT_INSTALL_DIR)\tcltest2.2"
- -@copy "$(ROOT)\library\tcltest\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\tcltest2.2"
+ @echo installing msgcat1.4
+ -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\msgcat1.4"
+ -@copy "$(ROOT)\library\msgcat\msgcat.tcl" "$(SCRIPT_INSTALL_DIR)\msgcat1.4"
+ -@copy "$(ROOT)\library\msgcat\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\msgcat1.4"
+ @echo installing tcltest2.3
+ -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\tcltest2.3"
+ -@copy "$(ROOT)\library\tcltest\tcltest.tcl" "$(SCRIPT_INSTALL_DIR)\tcltest2.3"
+ -@copy "$(ROOT)\library\tcltest\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\tcltest2.3"
+ @echo installing platform1.0
+ -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\platform1.0"
+ -@copy "$(ROOT)\library\platform\platform.tcl" "$(SCRIPT_INSTALL_DIR)\platform1.0"
+ -@copy "$(ROOT)\library\platform\shell.tcl" "$(SCRIPT_INSTALL_DIR)\platform1.0"
+ -@copy "$(ROOT)\library\platform\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\platform1.0"
@echo installing $(TCLDDEDLLNAME)
- -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\dde1.1"
- -@copy "$(TCLDDEDLL)" "$(SCRIPT_INSTALL_DIR)\dde1.1"
- -@copy "$(ROOT)\library\dde\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\dde1.1"
+ -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\dde1.3"
+ -@copy "$(TCLDDEDLL)" "$(SCRIPT_INSTALL_DIR)\dde1.3"
+ -@copy "$(ROOT)\library\dde\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\dde1.3"
@echo installing $(TCLREGDLLNAME)
- -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\reg1.1"
- -@copy "$(TCLREGDLL)" "$(SCRIPT_INSTALL_DIR)\reg1.1"
- -@copy "$(ROOT)\library\reg\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\reg1.1"
+ -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\reg1.2"
+ -@copy "$(TCLREGDLL)" "$(SCRIPT_INSTALL_DIR)\reg1.2"
+ -@copy "$(ROOT)\library\reg\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\reg1.2"
@echo installing encoding files
-@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\encoding"
-@copy "$(ROOT)\library\encoding\*.enc" "$(SCRIPT_INSTALL_DIR)\encoding"
@@ -433,7 +458,6 @@ install-libraries:
-@copy "$(GENERICDIR)\tclPlatDecls.h" "$(INCLUDE_INSTALL_DIR)"
-@copy "$(ROOT)\library\history.tcl" "$(SCRIPT_INSTALL_DIR)"
-@copy "$(ROOT)\library\init.tcl" "$(SCRIPT_INSTALL_DIR)"
- -@copy "$(ROOT)\library\ldAout.tcl" "$(SCRIPT_INSTALL_DIR)"
-@copy "$(ROOT)\library\parray.tcl" "$(SCRIPT_INSTALL_DIR)"
-@copy "$(ROOT)\library\safe.tcl" "$(SCRIPT_INSTALL_DIR)"
-@copy "$(ROOT)\library\tclIndex" "$(SCRIPT_INSTALL_DIR)"
@@ -490,6 +514,14 @@ $(TMPDIR)\tclTestObj.obj: $(GENERICDIR)\tclTestObj.c
$(TMPDIR)\tclWinTest.obj: $(WINDIR)\tclWinTest.c
$(cc32) $(TCL_CFLAGS) -o$(TMPDIR)\$@ $?
+$(TMP_DIR)\tclPkgConfig.obj: $(GENERICDIR)\tclPkgConfig.c
+ $(cc32) $(TCL_CFLAGS) \
+ -DCFG_INSTALL_EXEC_PREFIX=\"$(INSTALL_EXEC_PREFIX)\" \
+ -DCFG_INSTALL_PREFIX=\"$(INSTALL_PREFIX)\" \
+ -DCFG_RUNTIME_EXEC_PREFIX=\"$(RUNTIME_EXEC_PREFIX)\" \
+ -DCFG_RUNTIME_PREFIX=\"$(RUNTIME_PREFIX)\" \
+ -o$(TMPDIR)\$@ $?
+
$(TMPDIR)\tclAppInit.obj : $(WINDIR)\tclAppInit.c
$(cc32) $(TCL_CFLAGS) -o$(TMPDIR)\$@ $?
diff --git a/win/makefile.vc b/win/makefile.vc
index 426c907..d982284 100644
--- a/win/makefile.vc
+++ b/win/makefile.vc
@@ -1,4 +1,4 @@
-#------------------------------------------------------------------------------
+#------------------------------------------------------------- -*- makefile -*-
# makefile.vc --
#
# Microsoft Visual C++ makefile for use with nmake.exe v1.62+ (VC++ 5.0+)
@@ -9,7 +9,8 @@
# Copyright (c) 1995-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-2000 Ajuba Solutions.
# Copyright (c) 2001-2005 ActiveState Corporation.
-# Copyright (c) 2001-2002 David Gravereaux.
+# Copyright (c) 2001-2004 David Gravereaux.
+# Copyright (c) 2003-2008 Pat Thoyts.
#------------------------------------------------------------------------------
# Check to see we are configured to build with MSVC (MSDEVDIR or MSVCDIR)
@@ -66,26 +67,30 @@ the build instructions.
# 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,none
+# OPTS=static,msvcrt,staticpkg,threads,symbols,profile,loimpact,unchecked,none
# Sets special options for the core. The default is for none.
# Any combination of the above may be used (comma separated).
# 'none' will over-ride everything to nothing.
#
# static = Builds a static library of the core instead of a
# dll. The shell will be static (and large), as well.
-# msvcrt = Effects the static option only to switch it from
+# msvcrt = Affects the static option only to switch it from
# using libcmt(d) as the C runtime [by default] to
# msvcrt(d). This is useful for static embedding
# support.
-# staticpkg = Effects the static option only to switch
+# 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
# 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
+# or libcmt.lib not libcmtd.lib).
#
# STATS=memdbg,compdbg,none
# Sets optional memory and bytecode compiler debugging code added
@@ -96,6 +101,15 @@ the build instructions.
# memdbg = Enables the debugging memory allocator.
# compdbg = Enables byte compilation logging.
#
+# CHECKS=nodep,fullwarn,64bit,none
+# Sets special macros for checking compatability.
+#
+# nodep = Turns off compatability macros to ensure the core
+# 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)
+#
# MACHINE=(IX86|IA64|AMD64|ALPHA)
# Set the machine type used for the compiler, linker, and
# resource compiler. This hook is needed to tell the tools
@@ -112,6 +126,10 @@ the build instructions.
# TESTPAT=<file>
# Reads the tests requested to be run from this file.
#
+# CFG_ENCODING=encoding
+# name of encoding for configuration information. Defaults
+# to cp1252
+#
# 5) Examples:
#
# Basic syntax of calling nmake looks like this:
@@ -156,14 +174,14 @@ Please `cd` to its location first.
PROJECT = tcl
!include "rules.vc"
-STUBPREFIX = $(PROJECT)stub
-DOTVERSION = 8.4
-VERSION = $(DOTVERSION:.=)
+STUBPREFIX = $(PROJECT)stub
+DOTVERSION = $(TCL_MAJOR_VERSION).$(TCL_MINOR_VERSION)
+VERSION = $(TCL_MAJOR_VERSION)$(TCL_MINOR_VERSION)
-DDEDOTVERSION = 1.2
+DDEDOTVERSION = 1.3
DDEVERSION = $(DDEDOTVERSION:.=)
-REGDOTVERSION = 1.1
+REGDOTVERSION = 1.2
REGVERSION = $(REGDOTVERSION:.=)
BINROOT = .
@@ -190,6 +208,15 @@ TCLDDELIB = $(OUT_DIR)\$(TCLDDELIBNAME)
TCLTEST = $(OUT_DIR)\$(PROJECT)test.exe
CAT32 = $(OUT_DIR)\cat32.exe
+# Can we run what we build? IX86 runs on all architectures.
+!ifndef TCLSH_NATIVE
+!if "$(MACHINE)" == "IX86" || "$(MACHINE)" == "$(NATIVE_ARCH)"
+TCLSH_NATIVE = $(TCLSH)
+!else
+!error You must explicitly set TCLSH_NATIVE for cross-compilation
+!endif
+!endif
+
### Make sure we use backslash only.
LIB_INSTALL_DIR = $(_INSTALLDIR)\lib
BIN_INSTALL_DIR = $(_INSTALLDIR)\bin
@@ -222,9 +249,6 @@ TCLOBJS = \
$(TMP_DIR)\regerror.obj \
$(TMP_DIR)\regexec.obj \
$(TMP_DIR)\regfree.obj \
- $(TMP_DIR)\strftime.obj \
- $(TMP_DIR)\strtoll.obj \
- $(TMP_DIR)\strtoull.obj \
$(TMP_DIR)\tclAlloc.obj \
$(TMP_DIR)\tclAsync.obj \
$(TMP_DIR)\tclBasic.obj \
@@ -237,7 +261,9 @@ TCLOBJS = \
$(TMP_DIR)\tclCompCmds.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)\tclEnv.obj \
$(TMP_DIR)\tclEvent.obj \
@@ -254,6 +280,7 @@ TCLOBJS = \
$(TMP_DIR)\tclIOGT.obj \
$(TMP_DIR)\tclIOSock.obj \
$(TMP_DIR)\tclIOUtil.obj \
+ $(TMP_DIR)\tclIORChan.obj \
$(TMP_DIR)\tclLink.obj \
$(TMP_DIR)\tclListObj.obj \
$(TMP_DIR)\tclLiteral.obj \
@@ -264,9 +291,10 @@ TCLOBJS = \
$(TMP_DIR)\tclObj.obj \
$(TMP_DIR)\tclPanic.obj \
$(TMP_DIR)\tclParse.obj \
- $(TMP_DIR)\tclParseExpr.obj \
+ $(TMP_DIR)\tclPathObj.obj \
$(TMP_DIR)\tclPipe.obj \
$(TMP_DIR)\tclPkg.obj \
+ $(TMP_DIR)\tclPkgConfig.obj \
$(TMP_DIR)\tclPosixStr.obj \
$(TMP_DIR)\tclPreserve.obj \
$(TMP_DIR)\tclProc.obj \
@@ -275,12 +303,16 @@ TCLOBJS = \
$(TMP_DIR)\tclResult.obj \
$(TMP_DIR)\tclScan.obj \
$(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 \
+ $(TMP_DIR)\tclThreadStorage.obj \
$(TMP_DIR)\tclTimer.obj \
+ $(TMP_DIR)\tclTomMathInterface.obj \
+ $(TMP_DIR)\tclTrace.obj \
$(TMP_DIR)\tclUtf.obj \
$(TMP_DIR)\tclUtil.obj \
$(TMP_DIR)\tclVar.obj \
@@ -293,12 +325,75 @@ TCLOBJS = \
$(TMP_DIR)\tclWinFile.obj \
$(TMP_DIR)\tclWinInit.obj \
$(TMP_DIR)\tclWinLoad.obj \
- $(TMP_DIR)\tclWinMtherr.obj \
$(TMP_DIR)\tclWinNotify.obj \
$(TMP_DIR)\tclWinPipe.obj \
$(TMP_DIR)\tclWinSock.obj \
$(TMP_DIR)\tclWinThrd.obj \
$(TMP_DIR)\tclWinTime.obj \
+ $(TMP_DIR)\bncore.obj \
+ $(TMP_DIR)\bn_reverse.obj \
+ $(TMP_DIR)\bn_fast_s_mp_mul_digs.obj \
+ $(TMP_DIR)\bn_fast_s_mp_sqr.obj \
+ $(TMP_DIR)\bn_mp_add.obj \
+ $(TMP_DIR)\bn_mp_add_d.obj \
+ $(TMP_DIR)\bn_mp_and.obj \
+ $(TMP_DIR)\bn_mp_clamp.obj \
+ $(TMP_DIR)\bn_mp_clear.obj \
+ $(TMP_DIR)\bn_mp_clear_multi.obj \
+ $(TMP_DIR)\bn_mp_cmp.obj \
+ $(TMP_DIR)\bn_mp_cmp_d.obj \
+ $(TMP_DIR)\bn_mp_cmp_mag.obj \
+ $(TMP_DIR)\bn_mp_cnt_lsb.obj \
+ $(TMP_DIR)\bn_mp_copy.obj \
+ $(TMP_DIR)\bn_mp_count_bits.obj \
+ $(TMP_DIR)\bn_mp_div.obj \
+ $(TMP_DIR)\bn_mp_div_d.obj \
+ $(TMP_DIR)\bn_mp_div_2.obj \
+ $(TMP_DIR)\bn_mp_div_2d.obj \
+ $(TMP_DIR)\bn_mp_div_3.obj \
+ $(TMP_DIR)\bn_mp_exch.obj \
+ $(TMP_DIR)\bn_mp_expt_d.obj \
+ $(TMP_DIR)\bn_mp_grow.obj \
+ $(TMP_DIR)\bn_mp_init.obj \
+ $(TMP_DIR)\bn_mp_init_copy.obj \
+ $(TMP_DIR)\bn_mp_init_multi.obj \
+ $(TMP_DIR)\bn_mp_init_set.obj \
+ $(TMP_DIR)\bn_mp_init_set_int.obj \
+ $(TMP_DIR)\bn_mp_init_size.obj \
+ $(TMP_DIR)\bn_mp_karatsuba_mul.obj \
+ $(TMP_DIR)\bn_mp_karatsuba_sqr.obj \
+ $(TMP_DIR)\bn_mp_lshd.obj \
+ $(TMP_DIR)\bn_mp_mod.obj \
+ $(TMP_DIR)\bn_mp_mod_2d.obj \
+ $(TMP_DIR)\bn_mp_mul.obj \
+ $(TMP_DIR)\bn_mp_mul_2.obj \
+ $(TMP_DIR)\bn_mp_mul_2d.obj \
+ $(TMP_DIR)\bn_mp_mul_d.obj \
+ $(TMP_DIR)\bn_mp_neg.obj \
+ $(TMP_DIR)\bn_mp_or.obj \
+ $(TMP_DIR)\bn_mp_radix_size.obj \
+ $(TMP_DIR)\bn_mp_radix_smap.obj \
+ $(TMP_DIR)\bn_mp_read_radix.obj \
+ $(TMP_DIR)\bn_mp_rshd.obj \
+ $(TMP_DIR)\bn_mp_set.obj \
+ $(TMP_DIR)\bn_mp_set_int.obj \
+ $(TMP_DIR)\bn_mp_shrink.obj \
+ $(TMP_DIR)\bn_mp_sqr.obj \
+ $(TMP_DIR)\bn_mp_sqrt.obj \
+ $(TMP_DIR)\bn_mp_sub.obj \
+ $(TMP_DIR)\bn_mp_sub_d.obj \
+ $(TMP_DIR)\bn_mp_to_unsigned_bin.obj \
+ $(TMP_DIR)\bn_mp_to_unsigned_bin_n.obj \
+ $(TMP_DIR)\bn_mp_toom_mul.obj \
+ $(TMP_DIR)\bn_mp_toom_sqr.obj \
+ $(TMP_DIR)\bn_mp_toradix_n.obj \
+ $(TMP_DIR)\bn_mp_unsigned_bin_size.obj \
+ $(TMP_DIR)\bn_mp_xor.obj \
+ $(TMP_DIR)\bn_mp_zero.obj \
+ $(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 \
!if !$(STATIC_BUILD)
$(TMP_DIR)\tcl.res
!endif
@@ -309,6 +404,7 @@ TCLSTUBOBJS = $(TMP_DIR)\tclStubLib.obj
COMPATDIR = $(ROOT)\compat
DOCDIR = $(ROOT)\doc
GENERICDIR = $(ROOT)\generic
+TOMMATHDIR = $(ROOT)\libtommath
TOOLSDIR = $(ROOT)\tools
WINDIR = $(ROOT)\win
@@ -324,6 +420,9 @@ cdebug = -O2 $(OPTIMIZATIONS)
!else
cdebug =
!endif
+!if $(SYMBOLS)
+cdebug = $(cdebug) -Zi
+!endif
!else if "$(MACHINE)" == "IA64" || "$(MACHINE)" == "AMD64"
### Warnings are too many, can't support warnings into errors.
cdebug = -Zi -Od $(DEBUGFLAGS)
@@ -332,34 +431,30 @@ cdebug = -Zi -WX $(DEBUGFLAGS)
!endif
### Declarations common to all compiler options
-cwarn = -D _CRT_SECURE_NO_DEPRECATE -D _CRT_NONSTDC_NO_DEPRECATE
+cwarn = $(WARNINGS) -D _CRT_SECURE_NO_DEPRECATE -D _CRT_NONSTDC_NO_DEPRECATE
cflags = -nologo -c $(COMPILERFLAGS) $(cwarn) -Fp$(TMP_DIR)^\
-!if $(FULLWARNINGS)
-cflags = $(cflags) -W4
-!else
-cflags = $(cflags) -W3
-!endif
-
!if $(MSVCRT)
-!if "$(DBGX)" == ""
-crt = -MD
-!else
+!if $(DEBUG) && !$(UNCHECKED)
crt = -MDd
-!endif
!else
-!if "$(DBGX)" == ""
-crt = -MT
+crt = -MD
+!endif
!else
+!if $(DEBUG) && !$(UNCHECKED)
crt = -MTd
+!else
+crt = -MT
!endif
!endif
-TCL_INCLUDES = -I"$(WINDIR)" -I"$(GENERICDIR)"
-BASE_CFLAGS = $(cflags) $(cdebug) $(crt) $(TCL_INCLUDES) \
- -DTCL_PIPE_DLL=\"$(TCLPIPEDLLNAME)\"
+TCL_INCLUDES = -I"$(WINDIR)" -I"$(GENERICDIR)" -I"$(TOMMATHDIR)"
+TCL_DEFINES = -DTCL_PIPE_DLL=\"$(TCLPIPEDLLNAME)\" -DTCL_TOMMATH -DMP_PREC=4 -Dinline=__inline
+BASE_CFLAGS = $(cflags) $(cdebug) $(crt) $(TCL_INCLUDES) $(TCL_DEFINES)
CON_CFLAGS = $(cflags) $(cdebug) $(crt) -DCONSOLE
TCL_CFLAGS = $(BASE_CFLAGS) $(OPTDEFINES)
+### Stubs files should not be compiled with -GL
+STUB_CFLAGS = $(cflags) $(cdebug:-GL=) $(OPTDEFINES)
#---------------------------------------------------------------------
@@ -370,15 +465,14 @@ TCL_CFLAGS = $(BASE_CFLAGS) $(OPTDEFINES)
ldebug = -debug -debugtype:cv
!else
ldebug = -release -opt:ref -opt:icf,3
+!if $(SYMBOLS)
+ldebug = $(ldebug) -debug -debugtype:cv
+!endif
!endif
### Declarations common to all linker options
lflags = -nologo -machine:$(MACHINE) $(LINKERFLAGS) $(ldebug)
-!if $(FULLWARNINGS)
-lflags = $(lflags) -warn:3
-!endif
-
!if $(PROFILE)
lflags = $(lflags) -profile
!endif
@@ -399,12 +493,14 @@ dlllflags = $(lflags) -dll
conlflags = $(lflags) -subsystem:console
guilflags = $(lflags) -subsystem:windows
-baselibs = kernel32.lib advapi32.lib user32.lib
+baselibs = kernel32.lib user32.lib ws2_32.lib
# Avoid 'unresolved external symbol __security_cookie' errors.
# c.f. http://support.microsoft.com/?id=894573
!if "$(MACHINE)" == "IA64" || "$(MACHINE)" == "AMD64"
+!if $(VCVERSION) > 1399 && $(VCVERSION) < 1500
baselibs = $(baselibs) bufferoverflowU.lib
!endif
+!endif
#---------------------------------------------------------------------
# TclTest flags
@@ -431,15 +527,22 @@ install: install-binaries install-libraries install-docs
test: setup $(TCLTEST) dlls $(CAT32)
set TCL_LIBRARY=$(ROOT)/library
!if "$(OS)" == "Windows_NT" || "$(MSVCDIR)" == "IDE"
- $(TCLTEST) "$(ROOT)/tests/all.tcl" $(TESTFLAGS)
+ $(TCLTEST) "$(ROOT)/tests/all.tcl" $(TESTFLAGS) -loadfile <<
+ set ::ddelib [file normalize $(TCLDDELIB:\=/)]
+ set ::reglib [file normalize $(TCLREGLIB:\=/)]
+<<
!else
- $(TCLTEST) "$(ROOT)/tests/all.tcl" $(TESTFLAGS) > tests.log
+ @echo Please wait while the tests are collected...
+ $(TCLTEST) "$(ROOT)/tests/all.tcl" $(TESTFLAGS) -loadfile << > tests.log
+ set ::ddelib [file normalize $(TCLDDELIB:\=/)]
+ set ::reglib [file normalize $(TCLREGLIB:\=/)]
+<<
type tests.log | more
!endif
runtest: setup $(TCLTEST) dlls $(CAT32)
set TCL_LIBRARY=$(ROOT)/library
- $(TCLTEST)
+ $(DEBUGGER) $(TCLTEST)
setup:
@if not exist $(OUT_DIR)\nul mkdir $(OUT_DIR)
@@ -481,7 +584,7 @@ $(TCLPIPEDLL): $(WINDIR)\stub16.c
!if $(STATIC_BUILD)
$(TCLDDELIB): $(TMP_DIR)\tclWinDde.obj
- $(lib32) -nologo -out:$@ $(TMP_DIR)\tclWinDde.obj
+ $(lib32) -nologo -out:$@ $**
!else
$(TCLDDELIB): $(TMP_DIR)\tclWinDde.obj $(TCLSTUBLIB)
$(link32) $(dlllflags) -base:@$(WINDIR)\coffbase.txt,tcldde -out:$@ \
@@ -493,7 +596,7 @@ $(TCLDDELIB): $(TMP_DIR)\tclWinDde.obj $(TCLSTUBLIB)
!if $(STATIC_BUILD)
$(TCLREGLIB): $(TMP_DIR)\tclWinReg.obj
- $(lib32) -nologo -out:$@ $(TMP_DIR)\tclWinReg.obj
+ $(lib32) -nologo -out:$@ $**
!else
$(TCLREGLIB): $(TMP_DIR)\tclWinReg.obj $(TCLSTUBLIB)
$(link32) $(dlllflags) -base:@$(WINDIR)\coffbase.txt,tclreg -out:$@ \
@@ -517,27 +620,27 @@ genstubs:
!if !exist($(TCLSH))
@echo Build tclsh first!
!else
- $(TCLSH) $(TOOLSDIR:\=/)\genStubs.tcl $(GENERICDIR:\=/) \
- $(GENERICDIR:\=/)/tcl.decls $(GENERICDIR:\=/)/tclInt.decls
+ $(TCLSH) $(TOOLSDIR:\=/)/genStubs.tcl $(GENERICDIR:\=/) \
+ $(GENERICDIR:\=/)/tcl.decls $(GENERICDIR:\=/)/tclInt.decls \
+ $(GENERICDIR:\=/)/tclTomMath.decls
!endif
-#---------------------------------------------------------------------
-# Generate the makefile depedancies.
-#---------------------------------------------------------------------
+#----------------------------------------------------------------------
+# The following target generates the file generic/tclTomMath.h.
+# It needs to be run (and the results checked) after updating
+# to a new release of libtommath.
+#----------------------------------------------------------------------
-depend:
+gentommath_h:
!if !exist($(TCLSH))
@echo Build tclsh first!
!else
- $(TCLSH) $(TOOLSDIR:\=/)/mkdepend.tcl -vc32 -out:"$(OUT_DIR)\depend.mk" \
- -passthru:"-DBUILD_tcl $(TCL_INCLUDES:"="")" $(GENERICDIR) \
- $(COMPATDIR) $(WINDIR) @<<
-$(TCLOBJS)
-<<
+ $(TCLSH) "$(TOOLSDIR:\=/)/fix_tommath_h.tcl" \
+ "$(TOMMATHDIR:\=/)/tommath.h" \
+ > "$(GENERICDIR)\tclTomMath.h"
!endif
-
#---------------------------------------------------------------------
# Build the windows help file.
#---------------------------------------------------------------------
@@ -604,17 +707,91 @@ install-docs:
@$(CPY) "$(HELPCNT)" "$(DOC_INSTALL_DIR)\"
!endif
+#---------------------------------------------------------------------
+# Build tclConfig.sh for the TEA build system.
+#---------------------------------------------------------------------
+
+tclConfig: $(OUT_DIR)\tclConfig.sh
+
+$(OUT_DIR)\tclConfig.sh: $(WINDIR)\tclConfig.sh.in
+ @echo Creating tclConfig.sh
+ @nmakehlp -s << $** >$@
+@TCL_DLL_FILE@ $(TCLLIBNAME)
+@TCL_VERSION@ $(DOTVERSION)
+@TCL_MAJOR_VERSION@ $(TCL_MAJOR_VERSION)
+@TCL_MINOR_VERSION@ $(TCL_MINOR_VERSION)
+@TCL_PATCH_LEVEL@ $(TCL_PATCH_LEVEL)
+@CC@ $(CC)
+@DEFS@ $(TCL_CFLAGS)
+@CFLAGS_DEBUG@ -nologo -c -W3 -YX -Fp$(TMP_DIR)\ -MDd
+@CFLAGS_OPTIMIZE@ -nologo -c -W3 -YX -Fp$(TMP_DIR)\ -MD
+@LDFLAGS_DEBUG@ -nologo -machine:$(MACHINE) -debug -debugtype:cv
+@LDFLAGS_OPTIMIZE@ -nologo -machine:$(MACHINE) -release -opt:ref -opt:icf,3
+@TCL_DBGX@ $(SUFX)
+@TCL_LIB_FILE@ $(PROJECT)$(VERSION)$(SUFX).lib
+@TCL_NEEDS_EXP_FILE@
+@LIBS@ $(baselibs)
+@prefix@ $(_INSTALLDIR)
+@exec_prefix@ $(BIN_INSTALL_DIR)
+@SHLIB_CFLAGS@
+@STLIB_CFLAGS@
+@CFLAGS_WARNING@ -W3
+@EXTRA_CFLAGS@ -YX
+@SHLIB_LD@ $(link32) $(dlllflags)
+@STLIB_LD@ $(lib32) -nologo
+@SHLIB_LD_LIBS@ $(baselibs)
+@SHLIB_SUFFIX@ .dll
+@DL_LIBS@
+@LDFLAGS@
+@TCL_LD_SEARCH_FLAGS@
+@LIBOBJS@
+@RANLIB@
+@TCL_LIB_FLAG@
+@TCL_BUILD_LIB_SPEC@
+@TCL_LIB_SPEC@ $(LIB_INSTALL_DIR)\$(PROJECT)$(VERSION)$(SUFX).lib
+@TCL_INCLUDE_SPEC@ -I$(INCLUDE_INSTALL_DIR)
+@TCL_LIB_VERSIONS_OK@
+@TCL_SRC_DIR@ $(ROOT)
+@TCL_PACKAGE_PATH@
+@TCL_STUB_LIB_FILE@ $(TCLSTUBLIBNAME)
+@TCL_STUB_LIB_FLAG@ $(TCLSTUBLIBNAME)
+@TCL_STUB_LIB_SPEC@ -L$(LIB_INSTALL_DIR) $(TCLSTUBLIBNAME)
+@TCL_THREADS@ $(TCL_THREADS)
+@TCL_BUILD_STUB_LIB_SPEC@ -L$(OUT_DIR) $(TCLSTUBLIBNAME)
+@TCL_BUILD_STUB_LIB_PATH@ $(TCLSTUBLIB)
+@TCL_STUB_LIB_PATH@ $(LIB_INSTALL_DIR)\$(TCLSTUBLIBNAME)
+@CFG_TCL_EXPORT_FILE_SUFFIX@ $(VERSION)$(SUFX).lib
+@CFG_TCL_SHARED_LIB_SUFFIX@ $(VERSION)$(SUFX).dll
+@CFG_TCL_UNSHARED_LIB_SUFFIX@ $(VERSION)$(SUFX).lib
+!if $(STATIC_BUILD)
+@TCL_SHARED_BUILD@ 0
+!else
+@TCL_SHARED_BUILD@ 1
+!endif
+<<
+
+
+#---------------------------------------------------------------------
+# 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
+# so that make doesn't try to automatically regenerate the .c file.
+#---------------------------------------------------------------------
+
+gendate:
+ bison --output-file=$(GENERICDIR)/tclDate.c \
+ --name-prefix=TclDate \
+ $(GENERICDIR)/tclGetDate.y
#---------------------------------------------------------------------
# Special case object file targets
#---------------------------------------------------------------------
$(TMP_DIR)\testMain.obj: $(WINDIR)\tclAppInit.c
-!if $(TCL_USE_STATIC_PACKAGES)
- $(cc32) $(TCL_CFLAGS) -DTCL_TEST -DTCL_USE_STATIC_PACKAGES -Fo$@ $?
-!else
- $(cc32) $(TCL_CFLAGS) -DTCL_TEST -Fo$@ $?
-!endif
+ $(cc32) $(TCL_CFLAGS) -DTCL_TEST \
+ -DTCL_USE_STATIC_PACKAGES=$(TCL_USE_STATIC_PACKAGES) \
+ -Fo$@ $?
$(TMP_DIR)\tclTest.obj: $(GENERICDIR)\tclTest.c
$(cc32) $(TCL_CFLAGS) -Fo$@ $?
@@ -625,66 +802,77 @@ $(TMP_DIR)\tclTestObj.obj: $(GENERICDIR)\tclTestObj.c
$(TMP_DIR)\tclWinTest.obj: $(WINDIR)\tclWinTest.c
$(cc32) $(TCL_CFLAGS) -Fo$@ $?
+$(TMP_DIR)\tclPkgConfig.obj: $(GENERICDIR)\tclPkgConfig.c
+ $(cc32) -DBUILD_tcl $(TCL_CFLAGS) \
+ -DCFG_INSTALL_LIBDIR="\"$(LIB_INSTALL_DIR:\=\\)\"" \
+ -DCFG_INSTALL_BINDIR="\"$(BIN_INSTALL_DIR:\=\\)\"" \
+ -DCFG_INSTALL_SCRDIR="\"$(SCRIPT_INSTALL_DIR:\=\\)\"" \
+ -DCFG_INSTALL_INCDIR="\"$(INCLUDE_INSTALL_DIR:\=\\)\"" \
+ -DCFG_INSTALL_DOCDIR="\"$(DOC_INSTALL_DIR:\=\\)\"" \
+ -DCFG_RUNTIME_LIBDIR="\"$(LIB_INSTALL_DIR:\=\\)\"" \
+ -DCFG_RUNTIME_BINDIR="\"$(BIN_INSTALL_DIR:\=\\)\"" \
+ -DCFG_RUNTIME_SCRDIR="\"$(SCRIPT_INSTALL_DIR:\=\\)\"" \
+ -DCFG_RUNTIME_INCDIR="\"$(INCLUDE_INSTALL_DIR:\=\\)\"" \
+ -DCFG_RUNTIME_DOCDIR="\"$(DOC_INSTALL_DIR:\=\\)\"" \
+ -Fo$@ $?
+
$(TMP_DIR)\tclAppInit.obj: $(WINDIR)\tclAppInit.c
-!if $(TCL_USE_STATIC_PACKAGES)
- $(cc32) $(TCL_CFLAGS) -DTCL_USE_STATIC_PACKAGES -Fo$@ $?
-!else
- $(cc32) $(TCL_CFLAGS) -Fo$@ $?
-!endif
+ $(cc32) $(TCL_CFLAGS) \
+ -DTCL_USE_STATIC_PACKAGES=$(TCL_USE_STATIC_PACKAGES) \
+ -Fo$@ $?
### The following objects should be built using the stub interfaces
### *ALL* extensions need to built with -DTCL_THREADS=1
$(TMP_DIR)\tclWinReg.obj: $(WINDIR)\tclWinReg.c
!if $(STATIC_BUILD)
- $(cc32) $(BASE_CFLAGS) -DTCL_THREADS=1 -DSTATIC_BUILD -Fo$@ $?
+ $(cc32) $(TCL_CFLAGS) -DTCL_THREADS=1 -DSTATIC_BUILD -Fo$@ $?
!else
- $(cc32) $(BASE_CFLAGS) -DTCL_THREADS=1 -DUSE_TCL_STUBS -Fo$@ $?
+ $(cc32) $(TCL_CFLAGS) -DTCL_THREADS=1 -DUSE_TCL_STUBS -Fo$@ $?
!endif
$(TMP_DIR)\tclWinDde.obj: $(WINDIR)\tclWinDde.c
!if $(STATIC_BUILD)
- $(cc32) $(BASE_CFLAGS) -DTCL_THREADS=1 -DSTATIC_BUILD -Fo$@ $?
+ $(cc32) $(TCL_CFLAGS) -DTCL_THREADS=1 -DSTATIC_BUILD -Fo$@ $?
!else
- $(cc32) $(BASE_CFLAGS) -DTCL_THREADS=1 -DUSE_TCL_STUBS -Fo$@ $?
+ $(cc32) $(TCL_CFLAGS) -DTCL_THREADS=1 -DUSE_TCL_STUBS -Fo$@ $?
!endif
### The following objects are part of the stub library and should not
-### be built as DLL objects. -Zl is used to avoid a dependancy on any
+### be built as DLL objects. -Zl is used to avoid a dependency on any
### specific C run-time.
$(TMP_DIR)\tclStubLib.obj: $(GENERICDIR)\tclStubLib.c
- $(cc32) $(cdebug) $(cflags) -Zl -DSTATIC_BUILD $(TCL_INCLUDES) -Fo$@ $?
-
+ $(cc32) $(STUB_CFLAGS) -Zl -DSTATIC_BUILD $(TCL_INCLUDES) -Fo$@ $?
#---------------------------------------------------------------------
-# Dedependency rules
+# Generate the source dependencies. Having dependency rules will
+# improve incremental build accuracy without having to resort to a
+# full rebuild just because some non-global header file like
+# tclCompile.h was changed. These rules aren't needed when building
+# from scratch.
#---------------------------------------------------------------------
-$(GENERICDIR)\regcomp.c: \
- $(GENERICDIR)\regguts.h \
- $(GENERICDIR)\regc_lex.c \
- $(GENERICDIR)\regc_color.c \
- $(GENERICDIR)\regc_nfa.c \
- $(GENERICDIR)\regc_cvec.c \
- $(GENERICDIR)\regc_locale.c
-$(GENERICDIR)\regcustom.h: \
- $(GENERICDIR)\tclInt.h \
- $(GENERICDIR)\tclPort.h \
- $(GENERICDIR)\regex.h
-$(GENERICDIR)\regexec.c: \
- $(GENERICDIR)\rege_dfa.c \
- $(GENERICDIR)\regguts.h
-$(GENERICDIR)\regerror.c: $(GENERICDIR)\regguts.h
-$(GENERICDIR)\regfree.c: $(GENERICDIR)\regguts.h
-$(GENERICDIR)\regfronts.c: $(GENERICDIR)\regguts.h
-$(GENERICDIR)\regguts.h: $(GENERICDIR)\regcustom.h
+depend:
+!if !exist($(TCLSH))
+ @echo Build tclsh first!
+!else
+ $(TCLSH) $(TOOLSDIR:\=/)/mkdepend.tcl -vc32 -out:"$(OUT_DIR)\depend.mk" \
+ -passthru:"-DBUILD_tcl $(TCL_INCLUDES)" $(GENERICDIR),$$(GENERICDIR) \
+ $(COMPATDIR),$$(COMPATDIR) $(TOMMATHDIR),$$(TOMMATHDIR) $(WINDIR),$$(WINDIR) @<<
+$(TCLOBJS)
+<<
+!endif
+
+#---------------------------------------------------------------------
+# Dependency rules
+#---------------------------------------------------------------------
!if exist("$(OUT_DIR)\depend.mk")
!include "$(OUT_DIR)\depend.mk"
-!message *** Dependency rules in effect.
+!message *** Dependency rules in use.
!else
!message *** Dependency rules are not being used.
!endif
@@ -698,32 +886,31 @@ $(GENERICDIR)\regguts.h: $(GENERICDIR)\regcustom.h
#---------------------------------------------------------------------
{$(WINDIR)}.c{$(TMP_DIR)}.obj::
- $(cc32) $(TCL_CFLAGS) -DBUILD_tcl -Fo$(TMP_DIR)\ @<<
+ $(cc32) $(TCL_CFLAGS) -DBUILD_tcl -Fo$(TMP_DIR)\ @<<
+$<
+<<
+
+{$(TOMMATHDIR)}.c{$(TMP_DIR)}.obj::
+ $(cc32) $(TCL_CFLAGS) -DBUILD_tcl -Fo$(TMP_DIR)\ @<<
$<
<<
{$(GENERICDIR)}.c{$(TMP_DIR)}.obj::
- $(cc32) $(TCL_CFLAGS) -DBUILD_tcl -Fo$(TMP_DIR)\ @<<
+ $(cc32) $(TCL_CFLAGS) -DBUILD_tcl -Fo$(TMP_DIR)\ @<<
$<
<<
{$(COMPATDIR)}.c{$(TMP_DIR)}.obj::
- $(cc32) $(TCL_CFLAGS) -DBUILD_tcl -Fo$(TMP_DIR)\ @<<
+ $(cc32) $(TCL_CFLAGS) -DBUILD_tcl -Fo$(TMP_DIR)\ @<<
$<
<<
{$(WINDIR)}.rc{$(TMP_DIR)}.res:
- $(rc32) -fo $@ -r -i "$(GENERICDIR)" -D__WIN32__ \
-!if $(DEBUG)
- -d DEBUG \
-!endif
-!if $(TCL_THREADS)
- -d TCL_THREADS \
-!endif
-!if $(STATIC_BUILD)
- -d STATIC_BUILD \
-!endif
- $<
+ $(rc32) -fo $@ -r -i "$(GENERICDIR)" \
+ -d DEBUG=$(DEBUG) -d UNCHECKED=$(UNCHECKED) \
+ -d TCL_THREADS=$(TCL_THREADS) \
+ -d STATIC_BUILD=$(STATIC_BUILD) \
+ $<
.SUFFIXES:
.SUFFIXES:.c .rc
@@ -735,79 +922,129 @@ $<
install-binaries:
@echo Installing to '$(_INSTALLDIR)'
- @echo installing $(TCLLIBNAME)
+ @echo Installing $(TCLLIBNAME)
!if "$(TCLLIB)" != "$(TCLIMPLIB)"
@$(CPY) "$(TCLLIB)" "$(BIN_INSTALL_DIR)\"
!endif
@$(CPY) "$(TCLIMPLIB)" "$(LIB_INSTALL_DIR)\"
!if exist($(TCLSH))
- @echo installing $(TCLSHNAME)
+ @echo Installing $(TCLSHNAME)
@$(CPY) "$(TCLSH)" "$(BIN_INSTALL_DIR)\"
!endif
!if exist($(TCLPIPEDLL))
- @echo installing $(TCLPIPEDLLNAME)
+ @echo Installing $(TCLPIPEDLLNAME)
@$(CPY) "$(TCLPIPEDLL)" "$(BIN_INSTALL_DIR)\"
!endif
- @echo installing $(TCLSTUBLIBNAME)
+ @echo Installing $(TCLSTUBLIBNAME)
@$(CPY) "$(TCLSTUBLIB)" "$(LIB_INSTALL_DIR)\"
-install-libraries:
- @echo installing http1.0
+#" emacs fix
+
+install-libraries: tclConfig install-msgs install-tzdata
+ @if not exist "$(SCRIPT_INSTALL_DIR)$(NULL)" \
+ $(MKDIR) "$(SCRIPT_INSTALL_DIR)"
+ @if not exist "$(SCRIPT_INSTALL_DIR)\..\tcl8$(NULL)" \
+ $(MKDIR) "$(SCRIPT_INSTALL_DIR)\..\tcl8"
+ @if not exist "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.2$(NULL)" \
+ $(MKDIR) "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.2"
+ @if not exist "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.3$(NULL)" \
+ $(MKDIR) "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.3"
+ @if not exist "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.4$(NULL)" \
+ $(MKDIR) "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.4"
+ @if not exist "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.4\platform$(NULL)" \
+ $(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"
+ @echo Installing header files
+ @$(CPY) "$(GENERICDIR)\tcl.h" "$(INCLUDE_INSTALL_DIR)\"
+ @$(CPY) "$(GENERICDIR)\tclDecls.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)\"
+ @$(CPY) "$(TOMMATHDIR)\tommath_class.h" "$(INCLUDE_INSTALL_DIR)\"
+ @$(CPY) "$(TOMMATHDIR)\tommath_superclass.h" "$(INCLUDE_INSTALL_DIR)\"
+ @echo Installing library files to $(SCRIPT_INSTALL_DIR)
+ @$(CPY) "$(ROOT)\library\history.tcl" "$(SCRIPT_INSTALL_DIR)\"
+ @$(CPY) "$(ROOT)\library\init.tcl" "$(SCRIPT_INSTALL_DIR)\"
+ @$(CPY) "$(ROOT)\library\clock.tcl" "$(SCRIPT_INSTALL_DIR)\"
+ @$(CPY) "$(ROOT)\library\tm.tcl" "$(SCRIPT_INSTALL_DIR)\"
+ @$(CPY) "$(ROOT)\library\parray.tcl" "$(SCRIPT_INSTALL_DIR)\"
+ @$(CPY) "$(ROOT)\library\safe.tcl" "$(SCRIPT_INSTALL_DIR)\"
+ @$(CPY) "$(ROOT)\library\tclIndex" "$(SCRIPT_INSTALL_DIR)\"
+ @$(CPY) "$(ROOT)\library\package.tcl" "$(SCRIPT_INSTALL_DIR)\"
+ @$(CPY) "$(ROOT)\library\word.tcl" "$(SCRIPT_INSTALL_DIR)\"
+ @$(CPY) "$(ROOT)\library\auto.tcl" "$(SCRIPT_INSTALL_DIR)\"
+ @$(CPY) "$(OUT_DIR)\tclConfig.sh" "$(LIB_INSTALL_DIR)\"
+ @echo Installing library http1.0 directory
@$(CPY) "$(ROOT)\library\http1.0\*.tcl" \
- "$(SCRIPT_INSTALL_DIR)\http1.0\"
- @echo installing http2.5
- @$(CPY) "$(ROOT)\library\http\*.tcl" \
- "$(SCRIPT_INSTALL_DIR)\http2.5\"
- @echo installing opt0.4
+ "$(SCRIPT_INSTALL_DIR)\http1.0\"
+ @echo Installing library opt0.4 directory
@$(CPY) "$(ROOT)\library\opt\*.tcl" \
- "$(SCRIPT_INSTALL_DIR)\opt0.4\"
- @echo installing msgcat1.3
- @$(CPY) "$(ROOT)\library\msgcat\*.tcl" \
- "$(SCRIPT_INSTALL_DIR)\msgcat1.3\"
- @echo installing tcltest2.2
- @$(CPY) "$(ROOT)\library\tcltest\*.tcl" \
- "$(SCRIPT_INSTALL_DIR)\tcltest2.2\"
- @echo installing $(TCLDDELIBNAME)
+ "$(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"
+ @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"
+ @echo Installing package tcltest $(PKG_TCLTEST_VER) as a Tcl Module
+ @$(COPY) "$(ROOT)\library\tcltest\tcltest.tcl" \
+ "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.5\tcltest-$(PKG_TCLTEST_VER).tm"
+ @echo Installing package platform $(PKG_PLATFORM_VER) as a Tcl Module
+ @$(COPY) "$(ROOT)\library\platform\platform.tcl" \
+ "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.4\platform-$(PKG_PLATFORM_VER).tm"
+ @echo Installing package platform::shell $(PKG_SHELL_VER) as a Tcl Module
+ @$(COPY) "$(ROOT)\library\platform\shell.tcl" \
+ "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.4\platform\shell-$(PKG_SHELL_VER).tm"
+ @echo Installing $(TCLDDELIBNAME)
!if $(STATIC_BUILD)
+!if !$(TCL_USE_STATIC_PACKAGES)
@$(CPY) "$(TCLDDELIB)" "$(LIB_INSTALL_DIR)\"
+!endif
!else
@$(CPY) "$(TCLDDELIB)" "$(LIB_INSTALL_DIR)\dde$(DDEDOTVERSION)\"
@$(CPY) "$(ROOT)\library\dde\pkgIndex.tcl" \
"$(LIB_INSTALL_DIR)\dde$(DDEDOTVERSION)\"
!endif
- @echo installing $(TCLREGLIBNAME)
+ @echo Installing $(TCLREGLIBNAME)
!if $(STATIC_BUILD)
+!if !$(TCL_USE_STATIC_PACKAGES)
@$(CPY) "$(TCLREGLIB)" "$(LIB_INSTALL_DIR)\"
+!endif
!else
@$(CPY) "$(TCLREGLIB)" "$(LIB_INSTALL_DIR)\reg$(REGDOTVERSION)\"
@$(CPY) "$(ROOT)\library\reg\pkgIndex.tcl" \
"$(LIB_INSTALL_DIR)\reg$(REGDOTVERSION)\"
!endif
- @echo installing encoding files
+ @echo Installing encodings
@$(CPY) "$(ROOT)\library\encoding\*.enc" \
"$(SCRIPT_INSTALL_DIR)\encoding\"
- @echo installing library files
- @$(CPY) "$(GENERICDIR)\tcl.h" "$(INCLUDE_INSTALL_DIR)\"
- @$(CPY) "$(GENERICDIR)\tclDecls.h" "$(INCLUDE_INSTALL_DIR)\"
- @$(CPY) "$(GENERICDIR)\tclPlatDecls.h" "$(INCLUDE_INSTALL_DIR)\"
- @$(CPY) "$(ROOT)\library\history.tcl" "$(SCRIPT_INSTALL_DIR)\"
- @$(CPY) "$(ROOT)\library\init.tcl" "$(SCRIPT_INSTALL_DIR)\"
- @$(CPY) "$(ROOT)\library\ldAout.tcl" "$(SCRIPT_INSTALL_DIR)\"
- @$(CPY) "$(ROOT)\library\parray.tcl" "$(SCRIPT_INSTALL_DIR)\"
- @$(CPY) "$(ROOT)\library\safe.tcl" "$(SCRIPT_INSTALL_DIR)\"
- @$(CPY) "$(ROOT)\library\tclIndex" "$(SCRIPT_INSTALL_DIR)\"
- @$(CPY) "$(ROOT)\library\package.tcl" "$(SCRIPT_INSTALL_DIR)\"
- @$(CPY) "$(ROOT)\library\word.tcl" "$(SCRIPT_INSTALL_DIR)\"
- @$(CPY) "$(ROOT)\library\auto.tcl" "$(SCRIPT_INSTALL_DIR)\"
+#" emacs fix
+
+install-tzdata:
+ @echo Installing time zone data
+ @set TCL_LIBRARY=$(ROOT)/library
+ @$(TCLSH_NATIVE) "$(ROOT)/tools/installData.tcl" \
+ "$(ROOT)/library/tzdata" "$(SCRIPT_INSTALL_DIR)/tzdata"
+
+install-msgs:
+ @echo Installing message catalogs
+ @set TCL_LIBRARY=$(ROOT)/library
+ @$(TCLSH_NATIVE) "$(ROOT)/tools/installData.tcl" \
+ "$(ROOT)/library/msgs" "$(SCRIPT_INSTALL_DIR)/msgs"
#---------------------------------------------------------------------
# Clean up
#---------------------------------------------------------------------
tidy:
+!if "$(TCLLIB)" != "$(TCLIMPLIB)"
@echo Removing $(TCLLIB) ...
@if exist $(TCLLIB) del $(TCLLIB)
+!endif
+ @echo Removing $(TCLIMPLIB) ...
+ @if exist $(TCLIMPLIB) del $(TCLIMPLIB)
@echo Removing $(TCLSH) ...
@if exist $(TCLSH) del $(TCLSH)
@echo Removing $(TCLTEST) ...
@@ -820,6 +1057,18 @@ tidy:
clean:
@echo Cleaning $(TMP_DIR)\* ...
@if exist $(TMP_DIR)\nul $(RMDIR) $(TMP_DIR)
+ @echo Cleaning $(WINDIR)\nmakehlp.obj ...
+ @if exist $(WINDIR)\nmakehlp.obj del $(WINDIR)\nmakehlp.obj
+ @echo Cleaning $(WINDIR)\nmakehlp.exe ...
+ @if exist $(WINDIR)\nmakehlp.exe del $(WINDIR)\nmakehlp.exe
+ @echo Cleaning $(WINDIR)\_junk.pch ...
+ @if exist $(WINDIR)\_junk.pch del $(WINDIR)\_junk.pch
+ @echo Cleaning $(WINDIR)\vercl.x ...
+ @if exist $(WINDIR)\vercl.x del $(WINDIR)\vercl.x
+ @echo Cleaning $(WINDIR)\vercl.i ...
+ @if exist $(WINDIR)\vercl.i del $(WINDIR)\vercl.i
+ @echo Cleaning $(WINDIR)\versions.vc ...
+ @if exist $(WINDIR)\versions.vc del $(WINDIR)\versions.vc
hose:
@echo Hosing $(OUT_DIR)\* ...
diff --git a/win/nmakehlp.c b/win/nmakehlp.c
index 4657c81..f1b5f34 100644
--- a/win/nmakehlp.c
+++ b/win/nmakehlp.c
@@ -5,9 +5,10 @@
* This is used to fix limitations within nmake and the environment.
*
* Copyright (c) 2002 by David Gravereaux.
+ * Copyright (c) 2006 by Pat Thoyts
*
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
* ----------------------------------------------------------------------------
*/
@@ -17,9 +18,15 @@
#pragma comment (lib, "kernel32.lib")
#include <stdio.h>
#include <math.h>
+
+/*
+ * This library is required for x64 builds with _some_ versions
+ */
#if defined(_M_IA64) || defined(_M_AMD64)
+#if _MSC_FULL_VER > 140000000 && _MSC_FULL_VER <= 140040310
#pragma comment(lib, "bufferoverflowU")
#endif
+#endif
/* ISO hack for dumb VC++ */
#ifdef _MSC_VER
@@ -34,6 +41,8 @@ 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);
/* globals */
@@ -128,10 +137,35 @@ main(
return 2;
}
return GrepForDefine(argv[2], argv[3]);
+ case 's':
+ if (argc == 2) {
+ chars = snprintf(msg, sizeof(msg) - 1,
+ "usage: %s -s <substitutions file> <file>\n"
+ "Perform a set of string map type substutitions on a file\n"
+ "exitcodes: 0\n",
+ argv[0]);
+ WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars,
+ &dwWritten, NULL);
+ return 2;
+ }
+ return SubstituteFile(argv[2], argv[3]);
+ case 'V':
+ if (argc != 4) {
+ chars = snprintf(msg, sizeof(msg) - 1,
+ "usage: %s -V filename matchstring\n"
+ "Extract a version from a file:\n"
+ "eg: pkgIndex.tcl \"package ifneeded http\"",
+ argv[0]);
+ WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars,
+ &dwWritten, NULL);
+ return 0;
+ }
+ printf("%s\n", GetVersionFromFile(argv[2], argv[3]));
+ return 0;
}
}
chars = snprintf(msg, sizeof(msg) - 1,
- "usage: %s -c|-l|-f ...\n"
+ "usage: %s -c|-l|-f|-g|-V ...\n"
"This is a little helper app to equalize shell differences between WinNT and\n"
"Win9x and get nmake.exe to accomplish its job.\n",
argv[0]);
@@ -190,7 +224,7 @@ CheckForCompilerFeature(
* Base command line.
*/
- lstrcpy(cmdline, "cl.exe -nologo -c -TC -Zs -X ");
+ lstrcpy(cmdline, "cl.exe -nologo -c -TC -Zs -X -Fp.\\_junk.pch ");
/*
* Append our option for testing
@@ -224,7 +258,7 @@ CheckForCompilerFeature(
FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM|FORMAT_MESSAGE_IGNORE_INSERTS|
FORMAT_MESSAGE_MAX_WIDTH_MASK, 0L, err, 0, (LPVOID)&msg[chars],
(300-chars), 0);
- WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, lstrlen(msg), &err,NULL);
+ WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg,lstrlen(msg), &err,NULL);
return 2;
}
@@ -268,7 +302,9 @@ CheckForCompilerFeature(
return !(strstr(Out.buffer, "D4002") != NULL
|| strstr(Err.buffer, "D4002") != NULL
|| strstr(Out.buffer, "D9002") != NULL
- || strstr(Err.buffer, "D9002") != NULL);
+ || strstr(Err.buffer, "D9002") != NULL
+ || strstr(Out.buffer, "D2021") != NULL
+ || strstr(Err.buffer, "D2021") != NULL);
}
int
@@ -350,7 +386,7 @@ CheckForLinkerFeature(
FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM|FORMAT_MESSAGE_IGNORE_INSERTS|
FORMAT_MESSAGE_MAX_WIDTH_MASK, 0L, err, 0, (LPVOID)&msg[chars],
(300-chars), 0);
- WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, lstrlen(msg), &err,NULL);
+ WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg,lstrlen(msg), &err,NULL);
return 2;
}
@@ -391,9 +427,9 @@ CheckForLinkerFeature(
*/
return !(strstr(Out.buffer, "LNK1117") != NULL ||
- strstr(Err.buffer, "LNK1117") != NULL ||
- strstr(Out.buffer, "LNK4044") != NULL ||
- strstr(Err.buffer, "LNK4044") != NULL);
+ strstr(Err.buffer, "LNK1117") != NULL ||
+ strstr(Out.buffer, "LNK4044") != NULL ||
+ strstr(Err.buffer, "LNK4044") != NULL);
}
DWORD WINAPI
@@ -440,18 +476,16 @@ GrepForDefine(
const char *file,
const char *string)
{
- FILE *f;
char s1[51], s2[51], s3[51];
- int r = 0;
- double d1;
+ FILE *f = fopen(file, "rt");
- f = fopen(file, "rt");
if (f == NULL) {
return 0;
}
do {
- r = fscanf(f, "%50s", s1);
+ int r = fscanf(f, "%50s", s1);
+
if (r == 1 && !strcmp(s1, "#define")) {
/*
* Get next two words.
@@ -467,6 +501,8 @@ GrepForDefine(
*/
if (!strcmp(s2, string)) {
+ double d1;
+
fclose(f);
/*
@@ -485,3 +521,203 @@ GrepForDefine(
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
+ * package provide or package ifneeded.
+ */
+
+const char *
+GetVersionFromFile(
+ const char *filename,
+ const char *match)
+{
+ size_t cbBuffer = 100;
+ static char szBuffer[100];
+ char *szResult = NULL;
+ FILE *fp = fopen(filename, "rt");
+
+ if (fp != NULL) {
+ /*
+ * Read data until we see our match string.
+ */
+
+ while (fgets(szBuffer, cbBuffer, fp) != NULL) {
+ LPSTR p, q;
+
+ p = strstr(szBuffer, match);
+ if (p != NULL) {
+ /*
+ * Skip to first digit.
+ */
+
+ while (*p && !isdigit(*p)) {
+ ++p;
+ }
+
+ /*
+ * Find ending whitespace.
+ */
+
+ q = p;
+ while (*q && (isalnum(*q) || *q == '.')) {
+ ++q;
+ }
+
+ memcpy(szBuffer, p, q - p);
+ szBuffer[q-p] = 0;
+ szResult = szBuffer;
+ break;
+ }
+ }
+ fclose(fp);
+ }
+ return szResult;
+}
+
+/*
+ * List helpers for the SubstituteFile function
+ */
+
+typedef struct list_item_t {
+ struct list_item_t *nextPtr;
+ char * key;
+ char * value;
+} list_item_t;
+
+/* insert a list item into the list (list may be null) */
+static list_item_t *
+list_insert(list_item_t **listPtrPtr, const char *key, const char *value)
+{
+ list_item_t *itemPtr = malloc(sizeof(list_item_t));
+ if (itemPtr) {
+ itemPtr->key = strdup(key);
+ itemPtr->value = strdup(value);
+ itemPtr->nextPtr = NULL;
+
+ while(*listPtrPtr) {
+ listPtrPtr = &(*listPtrPtr)->nextPtr;
+ }
+ *listPtrPtr = itemPtr;
+ }
+ return itemPtr;
+}
+
+static void
+list_free(list_item_t **listPtrPtr)
+{
+ list_item_t *tmpPtr, *listPtr = *listPtrPtr;
+ while (listPtr) {
+ tmpPtr = listPtr;
+ listPtr = listPtr->nextPtr;
+ free(tmpPtr->key);
+ free(tmpPtr->value);
+ free(tmpPtr);
+ }
+}
+
+/*
+ * SubstituteFile --
+ * As windows doesn't provide anything useful like sed and it's unreliable
+ * to use the tclsh you are building against (consider x-platform builds -
+ * eg compiling AMD64 target from IX86) we provide a simple substitution
+ * option here to handle autoconf style substitutions.
+ * The substitution file is whitespace and line delimited. The file should
+ * consist of lines matching the regular expression:
+ * \s*\S+\s+\S*$
+ *
+ * Usage is something like:
+ * nmakehlp -S << $** > $@
+ * @PACKAGE_NAME@ $(PACKAGE_NAME)
+ * @PACKAGE_VERSION@ $(PACKAGE_VERSION)
+ * <<
+ */
+
+int
+SubstituteFile(
+ const char *substitutions,
+ const char *filename)
+{
+ size_t cbBuffer = 1024;
+ static char szBuffer[1024], szCopy[1024];
+ char *szResult = NULL;
+ list_item_t *substPtr = NULL;
+ FILE *fp, *sp;
+
+ fp = fopen(filename, "rt");
+ if (fp != NULL) {
+
+ /*
+ * Build a list of substutitions from the first filename
+ */
+
+ sp = fopen(substitutions, "rt");
+ if (sp != NULL) {
+ while (fgets(szBuffer, cbBuffer, sp) != NULL) {
+ char *ks, *ke, *vs, *ve;
+ ks = szBuffer;
+ while (ks && *ks && isspace(*ks)) ++ks;
+ ke = ks;
+ while (ke && *ke && !isspace(*ke)) ++ke;
+ vs = ke;
+ while (vs && *vs && isspace(*vs)) ++vs;
+ ve = vs;
+ while (ve && *ve && !(*ve == '\r' || *ve == '\n')) ++ve;
+ *ke = 0, *ve = 0;
+ list_insert(&substPtr, ks, vs);
+ }
+ fclose(sp);
+ }
+
+ /* debug: dump the list */
+#ifdef _DEBUG
+ {
+ int n = 0;
+ list_item_t *p = NULL;
+ for (p = substPtr; p != NULL; p = p->nextPtr, ++n) {
+ fprintf(stderr, "% 3d '%s' => '%s'\n", n, p->key, p->value);
+ }
+ }
+#endif
+
+ /*
+ * Run the substitutions over each line of the input
+ */
+
+ while (fgets(szBuffer, cbBuffer, fp) != NULL) {
+ list_item_t *p = NULL;
+ for (p = substPtr; p != NULL; p = p->nextPtr) {
+ char *m = strstr(szBuffer, p->key);
+ if (m) {
+ char *cp, *op, *sp;
+ cp = szCopy;
+ op = szBuffer;
+ while (op != m) *cp++ = *op++;
+ sp = p->value;
+ while (sp && *sp) *cp++ = *sp++;
+ op += strlen(p->key);
+ while (*op) *cp++ = *op++;
+ *cp = 0;
+ memcpy(szBuffer, szCopy, sizeof(szCopy));
+ }
+ }
+ printf(szBuffer);
+ }
+
+ list_free(&substPtr);
+ }
+ fclose(fp);
+ return 0;
+}
+
+/*
+ * Local variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * indent-tabs-mode: t
+ * tab-width: 8
+ * End:
+ */
diff --git a/win/rules.vc b/win/rules.vc
index 4efbad7..20c967a 100644
--- a/win/rules.vc
+++ b/win/rules.vc
@@ -6,9 +6,9 @@
#
# 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-2006 Patrick Thoyts
+# Copyright (c) 2003-2007 Patrick Thoyts
#------------------------------------------------------------------------------
!ifndef _RULES_VC
@@ -215,6 +215,7 @@ LINKERFLAGS =-ltcg
STATIC_BUILD = 0
TCL_THREADS = 0
DEBUG = 0
+SYMBOLS = 0
PROFILE = 0
MSVCRT = 0
LOIMPACT = 0
@@ -252,6 +253,12 @@ DEBUG = 1
!else
DEBUG = 0
!endif
+!if [nmakehlp -f $(OPTS) "pdbs"]
+!message *** Doing pdbs
+SYMBOLS = 1
+!else
+SYMBOLS = 0
+!endif
!if [nmakehlp -f $(OPTS) "profile"]
!message *** Doing profile
PROFILE = 1
@@ -307,11 +314,8 @@ SUFX = tsgx
!if $(DEBUG)
BUILDDIRTOP = Debug
-DBGX = g
!else
BUILDDIRTOP = Release
-DBGX =
-SUFX = $(SUFX:g=)
!endif
!if "$(MACHINE)" != "IX86"
@@ -321,6 +325,10 @@ BUILDDIRTOP =$(BUILDDIRTOP)_$(MACHINE)
BUILDDIRTOP =$(BUILDDIRTOP)_VC$(VCVER)
!endif
+!if !$(DEBUG) || $(DEBUG) && $(UNCHECKED)
+SUFX = $(SUFX:g=)
+!endif
+
TMP_DIRFULL = .\$(BUILDDIRTOP)\$(PROJECT)_ThreadedDynamicStaticX
!if !$(STATIC_BUILD)
@@ -379,13 +387,14 @@ TCL_COMPILE_DEBUG = 0
!endif
!endif
+
#----------------------------------------------------------
# Decode the checks requested.
#----------------------------------------------------------
!if "$(CHECKS)" == "" || [nmakehlp -f "$(CHECKS)" "none"]
TCL_NO_DEPRECATED = 0
-FULLWARNINGS = 0
+WARNINGS = -W3
!else
!if [nmakehlp -f $(CHECKS) "nodep"]
!message *** Doing nodep check
@@ -395,9 +404,16 @@ TCL_NO_DEPRECATED = 0
!endif
!if [nmakehlp -f $(CHECKS) "fullwarn"]
!message *** Doing full warnings check
-FULLWARNINGS = 1
+WARNINGS = -W4
+!if [nmakehlp -l -warn:3]
+LINKERFLAGS = $(LINKERFLAGS) -warn:3
+!endif
!else
-FULLWARNINGS = 0
+WARNINGS = -W3
+!endif
+!if [nmakehlp -f $(CHECKS) "64bit"] && [nmakehlp -c -Wp64]
+!message *** Doing 64bit portability warnings
+WARNINGS = $(WARNINGS) -Wp64
!endif
!endif
@@ -405,7 +421,8 @@ FULLWARNINGS = 0
# Set our defines now armed with our options.
#----------------------------------------------------------
-OPTDEFINES =
+OPTDEFINES = -DTCL_CFGVAL_ENCODING=$(CFG_ENCODING) -DSTDC_HEADERS
+
!if $(TCL_MEM_DEBUG)
OPTDEFINES = $(OPTDEFINES) -DTCL_MEM_DEBUG
!endif
@@ -421,6 +438,9 @@ OPTDEFINES = $(OPTDEFINES) -DUSE_THREAD_ALLOC=1
!if $(STATIC_BUILD)
OPTDEFINES = $(OPTDEFINES) -DSTATIC_BUILD
!endif
+!if $(TCL_NO_DEPRECATED)
+OPTDEFINES = $(OPTDEFINES) -DTCL_NO_DEPRECATED
+!endif
!if !$(DEBUG)
OPTDEFINES = $(OPTDEFINES) -DNDEBUG
@@ -439,16 +459,26 @@ OPTDEFINES = $(OPTDEFINES) -DNO_STRTOI64
!endif
#----------------------------------------------------------
-# Get common info used when building extensions.
+# Locate the Tcl headers to build against
#----------------------------------------------------------
-!if "$(PROJECT)" != "tcl"
+!if "$(PROJECT)" == "tcl"
-!if !defined(TCLDIR)
+_TCL_H = ..\generic\tcl.h
+
+!else
+
+# If INSTALLDIR set to tcl root dir then reset to the lib dir.
!if exist("$(_INSTALLDIR)\include\tcl.h")
-TCLH = "$(_INSTALLDIR)\include\tcl.h"
+_INSTALLDIR=$(_INSTALLDIR)\lib
+!endif
+
+!if !defined(TCLDIR)
+!if exist("$(_INSTALLDIR)\..\include\tcl.h")
TCLINSTALL = 1
-_TCLDIR = $(_INSTALLDIR)
+_TCLDIR = $(_INSTALLDIR)\..
+_TCL_H = $(_INSTALLDIR)\..\include\tcl.h
+TCLDIR = $(_INSTALLDIR)\..
!else
MSG=^
Failed to find tcl.h. Set the TCLDIR macro.
@@ -457,53 +487,181 @@ Failed to find tcl.h. Set the TCLDIR macro.
!else
_TCLDIR = $(TCLDIR:/=\)
!if exist("$(_TCLDIR)\include\tcl.h")
-TCLH = "$(_TCLDIR)\include\tcl.h"
TCLINSTALL = 1
+_TCL_H = $(_TCLDIR)\include\tcl.h
!elseif exist("$(_TCLDIR)\generic\tcl.h")
-TCLH = "$(_TCLDIR)\generic\tcl.h"
TCLINSTALL = 0
+_TCL_H = $(_TCLDIR)\generic\tcl.h
!else
MSG =^
Failed to find tcl.h. The TCLDIR macro does not appear correct.
!error $(MSG)
!endif
!endif
+!endif
+
+#--------------------------------------------------------------
+# Extract various version numbers from tcl headers
+# The generated file is then included in the makefile.
+#--------------------------------------------------------------
+
+!if [echo REM = This file is generated from rules.vc > versions.vc]
+!endif
+!if [echo TCL_MAJOR_VERSION = \>> versions.vc] \
+ && [nmakehlp -V "$(_TCL_H)" TCL_MAJOR_VERSION >> versions.vc]
+!endif
+!if [echo TCL_MINOR_VERSION = \>> versions.vc] \
+ && [nmakehlp -V "$(_TCL_H)" TCL_MINOR_VERSION >> versions.vc]
+!endif
+!if [echo TCL_PATCH_LEVEL = \>> versions.vc] \
+ && [nmakehlp -V "$(_TCL_H)" TCL_PATCH_LEVEL >> versions.vc]
+!endif
+
+# If building the tcl core then we need additional package versions
+!if "$(PROJECT)" == "tcl"
+!if [echo PKG_HTTP_VER = \>> versions.vc] \
+ && [nmakehlp -V ..\library\http\pkgIndex.tcl http >> versions.vc]
+!endif
+!if [echo PKG_TCLTEST_VER = \>> versions.vc] \
+ && [nmakehlp -V ..\library\tcltest\pkgIndex.tcl tcltest >> versions.vc]
+!endif
+!if [echo PKG_MSGCAT_VER = \>> versions.vc] \
+ && [nmakehlp -V ..\library\msgcat\pkgIndex.tcl msgcat >> versions.vc]
+!endif
+!if [echo PKG_PLATFORM_VER = \>> versions.vc] \
+ && [nmakehlp -V ..\library\platform\pkgIndex.tcl "platform " >> versions.vc]
+!endif
+!if [echo PKG_SHELL_VER = \>> versions.vc] \
+ && [nmakehlp -V ..\library\platform\pkgIndex.tcl "platform::shell" >> versions.vc]
+!endif
+!if [echo PKG_DDE_VER = \>> versions.vc] \
+ && [nmakehlp -V ..\library\dde\pkgIndex.tcl "dde " >> versions.vc]
+!endif
+!if [echo PKG_REG_VER =\>> versions.vc] \
+ && [nmakehlp -V ..\library\reg\pkgIndex.tcl registry >> versions.vc]
+!endif
+!endif
+
+!include versions.vc
-### TODO: add a command to nmakehlp.c to grep for Tcl's version from tcl.h.
-### Because nmake can't return a string, we'll need to play games with return
-### codes. It might look something like this:
-#!if [nmakehlp -g $(TCL.H)] == 81
-#TCL_DOTVERSION = 8.1
-#!elseif [nmakehlp -g $(TCL.H)] == 82
-#TCL_DOTVERSION = 8.2
-#...
-#!endif
+#--------------------------------------------------------------
+# Setup tcl version dependent stuff headers
+#--------------------------------------------------------------
+
+!if "$(PROJECT)" != "tcl"
-TCL_DOTVERSION = 8.4
-TCL_VERSION = $(TCL_DOTVERSION:.=)
+TCL_VERSION = $(TCL_MAJOR_VERSION)$(TCL_MINOR_VERSION)
+
+!if $(TCL_VERSION) < 81
+TCL_DOES_STUBS = 0
+!else
+TCL_DOES_STUBS = 1
+!endif
!if $(TCLINSTALL)
-TCLSH = "$(_INSTALLDIR)\bin\tclsh$(TCL_VERSION)$(SUFX).exe"
-TCLSTUBLIB = "$(_INSTALLDIR)\lib\tclstub$(TCL_VERSION).lib"
-TCLIMPLIB = "$(_INSTALLDIR)\lib\tcl$(TCL_VERSION)$(SUFX).lib"
-TCL_LIBRARY = $(_INSTALLDIR)\lib
-TCLREGLIB = "$(_INSTALLDIR)\lib\tclreg11$(SUFX:t=).lib"
-TCLDDELIB = "$(_INSTALLDIR)\lib\tcldde12$(SUFX:t=).lib"
+TCLSH = "$(_TCLDIR)\bin\tclsh$(TCL_VERSION)$(SUFX).exe"
+!if !exist($(TCLSH)) && $(TCL_THREADS)
+TCLSH = "$(_TCLDIR)\bin\tclsh$(TCL_VERSION)t$(SUFX).exe"
+!endif
+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"
+TCLDDELIB = "$(_TCLDIR)\lib\tcldde13$(SUFX:t=).lib"
COFFBASE = \must\have\tcl\sources\to\build\this\target
TCLTOOLSDIR = \must\have\tcl\sources\to\build\this\target
+TCL_INCLUDES = -I"$(_TCLDIR)\include"
!else
TCLSH = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclsh$(TCL_VERSION)$(SUFX).exe"
+!if !exist($(TCLSH)) && $(TCL_THREADS)
+TCLSH = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclsh$(TCL_VERSION)t$(SUFX).exe"
+!endif
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)\tclreg11$(SUFX:t=).lib"
-TCLDDELIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tcldde12$(SUFX:t=).lib"
+TCLREGLIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclreg12$(SUFX:t=).lib"
+TCLDDELIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tcldde13$(SUFX:t=).lib"
COFFBASE = "$(_TCLDIR)\win\coffbase.txt"
TCLTOOLSDIR = $(_TCLDIR)\tools
+TCL_INCLUDES = -I"$(_TCLDIR)\generic" -I"$(_TCLDIR)\win"
+!endif
+
+!endif
+
+#-------------------------------------------------------------------------
+# Locate the Tk headers to build against
+#-------------------------------------------------------------------------
+
+!if "$(PROJECT)" == "tk"
+_TK_H = ..\generic\tk.h
+_INSTALLDIR = $(_INSTALLDIR)\..
+!endif
+
+!ifdef PROJECT_REQUIRES_TK
+!if !defined(TKDIR)
+!if exist("$(_INSTALLDIR)\..\include\tk.h")
+TKINSTALL = 1
+_TKDIR = $(_INSTALLDIR)\..
+_TK_H = $(_TKDIR)\include\tk.h
+TKDIR = $(_TKDIR)
+!elseif exist("$(_TCLDIR)\include\tk.h")
+TKINSTALL = 1
+_TKDIR = $(_TCLDIR)
+_TK_H = $(_TKDIR)\include\tk.h
+TKDIR = $(_TKDIR)
+!endif
+!else
+_TKDIR = $(TKDIR:/=\)
+!if exist("$(_TKDIR)\include\tk.h")
+TKINSTALL = 1
+_TK_H = $(_TKDIR)\include\tk.h
+!elseif exist("$(_TKDIR)\generic\tk.h")
+TKINSTALL = 0
+_TK_H = $(_TKDIR)\generic\tk.h
+!else
+MSG =^
+Failed to find tk.h. The TKDIR macro does not appear correct.
+!error $(MSG)
+!endif
!endif
+!endif
+
+#-------------------------------------------------------------------------
+# Extract Tk version numbers
+#-------------------------------------------------------------------------
+!if defined(PROJECT_REQUIRES_TK) || "$(PROJECT)" == "tk"
+
+!if [echo TK_MAJOR_VERSION = \>> versions.vc] \
+ && [nmakehlp -V $(_TK_H) TK_MAJOR_VERSION >> versions.vc]
+!endif
+!if [echo TK_MINOR_VERSION = \>> versions.vc] \
+ && [nmakehlp -V $(_TK_H) TK_MINOR_VERSION >> versions.vc]
+!endif
+!if [echo TK_PATCH_LEVEL = \>> versions.vc] \
+ && [nmakehlp -V $(_TK_H) TK_PATCH_LEVEL >> versions.vc]
+!endif
+
+!include versions.vc
+
+TK_DOTVERSION = $(TK_MAJOR_VERSION).$(TK_MINOR_VERSION)
+TK_VERSION = $(TK_MAJOR_VERSION)$(TK_MINOR_VERSION)
+
+!if "$(PROJECT)" != "tk"
+!if $(TKINSTALL)
+WISH = "$(_TKDIR)\bin\wish$(TK_VERSION)$(SUFX).exe"
+TKSTUBLIB = "$(_TKDIR)\lib\tkstub$(TK_VERSION).lib"
+TKIMPLIB = "$(_TKDIR)\lib\tk$(TK_VERSION)$(SUFX).lib"
+TK_INCLUDES = -I"$(_TKDIR)\include"
+!else
+WISH = "$(_TKDIR)\win\$(BUILDDIRTOP)\wish$(TCL_VERSION)$(SUFX).exe"
+TKSTUBLIB = "$(_TKDIR)\win\$(BUILDDIRTOP)\tkstub$(TCL_VERSION).lib"
+TKIMPLIB = "$(_TKDIR)\win\$(BUILDDIRTOP)\tk$(TCL_VERSION)$(SUFX).lib"
+TK_INCLUDES = -I"$(_TKDIR)\generic" -I"$(_TKDIR)\win" -I"$(_TKDIR)\xlib"
+!endif
!endif
+!endif
#----------------------------------------------------------
# Display stats being used.
@@ -514,7 +672,8 @@ TCLTOOLSDIR = $(_TCLDIR)\tools
!message *** Suffix for binaries will be '$(SUFX)'
!message *** Optional defines are '$(OPTDEFINES)'
!message *** Compiler version $(VCVER). Target machine is $(MACHINE)
-!message *** Compiler options '$(OPTIMIZATIONS) $(DEBUGFLAGS)'
+!message *** Host architecture is $(NATIVE_ARCH)
+!message *** Compiler options '$(COMPILERFLAGS) $(OPTIMIZATIONS) $(DEBUGFLAGS) $(WARNINGS)'
!message *** Link options '$(LINKERFLAGS)'
!endif
diff --git a/win/stub16.c b/win/stub16.c
index aa42c58..70fc051 100644
--- a/win/stub16.c
+++ b/win/stub16.c
@@ -1,13 +1,13 @@
-/*
- * stub16.c
+/*
+ * 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.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#define STRICT
@@ -16,32 +16,31 @@
#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.
+ * 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.
*
- * 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.
+ * 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.
@@ -54,7 +53,7 @@ static HANDLE CreateTempFile(void);
*/
int
-main()
+main(void)
{
DWORD dwRead, dwWrite;
char *cmdLine;
@@ -72,10 +71,10 @@ main()
/*
* 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:
+ * 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 ...
*/
@@ -123,7 +122,7 @@ main()
ZeroMemory(&si, sizeof(si));
si.cb = sizeof(si);
- if (CreateProcess(NULL, cmdLine, NULL, NULL, TRUE, 0, NULL, NULL, &si,
+ if (CreateProcess(NULL, cmdLine, NULL, NULL, TRUE, 0, NULL, NULL, &si,
&pi) == FALSE) {
goto cleanup;
}
@@ -157,7 +156,7 @@ main()
}
}
-cleanup:
+ cleanup:
if (hFileInput != INVALID_HANDLE_VALUE) {
CloseHandle(hFileInput);
}
@@ -175,7 +174,7 @@ cleanup:
}
static HANDLE
-CreateTempFile()
+CreateTempFile(void)
{
char name[MAX_PATH];
SECURITY_ATTRIBUTES sa;
@@ -190,7 +189,7 @@ CreateTempFile()
sa.nLength = sizeof(sa);
sa.lpSecurityDescriptor = NULL;
sa.bInheritHandle = TRUE;
- return CreateFile(name, GENERIC_READ | GENERIC_WRITE, 0, &sa,
+ 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 2d99988..b3de0ff 100644
--- a/win/tcl.dsp
+++ b/win/tcl.dsp
@@ -36,16 +36,16 @@ CFG=tcl - Win32 Debug Static
# PROP BASE Intermediate_Dir "Release\tcl_Dynamic"
# PROP BASE Cmd_Line "nmake -nologo -f makefile.vc OPTS=none MSVCDIR=IDE"
# PROP BASE Rebuild_Opt "-a"
-# PROP BASE Target_File "Release\tclsh84.exe"
+# PROP BASE Target_File "Release\tclsh85.exe"
# PROP BASE Bsc_Name ""
# PROP BASE Target_Dir ""
# PROP Use_MFC 0
# PROP Use_Debug_Libraries 0
# PROP Output_Dir "Release"
# PROP Intermediate_Dir "Release\tcl_Dynamic"
-# PROP Cmd_Line "nmake -nologo -f makefile.vc OPTS=none MSVCDIR=IDE"
-# PROP Rebuild_Opt "-a"
-# PROP Target_File "Release\tclsh84.exe"
+# PROP Cmd_Line "nmake -nologo -f makefile.vc OPTS=threads MSVCDIR=IDE"
+# PROP Rebuild_Opt "clean release"
+# PROP Target_File "Release\tclsh85t.exe"
# PROP Bsc_Name ""
# PROP Target_Dir ""
@@ -57,16 +57,16 @@ CFG=tcl - Win32 Debug Static
# PROP BASE Intermediate_Dir "Debug\tcl_Dynamic"
# PROP BASE Cmd_Line "nmake -nologo -f makefile.vc OPTS=symbols MSVCDIR=IDE"
# PROP BASE Rebuild_Opt "-a"
-# PROP BASE Target_File "Debug\tclsh84d.exe"
+# PROP BASE Target_File "Debug\tclsh85g.exe"
# PROP BASE Bsc_Name ""
# PROP BASE Target_Dir ""
# PROP Use_MFC 0
# PROP Use_Debug_Libraries 1
# PROP Output_Dir "Debug"
# PROP Intermediate_Dir "Debug\tcl_Dynamic"
-# PROP Cmd_Line "nmake -nologo -f makefile.vc OPTS=symbols MSVCDIR=IDE"
-# PROP Rebuild_Opt "-a"
-# PROP Target_File "Debug\tclsh84d.exe"
+# PROP Cmd_Line "nmake -nologo -f makefile.vc OPTS=threads,symbols MSVCDIR=IDE"
+# PROP Rebuild_Opt "clean release"
+# PROP Target_File "Debug\tclsh85tg.exe"
# PROP Bsc_Name ""
# PROP Target_Dir ""
@@ -78,7 +78,7 @@ CFG=tcl - Win32 Debug Static
# PROP BASE Intermediate_Dir "Debug\tcl_Static"
# PROP BASE Cmd_Line "nmake -nologo -f makefile.vc OPTS=symbols,static MSVCDIR=IDE"
# PROP BASE Rebuild_Opt "-a"
-# PROP BASE Target_File "Debug\tclsh84d.exe"
+# PROP BASE Target_File "Debug\tclsh85sg.exe"
# PROP BASE Bsc_Name ""
# PROP BASE Target_Dir ""
# PROP Use_MFC 0
@@ -87,7 +87,7 @@ CFG=tcl - Win32 Debug Static
# PROP Intermediate_Dir "Debug\tcl_Static"
# PROP Cmd_Line "nmake -nologo -f makefile.vc OPTS=symbols,static MSVCDIR=IDE"
# PROP Rebuild_Opt "-a"
-# PROP Target_File "Debug\tclsh84sd.exe"
+# PROP Target_File "Debug\tclsh85sg.exe"
# PROP Bsc_Name ""
# PROP Target_Dir ""
@@ -99,7 +99,7 @@ CFG=tcl - Win32 Debug Static
# PROP BASE Intermediate_Dir "Release\tcl_Static"
# PROP BASE Cmd_Line "nmake -nologo -f makefile.vc OPTS=static MSVCDIR=IDE"
# PROP BASE Rebuild_Opt "-a"
-# PROP BASE Target_File "Release\tclsh84.exe"
+# PROP BASE Target_File "Release\tclsh85s.exe"
# PROP BASE Bsc_Name ""
# PROP BASE Target_Dir ""
# PROP Use_MFC 0
@@ -108,7 +108,7 @@ CFG=tcl - Win32 Debug Static
# PROP Intermediate_Dir "Release\tcl_Static"
# PROP Cmd_Line "nmake -nologo -f makefile.vc OPTS=static MSVCDIR=IDE"
# PROP Rebuild_Opt "-a"
-# PROP Target_File "Release\tclsh84s.exe"
+# PROP Target_File "Release\tclsh85s.exe"
# PROP Bsc_Name ""
# PROP Target_Dir ""
@@ -180,10 +180,6 @@ SOURCE=..\compat\stdlib.h
# End Source File
# Begin Source File
-SOURCE=..\compat\strftime.c
-# End Source File
-# Begin Source File
-
SOURCE=..\compat\string.h
# End Source File
# Begin Source File
@@ -212,10 +208,6 @@ SOURCE=..\compat\tclErrno.h
# End Source File
# Begin Source File
-SOURCE=..\compat\tmpnam.c
-# End Source File
-# Begin Source File
-
SOURCE=..\compat\unistd.h
# End Source File
# Begin Source File
@@ -652,10 +644,6 @@ SOURCE=..\doc\lsort.n
# End Source File
# Begin Source File
-SOURCE=..\doc\Macintosh.3
-# End Source File
-# Begin Source File
-
SOURCE=..\doc\man.macros
# End Source File
# Begin Source File
@@ -780,10 +768,6 @@ SOURCE=..\doc\rename.n
# End Source File
# Begin Source File
-SOURCE=..\doc\resource.n
-# End Source File
-# Begin Source File
-
SOURCE=..\doc\return.n
# End Source File
# Begin Source File
@@ -1168,10 +1152,6 @@ SOURCE=..\generic\tclIndexObj.c
# End Source File
# Begin Source File
-SOURCE=..\generic\tclInitScript.h
-# End Source File
-# Begin Source File
-
SOURCE=..\generic\tclInt.decls
# End Source File
# Begin Source File
@@ -1240,10 +1220,6 @@ SOURCE=..\generic\tclMain.c
# End Source File
# Begin Source File
-SOURCE=..\generic\tclMath.h
-# End Source File
-# Begin Source File
-
SOURCE=..\generic\tclNamesp.c
# End Source File
# Begin Source File
@@ -1264,10 +1240,6 @@ SOURCE=..\generic\tclParse.c
# End Source File
# Begin Source File
-SOURCE=..\generic\tclParseExpr.c
-# End Source File
-# Begin Source File
-
SOURCE=..\generic\tclPipe.c
# End Source File
# Begin Source File
@@ -1552,10 +1524,6 @@ SOURCE=.\tclWinLoad.c
# End Source File
# Begin Source File
-SOURCE=.\tclWinMtherr.c
-# End Source File
-# Begin Source File
-
SOURCE=.\tclWinNotify.c
# End Source File
# Begin Source File
diff --git a/win/tcl.hpj.in b/win/tcl.hpj.in
index 2a8c94a..0d01f35 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=tcl84.cnt
+CNT=tcl85.cnt
COPYRIGHT=Copyright © 2000 Ajuba Solutions
-HLP=tcl84.hlp
+HLP=tcl85.hlp
[FILES]
tcl.rtf
diff --git a/win/tcl.m4 b/win/tcl.m4
index 708efc48..9320d89 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.4$1/win; then
- TCL_BIN_DIR_DEFAULT=../../tcl8.4$1/win
- elif test -d ../../tcl8.4/win; then
- TCL_BIN_DIR_DEFAULT=../../tcl8.4/win
+ 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
else
TCL_BIN_DIR_DEFAULT=../../tcl/win
fi
- AC_ARG_WITH(tcl, [ --with-tcl=DIR use Tcl 8.4 binaries from DIR],
+ AC_ARG_WITH(tcl, [ --with-tcl=DIR use Tcl 8.5 binaries from DIR],
TCL_BIN_DIR=$withval, TCL_BIN_DIR=`cd $TCL_BIN_DIR_DEFAULT; pwd`)
if test ! -d $TCL_BIN_DIR; then
AC_MSG_ERROR(Tcl directory $TCL_BIN_DIR does not exist)
@@ -63,15 +63,15 @@ AC_DEFUN([SC_PATH_TCLCONFIG], [
AC_DEFUN([SC_PATH_TKCONFIG], [
AC_MSG_CHECKING([the location of tkConfig.sh])
- if test -d ../../tk8.4$1/win; then
- TK_BIN_DIR_DEFAULT=../../tk8.4$1/win
- elif test -d ../../tk8.4/win; then
- TK_BIN_DIR_DEFAULT=../../tk8.4/win
+ 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
else
TK_BIN_DIR_DEFAULT=../../tk/win
fi
- AC_ARG_WITH(tk, [ --with-tk=DIR use Tk 8.4 binaries from DIR],
+ AC_ARG_WITH(tk, [ --with-tk=DIR use Tk 8.5 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)
@@ -305,6 +305,8 @@ AC_DEFUN([SC_ENABLE_SYMBOLS], [
DBGX=""
AC_DEFINE(NDEBUG, 1, [Is no debugging enabled?])
AC_MSG_RESULT([no])
+
+ AC_DEFINE(TCL_CFG_OPTIMIZED)
else
CFLAGS_DEFAULT='$(CFLAGS_DEBUG)'
LDFLAGS_DEFAULT='$(LDFLAGS_DEBUG)'
@@ -498,8 +500,9 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
if test "${GCC}" = "yes" ; then
SHLIB_LD=""
SHLIB_LD_LIBS=""
- LIBS=""
- LIBS_GUI="-lgdi32 -lcomdlg32 -limm32 -lcomctl32 -lshell32"
+ LIBS="-lws2_32"
+ # mingw needs to link ole32 and oleaut32 for [send], but MSVC doesn't
+ LIBS_GUI="-lgdi32 -lcomdlg32 -limm32 -lcomctl32 -lshell32 -luuid -lole32 -loleaut32"
STLIB_LD='${AR} cr'
RC_OUT=-o
RC_TYPE=
@@ -557,7 +560,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
CFLAGS_DEBUG=-g
CFLAGS_OPTIMIZE="-O2 -fomit-frame-pointer"
- CFLAGS_WARNING="-Wall -fno-strict-aliasing"
+ CFLAGS_WARNING="-Wall"
LDFLAGS_DEBUG=
LDFLAGS_OPTIMIZE=
@@ -662,13 +665,17 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
fi
fi
- LIBS="user32.lib advapi32.lib"
+ LIBS="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
# TEA_PATH_NOSPACE to avoid this issue.
- CC="\"${PATH64}/cl.exe\" -I\"${MSSDK}/Include\" \
- -I\"${MSSDK}/Include/crt\" -I\"${MSSDK}/Include/crt/sys\""
+ # Check if _WIN64 is already recognized, and if so we don't
+ # need to modify CC.
+ AC_CHECK_DECL([_WIN64], [],
+ [CC="\"${PATH64}/cl.exe\" -I\"${MSSDK}/Include\" \
+ -I\"${MSSDK}/Include/crt\" \
+ -I\"${MSSDK}/Include/crt/sys\""])
RC="\"${MSSDK}/bin/rc.exe\""
CFLAGS_DEBUG="-nologo -Zi -Od ${runtime}d"
# Do not use -O2 for Win64 - this has proved buggy in code gen.
@@ -779,7 +786,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
LIBS="$LIBS \"\${CELIB_DIR}/wince-${ARCH}-pocket-wce300-release/celib.lib\""
LIBS_GUI="commctrl.lib commdlg.lib"
else
- LIBS_GUI="gdi32.lib comdlg32.lib imm32.lib comctl32.lib shell32.lib"
+ LIBS_GUI="gdi32.lib comdlg32.lib imm32.lib comctl32.lib shell32.lib uuid.lib"
fi
SHLIB_LD="${LINKBIN} -dll -incremental:no ${lflags}"
@@ -818,6 +825,10 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
fi
fi
+ if test "$do64bit" != "no" ; then
+ AC_DEFINE(TCL_CFG_DO64BIT)
+ fi
+
if test "${GCC}" = "yes" ; then
AC_CACHE_CHECK(for SEH support in compiler,
tcl_cv_seh,
@@ -938,13 +949,13 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
#------------------------------------------------------------------------
AC_DEFUN([SC_WITH_TCL], [
- if test -d ../../tcl8.4$1/win; then
- TCL_BIN_DEFAULT=../../tcl8.4$1/win
+ if test -d ../../tcl8.5$1/win; then
+ TCL_BIN_DEFAULT=../../tcl8.5$1/win
else
- TCL_BIN_DEFAULT=../../tcl8.4/win
+ TCL_BIN_DEFAULT=../../tcl8.5/win
fi
- AC_ARG_WITH(tcl, [ --with-tcl=DIR use Tcl 8.4 binaries from DIR],
+ AC_ARG_WITH(tcl, [ --with-tcl=DIR use Tcl 8.5 binaries from DIR],
TCL_BIN_DIR=$withval, TCL_BIN_DIR=`cd $TCL_BIN_DEFAULT; pwd`)
if test ! -d $TCL_BIN_DIR; then
AC_MSG_ERROR(Tcl directory $TCL_BIN_DIR does not exist)
@@ -1031,6 +1042,34 @@ AC_DEFUN([SC_BUILD_TCLSH], [
])
#--------------------------------------------------------------------
+# SC_TCL_CFG_ENCODING TIP #59
+#
+# Declare the encoding to use for embedded configuration information.
+#
+# Arguments:
+# None.
+#
+# Results:
+# Might append to the following vars:
+# DEFS (implicit)
+#
+# Will define the following vars:
+# TCL_CFGVAL_ENCODING
+#
+#--------------------------------------------------------------------
+
+AC_DEFUN([SC_TCL_CFG_ENCODING], [
+ AC_ARG_WITH(encoding, [ --with-encoding encoding for configuration values], with_tcencoding=${withval})
+
+ if test x"${with_tcencoding}" != x ; then
+ AC_DEFINE_UNQUOTED(TCL_CFGVAL_ENCODING,"${with_tcencoding}")
+ else
+ # Default encoding on windows is not "iso8859-1"
+ AC_DEFINE(TCL_CFGVAL_ENCODING,"cp1252")
+ fi
+])
+
+#--------------------------------------------------------------------
# SC_EMBED_MANIFEST
#
# Figure out if we can embed the manifest where necessary
@@ -1048,7 +1087,8 @@ AC_DEFUN([SC_BUILD_TCLSH], [
AC_DEFUN([SC_EMBED_MANIFEST], [
AC_MSG_CHECKING(whether to embed manifest)
AC_ARG_ENABLE(embedded-manifest,
- [ --enable-embedded-manifest embed manifest if possible (default: yes)],
+ AC_HELP_STRING([--enable-embedded-manifest],
+ [embed manifest if possible (default: yes)]),
[embed_ok=$enableval], [embed_ok=yes])
VC_MANIFEST_EMBED_DLL=
@@ -1065,8 +1105,11 @@ print("manifest needed")
# Could do a CHECK_PROG for mt, but should always be with MSVC8+
# Could add 'if test -f' check, but manifest should be created
# in this compiler case
- VC_MANIFEST_EMBED_DLL="mt.exe -nologo -manifest \[$]@.manifest $1 -outputresource:\[$]@\;2"
- VC_MANIFEST_EMBED_EXE="mt.exe -nologo -manifest \[$]@.manifest $1 -outputresource:\[$]@\;1"
+ # Add in a manifest argument that may be specified
+ # XXX Needs improvement so that the test for existence accounts
+ # XXX for a provided (known) manifest
+ VC_MANIFEST_EMBED_DLL="if test -f \[$]@.manifest ; then mt.exe -nologo -manifest \[$]@.manifest $1 -outputresource:\[$]@\;2 ; fi"
+ VC_MANIFEST_EMBED_EXE="if test -f \[$]@.manifest ; then mt.exe -nologo -manifest \[$]@.manifest $1 -outputresource:\[$]@\;1 ; fi"
result=yes
if test "x$1" != x ; then
result="yes ($1)"
diff --git a/win/tcl.rc b/win/tcl.rc
index 0cba28b..d88ca0a 100644
--- a/win/tcl.rc
+++ b/win/tcl.rc
@@ -7,14 +7,14 @@
//
// build-up the name suffix that defines the type of build this is.
//
-#ifdef TCL_THREADS
+#if TCL_THREADS
#define SUFFIX_THREADS "t"
#else
#define SUFFIX_THREADS ""
#endif
-#ifdef DEBUG
-#define SUFFIX_DEBUG "d"
+#if DEBUG && !UNCHECKED
+#define SUFFIX_DEBUG "g"
#else
#define SUFFIX_DEBUG ""
#endif
@@ -42,7 +42,7 @@ BEGIN
BLOCK "040904b0" /* LANG_ENGLISH/SUBLANG_ENGLISH_US, Unicode CP */
BEGIN
VALUE "FileDescription", "Tcl DLL\0"
- VALUE "OriginalFilename", "tcl" STRINGIFY(JOIN(TCL_MAJOR_VERSION,TCL_MINOR_VERSION)) SUFFIX ".dll\0"
+ VALUE "OriginalFilename", "tcl" STRINGIFY(TCL_MAJOR_VERSION) STRINGIFY(TCL_MINOR_VERSION) SUFFIX ".dll\0"
VALUE "CompanyName", "ActiveState Corporation\0"
VALUE "FileVersion", TCL_PATCH_LEVEL
VALUE "LegalCopyright", "Copyright \251 2001 by ActiveState Corporation, et al\0"
diff --git a/win/tclAppInit.c b/win/tclAppInit.c
index 4578ea8..0edd2c3 100644
--- a/win/tclAppInit.c
+++ b/win/tclAppInit.c
@@ -2,14 +2,14 @@
* tclAppInit.c --
*
* Provides a default version of the main program and Tcl_AppInit
- * procedure for Tcl applications (without Tk). Note that this
- * program must be built in Win32 console mode to work properly.
+ * function for Tcl applications (without Tk). Note that this program
+ * must be built in Win32 console mode to work properly.
*
* Copyright (c) 1996-1997 by Sun Microsystems, Inc.
* Copyright (c) 1998-1999 by Scriptics Corporation.
*
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#include "tcl.h"
@@ -17,24 +17,15 @@
#include <locale.h>
#ifdef TCL_TEST
-extern int Procbodytest_Init _ANSI_ARGS_((Tcl_Interp *interp));
-extern int Procbodytest_SafeInit _ANSI_ARGS_((Tcl_Interp *interp));
-extern int Tcltest_Init _ANSI_ARGS_((Tcl_Interp *interp));
-extern int TclObjTest_Init _ANSI_ARGS_((Tcl_Interp *interp));
-#ifdef TCL_THREADS
-extern int TclThread_Init _ANSI_ARGS_((Tcl_Interp *interp));
-#endif
+extern Tcl_PackageInitProc Procbodytest_Init;
+extern Tcl_PackageInitProc Procbodytest_SafeInit;
+extern Tcl_PackageInitProc Tcltest_Init;
+extern Tcl_PackageInitProc TclObjTest_Init;
#endif /* TCL_TEST */
-static void setargv _ANSI_ARGS_((int *argcPtr, char ***argvPtr));
-static BOOL __stdcall sigHandler (DWORD fdwCtrlType);
-static Tcl_AsyncProc asyncExit;
-static void AppInitExitHandler(ClientData clientData);
-
-static char ** argvSave = NULL;
-static Tcl_AsyncHandler exitToken = NULL;
-static DWORD exitErrorCode = 0;
-
+#if defined(__GNUC__)
+static void setargv(int *argcPtr, char ***argvPtr);
+#endif /* __GNUC__ */
/*
*----------------------------------------------------------------------
@@ -44,8 +35,8 @@ static DWORD exitErrorCode = 0;
* This is the main program for the application.
*
* Results:
- * None: Tcl_Main never returns here, so this procedure never
- * returns either.
+ * None: Tcl_Main never returns here, so this function never returns
+ * either.
*
* Side effects:
* Whatever the application does.
@@ -54,21 +45,21 @@ static DWORD exitErrorCode = 0;
*/
int
-main(argc, argv)
- int argc; /* Number of command-line arguments. */
- char **argv; /* Values of command-line arguments. */
+main(
+ int argc,
+ char *argv[])
{
/*
- * The following #if block allows you to change the AppInit
- * function by using a #define of TCL_LOCAL_APPINIT instead
- * of rewriting this entire file. The #if checks for that
- * #define and uses Tcl_AppInit if it doesn't exist.
+ * 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));
+ extern int TCL_LOCAL_APPINIT (Tcl_Interp *interp);
/*
* The following #if block allows you to change how Tcl finds the startup
@@ -77,32 +68,26 @@ main(argc, argv)
*/
#ifdef TCL_LOCAL_MAIN_HOOK
- extern int TCL_LOCAL_MAIN_HOOK _ANSI_ARGS_((int *argc, char ***argv));
+ extern int TCL_LOCAL_MAIN_HOOK (int *argc, char ***argv);
#endif
- char buffer[MAX_PATH +1];
char *p;
+
/*
- * Set up the default locale to be standard "C" locale so parsing
- * is performed correctly.
+ * Set up the default locale to be standard "C" locale so parsing is
+ * performed correctly.
*/
+#if defined(__GNUC__)
+ setargv( &argc, &argv );
+#endif
setlocale(LC_ALL, "C");
- setargv(&argc, &argv);
/*
- * Save this for later, so we can free it.
+ * Forward slashes substituted for backslashes.
*/
- argvSave = argv;
- /*
- * Replace argv[0] with full pathname of executable, and forward
- * slashes substituted for backslashes.
- */
-
- GetModuleFileName(NULL, buffer, sizeof(buffer));
- argv[0] = buffer;
- for (p = buffer; *p != '\0'; p++) {
+ for (p = argv[0]; *p != '\0'; p++) {
if (*p == '\\') {
*p = '/';
}
@@ -116,20 +101,19 @@ main(argc, argv)
return 0; /* Needed only to prevent compiler warning. */
}
-
/*
*----------------------------------------------------------------------
*
* Tcl_AppInit --
*
- * This procedure performs application-specific initialization.
- * Most applications, especially those that incorporate additional
- * packages, will have their own version of this procedure.
+ * This function performs application-specific initialization. Most
+ * applications, especially those that incorporate additional packages,
+ * will have their own version of this function.
*
* Results:
- * Returns a standard Tcl completion code, and leaves an error
- * message in the interp's result if an error occurs.
+ * Returns a standard Tcl completion code, and leaves an error message in
+ * the interp's result if an error occurs.
*
* Side effects:
* Depends on the startup script.
@@ -138,50 +122,33 @@ main(argc, argv)
*/
int
-Tcl_AppInit(interp)
- Tcl_Interp *interp; /* Interpreter for application. */
+Tcl_AppInit(
+ Tcl_Interp *interp) /* Interpreter for application. */
{
if (Tcl_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
- /*
- * Install a signal handler to the win32 console tclsh is running in.
- */
- SetConsoleCtrlHandler(sigHandler, TRUE);
- exitToken = Tcl_AsyncCreate(asyncExit, NULL);
-
- /*
- * This exit handler will be used to free the
- * resources allocated in this file.
- */
- Tcl_CreateExitHandler(AppInitExitHandler, NULL);
-
#ifdef TCL_TEST
if (Tcltest_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
- Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init,
- (Tcl_PackageInitProc *) NULL);
+ Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init, NULL);
if (TclObjTest_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
-#ifdef TCL_THREADS
- if (TclThread_Init(interp) == TCL_ERROR) {
- return TCL_ERROR;
- }
-#endif
if (Procbodytest_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_StaticPackage(interp, "procbodytest", Procbodytest_Init,
- Procbodytest_SafeInit);
+ Procbodytest_SafeInit);
#endif /* TCL_TEST */
-#if defined(STATIC_BUILD) && defined(TCL_USE_STATIC_PACKAGES)
+#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;
@@ -191,13 +158,13 @@ Tcl_AppInit(interp)
if (Dde_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
- Tcl_StaticPackage(interp, "dde", Dde_Init, NULL);
+ Tcl_StaticPackage(interp, "dde", Dde_Init, Dde_SafeInit);
}
#endif
/*
- * Call the init procedures for included packages. Each call should
- * look like this:
+ * Call the init functions for included packages. Each call should look
+ * like this:
*
* if (Mod_Init(interp) == TCL_ERROR) {
* return TCL_ERROR;
@@ -207,15 +174,15 @@ Tcl_AppInit(interp)
*/
/*
- * Call Tcl_CreateCommand for application-specific commands, if
- * they weren't already created by the init procedures called above.
+ * Call Tcl_CreateCommand for application-specific commands, if they
+ * weren't already created by the init functions 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.
+ * 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.
*/
Tcl_SetVar(interp, "tcl_rcFileName", "~/tclshrc.tcl", TCL_GLOBAL_ONLY);
@@ -223,50 +190,14 @@ Tcl_AppInit(interp)
}
/*
- *----------------------------------------------------------------------
- *
- * AppInitExitHandler --
- *
- * This function is called to cleanup the app init resources before
- * Tcl is unloaded.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Frees the saved argv and deletes the async exit handler.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-AppInitExitHandler(
- ClientData clientData)
-{
- if (argvSave != NULL) {
- ckfree((char *)argvSave);
- argvSave = NULL;
- }
-
- if (exitToken != NULL) {
- /*
- * This should be safe to do even if we
- * are in an async exit right now.
- */
- Tcl_AsyncDelete(exitToken);
- exitToken = NULL;
- }
-}
-
-/*
*-------------------------------------------------------------------------
*
* setargv --
*
- * Parse the Windows command line string into argc/argv. Done here
- * because we don't trust the builtin argument parser in crt0.
- * Windows applications are responsible for breaking their command
- * line into arguments.
+ * Parse the Windows command line string into argc/argv. Done here
+ * because we don't trust the builtin argument parser in crt0. Windows
+ * applications are responsible for breaking their command line into
+ * arguments.
*
* 2N backslashes + quote -> N backslashes + begin quoted string
* 2N + 1 backslashes + quote -> literal
@@ -276,8 +207,8 @@ AppInitExitHandler(
* quote -> begin quoted string
*
* Results:
- * Fills argcPtr with the number of arguments and argvPtr with the
- * array of arguments.
+ * Fills argcPtr with the number of arguments and argvPtr with the array
+ * of arguments.
*
* Side effects:
* Memory allocated.
@@ -285,10 +216,11 @@ AppInitExitHandler(
*--------------------------------------------------------------------------
*/
+#if defined(__GNUC__)
static void
-setargv(argcPtr, argvPtr)
- int *argcPtr; /* Filled with number of argument strings. */
- char ***argvPtr; /* Filled with argument strings (malloc'd). */
+setargv(
+ int *argcPtr, /* Filled with number of argument strings. */
+ char ***argvPtr) /* Filled with argument strings (malloc'd). */
{
char *cmdLine, *p, *arg, *argSpace;
char **argv;
@@ -297,8 +229,8 @@ setargv(argcPtr, argvPtr)
cmdLine = GetCommandLine(); /* INTL: BUG */
/*
- * Precompute an overly pessimistic guess at the number of arguments
- * in the command line by counting non-space spans.
+ * Precompute an overly pessimistic guess at the number of arguments in
+ * the command line by counting non-space spans.
*/
size = 2;
@@ -346,18 +278,18 @@ setargv(argcPtr, argvPtr)
} else {
inquote = !inquote;
}
- }
- slashes >>= 1;
- }
+ }
+ slashes >>= 1;
+ }
- while (slashes) {
+ while (slashes) {
*arg = '\\';
arg++;
slashes--;
}
- if ((*p == '\0')
- || (!inquote && ((*p == ' ') || (*p == '\t')))) { /* INTL: ISO space. */
+ if ((*p == '\0') || (!inquote &&
+ ((*p == ' ') || (*p == '\t')))) { /* INTL: ISO space. */
break;
}
if (copy != 0) {
@@ -365,7 +297,7 @@ setargv(argcPtr, argvPtr)
arg++;
}
p++;
- }
+ }
*arg = '\0';
argSpace = arg + 1;
}
@@ -374,80 +306,12 @@ setargv(argcPtr, argvPtr)
*argcPtr = argc;
*argvPtr = argv;
}
+#endif /* __GNUC__ */
/*
- *----------------------------------------------------------------------
- *
- * asyncExit --
- *
- * The AsyncProc for the exitToken.
- *
- * Results:
- * doesn't actually return.
- *
- * Side effects:
- * tclsh cleanly exits.
- *
- *----------------------------------------------------------------------
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
*/
-
-int
-asyncExit (ClientData clientData, Tcl_Interp *interp, int code)
-{
- Tcl_Exit((int)exitErrorCode);
-
- /* NOTREACHED */
- return code;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * sigHandler --
- *
- * Signal handler for the Win32 OS. Catches Ctrl+C, Ctrl+Break and
- * other exits. This is needed so tclsh can do it's real clean-up
- * and not an unclean crash terminate.
- *
- * Results:
- * TRUE.
- *
- * Side effects:
- * Effects the way the app exits from a signal. This is an
- * operating system supplied thread and unsafe to call ANY
- * Tcl commands except for Tcl_AsyncMark.
- *
- *----------------------------------------------------------------------
- */
-
-BOOL __stdcall
-sigHandler(DWORD fdwCtrlType)
-{
- HANDLE hStdIn;
-
- if (!exitToken) {
- /* Async token must have been destroyed, punt gracefully. */
- return FALSE;
- }
-
- /*
- * If Tcl is currently executing some bytecode or in the eventloop,
- * this will cause Tcl to enter asyncExit at the next command
- * boundry.
- */
- exitErrorCode = fdwCtrlType;
- Tcl_AsyncMark(exitToken);
-
- /*
- * This will cause Tcl_Gets in Tcl_Main() to drop-out with an <EOF>
- * should it be blocked on input and our Tcl_AsyncMark didn't grab
- * the attention of the interpreter.
- */
- hStdIn = GetStdHandle(STD_INPUT_HANDLE);
- if (hStdIn) {
- CloseHandle(hStdIn);
- }
-
- /* indicate to the OS not to call the default terminator */
- return TRUE;
-}
diff --git a/win/tclWin32Dll.c b/win/tclWin32Dll.c
index ba3af7c..6c863b9 100644
--- a/win/tclWin32Dll.c
+++ b/win/tclWin32Dll.c
@@ -1,20 +1,31 @@
-/*
+/*
* tclWin32Dll.c --
*
- * This file contains the DLL entry point.
+ * This file contains the DLL entry point and other low-level bit bashing
+ * code that needs inline assembly.
*
* Copyright (c) 1995-1996 Sun Microsystems, Inc.
* Copyright (c) 1998-2000 Scriptics Corporation.
*
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#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.
+ * 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,
@@ -26,41 +37,38 @@ typedef BOOL (WINAPI UTREGISTER)(HANDLE hModule, LPCSTR SixteenBitDLL,
typedef VOID (WINAPI UTUNREGISTER)(HANDLE hModule);
-/*
- * The following variables keep track of information about this DLL
- * on a per-instance basis. Each time this DLL is loaded, it gets its own
- * new data segment with its own copy of all static and global information.
+/*
+ * The following variables keep track of information about this DLL on a
+ * per-instance basis. Each time this DLL is loaded, it gets its own new data
+ * segment with its own copy of all static and global information.
*/
static HINSTANCE hInstance; /* HINSTANCE of this DLL. */
static int platformId; /* Running under NT, or 95/98? */
#ifdef HAVE_NO_SEH
-
/*
- * Unlike Borland and Microsoft, we don't register exception handlers
- * by pushing registration records onto the runtime stack. Instead, we
- * register them by creating an EXCEPTION_REGISTRATION within the activation
- * record.
+ * Unlike Borland and Microsoft, we don't register exception handlers by
+ * pushing registration records onto the runtime stack. Instead, we register
+ * them by creating an EXCEPTION_REGISTRATION within the activation record.
*/
typedef struct EXCEPTION_REGISTRATION {
- struct EXCEPTION_REGISTRATION* link;
- EXCEPTION_DISPOSITION (*handler)( struct _EXCEPTION_RECORD*, void*,
- struct _CONTEXT*, void* );
- void* ebp;
- void* esp;
+ struct EXCEPTION_REGISTRATION *link;
+ EXCEPTION_DISPOSITION (*handler)(
+ struct _EXCEPTION_RECORD*, void*, struct _CONTEXT*, void*);
+ void *ebp;
+ void *esp;
int status;
} EXCEPTION_REGISTRATION;
-
#endif
/*
- * VC++ 5.x has no 'cpuid' assembler instruction, so we
- * must emulate it
+ * VC++ 5.x has no 'cpuid' assembler instruction, so we must emulate it
*/
-#if defined(_MSC_VER) && ( _MSC_VER <= 1100 )
-#define cpuid __asm __emit 0fh __asm __emit 0a2h
+
+#if defined(_MSC_VER) && (_MSC_VER <= 1100)
+#define cpuid __asm __emit 0fh __asm __emit 0a2h
#endif
/*
@@ -76,10 +84,10 @@ static TclWinProcs asciiProcs = {
(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 *,
+ (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 *,
+ (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,
@@ -87,33 +95,35 @@ static TclWinProcs asciiProcs = {
(BOOL (WINAPI *)(WCHAR *, LPDWORD)) GetComputerNameA,
(DWORD (WINAPI *)(DWORD, WCHAR *)) GetCurrentDirectoryA,
(DWORD (WINAPI *)(CONST TCHAR *)) GetFileAttributesA,
- (DWORD (WINAPI *)(CONST TCHAR *, DWORD nBufferLength, WCHAR *,
+ (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,
+ (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,
+ (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,
+ (DWORD (WINAPI *)(CONST TCHAR *, CONST TCHAR *, CONST TCHAR *, DWORD,
WCHAR *, TCHAR **)) SearchPathA,
(BOOL (WINAPI *)(CONST TCHAR *)) SetCurrentDirectoryA,
(BOOL (WINAPI *)(CONST TCHAR *, DWORD)) SetFileAttributesA,
- /*
+
+ /*
* The three NULL function pointers will only be set when
- * Tcl_FindExecutable is called. If you don't ever call that
- * function, the application will crash whenever WinTcl tries to call
- * functions through these null pointers. That is not a bug in Tcl
- * -- Tcl_FindExecutable is obligatory in recent Tcl releases.
+ * 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,
- (int (__cdecl*)(CONST TCHAR *, struct _utimbuf *)) _utime,
+ /* deleted (int (__cdecl*)(CONST TCHAR *, struct _utimbuf *)) _utime, */
NULL,
NULL,
/* getLongPathNameProc */
@@ -122,7 +132,8 @@ static TclWinProcs asciiProcs = {
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 *)(HANDLE, const VOID*, DWORD, LPDWORD, LPVOID)) WriteConsoleA,
+ (BOOL (WINAPI *)(LPTSTR, LPDWORD)) GetUserNameA
};
static TclWinProcs unicodeProcs = {
@@ -132,10 +143,10 @@ static TclWinProcs unicodeProcs = {
(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 *,
+ (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 *,
+ (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,
@@ -143,33 +154,35 @@ static TclWinProcs unicodeProcs = {
(BOOL (WINAPI *)(WCHAR *, LPDWORD)) GetComputerNameW,
(DWORD (WINAPI *)(DWORD, WCHAR *)) GetCurrentDirectoryW,
(DWORD (WINAPI *)(CONST TCHAR *)) GetFileAttributesW,
- (DWORD (WINAPI *)(CONST TCHAR *, DWORD nBufferLength, WCHAR *,
+ (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,
+ (UINT (WINAPI *)(CONST TCHAR *, CONST TCHAR *, UINT uUnique,
WCHAR *)) GetTempFileNameW,
(DWORD (WINAPI *)(DWORD, WCHAR *)) GetTempPathW,
- (BOOL (WINAPI *)(CONST TCHAR *, WCHAR *, DWORD, LPDWORD, LPDWORD, LPDWORD,
+ (BOOL (WINAPI *)(CONST TCHAR *, WCHAR *, DWORD, LPDWORD, LPDWORD, LPDWORD,
WCHAR *, DWORD)) GetVolumeInformationW,
- (HINSTANCE (WINAPI *)(const TCHAR *, HANDLE, DWORD)) LoadLibraryExW,
+ (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,
+ (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 obligatory in recent Tcl releases.
+ * 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,
- (int (__cdecl*)(CONST TCHAR *, struct _utimbuf *)) _wutime,
+ /* deleted (int (__cdecl*)(CONST TCHAR *, struct _utimbuf *)) _wutime, */
NULL,
NULL,
/* getLongPathNameProc */
@@ -178,70 +191,70 @@ static TclWinProcs unicodeProcs = {
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 *)(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.
+/*
+ * 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));
-
+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);
+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
- * volume mount points and drive letters on the fly (no Win API exists
- * for this).
+ * volume mount points and drive letters on the fly (no Win API exists for
+ * this).
*/
+
typedef struct MountPointMap {
- CONST WCHAR* volumeName; /* Native wide string volume name */
- char driveLetter; /* Drive letter corresponding to
- * the volume name. */
- struct MountPointMap* nextPtr; /* Pointer to next structure in list,
- * or NULL */
+ CONST WCHAR *volumeName; /* Native wide string volume name. */
+ char driveLetter; /* Drive letter corresponding to the volume
+ * name. */
+ struct MountPointMap *nextPtr;
+ /* Pointer to next structure in list, or
+ * NULL. */
} MountPointMap;
-/*
- * This is the head of the linked list, which is protected by the
- * mutex which follows, for thread-enabled builds.
+/*
+ * This is the head of the linked list, which is protected by the mutex which
+ * follows, for thread-enabled builds.
*/
+
MountPointMap *driveLetterLookup = NULL;
TCL_DECLARE_MUTEX(mountPointMap)
-/* We will need this below */
+/*
+ * We will need this below.
+ */
+
extern Tcl_FSDupInternalRepProc TclNativeDupInternalRep;
#ifdef __WIN32__
#ifndef STATIC_BUILD
-
/*
*----------------------------------------------------------------------
*
* DllEntryPoint --
*
- * This wrapper function is used by Borland to invoke the
- * initialization code for Tcl. It simply calls the DllMain
- * routine.
+ * This wrapper function is used by Borland to invoke the initialization
+ * code for Tcl. It simply calls the DllMain routine.
*
* Results:
* See DllMain.
@@ -253,10 +266,10 @@ extern Tcl_FSDupInternalRepProc TclNativeDupInternalRep;
*/
BOOL APIENTRY
-DllEntryPoint(hInst, reason, reserved)
- HINSTANCE hInst; /* Library instance handle. */
- DWORD reason; /* Reason this function is being called. */
- LPVOID reserved; /* Not used. */
+DllEntryPoint(
+ HINSTANCE hInst, /* Library instance handle. */
+ DWORD reason, /* Reason this function is being called. */
+ LPVOID reserved) /* Not used. */
{
return DllMain(hInst, reason, reserved);
}
@@ -266,23 +279,27 @@ DllEntryPoint(hInst, reason, reserved)
*
* DllMain --
*
- * This routine is called by the VC++ C run time library init
- * code, or the DllEntryPoint routine. It is responsible for
- * initializing various dynamically loaded libraries.
+ * This routine is called by the VC++ C run time library init code, or
+ * the DllEntryPoint routine. It is responsible for initializing various
+ * dynamically loaded libraries.
*
* Results:
* TRUE on sucess, FALSE on failure.
*
* Side effects:
- * Establishes 32-to-16 bit thunk and initializes sockets library.
+ * 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."
*
*----------------------------------------------------------------------
*/
+
BOOL APIENTRY
-DllMain(hInst, reason, reserved)
- HINSTANCE hInst; /* Library instance handle. */
- DWORD reason; /* Reason this function is being called. */
- LPVOID reserved; /* Not used. */
+DllMain(
+ HINSTANCE hInst, /* Library instance handle. */
+ DWORD reason, /* Reason this function is being called. */
+ LPVOID reserved) /* Not used. */
{
#if defined(HAVE_NO_SEH) && !defined(_WIN64)
EXCEPTION_REGISTRATION registration;
@@ -407,7 +424,7 @@ DllMain(hInst, reason, reserved)
*/
HINSTANCE
-TclWinGetTclInstance()
+TclWinGetTclInstance(void)
{
return hInstance;
}
@@ -429,8 +446,8 @@ TclWinGetTclInstance()
*/
void
-TclWinInit(hInst)
- HINSTANCE hInst; /* Library instance handle. */
+TclWinInit(
+ HINSTANCE hInst) /* Library instance handle. */
{
OSVERSIONINFO os;
@@ -440,12 +457,12 @@ TclWinInit(hInst)
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, so just in case someone manages to get a
+ * runtime there, make sure they know that.
*/
if (platformId == VER_PLATFORM_WIN32s) {
- panic("Win32s is not a supported platform");
+ Tcl_Panic("Win32s is not a supported platform");
}
tclWinProcs = &asciiProcs;
@@ -456,14 +473,14 @@ TclWinInit(hInst)
*
* TclWinGetPlatformId --
*
- * Determines whether running under NT, 95, or Win32s, to allow
- * runtime conditional code.
+ * Determines whether running under NT, 95, or Win32s, to allow runtime
+ * conditional code.
*
* 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.
- * VER_PLATFORM_WIN32_NT Win32 on Windows NT
+ * VER_PLATFORM_WIN32_WINDOWS Win32 on Windows 95, 98, ME.
+ * VER_PLATFORM_WIN32_NT Win32 on Windows NT, 2000, XP
*
* Side effects:
* None.
@@ -471,8 +488,8 @@ TclWinInit(hInst)
*----------------------------------------------------------------------
*/
-int
-TclWinGetPlatformId()
+int
+TclWinGetPlatformId(void)
{
return platformId;
}
@@ -511,168 +528,93 @@ TclWinNoBackslash(
/*
*----------------------------------------------------------------------
*
- * TclpCheckStackSpace --
+ * TclpGetStackParams --
*
- * Detect if we are about to blow the stack. Called before an
- * evaluation can happen when nesting depth is checked.
+ * 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:
- * 1 if there is enough stack space to continue; 0 if not.
- *
- * Side effects:
- * None.
+ * 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
-TclpCheckStackSpace()
+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.
+ */
-#if defined(HAVE_NO_SEH) && !defined(__WIN64__)
- EXCEPTION_REGISTRATION registration;
-#endif
- int retval = 0;
-
- /*
- * We can recurse only if there is at least TCL_WIN_STACK_THRESHOLD
- * bytes of stack space left. alloca() is cheap on windows; basically
- * it just subtracts from the stack pointer causing the OS to throw an
- * exception if the stack pointer is set below the bottom of the stack.
- */
+ GetSystemInfo(&si);
+ if (VirtualQuery((LPCVOID) &tsdPtr, &mbi, sizeof(mbi)) == 0) {
-#ifdef HAVE_NO_SEH
-# ifdef __WIN64__
+ /* 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. */
- /* TODO: How to call allocal on Win64? */
- retval = 1;
+ if (!tsdPtr->stackBound) {
+ tsdPtr->stackBound =
+ (int*) ((UINT_PTR)(&tsdPtr)
+ & ~ (UINT_PTR)(si.dwPageSize - 1));
+ }
-# else
- __asm__ __volatile__ (
-
- /*
- * Construct an EXCEPTION_REGISTRATION to protect the
- * call to __alloca
- */
- "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"
-
- /*
- * Attempt a call to __alloca, to determine whether there's
- * sufficient memory to be had.
- */
-
- "movl %[size], %%eax" "\n\t"
- "pushl %%eax" "\n\t"
- "call __alloca" "\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\t"
-
- /*
- * 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),
- [size] "i" (TCL_WIN_STACK_THRESHOLD)
- :
- "%eax", "%ebx", "%ecx", "%edx", "%esi", "%edi", "memory"
- );
- retval = (registration.status == TCL_OK);
+ } else {
-# endif
-#else /* !HAVE_NO_SEH */
- __try {
-#ifdef HAVE_ALLOCA_GCC_INLINE
- __asm__ __volatile__ (
- "movl %0, %%eax" "\n\t"
- "call __alloca" "\n\t"
- :
- : "i"(TCL_WIN_STACK_THRESHOLD)
- : "%eax");
-#else
- alloca(TCL_WIN_STACK_THRESHOLD);
-#endif /* HAVE_ALLOCA_GCC_INLINE */
- retval = 1;
- } __except (EXCEPTION_EXECUTE_HANDLER) {}
-#endif /* HAVE_NO_SEH */
+ /* 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).
+ */
- return retval;
+ tsdPtr->stackBound =
+ (int*) ((UINT_PTR)(mbi.AllocationBase)
+ + (UINT_PTR)(si.dwPageSize)
+ + TCL_WIN_STACK_THRESHOLD);
+ }
+ }
+ *stackBoundPtr = tsdPtr->stackBound;
+ return 1;
}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclWinGetPlatform --
- *
- * This is a kludge that allows the test library to get access
- * the internal tclPlatform variable.
- *
- * Results:
- * Returns a pointer to the tclPlatform variable.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
+#endif
-TclPlatformType *
-TclWinGetPlatform()
-{
- return &tclPlatform;
-}
/*
*---------------------------------------------------------------------------
*
* TclWinSetInterfaces --
*
- * A helper proc that allows the test library to change the
- * tclWinProcs structure to dispatch to either the wide-character
- * or multi-byte versions of the operating system calls, depending
- * on whether Unicode is the system encoding.
- *
- * As well as this, we can also try to load in some additional
- * procs which may/may not be present depending on the current
- * Windows version (e.g. Win95 will not have the procs below).
+ * A helper proc that allows the test library to change the tclWinProcs
+ * structure to dispatch to either the wide-character or multi-byte
+ * versions of the operating system calls, depending on whether Unicode
+ * is the system encoding.
+ *
+ * As well as this, we can also try to load in some additional procs
+ * which may/may not be present depending on the current Windows version
+ * (e.g. Win95 will not have the procs below).
*
* Results:
* None.
@@ -696,21 +638,25 @@ TclWinSetInterfaces(
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->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");
@@ -750,22 +696,31 @@ TclWinSetInterfaces(
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 =
- (HANDLE (WINAPI *)(CONST TCHAR*, UINT,
- LPVOID, UINT, LPVOID, DWORD)) GetProcAddress(hInstance,
- "FindFirstFileExA");
+ 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;
- tclWinProcs->getVolumeNameForVMPProc =
- (BOOL (WINAPI *)(CONST TCHAR*, TCHAR*,
- DWORD)) GetProcAddress(hInstance,
- "GetVolumeNameForVolumeMountPointA");
+ /*
+ * 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);
}
}
@@ -777,15 +732,14 @@ TclWinSetInterfaces(
*
* TclWinResetInterfaceEncodings --
*
- * Called during finalization to free up any encodings we use.
- * The tclWinProcs-> look up table is still ok to use after
- * this call, provided no encoding conversion is required.
+ * Called during finalization to free up any encodings we use. The
+ * tclWinProcs-> look up table is still ok to use after this call,
+ * provided no encoding conversion is required.
+ *
+ * We also clean up any memory allocated in our mount point map which is
+ * used to follow certain kinds of symlinks. That code should never be
+ * used once encodings are taken down.
*
- * We also clean up any memory allocated in our mount point
- * map which is used to follow certain kinds of symlinks.
- * That code should never be used once encodings are taken
- * down.
- *
* Results:
* None.
*
@@ -794,17 +748,22 @@ TclWinSetInterfaces(
*
*---------------------------------------------------------------------------
*/
+
void
-TclWinResetInterfaceEncodings()
+TclWinResetInterfaceEncodings(void)
{
MountPointMap *dlIter, *dlIter2;
if (tclWinTCharEncoding != NULL) {
Tcl_FreeEncoding(tclWinTCharEncoding);
tclWinTCharEncoding = NULL;
}
- /* Clean up the mount point map */
+
+ /*
+ * Clean up the mount point map.
+ */
+
Tcl_MutexLock(&mountPointMap);
- dlIter = driveLetterLookup;
+ dlIter = driveLetterLookup;
while (dlIter != NULL) {
dlIter2 = dlIter->nextPtr;
ckfree((char*)dlIter->volumeName);
@@ -820,8 +779,8 @@ TclWinResetInterfaceEncodings()
* TclWinResetInterfaces --
*
* Called during finalization to reset us to a safe state for reuse.
- * After this call, it is best not to use the tclWinProcs-> look
- * up table since it is likely to be different to what is expected.
+ * After this call, it is best not to use the tclWinProcs-> look up table
+ * since it is likely to be different to what is expected.
*
* Results:
* None.
@@ -832,7 +791,7 @@ TclWinResetInterfaceEncodings()
*---------------------------------------------------------------------------
*/
void
-TclWinResetInterfaces()
+TclWinResetInterfaces(void)
{
tclWinProcs = &asciiProcs;
}
@@ -842,64 +801,76 @@ TclWinResetInterfaces()
*
* TclWinDriveLetterForVolMountPoint
*
- * Unfortunately, Windows provides no easy way at all to get hold
- * of the drive letter for a volume mount point, but we need that
- * information to understand paths correctly. So, we have to
- * build an associated array to find these correctly, and allow
- * quick and easy lookup from volume mount points to drive letters.
- *
- * We assume here that we are running on a system for which the wide
- * character interfaces are used, which is valid for Win 2000 and WinXP
- * which are the only systems on which this function will ever be called.
- *
- * Result: the drive letter, or -1 if no drive letter corresponds to
- * the given mount point.
- *
+ * Unfortunately, Windows provides no easy way at all to get hold of the
+ * drive letter for a volume mount point, but we need that information to
+ * understand paths correctly. So, we have to build an associated array
+ * to find these correctly, and allow quick and easy lookup from volume
+ * mount points to drive letters.
+ *
+ * We assume here that we are running on a system for which the wide
+ * character interfaces are used, which is valid for Win 2000 and WinXP
+ * which are the only systems on which this function will ever be called.
+ *
+ * Result:
+ * The drive letter, or -1 if no drive letter corresponds to the given
+ * mount point.
+ *
*--------------------------------------------------------------------
*/
-char
-TclWinDriveLetterForVolMountPoint(CONST WCHAR *mountPoint)
+
+char
+TclWinDriveLetterForVolMountPoint(
+ CONST WCHAR *mountPoint)
{
MountPointMap *dlIter, *dlPtr2;
- WCHAR Target[55]; /* Target of mount at mount point */
+ WCHAR Target[55]; /* Target of mount at mount point */
WCHAR drive[4] = { L'A', L':', L'\\', L'\0' };
-
- /*
- * Detect the volume mounted there. Unfortunately, there is no
- * simple way to map a unique volume name to a DOS drive letter.
- * So, we have to build an associative array.
+
+ /*
+ * Detect the volume mounted there. Unfortunately, there is no simple way
+ * to map a unique volume name to a DOS drive letter. So, we have to build
+ * an associative array.
*/
-
+
Tcl_MutexLock(&mountPointMap);
- dlIter = driveLetterLookup;
+ dlIter = driveLetterLookup;
while (dlIter != NULL) {
if (wcscmp(dlIter->volumeName, mountPoint) == 0) {
- /*
- * We need to check whether this information is
- * still valid, since either the user or various
- * programs could have adjusted the mount points on
- * the fly.
+ /*
+ * 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');
- /* Try to read the volume mount point and see where it points */
- if ((*tclWinProcs->getVolumeNameForVMPProc)((TCHAR*)drive,
- (TCHAR*)Target, 55) != 0) {
+
+ /*
+ * 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) {
- /* Nothing has changed */
+ /*
+ * Nothing has changed.
+ */
+
Tcl_MutexUnlock(&mountPointMap);
return dlIter->driveLetter;
}
}
- /*
- * If we reach here, unfortunately, this mount point is
- * no longer valid at all
+
+ /*
+ * If we reach here, unfortunately, this mount point is no longer
+ * valid at all.
*/
+
if (driveLetterLookup == dlIter) {
dlPtr2 = dlIter;
driveLetterLookup = dlIter->nextPtr;
} else {
- for (dlPtr2 = driveLetterLookup;
- dlPtr2 != NULL; dlPtr2 = dlPtr2->nextPtr) {
+ for (dlPtr2 = driveLetterLookup;
+ dlPtr2 != NULL; dlPtr2 = dlPtr2->nextPtr) {
if (dlPtr2->nextPtr == dlIter) {
dlPtr2->nextPtr = dlIter->nextPtr;
dlPtr2 = dlIter;
@@ -907,36 +878,48 @@ TclWinDriveLetterForVolMountPoint(CONST WCHAR *mountPoint)
}
}
}
- /* Now dlPtr2 points to the structure to free */
+
+ /*
+ * Now dlPtr2 points to the structure to free.
+ */
+
ckfree((char*)dlPtr2->volumeName);
ckfree((char*)dlPtr2);
- /*
- * Restart the loop --- we could try to be clever
- * and continue half way through, but the logic is a
- * bit messy, so it's cleanest just to restart
+
+ /*
+ * Restart the loop - we could try to be clever and continue half
+ * way through, but the logic is a bit messy, so it's cleanest
+ * just to restart.
*/
+
dlIter = driveLetterLookup;
continue;
}
dlIter = dlIter->nextPtr;
}
-
- /* We couldn't find it, so we must iterate over the letters */
-
+
+ /*
+ * We couldn't find it, so we must iterate over the letters.
+ */
+
for (drive[0] = L'A'; drive[0] <= L'Z'; drive[0]++) {
- /* Try to read the volume mount point and see where it points */
- if ((*tclWinProcs->getVolumeNameForVMPProc)((TCHAR*)drive,
- (TCHAR*)Target, 55) != 0) {
+ /*
+ * Try to read the volume mount point and see where it points.
+ */
+
+ if ((*tclWinProcs->getVolumeNameForVMPProc)((TCHAR*)drive,
+ (TCHAR*)Target, 55) != 0) {
int alreadyStored = 0;
- for (dlIter = driveLetterLookup; dlIter != NULL;
- dlIter = dlIter->nextPtr) {
+
+ for (dlIter = driveLetterLookup; dlIter != NULL;
+ dlIter = dlIter->nextPtr) {
if (wcscmp((WCHAR*)dlIter->volumeName, Target) == 0) {
alreadyStored = 1;
break;
}
}
if (!alreadyStored) {
- dlPtr2 = (MountPointMap*) ckalloc(sizeof(MountPointMap));
+ dlPtr2 = (MountPointMap *) ckalloc(sizeof(MountPointMap));
dlPtr2->volumeName = TclNativeDupInternalRep(Target);
dlPtr2->driveLetter = 'A' + (drive[0] - L'A');
dlPtr2->nextPtr = driveLetterLookup;
@@ -944,19 +927,24 @@ TclWinDriveLetterForVolMountPoint(CONST WCHAR *mountPoint)
}
}
}
- /* Try again */
- for (dlIter = driveLetterLookup; dlIter != NULL;
- dlIter = dlIter->nextPtr) {
+
+ /*
+ * Try again.
+ */
+
+ for (dlIter = driveLetterLookup; dlIter != NULL;
+ dlIter = dlIter->nextPtr) {
if (wcscmp(dlIter->volumeName, mountPoint) == 0) {
Tcl_MutexUnlock(&mountPointMap);
return dlIter->driveLetter;
}
}
- /*
- * The volume doesn't appear to correspond to a drive letter -- we
- * remember that fact and store '-1' so we don't have to look it
- * up each time.
+
+ /*
+ * The volume doesn't appear to correspond to a drive letter - we remember
+ * 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->driveLetter = -1;
@@ -971,26 +959,24 @@ TclWinDriveLetterForVolMountPoint(CONST WCHAR *mountPoint)
*
* Tcl_WinUtfToTChar, Tcl_WinTCharToUtf --
*
- * Convert between UTF-8 and Unicode when running Windows NT or
- * the current ANSI code page when running Windows 95.
+ * Convert between UTF-8 and Unicode when running Windows NT or the
+ * current ANSI code page when running Windows 95.
*
- * On Mac, Unix, and Windows 95, all strings exchanged between Tcl
- * and the OS are "char" oriented. We need only one Tcl_Encoding to
- * convert between UTF-8 and the system's native encoding. We use
- * NULL to represent that encoding.
+ * On Mac, Unix, and Windows 95, all strings exchanged between Tcl and
+ * the OS are "char" oriented. We need only one Tcl_Encoding to convert
+ * between UTF-8 and the system's native encoding. We use NULL to
+ * represent that encoding.
*
* On NT, some strings exchanged between Tcl and the OS are "char"
- * oriented, while others are in Unicode. We need two Tcl_Encoding
- * APIs depending on whether we are targeting a "char" or Unicode
- * interface.
- *
- * Calling Tcl_UtfToExternal() or Tcl_ExternalToUtf() with an
- * encoding of NULL should always used to convert between UTF-8
- * and the system's "char" oriented encoding. The following two
- * functions are used in Windows-specific code to convert between
- * UTF-8 and Unicode strings (NT) or "char" strings(95). This saves
- * you the trouble of writing the following type of fragment over and
- * over:
+ * oriented, while others are in Unicode. We need two Tcl_Encoding APIs
+ * depending on whether we are targeting a "char" or Unicode interface.
+ *
+ * Calling Tcl_UtfToExternal() or Tcl_ExternalToUtf() with an encoding of
+ * NULL should always used to convert between UTF-8 and the system's
+ * "char" oriented encoding. The following two functions are used in
+ * Windows-specific code to convert between UTF-8 and Unicode strings
+ * (NT) or "char" strings(95). This saves you the trouble of writing the
+ * following type of fragment over and over:
*
* if (running NT) {
* encoding <- Tcl_GetEncoding("unicode");
@@ -1000,19 +986,17 @@ TclWinDriveLetterForVolMountPoint(CONST WCHAR *mountPoint)
* nativeBuffer <- UtfToExternal(NULL, utfBuffer);
* }
*
- * By convention, in Windows a TCHAR is a character in the ANSI code
- * page on Windows 95, a Unicode character on Windows NT. If you
- * plan on targeting a Unicode interfaces when running on NT and a
- * "char" oriented interface while running on 95, these functions
- * should be used. If you plan on targetting the same "char"
- * oriented function on both 95 and NT, use Tcl_UtfToExternal()
- * with an encoding of NULL.
+ * By convention, in Windows a TCHAR is a character in the ANSI code page
+ * on Windows 95, a Unicode character on Windows NT. If you plan on
+ * targeting a Unicode interfaces when running on NT and a "char"
+ * oriented interface while running on 95, these functions should be
+ * used. If you plan on targetting the same "char" oriented function on
+ * both 95 and NT, use Tcl_UtfToExternal() with an encoding of NULL.
*
* Results:
- * The result is a pointer to the string in the desired target
- * encoding. Storage for the result string is allocated in
- * dsPtr; the caller must call Tcl_DStringFree() when the result
- * is no longer needed.
+ * The result is a pointer to the string in the desired target encoding.
+ * Storage for the result string is allocated in dsPtr; the caller must
+ * call Tcl_DStringFree() when the result is no longer needed.
*
* Side effects:
* None.
@@ -1021,27 +1005,27 @@ TclWinDriveLetterForVolMountPoint(CONST WCHAR *mountPoint)
*/
TCHAR *
-Tcl_WinUtfToTChar(string, len, dsPtr)
- CONST char *string; /* Source string in UTF-8. */
- int len; /* Source string length in bytes, or < 0 for
+Tcl_WinUtfToTChar(
+ 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. */
+ Tcl_DString *dsPtr) /* Uninitialized or free DString in which the
+ * converted string is stored. */
{
- return (TCHAR *) Tcl_UtfToExternalDString(tclWinTCharEncoding,
+ return (TCHAR *) Tcl_UtfToExternalDString(tclWinTCharEncoding,
string, len, dsPtr);
}
char *
-Tcl_WinTCharToUtf(string, len, dsPtr)
- CONST TCHAR *string; /* Source string in Unicode when running
- * NT, ANSI when running 95. */
- int len; /* Source string length in bytes, or < 0 for
+Tcl_WinTCharToUtf(
+ 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. */
+ Tcl_DString *dsPtr) /* Uninitialized or free DString in which the
+ * converted string is stored. */
{
- return Tcl_ExternalToUtfDString(tclWinTCharEncoding,
+ return Tcl_ExternalToUtfDString(tclWinTCharEncoding,
(CONST char *) string, len, dsPtr);
}
diff --git a/win/tclWinChan.c b/win/tclWinChan.c
index 98de3b0..0f17834 100644
--- a/win/tclWinChan.c
+++ b/win/tclWinChan.c
@@ -1,13 +1,13 @@
-/*
+/*
* tclWinChan.c
*
- * Channel drivers for Windows channels based on files, command
- * pipes and TCP sockets.
+ * Channel drivers for Windows channels based on files, command pipes and
+ * TCP sockets.
*
* Copyright (c) 1995-1997 Sun Microsystems, Inc.
*
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#include "tclWinInt.h"
@@ -39,8 +39,8 @@ typedef struct FileInfo {
int flags; /* State flags, see above for a list. */
HANDLE handle; /* Input/output file. */
struct FileInfo *nextPtr; /* Pointer to next registered file. */
- int dirty; /* Boolean flag. Set if the OS may have data
- * pending on the channel */
+ int dirty; /* Boolean flag. Set if the OS may have data
+ * pending on the channel. */
} FileInfo;
typedef struct ThreadSpecificData {
@@ -54,16 +54,16 @@ typedef struct ThreadSpecificData {
static Tcl_ThreadDataKey dataKey;
/*
- * The following structure is what is added to the Tcl event queue when
- * file events are generated.
+ * The following structure is what is added to the Tcl event queue when file
+ * events are generated.
*/
typedef struct FileEvent {
- Tcl_Event header; /* Information that is standard for
- * all events. */
- FileInfo *infoPtr; /* Pointer to file info structure. Note
- * that we still have to verify that the
- * file exists before dereferencing this
+ Tcl_Event header; /* Information that is standard for all
+ * events. */
+ FileInfo *infoPtr; /* Pointer to file info structure. Note that
+ * we still have to verify that the file
+ * exists before dereferencing this
* pointer. */
} FileEvent;
@@ -71,34 +71,30 @@ typedef struct FileEvent {
* Static routines for this file:
*/
-static int FileBlockProc _ANSI_ARGS_((ClientData instanceData,
- int mode));
-static void FileChannelExitHandler _ANSI_ARGS_((
- ClientData clientData));
-static void FileCheckProc _ANSI_ARGS_((ClientData clientData,
- int flags));
-static int FileCloseProc _ANSI_ARGS_((ClientData instanceData,
- Tcl_Interp *interp));
-static int FileEventProc _ANSI_ARGS_((Tcl_Event *evPtr,
- int flags));
-static int FileGetHandleProc _ANSI_ARGS_((ClientData instanceData,
- int direction, ClientData *handlePtr));
-static ThreadSpecificData *FileInit _ANSI_ARGS_((void));
-static int FileInputProc _ANSI_ARGS_((ClientData instanceData,
- char *buf, int toRead, int *errorCode));
-static int FileOutputProc _ANSI_ARGS_((ClientData instanceData,
- CONST char *buf, int toWrite, int *errorCode));
-static int FileSeekProc _ANSI_ARGS_((ClientData instanceData,
- long offset, int mode, int *errorCode));
-static Tcl_WideInt FileWideSeekProc _ANSI_ARGS_((ClientData instanceData,
- Tcl_WideInt offset, int mode, int *errorCode));
-static void FileSetupProc _ANSI_ARGS_((ClientData clientData,
- int flags));
-static void FileWatchProc _ANSI_ARGS_((ClientData instanceData,
- int mask));
-static void FileThreadActionProc _ANSI_ARGS_ ((
- ClientData instanceData, int action));
-static DWORD FileGetType _ANSI_ARGS_((HANDLE handle));
+static int FileBlockProc(ClientData instanceData, int mode);
+static void FileChannelExitHandler(ClientData clientData);
+static void FileCheckProc(ClientData clientData, int flags);
+static int FileCloseProc(ClientData instanceData,
+ Tcl_Interp *interp);
+static int FileEventProc(Tcl_Event *evPtr, int flags);
+static int FileGetHandleProc(ClientData instanceData,
+ int direction, ClientData *handlePtr);
+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);
+static int FileSeekProc(ClientData instanceData, long offset,
+ int mode, int *errorCode);
+static Tcl_WideInt FileWideSeekProc(ClientData instanceData,
+ Tcl_WideInt offset, int mode, int *errorCode);
+static void FileSetupProc(ClientData clientData, int flags);
+static void FileWatchProc(ClientData instanceData, int mask);
+static void FileThreadActionProc(ClientData instanceData,
+ int action);
+static int FileTruncateProc(ClientData instanceData,
+ Tcl_WideInt length);
+static DWORD FileGetType(HANDLE handle);
/*
* This structure describes the channel type structure for file based IO.
@@ -106,7 +102,7 @@ static DWORD FileGetType _ANSI_ARGS_((HANDLE handle));
static Tcl_ChannelType fileChannelType = {
"file", /* Type name. */
- TCL_CHANNEL_VERSION_4, /* v4 channel */
+ TCL_CHANNEL_VERSION_5, /* v5 channel */
FileCloseProc, /* Close proc. */
FileInputProc, /* Input proc. */
FileOutputProc, /* Output proc. */
@@ -121,26 +117,24 @@ static Tcl_ChannelType fileChannelType = {
NULL, /* handler proc. */
FileWideSeekProc, /* Wide seek proc. */
FileThreadActionProc, /* Thread action proc. */
+ FileTruncateProc, /* Truncate proc. */
};
#ifdef HAVE_NO_SEH
-
/*
- * Unlike Borland and Microsoft, we don't register exception handlers
- * by pushing registration records onto the runtime stack. Instead, we
- * register them by creating an EXCEPTION_REGISTRATION within the activation
- * record.
+ * Unlike Borland and Microsoft, we don't register exception handlers by
+ * pushing registration records onto the runtime stack. Instead, we register
+ * them by creating an EXCEPTION_REGISTRATION within the activation record.
*/
typedef struct EXCEPTION_REGISTRATION {
struct EXCEPTION_REGISTRATION* link;
- EXCEPTION_DISPOSITION (*handler)( struct _EXCEPTION_RECORD*, void*,
- struct _CONTEXT*, void* );
+ EXCEPTION_DISPOSITION (*handler)(
+ struct _EXCEPTION_RECORD*, void*, struct _CONTEXT*, void*);
void* ebp;
void* esp;
int status;
} EXCEPTION_REGISTRATION;
-
#endif
/*
@@ -154,16 +148,17 @@ typedef struct EXCEPTION_REGISTRATION {
* None.
*
* Side effects:
- * Creates a new window and creates an exit handler.
+ * Creates a new window and creates an exit handler.
*
*----------------------------------------------------------------------
*/
static ThreadSpecificData *
-FileInit()
+FileInit(void)
{
ThreadSpecificData *tsdPtr =
- (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
+ (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
+
if (tsdPtr == NULL) {
tsdPtr = TCL_TSD_INIT(&dataKey);
tsdPtr->firstFilePtr = NULL;
@@ -178,8 +173,8 @@ FileInit()
*
* FileChannelExitHandler --
*
- * This function is called to cleanup the channel driver before
- * Tcl is unloaded.
+ * This function is called to cleanup the channel driver before Tcl is
+ * unloaded.
*
* Results:
* None.
@@ -191,8 +186,8 @@ FileInit()
*/
static void
-FileChannelExitHandler(clientData)
- ClientData clientData; /* Old window proc */
+FileChannelExitHandler(
+ ClientData clientData) /* Old window proc */
{
Tcl_DeleteEventSource(FileSetupProc, FileCheckProc, NULL);
}
@@ -202,8 +197,8 @@ FileChannelExitHandler(clientData)
*
* FileSetupProc --
*
- * This procedure is invoked before Tcl_DoOneEvent blocks waiting
- * for an event.
+ * This function is invoked before Tcl_DoOneEvent blocks waiting for an
+ * event.
*
* Results:
* None.
@@ -215,9 +210,9 @@ FileChannelExitHandler(clientData)
*/
void
-FileSetupProc(data, flags)
- ClientData data; /* Not used. */
- int flags; /* Event flags as passed to Tcl_DoOneEvent. */
+FileSetupProc(
+ ClientData data, /* Not used. */
+ int flags) /* Event flags as passed to Tcl_DoOneEvent. */
{
FileInfo *infoPtr;
Tcl_Time blockTime = { 0, 0 };
@@ -226,12 +221,12 @@ FileSetupProc(data, flags)
if (!(flags & TCL_FILE_EVENTS)) {
return;
}
-
+
/*
- * Check to see if there is a ready file. If so, poll.
+ * Check to see if there is a ready file. If so, poll.
*/
- for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL;
+ for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL;
infoPtr = infoPtr->nextPtr) {
if (infoPtr->watchMask) {
Tcl_SetMaxBlockTime(&blockTime);
@@ -245,8 +240,8 @@ FileSetupProc(data, flags)
*
* FileCheckProc --
*
- * This procedure is called by Tcl_DoOneEvent to check the file
- * event source for events.
+ * This function is called by Tcl_DoOneEvent to check the file event
+ * source for events.
*
* Results:
* None.
@@ -258,9 +253,9 @@ FileSetupProc(data, flags)
*/
static void
-FileCheckProc(data, flags)
- ClientData data; /* Not used. */
- int flags; /* Event flags as passed to Tcl_DoOneEvent. */
+FileCheckProc(
+ ClientData data, /* Not used. */
+ int flags) /* Event flags as passed to Tcl_DoOneEvent. */
{
FileEvent *evPtr;
FileInfo *infoPtr;
@@ -269,14 +264,13 @@ FileCheckProc(data, flags)
if (!(flags & TCL_FILE_EVENTS)) {
return;
}
-
+
/*
- * Queue events for any ready files that don't already have events
- * queued (caused by persistent states that won't generate WinSock
- * events).
+ * Queue events for any ready files that don't already have events queued
+ * (caused by persistent states that won't generate WinSock events).
*/
- for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL;
+ for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL;
infoPtr = infoPtr->nextPtr) {
if (infoPtr->watchMask && !(infoPtr->flags & FILE_PENDING)) {
infoPtr->flags |= FILE_PENDING;
@@ -288,19 +282,20 @@ FileCheckProc(data, flags)
}
}
-/*----------------------------------------------------------------------
+/*
+ *----------------------------------------------------------------------
*
* FileEventProc --
*
- * This function is invoked by Tcl_ServiceEvent when a file event
- * reaches the front of the event queue. This procedure invokes
- * Tcl_NotifyChannel on the file.
+ * This function is invoked by Tcl_ServiceEvent when a file event reaches
+ * the front of the event queue. This function invokes Tcl_NotifyChannel
+ * on the file.
*
* Results:
- * Returns 1 if the event was handled, meaning it should be removed
- * from the queue. Returns 0 if the event was not handled, meaning
- * it should stay on the queue. The only time the event isn't
- * handled is if the TCL_FILE_EVENTS flag bit isn't set.
+ * Returns 1 if the event was handled, meaning it should be removed from
+ * the queue. Returns 0 if the event was not handled, meaning it should
+ * stay on the queue. The only time the event isn't handled is if the
+ * TCL_FILE_EVENTS flag bit isn't set.
*
* Side effects:
* Whatever the notifier callback does.
@@ -309,10 +304,10 @@ FileCheckProc(data, flags)
*/
static int
-FileEventProc(evPtr, flags)
- Tcl_Event *evPtr; /* Event to service. */
- int flags; /* Flags that indicate what events to
- * handle, such as TCL_FILE_EVENTS. */
+FileEventProc(
+ Tcl_Event *evPtr, /* Event to service. */
+ int flags) /* Flags that indicate what events to handle,
+ * such as TCL_FILE_EVENTS. */
{
FileEvent *fileEvPtr = (FileEvent *)evPtr;
FileInfo *infoPtr;
@@ -324,9 +319,9 @@ FileEventProc(evPtr, flags)
/*
* Search through the list of watched files for the one whose handle
- * matches the event. We do this rather than simply dereferencing
- * the handle in the event so that files can be deleted while the
- * event is in the queue.
+ * matches the event. We do this rather than simply dereferencing the
+ * handle in the event so that files can be deleted while the event is in
+ * the queue.
*/
for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL;
@@ -357,13 +352,13 @@ FileEventProc(evPtr, flags)
*/
static int
-FileBlockProc(instanceData, mode)
- ClientData instanceData; /* Instance data for channel. */
- int mode; /* TCL_MODE_BLOCKING or
- * TCL_MODE_NONBLOCKING. */
+FileBlockProc(
+ ClientData instanceData, /* Instance data for channel. */
+ int mode) /* TCL_MODE_BLOCKING or
+ * TCL_MODE_NONBLOCKING. */
{
FileInfo *infoPtr = (FileInfo *) instanceData;
-
+
/*
* Files on Windows can not be switched between blocking and nonblocking,
* hence we have to emulate the behavior. This is done in the input
@@ -396,9 +391,9 @@ FileBlockProc(instanceData, mode)
*/
static int
-FileCloseProc(instanceData, interp)
- ClientData instanceData; /* Pointer to FileInfo structure. */
- Tcl_Interp *interp; /* Not used. */
+FileCloseProc(
+ ClientData instanceData, /* Pointer to FileInfo structure. */
+ Tcl_Interp *interp) /* Not used. */
{
FileInfo *fileInfoPtr = (FileInfo *) instanceData;
FileInfo *infoPtr;
@@ -412,15 +407,15 @@ FileCloseProc(instanceData, interp)
FileWatchProc(instanceData, 0);
/*
- * 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 another.
+ * 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
+ * another.
*/
- if (!TclInThreadExit()
+ if (!TclInThreadExit()
|| ((GetStdHandle(STD_INPUT_HANDLE) != fileInfoPtr->handle)
- && (GetStdHandle(STD_OUTPUT_HANDLE) != fileInfoPtr->handle)
- && (GetStdHandle(STD_ERROR_HANDLE) != fileInfoPtr->handle))) {
+ && (GetStdHandle(STD_OUTPUT_HANDLE) != fileInfoPtr->handle)
+ && (GetStdHandle(STD_ERROR_HANDLE) != fileInfoPtr->handle))) {
if (CloseHandle(fileInfoPtr->handle) == FALSE) {
TclWinConvertError(GetLastError());
errorCode = errno;
@@ -430,19 +425,21 @@ FileCloseProc(instanceData, interp)
/*
* See if this FileInfo* is still on the thread local list.
*/
+
tsdPtr = TCL_TSD_INIT(&dataKey);
- for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL;
+ for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL;
infoPtr = infoPtr->nextPtr) {
if (infoPtr == fileInfoPtr) {
- /*
- * This channel exists on the thread local list. It should
- * have been removed by an earlier Thread Action call,
- * but do that now since just deallocating fileInfoPtr would
- * leave an deallocated pointer on the thread local list.
- */
+ /*
+ * This channel exists on the thread local list. It should have
+ * been removed by an earlier Threadaction call, but do that now
+ * since just deallocating fileInfoPtr would leave an deallocated
+ * pointer on the thread local list.
+ */
+
FileThreadActionProc(fileInfoPtr,TCL_CHANNEL_THREAD_REMOVE);
- break;
- }
+ break;
+ }
}
ckfree((char *)fileInfoPtr);
return errorCode;
@@ -456,44 +453,45 @@ FileCloseProc(instanceData, interp)
* Seeks on a file-based channel. Returns the new position.
*
* Results:
- * -1 if failed, the new position if successful. If failed, it
- * also sets *errorCodePtr to the error code.
+ * -1 if failed, the new position if successful. If failed, it also sets
+ * *errorCodePtr to the error code.
*
* Side effects:
- * Moves the location at which the channel will be accessed in
- * future operations.
+ * Moves the location at which the channel will be accessed in future
+ * operations.
*
*----------------------------------------------------------------------
*/
static int
-FileSeekProc(instanceData, offset, mode, errorCodePtr)
- ClientData instanceData; /* File state. */
- long offset; /* Offset to seek to. */
- int mode; /* Relative to where should we seek? */
- int *errorCodePtr; /* To store error code. */
+FileSeekProc(
+ ClientData instanceData, /* File state. */
+ long offset, /* Offset to seek to. */
+ int mode, /* Relative to where should we seek? */
+ int *errorCodePtr) /* To store error code. */
{
FileInfo *infoPtr = (FileInfo *) instanceData;
- DWORD moveMethod, newPos, oldPos;
- LONG newPosHigh, oldPosHigh;
+ LONG newPos, newPosHigh, oldPos, oldPosHigh;
+ DWORD moveMethod;
*errorCodePtr = 0;
if (mode == SEEK_SET) {
- moveMethod = FILE_BEGIN;
+ moveMethod = FILE_BEGIN;
} else if (mode == SEEK_CUR) {
- moveMethod = FILE_CURRENT;
+ moveMethod = FILE_CURRENT;
} else {
- moveMethod = FILE_END;
+ moveMethod = FILE_END;
}
/*
* Save our current place in case we need to roll-back the seek.
*/
- oldPosHigh = (LONG)0;
- oldPos = SetFilePointer(infoPtr->handle, (LONG)0, &oldPosHigh,
- FILE_CURRENT);
- if (oldPos == INVALID_SET_FILE_POINTER) {
+
+ oldPosHigh = 0;
+ oldPos = SetFilePointer(infoPtr->handle, 0, &oldPosHigh, FILE_CURRENT);
+ if (oldPos == (LONG)INVALID_SET_FILE_POINTER) {
DWORD winError = GetLastError();
+
if (winError != NO_ERROR) {
TclWinConvertError(winError);
*errorCodePtr = errno;
@@ -501,11 +499,11 @@ FileSeekProc(instanceData, offset, mode, errorCodePtr)
}
}
- newPosHigh = (LONG)(offset < 0 ? -1 : 0);
- newPos = SetFilePointer(infoPtr->handle, (LONG) offset, &newPosHigh,
- moveMethod);
- if (newPos == INVALID_SET_FILE_POINTER) {
+ newPosHigh = (offset < 0 ? -1 : 0);
+ newPos = SetFilePointer(infoPtr->handle, offset, &newPosHigh, moveMethod);
+ if (newPos == (LONG)INVALID_SET_FILE_POINTER) {
DWORD winError = GetLastError();
+
if (winError != NO_ERROR) {
TclWinConvertError(winError);
*errorCodePtr = errno;
@@ -516,9 +514,10 @@ FileSeekProc(instanceData, offset, mode, errorCodePtr)
/*
* Check for expressability in our return type, and roll-back otherwise.
*/
+
if (newPosHigh != 0) {
*errorCodePtr = EOVERFLOW;
- SetFilePointer(infoPtr->handle, (LONG)oldPos, &oldPosHigh, FILE_BEGIN);
+ SetFilePointer(infoPtr->handle, oldPos, &oldPosHigh, FILE_BEGIN);
return -1;
}
return (int) newPos;
@@ -532,41 +531,42 @@ FileSeekProc(instanceData, offset, mode, errorCodePtr)
* Seeks on a file-based channel. Returns the new position.
*
* Results:
- * -1 if failed, the new position if successful. If failed, it
- * also sets *errorCodePtr to the error code.
+ * -1 if failed, the new position if successful. If failed, it also sets
+ * *errorCodePtr to the error code.
*
* Side effects:
- * Moves the location at which the channel will be accessed in
- * future operations.
+ * Moves the location at which the channel will be accessed in future
+ * operations.
*
*----------------------------------------------------------------------
*/
static Tcl_WideInt
-FileWideSeekProc(instanceData, offset, mode, errorCodePtr)
- ClientData instanceData; /* File state. */
- Tcl_WideInt offset; /* Offset to seek to. */
- int mode; /* Relative to where should we seek? */
- int *errorCodePtr; /* To store error code. */
+FileWideSeekProc(
+ ClientData instanceData, /* File state. */
+ Tcl_WideInt offset, /* Offset to seek to. */
+ int mode, /* Relative to where should we seek? */
+ int *errorCodePtr) /* To store error code. */
{
FileInfo *infoPtr = (FileInfo *) instanceData;
- DWORD moveMethod, newPos;
- LONG newPosHigh;
+ DWORD moveMethod;
+ LONG newPos, newPosHigh;
*errorCodePtr = 0;
if (mode == SEEK_SET) {
- moveMethod = FILE_BEGIN;
+ moveMethod = FILE_BEGIN;
} else if (mode == SEEK_CUR) {
- moveMethod = FILE_CURRENT;
+ moveMethod = FILE_CURRENT;
} else {
- moveMethod = FILE_END;
+ moveMethod = FILE_END;
}
- newPosHigh = (DWORD)(offset >> 32);
- newPos = SetFilePointer(infoPtr->handle, (LONG) offset, &newPosHigh,
- moveMethod);
- if (newPos == INVALID_SET_FILE_POINTER) {
+ newPosHigh = Tcl_WideAsLong(offset >> 32);
+ newPos = SetFilePointer(infoPtr->handle, Tcl_WideAsLong(offset),
+ &newPosHigh, moveMethod);
+ if (newPos == (LONG)INVALID_SET_FILE_POINTER) {
DWORD winError = GetLastError();
+
if (winError != NO_ERROR) {
TclWinConvertError(winError);
*errorCodePtr = errno;
@@ -579,10 +579,82 @@ FileWideSeekProc(instanceData, offset, mode, errorCodePtr)
/*
*----------------------------------------------------------------------
*
+ * FileTruncateProc --
+ *
+ * Truncates a file-based channel. Returns the error code.
+ *
+ * Results:
+ * 0 if successful, POSIX-y error code if it failed.
+ *
+ * Side effects:
+ * Truncates the file, may move file pointers too.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+FileTruncateProc(
+ ClientData instanceData, /* File state. */
+ Tcl_WideInt length) /* Length to truncate at. */
+{
+ FileInfo *infoPtr = (FileInfo *) instanceData;
+ LONG newPos, newPosHigh, oldPos, oldPosHigh;
+
+ /*
+ * Save where we were...
+ */
+
+ oldPosHigh = 0;
+ oldPos = SetFilePointer(infoPtr->handle, 0, &oldPosHigh, FILE_CURRENT);
+ if (oldPos == (LONG)INVALID_SET_FILE_POINTER) {
+ DWORD winError = GetLastError();
+ if (winError != NO_ERROR) {
+ TclWinConvertError(winError);
+ return errno;
+ }
+ }
+
+ /*
+ * Move to where we want to truncate
+ */
+
+ newPosHigh = Tcl_WideAsLong(length >> 32);
+ newPos = SetFilePointer(infoPtr->handle, Tcl_WideAsLong(length),
+ &newPosHigh, FILE_BEGIN);
+ if (newPos == (LONG)INVALID_SET_FILE_POINTER) {
+ DWORD winError = GetLastError();
+ if (winError != NO_ERROR) {
+ TclWinConvertError(winError);
+ return errno;
+ }
+ }
+
+ /*
+ * Perform the truncation (unlike POSIX ftruncate(), we needed to move to
+ * the location to truncate at first).
+ */
+
+ if (!SetEndOfFile(infoPtr->handle)) {
+ TclWinConvertError(GetLastError());
+ return errno;
+ }
+
+ /*
+ * Move back. If this last step fails, we don't care; it's just a "best
+ * effort" attempt to restore our file pointer to where it was.
+ */
+
+ SetFilePointer(infoPtr->handle, oldPos, &oldPosHigh, FILE_BEGIN);
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* FileInputProc --
*
- * Reads input from the IO channel into the buffer given. Returns
- * count of how many bytes were actually read, and an error indication.
+ * Reads input from the IO channel into the buffer given. Returns count
+ * of how many bytes were actually read, and an error indication.
*
* Results:
* A count of how many bytes were read is returned and an error
@@ -595,12 +667,11 @@ FileWideSeekProc(instanceData, offset, mode, errorCodePtr)
*/
static int
-FileInputProc(instanceData, buf, bufSize, errorCode)
- ClientData instanceData; /* File state. */
- char *buf; /* Where to store data read. */
- int bufSize; /* How much space is available
- * in the buffer? */
- int *errorCode; /* Where to store error code. */
+FileInputProc(
+ ClientData instanceData, /* File state. */
+ char *buf, /* Where to store data read. */
+ int bufSize, /* Num bytes available in buffer. */
+ int *errorCode) /* Where to store error code. */
{
FileInfo *infoPtr;
DWORD bytesRead;
@@ -609,18 +680,18 @@ FileInputProc(instanceData, buf, bufSize, errorCode)
infoPtr = (FileInfo *) instanceData;
/*
- * Note that we will block on reads from a console buffer until a
- * full line has been entered. The only way I know of to get
- * around this is to write a console driver. We should probably
- * do this at some point, but for now, we just block. The same
- * problem exists for files being read over the network.
+ * Note that we will block on reads from a console buffer until a full
+ * line has been entered. The only way I know of to get around this is to
+ * write a console driver. We should probably do this at some point, but
+ * for now, we just block. The same problem exists for files being read
+ * over the network.
*/
if (ReadFile(infoPtr->handle, (LPVOID) buf, (DWORD) bufSize, &bytesRead,
- (LPOVERLAPPED) NULL) != FALSE) {
+ (LPOVERLAPPED) NULL) != FALSE) {
return bytesRead;
}
-
+
TclWinConvertError(GetLastError());
*errorCode = errno;
if (errno == EPIPE) {
@@ -634,12 +705,12 @@ FileInputProc(instanceData, buf, bufSize, errorCode)
*
* FileOutputProc --
*
- * Writes the given output on the IO channel. Returns count of how
- * many characters were actually written, and an error indication.
+ * Writes the given output on the IO channel. Returns count of how many
+ * characters were actually written, and an error indication.
*
* Results:
- * A count of how many characters were written is returned and an
- * error indication is returned in an output argument.
+ * A count of how many characters were written is returned and an error
+ * indication is returned in an output argument.
*
* Side effects:
* Writes output on the actual channel.
@@ -648,15 +719,15 @@ FileInputProc(instanceData, buf, bufSize, errorCode)
*/
static int
-FileOutputProc(instanceData, buf, toWrite, errorCode)
- ClientData instanceData; /* File state. */
- CONST char *buf; /* The data buffer. */
- int toWrite; /* How many bytes to write? */
- int *errorCode; /* Where to store error code. */
+FileOutputProc(
+ ClientData instanceData, /* File state. */
+ CONST char *buf, /* The data buffer. */
+ int toWrite, /* How many bytes to write? */
+ int *errorCode) /* Where to store error code. */
{
FileInfo *infoPtr = (FileInfo *) instanceData;
DWORD bytesWritten;
-
+
*errorCode = 0;
/*
@@ -665,14 +736,14 @@ FileOutputProc(instanceData, buf, toWrite, errorCode)
*/
if (infoPtr->flags & FILE_APPEND) {
- SetFilePointer(infoPtr->handle, 0, NULL, FILE_END);
+ SetFilePointer(infoPtr->handle, 0, NULL, FILE_END);
}
- if (WriteFile(infoPtr->handle, (LPVOID) buf, (DWORD) toWrite, &bytesWritten,
- (LPOVERLAPPED) NULL) == FALSE) {
- TclWinConvertError(GetLastError());
- *errorCode = errno;
- return -1;
+ if (WriteFile(infoPtr->handle, (LPVOID) buf, (DWORD) toWrite,
+ &bytesWritten, (LPOVERLAPPED) NULL) == FALSE) {
+ TclWinConvertError(GetLastError());
+ *errorCode = errno;
+ return -1;
}
infoPtr->dirty = 1;
return bytesWritten;
@@ -683,8 +754,7 @@ FileOutputProc(instanceData, buf, toWrite, errorCode)
*
* FileWatchProc --
*
- * Called by the notifier to set up to watch for events on this
- * channel.
+ * Called by the notifier to set up to watch for events on this channel.
*
* Results:
* None.
@@ -696,18 +766,18 @@ FileOutputProc(instanceData, buf, toWrite, errorCode)
*/
static void
-FileWatchProc(instanceData, mask)
- ClientData instanceData; /* File state. */
- int mask; /* What events to watch for; OR-ed
- * combination of TCL_READABLE,
- * TCL_WRITABLE and TCL_EXCEPTION. */
+FileWatchProc(
+ ClientData instanceData, /* File state. */
+ int mask) /* What events to watch for; OR-ed combination
+ * of TCL_READABLE, TCL_WRITABLE and
+ * TCL_EXCEPTION. */
{
FileInfo *infoPtr = (FileInfo *) instanceData;
Tcl_Time blockTime = { 0, 0 };
/*
- * Since the file is always ready for events, we set the block time
- * to zero so we will poll.
+ * Since the file is always ready for events, we set the block time to
+ * zero so we will poll.
*/
infoPtr->watchMask = mask & infoPtr->validMask;
@@ -721,12 +791,12 @@ FileWatchProc(instanceData, mask)
*
* FileGetHandleProc --
*
- * Called from Tcl_GetChannelHandle to retrieve OS handles from
- * a file based channel.
+ * Called from Tcl_GetChannelHandle to retrieve OS handles from a file
+ * based channel.
*
* Results:
- * Returns TCL_OK with the fd in handlePtr, or TCL_ERROR if
- * there is no handle for the specified direction.
+ * Returns TCL_OK with the fd in handlePtr, or TCL_ERROR if there is no
+ * handle for the specified direction.
*
* Side effects:
* None.
@@ -735,10 +805,10 @@ FileWatchProc(instanceData, mask)
*/
static int
-FileGetHandleProc(instanceData, direction, handlePtr)
- ClientData instanceData; /* The file state. */
- int direction; /* TCL_READABLE or TCL_WRITABLE */
- ClientData *handlePtr; /* Where to store the handle. */
+FileGetHandleProc(
+ ClientData instanceData, /* The file state. */
+ int direction, /* TCL_READABLE or TCL_WRITABLE */
+ ClientData *handlePtr) /* Where to store the handle. */
{
FileInfo *infoPtr = (FileInfo *) instanceData;
@@ -749,7 +819,6 @@ FileGetHandleProc(instanceData, direction, handlePtr)
return TCL_ERROR;
}
}
-
/*
*----------------------------------------------------------------------
@@ -759,25 +828,24 @@ FileGetHandleProc(instanceData, direction, handlePtr)
* Open an File based channel on Unix systems.
*
* Results:
- * The new channel or NULL. If NULL, the output argument
- * errorCodePtr is set to a POSIX error.
+ * The new channel or NULL. If NULL, the output argument errorCodePtr is
+ * set to a POSIX error.
*
* Side effects:
- * May open the channel and may cause creation of a file on the
- * file system.
+ * May open the channel and may cause creation of a file on the file
+ * system.
*
*----------------------------------------------------------------------
*/
Tcl_Channel
-TclpOpenFileChannel(interp, pathPtr, mode, permissions)
- Tcl_Interp *interp; /* Interpreter for error reporting;
- * can be NULL. */
- Tcl_Obj *pathPtr; /* Name of file to open. */
- int mode; /* POSIX mode. */
- int permissions; /* If the open involves creating a
- * file, with what modes to create
- * it? */
+TclpOpenFileChannel(
+ Tcl_Interp *interp, /* Interpreter for error reporting; can be
+ * NULL. */
+ Tcl_Obj *pathPtr, /* Name of file to open. */
+ int mode, /* POSIX mode. */
+ int permissions) /* If the open involves creating a file, with
+ * what modes to create it? */
{
Tcl_Channel channel = 0;
int channelPermissions = 0;
@@ -785,30 +853,29 @@ TclpOpenFileChannel(interp, pathPtr, mode, permissions)
CONST TCHAR *nativeName;
HANDLE handle;
char channelName[16 + TCL_INTEGER_SPACE];
- TclFile readFile = NULL;
- TclFile writeFile = NULL;
+ TclFile readFile = NULL, writeFile = NULL;
nativeName = (TCHAR*) Tcl_FSGetNativePath(pathPtr);
if (nativeName == NULL) {
return NULL;
}
-
+
switch (mode & (O_RDONLY | O_WRONLY | O_RDWR)) {
- case O_RDONLY:
- accessMode = GENERIC_READ;
- channelPermissions = TCL_READABLE;
- break;
- case O_WRONLY:
- accessMode = GENERIC_WRITE;
- channelPermissions = TCL_WRITABLE;
- break;
- case O_RDWR:
- accessMode = (GENERIC_READ | GENERIC_WRITE);
- channelPermissions = (TCL_READABLE | TCL_WRITABLE);
- break;
- default:
- panic("TclpOpenFileChannel: invalid mode value");
- break;
+ case O_RDONLY:
+ accessMode = GENERIC_READ;
+ channelPermissions = TCL_READABLE;
+ break;
+ case O_WRONLY:
+ accessMode = GENERIC_WRITE;
+ channelPermissions = TCL_WRITABLE;
+ break;
+ case O_RDWR:
+ accessMode = (GENERIC_READ | GENERIC_WRITE);
+ channelPermissions = (TCL_READABLE | TCL_WRITABLE);
+ break;
+ default:
+ Tcl_Panic("TclpOpenFileChannel: invalid mode value");
+ break;
}
/*
@@ -816,23 +883,23 @@ TclpOpenFileChannel(interp, pathPtr, mode, permissions)
*/
switch (mode & (O_CREAT | O_EXCL | O_TRUNC)) {
- case (O_CREAT | O_EXCL):
- case (O_CREAT | O_EXCL | O_TRUNC):
- createMode = CREATE_NEW;
- break;
- case (O_CREAT | O_TRUNC):
- createMode = CREATE_ALWAYS;
- break;
- case O_CREAT:
- createMode = OPEN_ALWAYS;
- break;
- case O_TRUNC:
- case (O_TRUNC | O_EXCL):
- createMode = TRUNCATE_EXISTING;
- break;
- default:
- createMode = OPEN_EXISTING;
- break;
+ case (O_CREAT | O_EXCL):
+ case (O_CREAT | O_EXCL | O_TRUNC):
+ createMode = CREATE_NEW;
+ break;
+ case (O_CREAT | O_TRUNC):
+ createMode = CREATE_ALWAYS;
+ break;
+ case O_CREAT:
+ createMode = OPEN_ALWAYS;
+ break;
+ case O_TRUNC:
+ case (O_TRUNC | O_EXCL):
+ createMode = TRUNCATE_EXISTING;
+ break;
+ default:
+ createMode = OPEN_EXISTING;
+ break;
}
/*
@@ -841,14 +908,14 @@ TclpOpenFileChannel(interp, pathPtr, mode, permissions)
*/
if (mode & O_CREAT) {
- if (permissions & S_IWRITE) {
- flags = FILE_ATTRIBUTE_NORMAL;
- } else {
- flags = FILE_ATTRIBUTE_READONLY;
- }
+ if (permissions & S_IWRITE) {
+ flags = FILE_ATTRIBUTE_NORMAL;
+ } else {
+ flags = FILE_ATTRIBUTE_READONLY;
+ }
} else {
flags = (*tclWinProcs->getFileAttributesProc)(nativeName);
- if (flags == 0xFFFFFFFF) {
+ if (flags == 0xFFFFFFFF) {
flags = 0;
}
}
@@ -863,48 +930,48 @@ TclpOpenFileChannel(interp, pathPtr, mode, permissions)
* Now we get to create the file.
*/
- handle = (*tclWinProcs->createFileProc)(nativeName, accessMode,
+ handle = (*tclWinProcs->createFileProc)(nativeName, accessMode,
shareMode, NULL, createMode, flags, (HANDLE) NULL);
if (handle == INVALID_HANDLE_VALUE) {
- DWORD err;
- err = GetLastError();
+ DWORD err = GetLastError();
+
if ((err & 0xffffL) == ERROR_OPEN_FAILED) {
err = (mode & O_CREAT) ? ERROR_FILE_EXISTS : ERROR_FILE_NOT_FOUND;
}
- TclWinConvertError(err);
+ TclWinConvertError(err);
if (interp != (Tcl_Interp *) NULL) {
- Tcl_AppendResult(interp, "couldn't open \"",
- Tcl_GetString(pathPtr), "\": ",
- Tcl_PosixError(interp), (char *) NULL);
- }
- return NULL;
+ Tcl_AppendResult(interp, "couldn't open \"", TclGetString(pathPtr),
+ "\": ", Tcl_PosixError(interp), NULL);
+ }
+ return NULL;
}
-
+
channel = NULL;
- switch ( FileGetType(handle) ) {
+ switch (FileGetType(handle)) {
case FILE_TYPE_SERIAL:
/*
- * Reopen channel for OVERLAPPED operation
- * Normally this shouldn't fail, because the channel exists
+ * Reopen channel for OVERLAPPED operation. Normally this shouldn't
+ * fail, because the channel exists.
*/
+
handle = TclWinSerialReopen(handle, nativeName, accessMode);
if (handle == INVALID_HANDLE_VALUE) {
TclWinConvertError(GetLastError());
if (interp != (Tcl_Interp *) NULL) {
Tcl_AppendResult(interp, "couldn't reopen serial \"",
- Tcl_GetString(pathPtr), "\": ",
- Tcl_PosixError(interp), (char *) NULL);
+ TclGetString(pathPtr), "\": ",
+ Tcl_PosixError(interp), NULL);
}
return NULL;
}
channel = TclWinOpenSerialChannel(handle, channelName,
- channelPermissions);
+ channelPermissions);
break;
case FILE_TYPE_CONSOLE:
channel = TclWinOpenConsoleChannel(handle, channelName,
- channelPermissions);
+ channelPermissions);
break;
case FILE_TYPE_PIPE:
if (channelPermissions & TCL_READABLE) {
@@ -919,20 +986,18 @@ TclpOpenFileChannel(interp, pathPtr, mode, permissions)
case FILE_TYPE_DISK:
case FILE_TYPE_UNKNOWN:
channel = TclWinOpenFileChannel(handle, channelName,
- channelPermissions,
- (mode & O_APPEND) ? FILE_APPEND : 0);
+ channelPermissions, (mode & O_APPEND) ? FILE_APPEND : 0);
break;
default:
/*
- * The handle is of an unknown type, probably /dev/nul equivalent
- * or possibly a closed handle.
+ * The handle is of an unknown type, probably /dev/nul equivalent or
+ * possibly a closed handle.
*/
-
+
channel = NULL;
- Tcl_AppendResult(interp, "couldn't open \"",
- Tcl_GetString(pathPtr), "\": ",
- "bad file type", (char *) NULL);
+ Tcl_AppendResult(interp, "couldn't open \"", TclGetString(pathPtr),
+ "\": bad file type", NULL);
break;
}
@@ -944,8 +1009,7 @@ TclpOpenFileChannel(interp, pathPtr, mode, permissions)
*
* Tcl_MakeFileChannel --
*
- * Creates a Tcl_Channel from an existing platform specific file
- * handle.
+ * Creates a Tcl_Channel from an existing platform specific file handle.
*
* Results:
* The Tcl_Channel created around the preexisting file.
@@ -957,10 +1021,10 @@ TclpOpenFileChannel(interp, pathPtr, mode, permissions)
*/
Tcl_Channel
-Tcl_MakeFileChannel(rawHandle, mode)
- ClientData rawHandle; /* OS level handle */
- int mode; /* ORed combination of TCL_READABLE and
- * TCL_WRITABLE to indicate file mode. */
+Tcl_MakeFileChannel(
+ ClientData rawHandle, /* OS level handle */
+ int mode) /* ORed combination of TCL_READABLE and
+ * TCL_WRITABLE to indicate file mode. */
{
#if defined(HAVE_NO_SEH) && !defined(_WIN64)
EXCEPTION_REGISTRATION registration;
@@ -969,16 +1033,14 @@ Tcl_MakeFileChannel(rawHandle, mode)
Tcl_Channel channel = NULL;
HANDLE handle = (HANDLE) rawHandle;
HANDLE dupedHandle;
- TclFile readFile = NULL;
- TclFile writeFile = NULL;
+ TclFile readFile = NULL, writeFile = NULL;
BOOL result;
if (mode == 0) {
return NULL;
}
- switch (FileGetType(handle))
- {
+ switch (FileGetType(handle)) {
case FILE_TYPE_SERIAL:
channel = TclWinOpenSerialChannel(handle, channelName, mode);
break;
@@ -986,12 +1048,10 @@ Tcl_MakeFileChannel(rawHandle, mode)
channel = TclWinOpenConsoleChannel(handle, channelName, mode);
break;
case FILE_TYPE_PIPE:
- if (mode & TCL_READABLE)
- {
+ if (mode & TCL_READABLE) {
readFile = TclWinMakeFile(handle);
}
- if (mode & TCL_WRITABLE)
- {
+ if (mode & TCL_WRITABLE) {
writeFile = TclWinMakeFile(handle);
}
channel = TclpCreateCommandChannel(readFile, writeFile, NULL, 0, NULL);
@@ -1001,14 +1061,14 @@ Tcl_MakeFileChannel(rawHandle, mode)
case FILE_TYPE_CHAR:
channel = TclWinOpenFileChannel(handle, channelName, mode, 0);
break;
-
+
case FILE_TYPE_UNKNOWN:
default:
/*
- * The handle is of an unknown type. Test the validity of this OS
- * handle by duplicating it, then closing the dupe. The Win32 API
+ * The handle is of an unknown type. Test the validity of this OS
+ * handle by duplicating it, then closing the dupe. The Win32 API
* doesn't provide an IsValidHandle() function, so we have to emulate
- * it here. This test will not work on a console handle reliably,
+ * it here. This test will not work on a console handle reliably,
* which is why we can't test every handle that comes into this
* function in this way.
*/
@@ -1018,7 +1078,7 @@ Tcl_MakeFileChannel(rawHandle, mode)
DUPLICATE_SAME_ACCESS);
if (result == 0) {
- /*
+ /*
* Unable to make a duplicate. It's definately invalid at this
* point.
*/
@@ -1034,12 +1094,11 @@ Tcl_MakeFileChannel(rawHandle, mode)
result = 0;
#if defined(HAVE_NO_SEH) && !defined(_WIN64)
/*
- * Don't have SEH available, do things the hard way.
- * Note that this needs to be one block of asm, to avoid stack
- * imbalance; also, it is illegal for one asm block to contain
- * a jump to another.
+ * Don't have SEH available, do things the hard way. Note that this
+ * needs to be one block of asm, to avoid stack imbalance; also, it is
+ * illegal for one asm block to contain a jump to another.
*/
-
+
__asm__ __volatile__ (
/*
@@ -1049,9 +1108,10 @@ Tcl_MakeFileChannel(rawHandle, mode)
"movl %[dupedHandle], %%ebx" "\n\t"
/*
- * Construct an EXCEPTION_REGISTRATION to protect the
- * call to CloseHandle
+ * Construct an EXCEPTION_REGISTRATION to protect the call to
+ * CloseHandle.
*/
+
"leal %[registration], %%edx" "\n\t"
"movl %%fs:0, %%eax" "\n\t"
"movl %%eax, 0x0(%%edx)" "\n\t" /* link */
@@ -1060,45 +1120,49 @@ Tcl_MakeFileChannel(rawHandle, mode)
"movl %%ebp, 0x8(%%edx)" "\n\t" /* ebp */
"movl %%esp, 0xc(%%edx)" "\n\t" /* esp */
"movl $0, 0x10(%%edx)" "\n\t" /* status */
-
- /* Link the EXCEPTION_REGISTRATION on the chain */
-
+
+ /*
+ * Link the EXCEPTION_REGISTRATION on the chain.
+ */
+
"movl %%edx, %%fs:0" "\n\t"
-
- /* Call CloseHandle( dupedHandle ) */
-
+
+ /*
+ * Call CloseHandle(dupedHandle).
+ */
+
"pushl %%ebx" "\n\t"
"call _CloseHandle@4" "\n\t"
-
- /*
- * Come here on normal exit. Recover the EXCEPTION_REGISTRATION
+
+ /*
+ * Come here on normal exit. Recover the EXCEPTION_REGISTRATION
* and put a TRUE status return into it.
*/
-
+
"movl %%fs:0, %%edx" "\n\t"
"movl $1, %%eax" "\n\t"
"movl %%eax, 0x10(%%edx)" "\n\t"
"jmp 2f" "\n"
-
+
/*
- * Come here on an exception. Recover the EXCEPTION_REGISTRATION
+ * Come here on an exception. Recover the EXCEPTION_REGISTRATION
*/
-
+
"1:" "\t"
"movl %%fs:0, %%edx" "\n\t"
"movl 0x8(%%edx), %%edx" "\n\t"
-
- /*
- * Come here however we exited. Restore context from the
+
+ /*
+ * 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 */
:
@@ -1108,7 +1172,6 @@ Tcl_MakeFileChannel(rawHandle, mode)
"%eax", "%ebx", "%ecx", "%edx", "%esi", "%edi", "memory"
);
result = registration.status;
-
#else
#ifndef HAVE_NO_SEH
__try {
@@ -1123,9 +1186,9 @@ Tcl_MakeFileChannel(rawHandle, mode)
return NULL;
}
- /* Fall through, the handle is valid. */
-
/*
+ * Fall through, the handle is valid.
+ *
* Create the undefined channel, anyways, because we know the handle
* is valid to something.
*/
@@ -1147,42 +1210,42 @@ Tcl_MakeFileChannel(rawHandle, mode)
* Returns the specified default standard channel, or NULL.
*
* Side effects:
- * May cause the creation of a standard channel and the underlying
- * file.
+ * May cause the creation of a standard channel and the underlying file.
*
*----------------------------------------------------------------------
*/
Tcl_Channel
-TclpGetDefaultStdChannel(type)
- int type; /* One of TCL_STDIN, TCL_STDOUT, TCL_STDERR. */
+TclpGetDefaultStdChannel(
+ int type) /* One of TCL_STDIN, TCL_STDOUT, or
+ * TCL_STDERR. */
{
Tcl_Channel channel;
HANDLE handle;
int mode = -1;
char *bufMode = NULL;
- DWORD handleId = (DWORD)INVALID_HANDLE_VALUE;
+ DWORD handleId = (DWORD)-1;
/* Standard handle to retrieve. */
switch (type) {
- case TCL_STDIN:
- handleId = STD_INPUT_HANDLE;
- mode = TCL_READABLE;
- bufMode = "line";
- break;
- case TCL_STDOUT:
- handleId = STD_OUTPUT_HANDLE;
- mode = TCL_WRITABLE;
- bufMode = "line";
- break;
- case TCL_STDERR:
- handleId = STD_ERROR_HANDLE;
- mode = TCL_WRITABLE;
- bufMode = "none";
- break;
- default:
- panic("TclGetDefaultStdChannel: Unexpected channel type");
- break;
+ case TCL_STDIN:
+ handleId = STD_INPUT_HANDLE;
+ mode = TCL_READABLE;
+ bufMode = "line";
+ break;
+ case TCL_STDOUT:
+ handleId = STD_OUTPUT_HANDLE;
+ mode = TCL_WRITABLE;
+ bufMode = "line";
+ break;
+ case TCL_STDERR:
+ handleId = STD_ERROR_HANDLE;
+ mode = TCL_WRITABLE;
+ bufMode = "none";
+ break;
+ default:
+ Tcl_Panic("TclGetDefaultStdChannel: Unexpected channel type");
+ break;
}
handle = GetStdHandle(handleId);
@@ -1207,126 +1270,121 @@ TclpGetDefaultStdChannel(type)
* Set up the normal channel options for stdio handles.
*/
- if ((Tcl_SetChannelOption((Tcl_Interp *) NULL, channel, "-translation",
- "auto") == TCL_ERROR)
- || (Tcl_SetChannelOption((Tcl_Interp *) NULL, channel, "-eofchar",
- "\032 {}") == TCL_ERROR)
- || (Tcl_SetChannelOption((Tcl_Interp *) NULL, channel,
- "-buffering", bufMode) == TCL_ERROR)) {
- Tcl_Close((Tcl_Interp *) NULL, channel);
- return (Tcl_Channel) NULL;
+ if (Tcl_SetChannelOption(NULL,channel,"-translation","auto")!=TCL_OK ||
+ Tcl_SetChannelOption(NULL,channel,"-eofchar","\032 {}")!=TCL_OK ||
+ Tcl_SetChannelOption(NULL,channel,"-buffering",bufMode)!=TCL_OK) {
+ Tcl_Close(NULL, channel);
+ return (Tcl_Channel) NULL;
}
return channel;
}
-
-
/*
*----------------------------------------------------------------------
*
* TclWinOpenFileChannel --
*
- * Constructs a File channel for the specified standard OS handle.
- * This is a helper function to break up the construction of
- * channels into File, Console, or Serial.
+ * Constructs a File channel for the specified standard OS handle. This
+ * is a helper function to break up the construction of channels into
+ * File, Console, or Serial.
*
* Results:
* Returns the new channel, or NULL.
*
* Side effects:
- * May open the channel and may cause creation of a file on the
- * file system.
+ * May open the channel and may cause creation of a file on the file
+ * system.
*
*----------------------------------------------------------------------
*/
Tcl_Channel
-TclWinOpenFileChannel(handle, channelName, permissions, appendMode)
- HANDLE handle;
- char *channelName;
- int permissions;
- int appendMode;
+TclWinOpenFileChannel(
+ HANDLE handle, /* Win32 HANDLE to swallow */
+ char *channelName, /* Buffer to receive channel name */
+ int permissions, /* OR'ed combination of TCL_READABLE,
+ * TCL_WRITABLE, or TCL_EXCEPTION, indicating
+ * which operations are valid on the file. */
+ int appendMode) /* OR'ed combination of bits indicating what
+ * additional configuration of the channel is
+ * present. */
{
FileInfo *infoPtr;
- ThreadSpecificData *tsdPtr;
-
- tsdPtr = FileInit();
+ ThreadSpecificData *tsdPtr = FileInit();
/*
* See if a channel with this handle already exists.
*/
-
- for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL;
- infoPtr = infoPtr->nextPtr) {
+
+ for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL;
+ infoPtr = infoPtr->nextPtr) {
if (infoPtr->handle == (HANDLE) handle) {
- return (permissions == infoPtr->validMask) ? infoPtr->channel : NULL;
+ return (permissions==infoPtr->validMask) ? infoPtr->channel : NULL;
}
}
infoPtr = (FileInfo *) ckalloc((unsigned) sizeof(FileInfo));
- /* TIP #218. Removed the code inserting the new structure
- * into the global list. This is now handled in the thread
- * action callbacks, and only there.
+
+ /*
+ * TIP #218. Removed the code inserting the new structure into the global
+ * list. This is now handled in the thread action callbacks, and only
+ * there.
*/
+
infoPtr->nextPtr = NULL;
infoPtr->validMask = permissions;
infoPtr->watchMask = 0;
infoPtr->flags = appendMode;
infoPtr->handle = handle;
infoPtr->dirty = 0;
- wsprintfA(channelName, "file%lx", (int) infoPtr);
-
+ wsprintfA(channelName, "file%lx", PTR2INT(infoPtr));
+
infoPtr->channel = Tcl_CreateChannel(&fileChannelType, channelName,
(ClientData) infoPtr, permissions);
-
+
/*
- * Files have default translation of AUTO and ^Z eof char, which
- * means that a ^Z will be accepted as EOF when reading.
+ * Files have default translation of AUTO and ^Z eof char, which means
+ * that a ^Z will be accepted as EOF when reading.
*/
-
+
Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto");
Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "\032 {}");
return infoPtr->channel;
}
-
-
+
/*
*----------------------------------------------------------------------
*
* TclWinFlushDirtyChannels --
*
- * Flush all dirty channels to disk, so that requesting the
- * size of any file returns the correct value.
+ * Flush all dirty channels to disk, so that requesting the size of any
+ * file returns the correct value.
*
* Results:
* None.
*
* Side effects:
- * Information is actually written to disk now, rather than
- * later. Don't call this too often, or there will be a
- * performance hit (i.e. only call when we need to ask for
- * the size of a file).
+ * Information is actually written to disk now, rather than later. Don't
+ * call this too often, or there will be a performance hit (i.e. only
+ * call when we need to ask for the size of a file).
*
*----------------------------------------------------------------------
*/
void
-TclWinFlushDirtyChannels ()
+TclWinFlushDirtyChannels(void)
{
FileInfo *infoPtr;
- ThreadSpecificData *tsdPtr;
-
- tsdPtr = FileInit();
+ ThreadSpecificData *tsdPtr = FileInit();
/*
- * Flush all channels which are dirty, i.e. may have data pending
- * in the OS
+ * Flush all channels which are dirty, i.e. may have data pending in the
+ * OS.
*/
-
- for (infoPtr = tsdPtr->firstFilePtr;
- infoPtr != NULL;
- infoPtr = infoPtr->nextPtr) {
+
+ for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL;
+ infoPtr = infoPtr->nextPtr) {
if (infoPtr->dirty) {
FlushFileBuffers(infoPtr->handle);
infoPtr->dirty = 0;
@@ -1351,42 +1409,41 @@ TclWinFlushDirtyChannels ()
*/
static void
-FileThreadActionProc (instanceData, action)
- ClientData instanceData;
- int action;
+FileThreadActionProc(
+ ClientData instanceData,
+ int action)
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
FileInfo *infoPtr = (FileInfo *) instanceData;
if (action == TCL_CHANNEL_THREAD_INSERT) {
- infoPtr->nextPtr = tsdPtr->firstFilePtr;
+ infoPtr->nextPtr = tsdPtr->firstFilePtr;
tsdPtr->firstFilePtr = infoPtr;
} else {
- FileInfo **nextPtrPtr;
+ FileInfo **nextPtrPtr;
int removed = 0;
for (nextPtrPtr = &(tsdPtr->firstFilePtr); (*nextPtrPtr) != NULL;
- nextPtrPtr = &((*nextPtrPtr)->nextPtr)) {
+ nextPtrPtr = &((*nextPtrPtr)->nextPtr)) {
if ((*nextPtrPtr) == infoPtr) {
- (*nextPtrPtr) = infoPtr->nextPtr;
+ (*nextPtrPtr) = infoPtr->nextPtr;
removed = 1;
break;
}
}
/*
- * This could happen if the channel was created in one thread
- * and then moved to another without updating the thread
- * local data in each thread.
+ * This could happen if the channel was created in one thread and then
+ * moved to another without updating the thread local data in each
+ * thread.
*/
if (!removed) {
- panic("file info ptr not on thread channel list");
+ Tcl_Panic("file info ptr not on thread channel list");
}
}
}
-
-
+
/*
*----------------------------------------------------------------------
*
@@ -1404,31 +1461,42 @@ FileThreadActionProc (instanceData, action)
*/
DWORD
-FileGetType(handle)
- HANDLE handle; /* Opened file handle */
-{
+FileGetType(
+ HANDLE handle) /* Opened file handle */
+{
DWORD type;
- DWORD consoleParams;
- DCB dcb;
type = GetFileType(handle);
/*
- * If the file is a character device, we need to try to figure out
- * whether it is a serial port, a console, or something else. We
- * test for the console case first because this is more common.
+ * If the file is a character device, we need to try to figure out whether
+ * it is a serial port, a console, or something else. We test for the
+ * console case first because this is more common.
*/
-
- if (type == FILE_TYPE_CHAR || (type == FILE_TYPE_UNKNOWN && !GetLastError())) {
- if (GetConsoleMode(handle, &consoleParams)) {
- type = FILE_TYPE_CONSOLE;
- } else {
- dcb.DCBlength = sizeof( DCB ) ;
- if (GetCommState(handle, &dcb)) {
- type = FILE_TYPE_SERIAL;
- }
- }
+
+ if ((type == FILE_TYPE_CHAR)
+ || ((type == FILE_TYPE_UNKNOWN) && !GetLastError())) {
+ DWORD consoleParams;
+
+ if (GetConsoleMode(handle, &consoleParams)) {
+ type = FILE_TYPE_CONSOLE;
+ } else {
+ DCB dcb;
+
+ dcb.DCBlength = sizeof(DCB);
+ if (GetCommState(handle, &dcb)) {
+ type = FILE_TYPE_SERIAL;
+ }
+ }
}
return type;
}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/win/tclWinConsole.c b/win/tclWinConsole.c
index d036bda..8be8e09 100644
--- a/win/tclWinConsole.c
+++ b/win/tclWinConsole.c
@@ -1,13 +1,13 @@
-/*
+/*
* tclWinConsole.c --
*
- * This file implements the Windows-specific console functions,
- * and the "console" channel driver.
+ * This file implements the Windows-specific console functions, and the
+ * "console" channel driver.
*
* Copyright (c) 1999 by Scriptics Corp.
*
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#include "tclWinInt.h"
@@ -43,10 +43,11 @@ TCL_DECLARE_MUTEX(consoleMutex)
*/
#define CONSOLE_EOF (1<<2) /* Console has reached EOF. */
-#define CONSOLE_BUFFERED (1<<3) /* data was read into a buffer by the reader
- thread */
+#define CONSOLE_BUFFERED (1<<3) /* Data was read into a buffer by the reader
+ * thread. */
#define CONSOLE_BUFFER_SIZE (8*1024)
+
/*
* This structure describes per-instance data for a console based channel.
*/
@@ -69,52 +70,47 @@ typedef struct ConsoleInfo {
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. */
+ * 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. */
+ * 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.
- */
+ * 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. */
+ * 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.
- */
+ * signal when the reader thread should exit */
DWORD writeError; /* An error caused by the last background
- * write. Set to 0 if no error has been
- * detected. This word is shared with the
+ * write. Set to 0 if no error has been
+ * detected. This word is shared with the
* writer thread so access must be
- * synchronized with the writable object.
- */
- char *writeBuf; /* Current background output buffer.
- * Access is synchronized with the writable
- * object. */
- int writeBufLen; /* Size of write buffer. Access is
- * synchronized with the writable
- * object. */
- int toWrite; /* Current amount to be written. Access is
+ * synchronized with the writable object. */
+ char *writeBuf; /* Current background output buffer. Access is
+ * synchronized with the writable object. */
+ int writeBufLen; /* Size of write buffer. Access is
+ * synchronized with the writable object. */
+ int toWrite; /* Current amount to be written. Access is
* synchronized with the writable object. */
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 */
+ * 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 */
char buffer[CONSOLE_BUFFER_SIZE];
- /* Data consumed by reader thread. */
+ /* Data consumed by reader thread. */
} ConsoleInfo;
typedef struct ThreadSpecificData {
/*
- * The following pointer refers to the head of the list of consoles
- * that are being watched for file events.
+ * The following pointer refers to the head of the list of consoles that
+ * are being watched for file events.
*/
-
+
ConsoleInfo *firstConsolePtr;
} ThreadSpecificData;
@@ -126,9 +122,9 @@ static Tcl_ThreadDataKey dataKey;
*/
typedef struct ConsoleEvent {
- Tcl_Event header; /* Information that is standard for
- * all events. */
- ConsoleInfo *infoPtr; /* Pointer to console info structure. Note
+ Tcl_Event header; /* Information that is standard for all
+ * events. */
+ ConsoleInfo *infoPtr; /* Pointer to console info structure. Note
* that we still have to verify that the
* console exists before dereferencing this
* pointer. */
@@ -138,7 +134,7 @@ typedef struct ConsoleEvent {
* Declarations for functions used only in this file.
*/
-static int ConsoleBlockModeProc(ClientData instanceData, int mode);
+static int ConsoleBlockModeProc(ClientData instanceData,int mode);
static void ConsoleCheckProc(ClientData clientData, int flags);
static int ConsoleCloseProc(ClientData instanceData,
Tcl_Interp *interp);
@@ -146,7 +142,7 @@ static int ConsoleEventProc(Tcl_Event *evPtr, int flags);
static void ConsoleExitHandler(ClientData clientData);
static int ConsoleGetHandleProc(ClientData instanceData,
int direction, ClientData *handlePtr);
-static void ConsoleInit(void);
+static void ConsoleInit(void);
static int ConsoleInputProc(ClientData instanceData, char *buf,
int toRead, int *errorCode);
static int ConsoleOutputProc(ClientData instanceData,
@@ -157,9 +153,8 @@ static void ConsoleWatchProc(ClientData instanceData, int mask);
static DWORD WINAPI ConsoleWriterThread(LPVOID arg);
static void ProcExitHandler(ClientData clientData);
static int WaitForRead(ConsoleInfo *infoPtr, int blocking);
-
-static void ConsoleThreadActionProc _ANSI_ARGS_ ((
- ClientData instanceData, int action));
+static void ConsoleThreadActionProc(ClientData instanceData,
+ int action);
/*
* This structure describes the channel type structure for command console
@@ -168,7 +163,7 @@ static void ConsoleThreadActionProc _ANSI_ARGS_ ((
static Tcl_ChannelType consoleChannelType = {
"console", /* Type name. */
- TCL_CHANNEL_VERSION_4, /* v4 channel */
+ TCL_CHANNEL_VERSION_5, /* v5 channel */
ConsoleCloseProc, /* Close proc. */
ConsoleInputProc, /* Input proc. */
ConsoleOutputProc, /* Output proc. */
@@ -181,13 +176,57 @@ static Tcl_ChannelType consoleChannelType = {
ConsoleBlockModeProc, /* Set blocking or non-blocking mode.*/
NULL, /* flush proc. */
NULL, /* handler proc. */
- NULL, /* wide seek proc */
+ NULL, /* wide seek proc */
ConsoleThreadActionProc, /* thread action proc */
+ NULL, /* truncation */
};
/*
*----------------------------------------------------------------------
*
+ * readConsoleBytes, writeConsoleBytes --
+ * Wrapper for ReadConsole{A,W}, that takes and returns number of bytes
+ * instead of number of TCHARS
+ */
+static BOOL
+readConsoleBytes(
+ HANDLE hConsole,
+ LPVOID lpBuffer,
+ DWORD nbytes,
+ LPDWORD nbytesread)
+{
+ 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);
+ return result;
+}
+
+static BOOL
+writeConsoleBytes(
+ HANDLE hConsole,
+ 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);
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* ConsoleInit --
*
* This function initializes the static variables for this file.
@@ -202,13 +241,13 @@ static Tcl_ChannelType consoleChannelType = {
*/
static void
-ConsoleInit()
+ConsoleInit(void)
{
ThreadSpecificData *tsdPtr;
/*
- * Check the initialized flag first, then check again in the mutex.
- * This is a speed enhancement.
+ * Check the initialized flag first, then check again in the mutex. This
+ * is a speed enhancement.
*/
if (!initialized) {
@@ -234,8 +273,8 @@ ConsoleInit()
*
* ConsoleExitHandler --
*
- * This function is called to cleanup the console module before
- * Tcl is unloaded.
+ * This function is called to cleanup the console module before Tcl is
+ * unloaded.
*
* Results:
* None.
@@ -258,8 +297,8 @@ ConsoleExitHandler(
*
* ProcExitHandler --
*
- * This function is called to cleanup the process list before
- * Tcl is unloaded.
+ * This function is called to cleanup the process list before Tcl is
+ * unloaded.
*
* Results:
* None.
@@ -284,8 +323,8 @@ ProcExitHandler(
*
* ConsoleSetupProc --
*
- * This procedure is invoked before Tcl_DoOneEvent blocks waiting
- * for an event.
+ * This procedure is invoked before Tcl_DoOneEvent blocks waiting for an
+ * event.
*
* Results:
* None.
@@ -309,12 +348,12 @@ ConsoleSetupProc(
if (!(flags & TCL_FILE_EVENTS)) {
return;
}
-
+
/*
- * Look to see if any events are already pending. If they are, poll.
+ * Look to see if any events are already pending. If they are, poll.
*/
- for (infoPtr = tsdPtr->firstConsolePtr; infoPtr != NULL;
+ for (infoPtr = tsdPtr->firstConsolePtr; infoPtr != NULL;
infoPtr = infoPtr->nextPtr) {
if (infoPtr->watchMask & TCL_WRITABLE) {
if (WaitForSingleObject(infoPtr->writable, 0) != WAIT_TIMEOUT) {
@@ -337,8 +376,8 @@ ConsoleSetupProc(
*
* ConsoleCheckProc --
*
- * This procedure is called by Tcl_DoOneEvent to check the console
- * event source for events.
+ * This procedure is called by Tcl_DoOneEvent to check the console event
+ * source for events.
*
* Results:
* None.
@@ -362,18 +401,18 @@ ConsoleCheckProc(
if (!(flags & TCL_FILE_EVENTS)) {
return;
}
-
+
/*
* Queue events for any ready consoles that don't already have events
* queued.
*/
- for (infoPtr = tsdPtr->firstConsolePtr; infoPtr != NULL;
+ for (infoPtr = tsdPtr->firstConsolePtr; infoPtr != NULL;
infoPtr = infoPtr->nextPtr) {
if (infoPtr->flags & CONSOLE_PENDING) {
continue;
}
-
+
/*
* Queue an event if the console is signaled for reading or writing.
*/
@@ -384,7 +423,7 @@ ConsoleCheckProc(
needEvent = 1;
}
}
-
+
if (infoPtr->watchMask & TCL_READABLE) {
if (WaitForRead(infoPtr, 0) >= 0) {
needEvent = 1;
@@ -422,15 +461,16 @@ static int
ConsoleBlockModeProc(
ClientData instanceData, /* Instance data for channel. */
int mode) /* TCL_MODE_BLOCKING or
- * TCL_MODE_NONBLOCKING. */
+ * TCL_MODE_NONBLOCKING. */
{
ConsoleInfo *infoPtr = (ConsoleInfo *) instanceData;
-
+
/*
- * Consoles on Windows can not be switched between blocking and nonblocking,
- * hence we have to emulate the behavior. This is done in the input
- * function by checking against a bit in the state. We set or unset the
- * bit here to cause the input function to emulate the correct behavior.
+ * Consoles on Windows can not be switched between blocking and
+ * nonblocking, hence we have to emulate the behavior. This is done in the
+ * input function by checking against a bit in the state. We set or unset
+ * the bit here to cause the input function to emulate the correct
+ * behavior.
*/
if (mode == TCL_MODE_NONBLOCKING) {
@@ -469,27 +509,25 @@ ConsoleCloseProc(
DWORD exitCode;
errorCode = 0;
-
+
/*
- * Clean up the background thread if necessary. Note that this
- * must be done before we can close the file, since the
- * thread may be blocking trying to read from the console.
+ * Clean up the background thread if necessary. Note that this must be
+ * done before we can close the file, since the thread may be blocking
+ * trying to read from the console.
*/
-
- if (consolePtr->readThread) {
+ if (consolePtr->readThread) {
/*
- * The thread may already have closed on it's own. Check it's
- * exit code.
+ * 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
+ * Set the stop event so that if the reader thread is blocked in
+ * ConsoleReaderThread on WaitForMultipleEvents, it will exit
* cleanly.
*/
@@ -502,11 +540,10 @@ ConsoleCloseProc(
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.
+ * 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);
@@ -526,32 +563,33 @@ ConsoleCloseProc(
consolePtr->validMask &= ~TCL_READABLE;
/*
- * Wait for the writer thread to finish the current buffer, then
- * terminate the thread and close the handles. If the channel is
- * nonblocking, there should be no pending write operations.
+ * Wait for the writer thread to finish the current buffer, then terminate
+ * the thread and close the handles. If the channel is nonblocking, there
+ * should be no pending write operations.
*/
-
+
if (consolePtr->writeThread) {
if (consolePtr->toWrite) {
/*
- * We only need to wait if there is something to write.
- * This may prevent infinite wait on exit. [python bug 216289]
+ * 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.
+ * 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.
+ * Set the stop event so that if the reader thread is blocked in
+ * ConsoleWriterThread on WaitForMultipleEvents, it will exit
+ * cleanly.
*/
SetEvent(consolePtr->stopWriter);
@@ -563,11 +601,10 @@ ConsoleCloseProc(
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.
+ * 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);
@@ -588,12 +625,12 @@ ConsoleCloseProc(
/*
- * 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 another.
+ * 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
+ * another.
*/
- if (!TclInThreadExit()
+ if (!TclInThreadExit()
|| ((GetStdHandle(STD_INPUT_HANDLE) != consolePtr->handle)
&& (GetStdHandle(STD_OUTPUT_HANDLE) != consolePtr->handle)
&& (GetStdHandle(STD_ERROR_HANDLE) != consolePtr->handle))) {
@@ -602,7 +639,7 @@ ConsoleCloseProc(
errorCode = errno;
}
}
-
+
consolePtr->watchMask &= consolePtr->validMask;
/*
@@ -631,8 +668,8 @@ ConsoleCloseProc(
*
* ConsoleInputProc --
*
- * Reads input from the IO channel into the buffer given. Returns
- * count of how many bytes were actually read, and an error indication.
+ * Reads input from the IO channel into the buffer given. Returns count
+ * of how many bytes were actually read, and an error indication.
*
* Results:
* A count of how many bytes were read is returned and an error
@@ -646,11 +683,11 @@ ConsoleCloseProc(
static int
ConsoleInputProc(
- ClientData instanceData, /* Console state. */
- char *buf, /* Where to store data read. */
- int bufSize, /* How much space is available
- * in the buffer? */
- int *errorCode) /* Where to store error code. */
+ ClientData instanceData, /* Console state. */
+ char *buf, /* Where to store data read. */
+ int bufSize, /* How much space is available in the
+ * buffer? */
+ int *errorCode) /* Where to store error code. */
{
ConsoleInfo *infoPtr = (ConsoleInfo *) instanceData;
DWORD count, bytesRead = 0;
@@ -661,13 +698,13 @@ ConsoleInputProc(
/*
* Synchronize with the reader thread.
*/
-
+
result = WaitForRead(infoPtr, (infoPtr->flags & CONSOLE_ASYNC) ? 0 : 1);
-
+
/*
* If an error occurred, return immediately.
*/
-
+
if (result == -1) {
*errorCode = errno;
return -1;
@@ -689,22 +726,22 @@ ConsoleInputProc(
/*
* Reset the buffer
*/
-
+
infoPtr->readFlags &= ~CONSOLE_BUFFERED;
infoPtr->offset = 0;
}
return bytesRead;
}
-
+
/*
- * Attempt to read bufSize bytes. The read will return immediately
- * if there is any data available. Otherwise it will block until
- * at least one byte is available or an EOF occurs.
+ * Attempt to read bufSize bytes. The read will return immediately if
+ * there is any data available. Otherwise it will block until at least one
+ * byte is available or an EOF occurs.
*/
- if (ReadConsole(infoPtr->handle, (LPVOID) buf, (DWORD) bufSize, &count,
- NULL) == TRUE) {
+ if (readConsoleBytes(infoPtr->handle, (LPVOID) buf, (DWORD) bufSize, &count)
+ == TRUE) {
buf[count] = '\0';
return count;
}
@@ -717,12 +754,12 @@ ConsoleInputProc(
*
* ConsoleOutputProc --
*
- * Writes the given output on the IO channel. Returns count of how
- * many characters were actually written, and an error indication.
+ * Writes the given output on the IO channel. Returns count of how many
+ * characters were actually written, and an error indication.
*
* Results:
- * A count of how many characters were written is returned and an
- * error indication is returned in an output argument.
+ * A count of how many characters were written is returned and an error
+ * indication is returned in an output argument.
*
* Side effects:
* Writes output on the actual channel.
@@ -732,26 +769,26 @@ ConsoleInputProc(
static int
ConsoleOutputProc(
- ClientData instanceData, /* Console state. */
- CONST char *buf, /* The data buffer. */
- int toWrite, /* How many bytes to write? */
- int *errorCode) /* Where to store error code. */
+ ClientData instanceData, /* Console state. */
+ CONST char *buf, /* The data buffer. */
+ int toWrite, /* How many bytes to write? */
+ int *errorCode) /* Where to store error code. */
{
ConsoleInfo *infoPtr = (ConsoleInfo *) instanceData;
DWORD bytesWritten, timeout;
-
+
*errorCode = 0;
timeout = (infoPtr->flags & CONSOLE_ASYNC) ? 0 : INFINITE;
if (WaitForSingleObject(infoPtr->writable, timeout) == WAIT_TIMEOUT) {
/*
- * The writer thread is blocked waiting for a write to complete
- * and the channel is in non-blocking mode.
+ * The writer thread is blocked waiting for a write to complete and
+ * the channel is in non-blocking mode.
*/
errno = EAGAIN;
goto error;
}
-
+
/*
* Check for a background error on the last write.
*/
@@ -777,31 +814,31 @@ ConsoleOutputProc(
ckfree(infoPtr->writeBuf);
}
infoPtr->writeBufLen = toWrite;
- infoPtr->writeBuf = ckalloc((unsigned int) toWrite);
+ infoPtr->writeBuf = ckalloc((size_t)toWrite);
}
- memcpy(infoPtr->writeBuf, buf, (size_t) toWrite);
+ memcpy(infoPtr->writeBuf, buf, (size_t)toWrite);
infoPtr->toWrite = toWrite;
ResetEvent(infoPtr->writable);
SetEvent(infoPtr->startWriter);
bytesWritten = toWrite;
} else {
/*
- * In the blocking case, just try to write the buffer directly.
- * This avoids an unnecessary copy.
+ * In the blocking case, just try to write the buffer directly. This
+ * avoids an unnecessary copy.
*/
- if (WriteFile(infoPtr->handle, (LPVOID) buf, (DWORD) toWrite,
- &bytesWritten, (LPOVERLAPPED) NULL) == FALSE) {
+ if (writeConsoleBytes(infoPtr->handle, buf, (DWORD)toWrite,
+ &bytesWritten)
+ == FALSE) {
TclWinConvertError(GetLastError());
goto error;
}
}
return bytesWritten;
- error:
+ error:
*errorCode = errno;
return -1;
-
}
/*
@@ -809,15 +846,15 @@ ConsoleOutputProc(
*
* ConsoleEventProc --
*
- * This function is invoked by Tcl_ServiceEvent when a file event
- * reaches the front of the event queue. This procedure invokes
- * Tcl_NotifyChannel on the console.
+ * This function is invoked by Tcl_ServiceEvent when a file event reaches
+ * the front of the event queue. This procedure invokes Tcl_NotifyChannel
+ * on the console.
*
* Results:
- * Returns 1 if the event was handled, meaning it should be removed
- * from the queue. Returns 0 if the event was not handled, meaning
- * it should stay on the queue. The only time the event isn't
- * handled is if the TCL_FILE_EVENTS flag bit isn't set.
+ * Returns 1 if the event was handled, meaning it should be removed from
+ * the queue. Returns 0 if the event was not handled, meaning it should
+ * stay on the queue. The only time the event isn't handled is if the
+ * TCL_FILE_EVENTS flag bit isn't set.
*
* Side effects:
* Whatever the notifier callback does.
@@ -828,8 +865,8 @@ ConsoleOutputProc(
static int
ConsoleEventProc(
Tcl_Event *evPtr, /* Event to service. */
- int flags) /* Flags that indicate what events to
- * handle, such as TCL_FILE_EVENTS. */
+ int flags) /* Flags that indicate what events to handle,
+ * such as TCL_FILE_EVENTS. */
{
ConsoleEvent *consoleEvPtr = (ConsoleEvent *)evPtr;
ConsoleInfo *infoPtr;
@@ -842,9 +879,9 @@ ConsoleEventProc(
/*
* Search through the list of watched consoles for the one whose handle
- * matches the event. We do this rather than simply dereferencing
- * the handle in the event so that consoles can be deleted while the
- * event is in the queue.
+ * matches the event. We do this rather than simply dereferencing the
+ * handle in the event so that consoles can be deleted while the event is
+ * in the queue.
*/
for (infoPtr = tsdPtr->firstConsolePtr; infoPtr != NULL;
@@ -864,9 +901,9 @@ ConsoleEventProc(
}
/*
- * Check to see if the console is readable. Note
- * that we can't tell if a console is writable, so we always report it
- * as being writable unless we have detected EOF.
+ * Check to see if the console is readable. Note that we can't tell if a
+ * console is writable, so we always report it as being writable unless we
+ * have detected EOF.
*/
mask = 0;
@@ -883,7 +920,7 @@ ConsoleEventProc(
} else {
mask |= TCL_READABLE;
}
- }
+ }
}
/*
@@ -899,8 +936,7 @@ ConsoleEventProc(
*
* ConsoleWatchProc --
*
- * Called by the notifier to set up to watch for events on this
- * channel.
+ * Called by the notifier to set up to watch for events on this channel.
*
* Results:
* None.
@@ -913,10 +949,10 @@ ConsoleEventProc(
static void
ConsoleWatchProc(
- ClientData instanceData, /* Console state. */
- int mask) /* What events to watch for, OR-ed
- * combination of TCL_READABLE,
- * TCL_WRITABLE and TCL_EXCEPTION. */
+ ClientData instanceData, /* Console state. */
+ int mask) /* What events to watch for, OR-ed combination
+ * of TCL_READABLE, TCL_WRITABLE and
+ * TCL_EXCEPTION. */
{
ConsoleInfo **nextPtrPtr, *ptr;
ConsoleInfo *infoPtr = (ConsoleInfo *) instanceData;
@@ -924,9 +960,8 @@ ConsoleWatchProc(
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
/*
- * Since most of the work is handled by the background threads,
- * we just need to update the watchMask and then force the notifier
- * to poll once.
+ * Since most of the work is handled by the background threads, we just
+ * need to update the watchMask and then force the notifier to poll once.
*/
infoPtr->watchMask = mask & infoPtr->validMask;
@@ -937,19 +972,17 @@ ConsoleWatchProc(
tsdPtr->firstConsolePtr = infoPtr;
}
Tcl_SetMaxBlockTime(&blockTime);
- } else {
- if (oldMask) {
- /*
- * Remove the console from the list of watched consoles.
- */
+ } else if (oldMask) {
+ /*
+ * Remove the console from the list of watched consoles.
+ */
- for (nextPtrPtr = &(tsdPtr->firstConsolePtr), ptr = *nextPtrPtr;
- ptr != NULL;
- nextPtrPtr = &ptr->nextPtr, ptr = *nextPtrPtr) {
- if (infoPtr == ptr) {
- *nextPtrPtr = ptr->nextPtr;
- break;
- }
+ for (nextPtrPtr = &(tsdPtr->firstConsolePtr), ptr = *nextPtrPtr;
+ ptr != NULL;
+ nextPtrPtr = &ptr->nextPtr, ptr = *nextPtrPtr) {
+ if (infoPtr == ptr) {
+ *nextPtrPtr = ptr->nextPtr;
+ break;
}
}
}
@@ -960,12 +993,12 @@ ConsoleWatchProc(
*
* ConsoleGetHandleProc --
*
- * Called from Tcl_GetChannelHandle to retrieve OS handles from
- * inside a command consoleline based channel.
+ * Called from Tcl_GetChannelHandle to retrieve OS handles from inside a
+ * command consoleline based channel.
*
* Results:
- * Returns TCL_OK with the fd in handlePtr, or TCL_ERROR if
- * there is no handle for the specified direction.
+ * Returns TCL_OK with the fd in handlePtr, or TCL_ERROR if there is no
+ * handle for the specified direction.
*
* Side effects:
* None.
@@ -977,7 +1010,7 @@ static int
ConsoleGetHandleProc(
ClientData instanceData, /* The console state. */
int direction, /* TCL_READABLE or TCL_WRITABLE */
- ClientData *handlePtr) /* Where to store the handle. */
+ ClientData *handlePtr) /* Where to store the handle. */
{
ConsoleInfo *infoPtr = (ConsoleInfo *) instanceData;
@@ -990,69 +1023,68 @@ ConsoleGetHandleProc(
*
* WaitForRead --
*
- * Wait until some data is available, the console is at
- * EOF or the reader thread is blocked waiting for data (if the
- * channel is in non-blocking mode).
+ * Wait until some data is available, the console is at EOF or the reader
+ * thread is blocked waiting for data (if the channel is in non-blocking
+ * mode).
*
* Results:
- * Returns 1 if console is readable. Returns 0 if there is no data
- * on the console, but there is buffered data. Returns -1 if an
- * error occurred. If an error occurred, the threads may not
- * be synchronized.
+ * Returns 1 if console is readable. Returns 0 if there is no data on the
+ * console, but there is buffered data. Returns -1 if an error occurred.
+ * If an error occurred, the threads may not be synchronized.
*
* Side effects:
- * Updates the shared state flags. If no error occurred,
- * the reader thread is blocked waiting for a signal from the
- * main thread.
+ * Updates the shared state flags. If no error occurred, the reader
+ * thread is blocked waiting for a signal from the main thread.
*
*----------------------------------------------------------------------
*/
static int
WaitForRead(
- ConsoleInfo *infoPtr, /* Console state. */
- int blocking) /* Indicates whether call should be
- * blocking or not. */
+ ConsoleInfo *infoPtr, /* Console state. */
+ int blocking) /* Indicates whether call should be blocking
+ * or not. */
{
DWORD timeout, count;
HANDLE *handle = infoPtr->handle;
INPUT_RECORD input;
-
+
while (1) {
/*
* Synchronize with the reader thread.
*/
-
+
timeout = blocking ? INFINITE : 0;
if (WaitForSingleObject(infoPtr->readable, timeout) == WAIT_TIMEOUT) {
/*
* The reader thread is blocked waiting for data and the channel
* is in non-blocking mode.
*/
+
errno = EAGAIN;
return -1;
}
-
+
/*
- * At this point, the two threads are synchronized, so it is safe
- * to access shared state.
+ * At this point, the two threads are synchronized, so it is safe to
+ * access shared state.
*/
-
+
/*
* If the console has hit EOF, it is always readable.
*/
-
+
if (infoPtr->readFlags & CONSOLE_EOF) {
return 1;
}
-
+
if (PeekConsoleInput(handle, &input, 1, &count) == FALSE) {
- /*
+ /*
* Check to see if the peek failed because of EOF.
*/
-
+
TclWinConvertError(GetLastError());
-
+
if (errno == EOF) {
infoPtr->readFlags |= CONSOLE_EOF;
return 1;
@@ -1061,7 +1093,7 @@ WaitForRead(
/*
* Ignore errors if there is data in the buffer.
*/
-
+
if (infoPtr->readFlags & CONSOLE_BUFFERED) {
return 0;
} else {
@@ -1070,20 +1102,18 @@ WaitForRead(
}
/*
- * If there is data in the buffer, the console must be
- * readable (since it is a line-oriented device).
+ * If there is data in the buffer, the console must be readable (since
+ * it is a line-oriented device).
*/
if (infoPtr->readFlags & CONSOLE_BUFFERED) {
return 1;
}
-
/*
- * There wasn't any data available, so reset the thread and
- * try again.
+ * There wasn't any data available, so reset the thread and try again.
*/
-
+
ResetEvent(infoPtr->readable);
SetEvent(infoPtr->startReader);
}
@@ -1094,22 +1124,23 @@ WaitForRead(
*
* ConsoleReaderThread --
*
- * This function runs in a separate thread and waits for input
- * to become available on a console.
+ * This function runs in a separate thread and waits for input to become
+ * available on a console.
*
* Results:
* None.
*
* Side effects:
- * Signals the main thread when input become available. May
- * cause the main thread to wake up by posting a message. May
- * one line from the console for each wait operation.
+ * Signals the main thread when input become available. May cause the
+ * main thread to wake up by posting a message. May one line from the
+ * console for each wait operation.
*
*----------------------------------------------------------------------
*/
static DWORD WINAPI
-ConsoleReaderThread(LPVOID arg)
+ConsoleReaderThread(
+ LPVOID arg)
{
ConsoleInfo *infoPtr = (ConsoleInfo *)arg;
HANDLE *handle = infoPtr->handle;
@@ -1129,49 +1160,53 @@ ConsoleReaderThread(LPVOID arg)
if (waitResult != (WAIT_OBJECT_0 + 1)) {
/*
- * The start event was not signaled. It must be the stop event
- * or an error, so exit this thread.
+ * The start event was not signaled. It must be the stop event or
+ * an error, so exit this thread.
*/
break;
}
- /*
- * Look for data on the console, but first ignore any events
- * that are not KEY_EVENTs
+ /*
+ * Look for data on the console, but first ignore any events that are
+ * not KEY_EVENTs.
*/
- if (ReadConsoleA(handle, infoPtr->buffer, CONSOLE_BUFFER_SIZE,
- (LPDWORD) &infoPtr->bytesRead, NULL) != FALSE) {
+
+ if (readConsoleBytes(handle, infoPtr->buffer, CONSOLE_BUFFER_SIZE,
+ (LPDWORD) &infoPtr->bytesRead) != FALSE) {
/*
* Data was stored in the buffer.
*/
-
+
infoPtr->readFlags |= CONSOLE_BUFFERED;
} else {
DWORD err;
err = GetLastError();
-
+
if (err == (DWORD)EOF) {
infoPtr->readFlags = CONSOLE_EOF;
}
}
/*
- * Signal the main thread by signalling the readable event and
- * then waking up the notifier thread.
+ * Signal the main thread by signalling the readable event and then
+ * waking up the notifier thread.
*/
SetEvent(infoPtr->readable);
/*
- * Alert the foreground thread. Note that we need to treat this like
- * a critical section so the foreground thread does not terminate
- * this thread while we are holding a mutex in the notifier code.
+ * Alert the foreground thread. Note that we need to treat this like a
+ * critical section so the foreground thread does not terminate this
+ * thread while we are holding a mutex in the notifier code.
*/
Tcl_MutexLock(&consoleMutex);
if (infoPtr->threadId != NULL) {
- /* TIP #218. When in flight ignore the event, no one will receive it anyway */
+ /*
+ * TIP #218. When in flight ignore the event, no one will receive
+ * it anyway.
+ */
Tcl_ThreadAlert(infoPtr->threadId);
}
Tcl_MutexUnlock(&consoleMutex);
@@ -1185,21 +1220,23 @@ ConsoleReaderThread(LPVOID arg)
*
* ConsoleWriterThread --
*
- * This function runs in a separate thread and writes data
- * onto a console.
+ * This function runs in a separate thread and writes data onto a
+ * console.
*
* Results:
* Always returns 0.
*
* Side effects:
- * Signals the main thread when an output operation is completed.
- * May cause the main thread to wake up by posting a message.
+
+ * Signals the main thread when an output operation is completed. May
+ * cause the main thread to wake up by posting a message.
*
*----------------------------------------------------------------------
*/
static DWORD WINAPI
-ConsoleWriterThread(LPVOID arg)
+ConsoleWriterThread(
+ LPVOID arg)
{
ConsoleInfo *infoPtr = (ConsoleInfo *)arg;
@@ -1221,8 +1258,8 @@ ConsoleWriterThread(LPVOID arg)
if (waitResult != (WAIT_OBJECT_0 + 1)) {
/*
- * The start event was not signaled. It must be the stop event
- * or an error, so exit this thread.
+ * The start event was not signaled. It must be the stop event or
+ * an error, so exit this thread.
*/
break;
@@ -1236,7 +1273,8 @@ ConsoleWriterThread(LPVOID arg)
*/
while (toWrite > 0) {
- if (WriteConsoleA(handle, buf, toWrite, &count, NULL) == FALSE) {
+ if (writeConsoleBytes(handle, buf, (DWORD)toWrite,
+ &count) == FALSE) {
infoPtr->writeError = GetLastError();
break;
} else {
@@ -1246,21 +1284,25 @@ ConsoleWriterThread(LPVOID arg)
}
/*
- * Signal the main thread by signalling the writable event and
- * then waking up the notifier thread.
+ * Signal the main thread by signalling the writable event and then
+ * waking up the notifier thread.
*/
-
+
SetEvent(infoPtr->writable);
/*
- * Alert the foreground thread. Note that we need to treat this like
- * a critical section so the foreground thread does not terminate
- * this thread while we are holding a mutex in the notifier code.
+ * Alert the foreground thread. Note that we need to treat this like a
+ * critical section so the foreground thread does not terminate this
+ * thread while we are holding a mutex in the notifier code.
*/
Tcl_MutexLock(&consoleMutex);
if (infoPtr->threadId != NULL) {
- /* TIP #218. When in flight ignore the event, no one will receive it anyway */
+ /*
+ * TIP #218. When in flight ignore the event, no one will receive
+ * it anyway.
+ */
+
Tcl_ThreadAlert(infoPtr->threadId);
}
Tcl_MutexUnlock(&consoleMutex);
@@ -1268,8 +1310,6 @@ ConsoleWriterThread(LPVOID arg)
return 0;
}
-
-
/*
*----------------------------------------------------------------------
@@ -1277,8 +1317,8 @@ ConsoleWriterThread(LPVOID arg)
* TclWinOpenConsoleChannel --
*
* Constructs a Console channel for the specified standard OS handle.
- * This is a helper function to break up the construction of
- * channels into File, Console, or Serial.
+ * This is a helper function to break up the construction of channels
+ * into File, Console, or Serial.
*
* Results:
* Returns the new channel, or NULL.
@@ -1290,10 +1330,10 @@ ConsoleWriterThread(LPVOID arg)
*/
Tcl_Channel
-TclWinOpenConsoleChannel(handle, channelName, permissions)
- HANDLE handle;
- char *channelName;
- int permissions;
+TclWinOpenConsoleChannel(
+ HANDLE handle,
+ char *channelName,
+ int permissions)
{
char encoding[4 + TCL_INTEGER_SPACE];
ConsoleInfo *infoPtr;
@@ -1304,7 +1344,7 @@ TclWinOpenConsoleChannel(handle, channelName, permissions)
/*
* See if a channel with this handle already exists.
*/
-
+
infoPtr = (ConsoleInfo *) ckalloc((unsigned) sizeof(ConsoleInfo));
memset(infoPtr, 0, sizeof(ConsoleInfo));
@@ -1317,23 +1357,23 @@ TclWinOpenConsoleChannel(handle, channelName, permissions)
infoPtr->threadId = Tcl_GetCurrentThread();
/*
- * Use the pointer for the name of the result channel.
- * This keeps the channel names unique, since some may share
- * handles (stdin/stdout/stderr for instance).
+ * Use the pointer for the name of the result channel. This keeps the
+ * channel names unique, since some may share handles (stdin/stdout/stderr
+ * for instance).
*/
- wsprintfA(channelName, "file%lx", (int) infoPtr);
-
+ wsprintfA(channelName, "file%lx", PTR2INT(infoPtr));
+
infoPtr->channel = Tcl_CreateChannel(&consoleChannelType, channelName,
- (ClientData) infoPtr, permissions);
+ (ClientData) infoPtr, permissions);
if (permissions & TCL_READABLE) {
/*
* Make sure the console input buffer is ready for only character
- * input notifications and the buffer is set for line buffering.
- * IOW, we only want to catch when complete lines are ready for
- * reading.
+ * input notifications and the buffer is set for line buffering. IOW,
+ * we only want to catch when complete lines are ready for reading.
*/
+
GetConsoleMode(infoPtr->handle, &modes);
modes &= ~(ENABLE_WINDOW_INPUT | ENABLE_MOUSE_INPUT);
modes |= ENABLE_LINE_INPUT;
@@ -1343,7 +1383,7 @@ TclWinOpenConsoleChannel(handle, channelName, permissions)
infoPtr->startReader = CreateEvent(NULL, FALSE, FALSE, NULL);
infoPtr->stopReader = CreateEvent(NULL, FALSE, FALSE, NULL);
infoPtr->readThread = CreateThread(NULL, 256, ConsoleReaderThread,
- infoPtr, 0, &id);
+ infoPtr, 0, &id);
SetThreadPriority(infoPtr->readThread, THREAD_PRIORITY_HIGHEST);
}
@@ -1352,18 +1392,21 @@ TclWinOpenConsoleChannel(handle, channelName, permissions)
infoPtr->startWriter = CreateEvent(NULL, FALSE, FALSE, NULL);
infoPtr->stopWriter = CreateEvent(NULL, FALSE, FALSE, NULL);
infoPtr->writeThread = CreateThread(NULL, 256, ConsoleWriterThread,
- infoPtr, 0, &id);
+ infoPtr, 0, &id);
SetThreadPriority(infoPtr->writeThread, THREAD_PRIORITY_HIGHEST);
}
/*
- * Files have default translation of AUTO and ^Z eof char, which
- * means that a ^Z will be accepted as EOF when reading.
+ * Files have default translation of AUTO and ^Z eof char, which means
+ * that a ^Z will be accepted as EOF when reading.
*/
-
+
Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto");
Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "\032 {}");
- Tcl_SetChannelOption(NULL, infoPtr->channel, "-encoding", encoding);
+ if (tclWinProcs->useWide)
+ Tcl_SetChannelOption(NULL, infoPtr->channel, "-encoding", "unicode");
+ else
+ Tcl_SetChannelOption(NULL, infoPtr->channel, "-encoding", encoding);
return infoPtr->channel;
}
@@ -1385,33 +1428,42 @@ TclWinOpenConsoleChannel(handle, channelName, permissions)
*/
static void
-ConsoleThreadActionProc (instanceData, action)
- ClientData instanceData;
- int action;
+ConsoleThreadActionProc(
+ ClientData instanceData,
+ int action)
{
ConsoleInfo *infoPtr = (ConsoleInfo *) instanceData;
- /* 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.
+ /* 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.
*/
Tcl_MutexLock(&consoleMutex);
if (action == TCL_CHANNEL_THREAD_INSERT) {
- /* We can't copy the thread information from the channel when
- * the channel is created. At this time the channel back
- * pointer has not been set yet. However in that case the
- * threadId has already been set by TclpCreateCommandChannel
- * itself, so the structure is still good.
+ /*
+ * We can't copy the thread information from the channel when the
+ * channel is created. At this time the channel back pointer has not
+ * been set yet. However in that case the threadId has already been
+ * set by TclpCreateCommandChannel itself, so the structure is still
+ * good.
*/
- ConsoleInit ();
- if (infoPtr->channel != NULL) {
- infoPtr->threadId = Tcl_GetChannelThread (infoPtr->channel);
+ ConsoleInit();
+ if (infoPtr->channel != NULL) {
+ infoPtr->threadId = Tcl_GetChannelThread(infoPtr->channel);
}
} else {
infoPtr->threadId = NULL;
}
Tcl_MutexUnlock(&consoleMutex);
}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/win/tclWinDde.c b/win/tclWinDde.c
index 291a244..9f39b37 100644
--- a/win/tclWinDde.c
+++ b/win/tclWinDde.c
@@ -1,31 +1,30 @@
-/*
+/*
* tclWinDde.c --
*
- * This file provides procedures that implement the "send"
- * command, allowing commands to be passed from interpreter
- * to interpreter.
+ * This file provides functions that implement the "send" command,
+ * allowing commands to be passed from interpreter to interpreter.
*
* Copyright (c) 1997 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.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
-#include "tclPort.h"
+#include "tclInt.h"
#include <dde.h>
#include <ddeml.h>
-#include <tchar.h>
/*
- * 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.
+ * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the Dde_Init
+ * declaration is in the source file itself, which is only accessed when we
+ * are building a library. DO NOT MOVE BEFORE ANY #include LINES. ONLY USE
+ * EXTERN TO INDICATE EXPORTED FUNCTIONS FROM NOW ON.
*/
#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLEXPORT
-/*
+/*
* The following structure is used to keep track of the interpreters
* registered by this process.
*/
@@ -35,6 +34,7 @@ typedef struct RegisteredInterp {
/* The next interp this application knows
* about. */
char *name; /* Interpreter's name (malloc-ed). */
+ Tcl_Obj *handlerPtr; /* The server handler command */
Tcl_Interp *interp; /* The interpreter attached to this name. */
} RegisteredInterp;
@@ -50,64 +50,77 @@ typedef struct Conversation {
Tcl_Obj *returnPackagePtr; /* The result package for this conversation. */
} Conversation;
+typedef struct DdeEnumServices {
+ Tcl_Interp *interp;
+ int result;
+ ATOM service;
+ ATOM topic;
+ HWND hwnd;
+} DdeEnumServices;
+
typedef struct ThreadSpecificData {
Conversation *currentConversations;
- /* A list of conversations currently
- * being processed. */
+ /* A list of conversations currently being
+ * processed. */
RegisteredInterp *interpListPtr;
- /* List of all interpreters registered
- * in the current process. */
+ /* List of all interpreters registered in the
+ * current process. */
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;
/*
- * The following variables cannot be placed in thread-local storage.
- * The Mutex ddeMutex guards access to the ddeInstance.
+ * The following variables cannot be placed in thread-local storage. The Mutex
+ * ddeMutex guards access to the ddeInstance.
*/
+
static HSZ ddeServiceGlobal = 0;
-static DWORD ddeInstance; /* The application instance handle given
- * to us by DdeInitialize. */
+static DWORD ddeInstance; /* The application instance handle given to us
+ * by DdeInitialize. */
static int ddeIsServer = 0;
-#define TCL_DDE_VERSION "1.2.4"
-#define TCL_DDE_PACKAGE_NAME "dde"
-#define TCL_DDE_SERVICE_NAME "TclEval"
+#define TCL_DDE_VERSION "1.3.2"
+#define TCL_DDE_PACKAGE_NAME "dde"
+#define TCL_DDE_SERVICE_NAME "TclEval"
+#define TCL_DDE_EXECUTE_RESULT "$TCLEVAL$EXECUTE$RESULT"
TCL_DECLARE_MUTEX(ddeMutex)
/*
- * Forward declarations for procedures defined later in this file.
+ * Forward declarations for functions defined later in this file.
*/
-static void DdeExitProc _ANSI_ARGS_((ClientData clientData));
-static void DeleteProc _ANSI_ARGS_((ClientData clientData));
-static Tcl_Obj * ExecuteRemoteObject _ANSI_ARGS_((
- RegisteredInterp *riPtr,
- Tcl_Obj *ddeObjectPtr));
-static int MakeDdeConnection _ANSI_ARGS_((Tcl_Interp *interp,
- char *name, HCONV *ddeConvPtr));
-static HDDEDATA CALLBACK DdeServerProc _ANSI_ARGS_((UINT uType,
- UINT uFmt, HCONV hConv, HSZ ddeTopic,
- HSZ ddeItem, HDDEDATA hData, DWORD dwData1,
- DWORD dwData2));
-static void SetDdeError _ANSI_ARGS_((Tcl_Interp *interp));
-static int DdeGetServicesList _ANSI_ARGS_((
- Tcl_Interp *interp,
- char *serviceName,
- char *topicName));
-int Tcl_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 */
-
-EXTERN int Dde_Init(Tcl_Interp *interp);
+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 void DdeExitProc(ClientData clientData);
+static int DdeGetServicesList(Tcl_Interp *interp,
+ char *serviceName, char *topicName);
+static HDDEDATA CALLBACK DdeServerProc(UINT uType, UINT uFmt, HCONV hConv,
+ HSZ ddeTopic, HSZ ddeItem, HDDEDATA hData,
+ DWORD dwData1, DWORD dwData2);
+static LRESULT DdeServicesOnAck(HWND hwnd, WPARAM wParam,
+ LPARAM lParam);
+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 void SetDdeError(Tcl_Interp *interp);
+
+int Tcl_DdeObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]);
+
+EXTERN int Dde_Init(Tcl_Interp *interp);
+EXTERN int Dde_SafeInit(Tcl_Interp *interp);
/*
*----------------------------------------------------------------------
*
* Dde_Init --
*
- * This procedure initializes the dde command.
+ * This function initializes the dde command.
*
* Results:
* A standard Tcl result.
@@ -127,15 +140,40 @@ Dde_Init(
}
Tcl_CreateObjCommand(interp, "dde", Tcl_DdeObjCmd, NULL, NULL);
-
Tcl_CreateExitHandler(DdeExitProc, NULL);
-
return Tcl_PkgProvide(interp, TCL_DDE_PACKAGE_NAME, TCL_DDE_VERSION);
}
/*
*----------------------------------------------------------------------
*
+ * Dde_SafeInit --
+ *
+ * This function initializes the dde command within a safe interp
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Dde_SafeInit(
+ Tcl_Interp *interp)
+{
+ int result = Dde_Init(interp);
+ if (result == TCL_OK) {
+ Tcl_HideCommand(interp, "dde", "dde");
+ }
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Initialize --
*
* Initialize the global DDE instance.
@@ -154,11 +192,11 @@ Initialize(void)
{
int nameFound = 0;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-
+
/*
- * See if the application is already registered; if so, remove its
- * current name from the registry. The deletion of the command
- * will take care of disposing of this entry.
+ * See if the application is already registered; if so, remove its current
+ * name from the registry. The deletion of the command will take care of
+ * disposing of this entry.
*/
if (tsdPtr->interpListPtr != NULL) {
@@ -166,18 +204,16 @@ Initialize(void)
}
/*
- * Make sure that the DDE server is there. This is done only once,
- * add an exit handler tear it down.
+ * Make sure that the DDE server is there. This is done only once, add an
+ * exit handler tear it down.
*/
if (ddeInstance == 0) {
Tcl_MutexLock(&ddeMutex);
if (ddeInstance == 0) {
if (DdeInitialize(&ddeInstance, (PFNCALLBACK) DdeServerProc,
- CBF_SKIP_REGISTRATIONS
- | CBF_SKIP_UNREGISTRATIONS
- | CBF_FAIL_POKES, 0)
- != DMLERR_NO_ERROR) {
+ CBF_SKIP_REGISTRATIONS | CBF_SKIP_UNREGISTRATIONS
+ | CBF_FAIL_POKES, 0) != DMLERR_NO_ERROR) {
ddeInstance = 0;
}
}
@@ -188,7 +224,7 @@ Initialize(void)
if ((ddeServiceGlobal == 0) && (nameFound != 0)) {
ddeIsServer = 1;
Tcl_CreateExitHandler(DdeExitProc, NULL);
- ddeServiceGlobal = DdeCreateStringHandle(ddeInstance, \
+ ddeServiceGlobal = DdeCreateStringHandle(ddeInstance,
TCL_DDE_SERVICE_NAME, 0);
DdeNameService(ddeInstance, ddeServiceGlobal, 0L, DNS_REGISTER);
} else {
@@ -196,53 +232,58 @@ Initialize(void)
}
Tcl_MutexUnlock(&ddeMutex);
}
-}
+}
/*
- *--------------------------------------------------------------
+ *----------------------------------------------------------------------
*
* DdeSetServerName --
*
- * This procedure is called to associate an ASCII name with a Dde
- * server. If the interpreter has already been named, the
- * name replaces the old one.
+ * This function is called to associate an ASCII name with a Dde server.
+ * If the interpreter has already been named, the name replaces the old
+ * one.
*
* Results:
- * The return value is the name actually given to the interp.
- * This will normally be the same as name, but if name was already
- * in use for a Dde Server then a name of the form "name #2" will
- * be chosen, with a high enough number to make the name unique.
+ * The return value is the name actually given to the interp. This will
+ * normally be the same as name, but if name was already in use for a Dde
+ * Server then a name of the form "name #2" will be chosen, with a high
+ * enough number to make the name unique.
*
* Side effects:
- * Registration info is saved, thereby allowing the "send" command
- * to be used later to invoke commands in the application. In
- * addition, the "send" command is created in the application's
- * interpreter. The registration will be removed automatically
- * if the interpreter is deleted or the "send" command is removed.
+ * Registration info is saved, thereby allowing the "send" command to be
+ * used later to invoke commands in the application. In addition, the
+ * "send" command is created in the application's interpreter. The
+ * registration will be removed automatically if the interpreter is
+ * deleted or the "send" command is removed.
*
- *--------------------------------------------------------------
+ *----------------------------------------------------------------------
*/
static char *
DdeSetServerName(
Tcl_Interp *interp,
- char *name /* The name that will be used to
- * refer to the interpreter in later
- * "send" commands. Must be globally
- * unique. */
- )
+ 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 */
+ Tcl_Obj *handlerPtr) /* Name of the optional proc/command to handle
+ * incoming Dde eval's */
{
+ int suffix, offset;
RegisteredInterp *riPtr, *prevPtr;
Tcl_DString dString;
+ char *actualName;
+ Tcl_Obj *srvListPtr = NULL, **srvPtrPtr = NULL;
+ int n, srvCount = 0, lastSuffix, r = TCL_OK;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
/*
- * See if the application is already registered; if so, remove its
- * current name from the registry. The deletion of the command
- * will take care of disposing of this entry.
+ * See if the application is already registered; if so, remove its current
+ * name from the registry. The deletion of the command will take care of
+ * disposing of this entry.
*/
- for (riPtr = tsdPtr->interpListPtr, prevPtr = NULL; riPtr != NULL;
+ for (riPtr = tsdPtr->interpListPtr, prevPtr = NULL; riPtr != NULL;
prevPtr = riPtr, riPtr = riPtr->nextPtr) {
if (riPtr->interp == interp) {
if (name != NULL) {
@@ -254,8 +295,8 @@ DdeSetServerName(
break;
} else {
/*
- * the name was NULL, so the caller is asking for
- * the name of the current interp.
+ * The name was NULL, so the caller is asking for the name of
+ * the current interp.
*/
return riPtr->name;
@@ -265,22 +306,74 @@ DdeSetServerName(
if (name == NULL) {
/*
- * the name was NULL, so the caller is asking for
- * the name of the current interp, but it doesn't
- * have a name.
+ * The name was NULL, so the caller is asking for the name of the
+ * current interp, but it doesn't have a name.
*/
return "";
}
-
+
/*
- * Pick a name to use for the application. Use "name" if it's not
- * already in use. Otherwise add a suffix such as " #2", trying
- * larger and larger numbers until we eventually find one that is
- * unique.
+ * Get the list of currently registered Tcl interpreters by calling the
+ * internal implementation of the 'dde services' command.
*/
Tcl_DStringInit(&dString);
+ actualName = name;
+
+ if (!exactName) {
+ r = DdeGetServicesList(interp, TCL_DDE_SERVICE_NAME, NULL);
+ if (r == TCL_OK) {
+ srvListPtr = Tcl_GetObjResult(interp);
+ }
+ if (r == TCL_OK) {
+ r = Tcl_ListObjGetElements(interp, srvListPtr, &srvCount,
+ &srvPtrPtr);
+ }
+ if (r != TCL_OK) {
+ OutputDebugString(Tcl_GetStringResult(interp));
+ return NULL;
+ }
+
+ /*
+ * Pick a name to use for the application. Use "name" if it's not
+ * already in use. Otherwise add a suffix such as " #2", trying larger
+ * and larger numbers until we eventually find one that is unique.
+ */
+
+ offset = lastSuffix = 0;
+ suffix = 1;
+
+ while (suffix != lastSuffix) {
+ lastSuffix = suffix;
+ if (suffix > 1) {
+ if (suffix == 2) {
+ Tcl_DStringAppend(&dString, name, -1);
+ Tcl_DStringAppend(&dString, " #", 2);
+ offset = Tcl_DStringLength(&dString);
+ Tcl_DStringSetLength(&dString, offset + TCL_INTEGER_SPACE);
+ actualName = Tcl_DStringValue(&dString);
+ }
+ sprintf(Tcl_DStringValue(&dString) + offset, "%d", suffix);
+ }
+
+ /*
+ * See if the name is already in use, if so increment suffix.
+ */
+
+ for (n = 0; n < srvCount; ++n) {
+ Tcl_Obj* namePtr;
+
+ Tcl_ListObjIndex(interp, srvPtrPtr[n], 1, &namePtr);
+ if (strcmp(actualName, Tcl_GetString(namePtr)) == 0) {
+ suffix++;
+ break;
+ }
+ }
+ }
+ Tcl_DStringSetLength(&dString,
+ offset + (int)strlen(Tcl_DStringValue(&dString)+offset));
+ }
/*
* We have found a unique name. Now add it to the registry.
@@ -288,10 +381,18 @@ DdeSetServerName(
riPtr = (RegisteredInterp *) ckalloc(sizeof(RegisteredInterp));
riPtr->interp = interp;
- riPtr->name = ckalloc((unsigned int) strlen(name) + 1);
+ riPtr->name = ckalloc((unsigned int) strlen(actualName) + 1);
riPtr->nextPtr = tsdPtr->interpListPtr;
+ riPtr->handlerPtr = handlerPtr;
+ if (riPtr->handlerPtr != NULL) {
+ Tcl_IncrRefCount(riPtr->handlerPtr);
+ }
tsdPtr->interpListPtr = riPtr;
- strcpy(riPtr->name, name);
+ strcpy(riPtr->name, actualName);
+
+ if (Tcl_IsSafe(interp)) {
+ Tcl_ExposeCommand(interp, "dde", "dde");
+ }
Tcl_CreateObjCommand(interp, "dde", Tcl_DdeObjCmd,
(ClientData) riPtr, DeleteProc);
@@ -301,19 +402,52 @@ DdeSetServerName(
Tcl_DStringFree(&dString);
/*
- * re-initialize with the new name
+ * Re-initialize with the new name.
*/
+
Initialize();
-
+
return riPtr->name;
}
/*
- *--------------------------------------------------------------
+ *----------------------------------------------------------------------
+ *
+ * DdeGetRegistrationPtr
+ *
+ * Retrieve the registration info for an interpreter.
+ *
+ * Results:
+ * Returns a pointer to the registration structure or NULL
+ *
+ * Side effects:
+ * None
+ *
+ *----------------------------------------------------------------------
+ */
+
+static RegisteredInterp *
+DdeGetRegistrationPtr(
+ Tcl_Interp *interp)
+{
+ RegisteredInterp *riPtr;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ for (riPtr = tsdPtr->interpListPtr; riPtr != NULL;
+ riPtr = riPtr->nextPtr) {
+ if (riPtr->interp == interp) {
+ break;
+ }
+ }
+ return riPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
*
* DeleteProc
*
- * This procedure is called when the command "dde" is destroyed.
+ * This function is called when the command "dde" is destroyed.
*
* Results:
* none
@@ -321,20 +455,20 @@ DdeSetServerName(
* Side effects:
* The interpreter given by riPtr is unregistered.
*
- *--------------------------------------------------------------
+ *----------------------------------------------------------------------
*/
static void
-DeleteProc(clientData)
- ClientData clientData; /* The interp we are deleting passed
- * as ClientData. */
+DeleteProc(
+ ClientData clientData) /* The interp we are deleting passed as
+ * ClientData. */
{
RegisteredInterp *riPtr = (RegisteredInterp *) clientData;
RegisteredInterp *searchPtr, *prevPtr;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
for (searchPtr = tsdPtr->interpListPtr, prevPtr = NULL;
- (searchPtr != NULL) && (searchPtr != riPtr);
+ searchPtr != NULL && searchPtr != riPtr;
prevPtr = searchPtr, searchPtr = searchPtr->nextPtr) {
/*
* Empty loop body.
@@ -349,31 +483,33 @@ DeleteProc(clientData)
}
}
ckfree(riPtr->name);
+ if (riPtr->handlerPtr) {
+ Tcl_DecrRefCount(riPtr->handlerPtr);
+ }
Tcl_EventuallyFree(clientData, TCL_DYNAMIC);
}
/*
- *--------------------------------------------------------------
+ *----------------------------------------------------------------------
*
* ExecuteRemoteObject --
*
- * Takes the package delivered by DDE and executes it in
- * the server's interpreter.
+ * Takes the package delivered by DDE and executes it in the server's
+ * interpreter.
*
* Results:
- * A list Tcl_Obj * that describes what happened. The first
- * element is the numerical return code (TCL_ERROR, etc.).
- * The second element is the result of the script. If the
- * return result was TCL_ERROR, then the third element
- * will be the value of the global "errorCode", and the
- * fourth will be the value of the global "errorInfo".
- * The return result will have a refCount of 0.
+ * A list Tcl_Obj * that describes what happened. The first element is
+ * the numerical return code (TCL_ERROR, etc.). The second element is the
+ * result of the script. If the return result was TCL_ERROR, then the
+ * third element will be the value of the global "errorCode", and the
+ * fourth will be the value of the global "errorInfo". The return result
+ * will have a refCount of 0.
*
* Side effects:
- * A Tcl script is run, which can cause all kinds of other
- * things to happen.
+ * A Tcl script is run, which can cause all kinds of other things to
+ * happen.
*
- *--------------------------------------------------------------
+ *----------------------------------------------------------------------
*/
static Tcl_Obj *
@@ -381,63 +517,86 @@ ExecuteRemoteObject(
RegisteredInterp *riPtr, /* Info about this server. */
Tcl_Obj *ddeObjectPtr) /* The object to execute. */
{
- Tcl_Obj *errorObjPtr;
Tcl_Obj *returnPackagePtr;
- int result;
+ int result = TCL_OK;
- result = Tcl_EvalObjEx(riPtr->interp, ddeObjectPtr, TCL_EVAL_GLOBAL);
- returnPackagePtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
- Tcl_ListObjAppendElement(NULL, returnPackagePtr,
- Tcl_NewIntObj(result));
+ if (riPtr->handlerPtr == NULL && Tcl_IsSafe(riPtr->interp)) {
+ Tcl_SetObjResult(riPtr->interp, Tcl_NewStringObj("permission denied: "
+ "a handler procedure must be defined for use in a safe "
+ "interp", -1));
+ result = TCL_ERROR;
+ }
+
+ if (riPtr->handlerPtr != NULL) {
+ /*
+ * Add the dde request data to the handler proc list.
+ */
+
+ Tcl_Obj *cmdPtr = Tcl_DuplicateObj(riPtr->handlerPtr);
+
+ result = Tcl_ListObjAppendElement(riPtr->interp, cmdPtr, ddeObjectPtr);
+ if (result == TCL_OK) {
+ ddeObjectPtr = cmdPtr;
+ }
+ }
+
+ if (result == TCL_OK) {
+ result = Tcl_EvalObjEx(riPtr->interp, ddeObjectPtr, TCL_EVAL_GLOBAL);
+ }
+
+ returnPackagePtr = Tcl_NewListObj(0, NULL);
+
+ Tcl_ListObjAppendElement(NULL, returnPackagePtr, Tcl_NewIntObj(result));
Tcl_ListObjAppendElement(NULL, returnPackagePtr,
Tcl_GetObjResult(riPtr->interp));
+
if (result == TCL_ERROR) {
- errorObjPtr = Tcl_GetVar2Ex(riPtr->interp, "errorCode", NULL,
+ Tcl_Obj *errorObjPtr = Tcl_GetVar2Ex(riPtr->interp, "errorCode", NULL,
TCL_GLOBAL_ONLY);
- Tcl_ListObjAppendElement(NULL, returnPackagePtr, errorObjPtr);
+ if (errorObjPtr) {
+ Tcl_ListObjAppendElement(NULL, returnPackagePtr, errorObjPtr);
+ }
errorObjPtr = Tcl_GetVar2Ex(riPtr->interp, "errorInfo", NULL,
TCL_GLOBAL_ONLY);
- Tcl_ListObjAppendElement(NULL, returnPackagePtr, errorObjPtr);
+ if (errorObjPtr) {
+ Tcl_ListObjAppendElement(NULL, returnPackagePtr, errorObjPtr);
+ }
}
return returnPackagePtr;
}
/*
- *--------------------------------------------------------------
+ *----------------------------------------------------------------------
*
* DdeServerProc --
*
- * Handles all transactions for this server. Can handle
- * execute, request, and connect protocols. Dde will
- * call this routine when a client attempts to run a dde
- * command using this server.
+ * Handles all transactions for this server. Can handle execute, request,
+ * and connect protocols. Dde will call this routine when a client
+ * attempts to run a dde command using this server.
*
* Results:
* A DDE Handle with the result of the dde command.
*
* Side effects:
- * Depending on which command is executed, arbitrary
- * Tcl scripts can be run.
+ * Depending on which command is executed, arbitrary Tcl scripts can be
+ * run.
*
- *--------------------------------------------------------------
+ *----------------------------------------------------------------------
*/
static HDDEDATA CALLBACK
-DdeServerProc (
- UINT uType, /* The type of DDE transaction we
- * are performing. */
- UINT uFmt, /* The format that data is sent or
- * received. */
- HCONV hConv, /* The conversation associated with the
+DdeServerProc(
+ UINT uType, /* The type of DDE transaction we are
+ * performing. */
+ UINT uFmt, /* The format that data is sent or received. */
+ HCONV hConv, /* The conversation associated with the
* current transaction. */
- HSZ ddeTopic, /* A string handle. Transaction-type
- * dependent. */
- HSZ ddeItem, /* A string handle. Transaction-type
+ HSZ ddeTopic, HSZ ddeItem, /* String handles. Transaction-type
* dependent. */
HDDEDATA hData, /* DDE data. Transaction-type dependent. */
- DWORD dwData1, /* Transaction-dependent data. */
- DWORD dwData2) /* Transaction-dependent data. */
+ DWORD dwData1, DWORD dwData2)
+ /* Transaction-dependent data. */
{
Tcl_DString dString;
int len;
@@ -450,129 +609,125 @@ DdeServerProc (
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
switch(uType) {
- case XTYP_CONNECT:
-
- /*
- * Dde is trying to initialize a conversation with us. Check
- * and make sure we have a valid topic.
- */
+ case XTYP_CONNECT:
+ /*
+ * Dde is trying to initialize a conversation with us. Check and make
+ * sure we have a valid topic.
+ */
- len = DdeQueryString(ddeInstance, ddeTopic, NULL, 0, 0);
- Tcl_DStringInit(&dString);
- Tcl_DStringSetLength(&dString, len);
- utilString = Tcl_DStringValue(&dString);
- DdeQueryString(ddeInstance, ddeTopic, utilString, (DWORD) len + 1,
- CP_WINANSI);
+ len = DdeQueryString(ddeInstance, ddeTopic, NULL, 0, 0);
+ Tcl_DStringInit(&dString);
+ Tcl_DStringSetLength(&dString, len);
+ utilString = Tcl_DStringValue(&dString);
+ DdeQueryString(ddeInstance, ddeTopic, utilString, (DWORD) len + 1,
+ CP_WINANSI);
- for (riPtr = tsdPtr->interpListPtr; riPtr != NULL;
- riPtr = riPtr->nextPtr) {
- if (stricmp(utilString, riPtr->name) == 0) {
- Tcl_DStringFree(&dString);
- return (HDDEDATA) TRUE;
- }
+ for (riPtr = tsdPtr->interpListPtr; riPtr != NULL;
+ riPtr = riPtr->nextPtr) {
+ if (stricmp(utilString, riPtr->name) == 0) {
+ Tcl_DStringFree(&dString);
+ return (HDDEDATA) TRUE;
}
+ }
- Tcl_DStringFree(&dString);
- return (HDDEDATA) FALSE;
-
- case XTYP_CONNECT_CONFIRM:
+ Tcl_DStringFree(&dString);
+ return (HDDEDATA) FALSE;
- /*
- * Dde has decided that we can connect, so it gives us a
- * conversation handle. We need to keep track of it
- * so we know which execution result to return in an
- * XTYP_REQUEST.
- */
+ case XTYP_CONNECT_CONFIRM:
+ /*
+ * Dde has decided that we can connect, so it gives us a conversation
+ * handle. We need to keep track of it so we know which execution
+ * result to return in an XTYP_REQUEST.
+ */
- len = DdeQueryString(ddeInstance, ddeTopic, NULL, 0, 0);
- Tcl_DStringInit(&dString);
- Tcl_DStringSetLength(&dString, len);
- utilString = Tcl_DStringValue(&dString);
- DdeQueryString(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));
- convPtr->nextPtr = tsdPtr->currentConversations;
- convPtr->returnPackagePtr = NULL;
- convPtr->hConv = hConv;
- convPtr->riPtr = riPtr;
- tsdPtr->currentConversations = convPtr;
- break;
- }
+ len = DdeQueryString(ddeInstance, ddeTopic, NULL, 0, 0);
+ Tcl_DStringInit(&dString);
+ Tcl_DStringSetLength(&dString, len);
+ utilString = Tcl_DStringValue(&dString);
+ DdeQueryString(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));
+ convPtr->nextPtr = tsdPtr->currentConversations;
+ convPtr->returnPackagePtr = NULL;
+ convPtr->hConv = hConv;
+ convPtr->riPtr = riPtr;
+ tsdPtr->currentConversations = convPtr;
+ break;
}
- Tcl_DStringFree(&dString);
- return (HDDEDATA) TRUE;
-
- case XTYP_DISCONNECT:
+ }
+ Tcl_DStringFree(&dString);
+ return (HDDEDATA) TRUE;
- /*
- * The client has disconnected from our server. Forget this
- * conversation.
- */
+ case XTYP_DISCONNECT:
+ /*
+ * The client has disconnected from our server. Forget this
+ * conversation.
+ */
- for (convPtr = tsdPtr->currentConversations, prevConvPtr = NULL;
- convPtr != NULL;
- prevConvPtr = convPtr, convPtr = convPtr->nextPtr) {
- if (hConv == convPtr->hConv) {
- if (prevConvPtr == NULL) {
- tsdPtr->currentConversations = convPtr->nextPtr;
- } else {
- prevConvPtr->nextPtr = convPtr->nextPtr;
- }
- if (convPtr->returnPackagePtr != NULL) {
- Tcl_DecrRefCount(convPtr->returnPackagePtr);
- }
- ckfree((char *) convPtr);
- break;
+ for (convPtr = tsdPtr->currentConversations, prevConvPtr = NULL;
+ convPtr != NULL;
+ prevConvPtr = convPtr, convPtr = convPtr->nextPtr) {
+ if (hConv == convPtr->hConv) {
+ if (prevConvPtr == NULL) {
+ tsdPtr->currentConversations = convPtr->nextPtr;
+ } else {
+ prevConvPtr->nextPtr = convPtr->nextPtr;
}
+ if (convPtr->returnPackagePtr != NULL) {
+ Tcl_DecrRefCount(convPtr->returnPackagePtr);
+ }
+ ckfree((char *) convPtr);
+ break;
}
- return (HDDEDATA) TRUE;
+ }
+ return (HDDEDATA) TRUE;
- case XTYP_REQUEST:
+ case XTYP_REQUEST:
+ /*
+ * This could be either a request for a value of a Tcl variable, or it
+ * could be the send command requesting the results of the last
+ * execute.
+ */
+
+ if (uFmt != CF_TEXT) {
+ return (HDDEDATA) FALSE;
+ }
+ ddeReturn = (HDDEDATA) FALSE;
+ for (convPtr = tsdPtr->currentConversations; (convPtr != NULL)
+ && (convPtr->hConv != hConv); convPtr = convPtr->nextPtr) {
/*
- * This could be either a request for a value of a Tcl variable,
- * or it could be the send command requesting the results of the
- * last execute.
+ * Empty loop body.
*/
+ }
- if (uFmt != CF_TEXT) {
- return (HDDEDATA) FALSE;
- }
+ if (convPtr != NULL) {
+ BYTE *returnString;
- ddeReturn = (HDDEDATA) FALSE;
- for (convPtr = tsdPtr->currentConversations; (convPtr != NULL)
- && (convPtr->hConv != hConv); convPtr = convPtr->nextPtr) {
- /*
- * Empty loop body.
- */
- }
-
- if (convPtr != NULL) {
- BYTE *returnString;
-
- len = DdeQueryString(ddeInstance, ddeItem, NULL, 0,
- CP_WINANSI);
- Tcl_DStringInit(&dString);
- Tcl_DStringSetLength(&dString, len);
- utilString = Tcl_DStringValue(&dString);
- DdeQueryString(ddeInstance, ddeItem, utilString,
- (DWORD) len + 1, CP_WINANSI);
- if (stricmp(utilString, "$TCLEVAL$EXECUTE$RESULT") == 0) {
- returnString =
- (BYTE *)Tcl_GetStringFromObj(convPtr->returnPackagePtr, &len);
- ddeReturn = DdeCreateDataHandle(ddeInstance,
- returnString, (DWORD) len+1, 0, ddeItem, CF_TEXT,
- 0);
+ len = DdeQueryString(ddeInstance, ddeItem, NULL, 0, CP_WINANSI);
+ Tcl_DStringInit(&dString);
+ Tcl_DStringSetLength(&dString, len);
+ utilString = Tcl_DStringValue(&dString);
+ DdeQueryString(ddeInstance, ddeItem, utilString, (DWORD) len + 1,
+ CP_WINANSI);
+ if (stricmp(utilString, TCL_DDE_EXECUTE_RESULT) == 0) {
+ returnString = (BYTE *)
+ Tcl_GetStringFromObj(convPtr->returnPackagePtr, &len);
+ ddeReturn = DdeCreateDataHandle(ddeInstance, returnString,
+ (DWORD) len+1, 0, ddeItem, CF_TEXT, 0);
+ } else {
+ if (Tcl_IsSafe(convPtr->riPtr->interp)) {
+ ddeReturn = NULL;
} else {
Tcl_Obj *variableObjPtr = Tcl_GetVar2Ex(
- convPtr->riPtr->interp, utilString, NULL,
+ convPtr->riPtr->interp, utilString, NULL,
TCL_GLOBAL_ONLY);
if (variableObjPtr != NULL) {
- returnString = (BYTE *)Tcl_GetStringFromObj(variableObjPtr,
- &len);
+ returnString = (BYTE *) Tcl_GetStringFromObj(
+ variableObjPtr, &len);
ddeReturn = DdeCreateDataHandle(ddeInstance,
returnString, (DWORD) len+1, 0, ddeItem,
CF_TEXT, 0);
@@ -580,106 +735,101 @@ DdeServerProc (
ddeReturn = NULL;
}
}
- Tcl_DStringFree(&dString);
}
- return ddeReturn;
+ Tcl_DStringFree(&dString);
+ }
+ return ddeReturn;
- case XTYP_EXECUTE: {
+ case XTYP_EXECUTE: {
+ /*
+ * Execute this script. The results will be saved into a list object
+ * which will be retreived later. See ExecuteRemoteObject.
+ */
+ Tcl_Obj *returnPackagePtr;
+
+ for (convPtr = tsdPtr->currentConversations; (convPtr != NULL)
+ && (convPtr->hConv != hConv); convPtr = convPtr->nextPtr) {
/*
- * Execute this script. The results will be saved into
- * a list object which will be retreived later. See
- * ExecuteRemoteObject.
+ * Empty loop body.
*/
+ }
- Tcl_Obj *returnPackagePtr;
-
- for (convPtr = tsdPtr->currentConversations; (convPtr != NULL)
- && (convPtr->hConv != hConv); convPtr = convPtr->nextPtr) {
- /*
- * Empty loop body.
- */
-
- }
-
- if (convPtr == NULL) {
- return (HDDEDATA) DDE_FNOTPROCESSED;
- }
-
- utilString = (char *) DdeAccessData(hData, &dlen);
- len = dlen;
- ddeObjectPtr = Tcl_NewStringObj(utilString, -1);
- Tcl_IncrRefCount(ddeObjectPtr);
- DdeUnaccessData(hData);
- if (convPtr->returnPackagePtr != NULL) {
- Tcl_DecrRefCount(convPtr->returnPackagePtr);
- }
- convPtr->returnPackagePtr = NULL;
- returnPackagePtr =
- ExecuteRemoteObject(convPtr->riPtr, ddeObjectPtr);
- Tcl_IncrRefCount(returnPackagePtr);
- for (convPtr = tsdPtr->currentConversations; (convPtr != NULL)
- && (convPtr->hConv != hConv); convPtr = convPtr->nextPtr) {
- /*
- * Empty loop body.
- */
-
- }
- if (convPtr != NULL) {
- convPtr->returnPackagePtr = returnPackagePtr;
- } else {
- Tcl_DecrRefCount(returnPackagePtr);
- }
- Tcl_DecrRefCount(ddeObjectPtr);
- if (returnPackagePtr == NULL) {
- return (HDDEDATA) DDE_FNOTPROCESSED;
- } else {
- return (HDDEDATA) DDE_FACK;
- }
+ if (convPtr == NULL) {
+ return (HDDEDATA) DDE_FNOTPROCESSED;
}
-
- case XTYP_WILDCONNECT: {
+ utilString = (char *) DdeAccessData(hData, &dlen);
+ len = dlen;
+ ddeObjectPtr = Tcl_NewStringObj(utilString, -1);
+ Tcl_IncrRefCount(ddeObjectPtr);
+ DdeUnaccessData(hData);
+ if (convPtr->returnPackagePtr != NULL) {
+ Tcl_DecrRefCount(convPtr->returnPackagePtr);
+ }
+ convPtr->returnPackagePtr = NULL;
+ returnPackagePtr = ExecuteRemoteObject(convPtr->riPtr, ddeObjectPtr);
+ Tcl_IncrRefCount(returnPackagePtr);
+ for (convPtr = tsdPtr->currentConversations; (convPtr != NULL)
+ && (convPtr->hConv != hConv); convPtr = convPtr->nextPtr) {
/*
- * Dde wants a list of services and topics that we support.
+ * Empty loop body.
*/
+ }
+ if (convPtr != NULL) {
+ convPtr->returnPackagePtr = returnPackagePtr;
+ } else {
+ Tcl_DecrRefCount(returnPackagePtr);
+ }
+ Tcl_DecrRefCount(ddeObjectPtr);
+ if (returnPackagePtr == NULL) {
+ return (HDDEDATA) DDE_FNOTPROCESSED;
+ } else {
+ return (HDDEDATA) DDE_FACK;
+ }
+ }
- HSZPAIR *returnPtr;
- int i;
- int numItems;
+ case XTYP_WILDCONNECT: {
+ /*
+ * Dde wants a list of services and topics that we support.
+ */
- for (i = 0, riPtr = tsdPtr->interpListPtr; riPtr != NULL;
- i++, riPtr = riPtr->nextPtr) {
- /*
- * Empty loop body.
- */
+ HSZPAIR *returnPtr;
+ int i;
+ int numItems;
- }
+ for (i = 0, riPtr = tsdPtr->interpListPtr; riPtr != NULL;
+ i++, riPtr = riPtr->nextPtr) {
+ /*
+ * Empty loop body.
+ */
+ }
- numItems = i;
- ddeReturn = DdeCreateDataHandle(ddeInstance, NULL,
- (numItems + 1) * sizeof(HSZPAIR), 0, 0, 0, 0);
- returnPtr = (HSZPAIR *) DdeAccessData(ddeReturn, &dlen);
- len = dlen;
- for (i = 0, riPtr = tsdPtr->interpListPtr; i < numItems;
- i++, riPtr = riPtr->nextPtr) {
- returnPtr[i].hszSvc = DdeCreateStringHandle(
- ddeInstance, "TclEval", CP_WINANSI);
- returnPtr[i].hszTopic = DdeCreateStringHandle(
- ddeInstance, riPtr->name, CP_WINANSI);
- }
- returnPtr[i].hszSvc = NULL;
- returnPtr[i].hszTopic = NULL;
- DdeUnaccessData(ddeReturn);
- return ddeReturn;
+ numItems = i;
+ ddeReturn = DdeCreateDataHandle(ddeInstance, NULL,
+ (numItems + 1) * sizeof(HSZPAIR), 0, 0, 0, 0);
+ returnPtr = (HSZPAIR *) DdeAccessData(ddeReturn, &dlen);
+ len = dlen;
+ for (i = 0, riPtr = tsdPtr->interpListPtr; i < numItems;
+ i++, riPtr = riPtr->nextPtr) {
+ returnPtr[i].hszSvc = DdeCreateStringHandle(ddeInstance,
+ TCL_DDE_SERVICE_NAME, CP_WINANSI);
+ returnPtr[i].hszTopic = DdeCreateStringHandle(ddeInstance,
+ riPtr->name, CP_WINANSI);
}
+ returnPtr[i].hszSvc = NULL;
+ returnPtr[i].hszTopic = NULL;
+ DdeUnaccessData(ddeReturn);
+ return ddeReturn;
+ }
+ default:
+ return NULL;
}
- return NULL;
}
/*
- *--------------------------------------------------------------
+ *----------------------------------------------------------------------
*
* DdeExitProc --
*
@@ -691,7 +841,7 @@ DdeServerProc (
* Side effects:
* The DDE server is deleted.
*
- *--------------------------------------------------------------
+ *----------------------------------------------------------------------
*/
static void
@@ -704,21 +854,20 @@ DdeExitProc(
}
/*
- *--------------------------------------------------------------
+ *----------------------------------------------------------------------
*
* MakeDdeConnection --
*
- * This procedure is a utility used to connect to a DDE
- * server when given a server name and a topic name.
+ * This function is a utility used to connect to a DDE server when given
+ * a server name and a topic name.
*
* Results:
* A standard Tcl result.
- *
*
* Side effects:
* Passes back a conversation through ddeConvPtr
*
- *--------------------------------------------------------------
+ *----------------------------------------------------------------------
*/
static int
@@ -729,9 +878,9 @@ MakeDdeConnection(
{
HSZ ddeTopic, ddeService;
HCONV ddeConv;
-
- ddeService = DdeCreateStringHandle(ddeInstance, "TclEval", 0);
- ddeTopic = DdeCreateStringHandle(ddeInstance, name, 0);
+
+ ddeService = DdeCreateStringHandle(ddeInstance, TCL_DDE_SERVICE_NAME, 0);
+ ddeTopic = DdeCreateStringHandle(ddeInstance, (void *) name, 0);
ddeConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL);
DdeFreeStringHandle(ddeInstance, ddeService);
@@ -740,7 +889,7 @@ MakeDdeConnection(
if (ddeConv == (HCONV) NULL) {
if (interp != NULL) {
Tcl_AppendResult(interp, "no registered server named \"",
- name, "\"", (char *) NULL);
+ name, "\"", NULL);
}
return TCL_ERROR;
}
@@ -750,14 +899,15 @@ MakeDdeConnection(
}
/*
- *--------------------------------------------------------------
+ *----------------------------------------------------------------------
*
* DdeGetServicesList --
*
- * This procedure obtains the list of DDE services.
+ * This function obtains the list of DDE services.
*
- * The functions between here and this procedure are all
- * involved with handling the DDE callbacks for this.
+ * The functions between here and this function are all involved with
+ * handling the DDE callbacks for this. They are: DdeCreateClient,
+ * DdeClientWindowProc, DdeServicesOnAck, and DdeEnumWindowsCallback
*
* Results:
* A standard Tcl result.
@@ -765,24 +915,12 @@ MakeDdeConnection(
* Side effects:
* Sets the services list into the interp result.
*
- *--------------------------------------------------------------
+ *----------------------------------------------------------------------
*/
-typedef struct ddeEnumServices {
- Tcl_Interp *interp;
- int result;
- ATOM service;
- ATOM topic;
- HWND hwnd;
-} ddeEnumServices;
-
-LRESULT CALLBACK
-DdeClientWindowProc(HWND hwnd, UINT uMsg, WPARAM wParam, LPARAM lParam);
-static LRESULT
-DdeServicesOnAck(HWND hwnd, WPARAM wParam, LPARAM lParam);
-
static int
-DdeCreateClient(ddeEnumServices *es)
+DdeCreateClient(
+ struct DdeEnumServices *es)
{
WNDCLASSEX wc;
static const char *szDdeClientClassName = "TclEval client class";
@@ -792,176 +930,196 @@ DdeCreateClient(ddeEnumServices *es)
wc.cbSize = sizeof(wc);
wc.lpfnWndProc = DdeClientWindowProc;
wc.lpszClassName = szDdeClientClassName;
- wc.cbWndExtra = sizeof(ddeEnumServices*);
+ wc.cbWndExtra = sizeof(struct DdeEnumServices *);
+
+ /*
+ * Register and create the callback window.
+ */
- /* register and create the callback window */
RegisterClassEx(&wc);
- es->hwnd = CreateWindowEx(0, szDdeClientClassName,
- szDdeClientWindowName,
- WS_POPUP, 0, 0, 0, 0, NULL, NULL, NULL,
- (LPVOID)es);
+ es->hwnd = CreateWindowEx(0, szDdeClientClassName, szDdeClientWindowName,
+ WS_POPUP, 0, 0, 0, 0, NULL, NULL, NULL, (LPVOID)es);
return TCL_OK;
}
-LRESULT CALLBACK
-DdeClientWindowProc(HWND hwnd, UINT uMsg, WPARAM wParam, LPARAM lParam)
+static LRESULT CALLBACK
+DdeClientWindowProc(
+ HWND hwnd, /* What window is the message for */
+ UINT uMsg, /* The type of message received */
+ WPARAM wParam,
+ LPARAM lParam) /* (Potentially) our local handle */
{
- LRESULT lr = 0L;
switch (uMsg) {
- case WM_CREATE: {
- LPCREATESTRUCT lpcs = (LPCREATESTRUCT)lParam;
- ddeEnumServices *es;
- es = (ddeEnumServices*)lpcs->lpCreateParams;
+ case WM_CREATE: {
+ LPCREATESTRUCT lpcs = (LPCREATESTRUCT) lParam;
+ struct DdeEnumServices *es =
+ (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);
+ SetWindowLong(hwnd, GWL_USERDATA, (long)es);
#endif
- break;
- }
- case WM_DDE_ACK:
- lr = DdeServicesOnAck(hwnd, wParam, lParam);
- break;
- default:
- lr = DefWindowProc(hwnd, uMsg, wParam, lParam);
+ return (LRESULT) 0L;
+ }
+ case WM_DDE_ACK:
+ return DdeServicesOnAck(hwnd, wParam, lParam);
+ break;
+ default:
+ return DefWindowProc(hwnd, uMsg, wParam, lParam);
}
- return lr;
}
static LRESULT
-DdeServicesOnAck(HWND hwnd, WPARAM wParam, LPARAM lParam)
+DdeServicesOnAck(
+ HWND hwnd,
+ WPARAM wParam,
+ LPARAM lParam)
{
HWND hwndRemote = (HWND)wParam;
ATOM service = (ATOM)LOWORD(lParam);
ATOM topic = (ATOM)HIWORD(lParam);
- ddeEnumServices *es;
- TCHAR sz[255];
+ struct DdeEnumServices *es;
+ char sz[255];
#ifdef _WIN64
- es = (ddeEnumServices *)GetWindowLongPtr(hwnd, GWLP_USERDATA);
+ es = (struct DdeEnumServices *) GetWindowLongPtr(hwnd, GWLP_USERDATA);
#else
- es = (ddeEnumServices *)GetWindowLong(hwnd, GWL_USERDATA);
+ es = (struct DdeEnumServices *) GetWindowLong(hwnd, GWL_USERDATA);
#endif
if ((es->service == (ATOM)0 || es->service == service)
- && (es->topic == (ATOM)0 || es->topic == topic)) {
+ && (es->topic == (ATOM)0 || es->topic == topic)) {
Tcl_Obj *matchPtr = Tcl_NewListObj(0, NULL);
+ Tcl_Obj *resultPtr = Tcl_GetObjResult(es->interp);
+
+ GlobalGetAtomNameA(service, sz, 255);
+ Tcl_ListObjAppendElement(NULL, matchPtr, Tcl_NewStringObj(sz, -1));
+ GlobalGetAtomNameA(topic, sz, 255);
+ Tcl_ListObjAppendElement(NULL, matchPtr, Tcl_NewStringObj(sz, -1));
- GlobalGetAtomName(service, sz, 255);
- Tcl_ListObjAppendElement(es->interp, matchPtr,
- Tcl_NewStringObj(sz, -1));
- GlobalGetAtomName(topic, sz, 255);
- Tcl_ListObjAppendElement(es->interp, matchPtr,
- Tcl_NewStringObj(sz, -1));
- /* Adding the hwnd as a third list element provides a unique
+ /*
+ * Adding the hwnd as a third list element provides a unique
* identifier in the case of multiple servers with the name
* application and topic names.
*/
- /* Needs a TIP though
- * Tcl_ListObjAppendElement(es->interp, matchPtr,
+ /*
+ * Needs a TIP though:
+ * Tcl_ListObjAppendElement(NULL, matchPtr,
* Tcl_NewLongObj((long)hwndRemote));
*/
- Tcl_ListObjAppendElement(es->interp,
- Tcl_GetObjResult(es->interp), matchPtr);
+
+ if (Tcl_IsShared(resultPtr)) {
+ resultPtr = Tcl_DuplicateObj(resultPtr);
+ }
+ if (Tcl_ListObjAppendElement(es->interp, resultPtr,
+ matchPtr) == TCL_OK) {
+ Tcl_SetObjResult(es->interp, resultPtr);
+ }
}
- /* tell the server we are no longer interested */
+ /*
+ * Tell the server we are no longer interested.
+ */
+
PostMessage(hwndRemote, WM_DDE_TERMINATE, (WPARAM)hwnd, 0L);
return 0L;
}
-
+
static BOOL CALLBACK
-DdeEnumWindowsCallback(HWND hwndTarget, LPARAM lParam)
+DdeEnumWindowsCallback(
+ HWND hwndTarget,
+ LPARAM lParam)
{
DWORD_PTR dwResult = 0;
- ddeEnumServices *es = (ddeEnumServices *)lParam;
- SendMessageTimeout(hwndTarget, WM_DDE_INITIATE,
- (WPARAM)es->hwnd,
- MAKELONG(es->service, es->topic),
- SMTO_ABORTIFHUNG, 1000, &dwResult);
+ struct DdeEnumServices *es = (struct DdeEnumServices *) lParam;
+
+ SendMessageTimeout(hwndTarget, WM_DDE_INITIATE, (WPARAM)es->hwnd,
+ MAKELONG(es->service, es->topic), SMTO_ABORTIFHUNG, 1000,
+ &dwResult);
return TRUE;
}
-
+
static int
-DdeGetServicesList(Tcl_Interp *interp, char *serviceName, char *topicName)
+DdeGetServicesList(
+ Tcl_Interp *interp,
+ char *serviceName,
+ char *topicName)
{
- ddeEnumServices es;
+ 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 : GlobalAddAtom(serviceName);
+ es.topic = (topicName == NULL) ? (ATOM)0 : GlobalAddAtom(topicName);
+
Tcl_ResetResult(interp); /* our list is to be appended to result. */
DdeCreateClient(&es);
EnumWindows(DdeEnumWindowsCallback, (LPARAM)&es);
-
- if (IsWindow(es.hwnd))
- DestroyWindow(es.hwnd);
- if (es.service != (ATOM)0)
+
+ if (IsWindow(es.hwnd)) {
+ DestroyWindow(es.hwnd);
+ }
+ if (es.service != (ATOM)0) {
GlobalDeleteAtom(es.service);
- if (es.topic != (ATOM)0)
+ }
+ if (es.topic != (ATOM)0) {
GlobalDeleteAtom(es.topic);
+ }
return es.result;
}
/*
- *--------------------------------------------------------------
+ *----------------------------------------------------------------------
*
* SetDdeError --
*
- * Sets the interp result to a cogent error message
- * describing the last DDE error.
+ * Sets the interp result to a cogent error message describing the last
+ * DDE error.
*
* Results:
* None.
- *
*
* Side effects:
* The interp's result object is changed.
*
- *--------------------------------------------------------------
+ *----------------------------------------------------------------------
*/
static void
SetDdeError(
- Tcl_Interp *interp) /* The interp to put the message in.*/
+ Tcl_Interp *interp) /* The interp to put the message in. */
{
- Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
- int err;
-
- err = DdeGetLastError(ddeInstance);
- switch (err) {
- case DMLERR_DATAACKTIMEOUT:
- case DMLERR_EXECACKTIMEOUT:
- case DMLERR_POKEACKTIMEOUT:
- Tcl_SetStringObj(resultPtr,
- "remote interpreter did not respond", -1);
- break;
-
- case DMLERR_BUSY:
- Tcl_SetStringObj(resultPtr, "remote server is busy", -1);
- break;
-
- case DMLERR_NOTPROCESSED:
- Tcl_SetStringObj(resultPtr,
- "remote server cannot handle this command", -1);
- break;
-
- default:
- Tcl_SetStringObj(resultPtr, "dde command failed", -1);
+ char *errorMessage;
+
+ switch (DdeGetLastError(ddeInstance)) {
+ case DMLERR_DATAACKTIMEOUT:
+ case DMLERR_EXECACKTIMEOUT:
+ case DMLERR_POKEACKTIMEOUT:
+ errorMessage = "remote interpreter did not respond";
+ break;
+ case DMLERR_BUSY:
+ errorMessage = "remote server is busy";
+ break;
+ case DMLERR_NOTPROCESSED:
+ errorMessage = "remote server cannot handle this command";
+ break;
+ default:
+ errorMessage = "dde command failed";
}
+
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(errorMessage, -1));
}
/*
- *--------------------------------------------------------------
+ *----------------------------------------------------------------------
*
* Tcl_DdeObjCmd --
*
- * This procedure is invoked to process the "dde" Tcl command.
- * See the user documentation for details on what it does.
+ * This function is invoked to process the "dde" Tcl command. See the
+ * user documentation for details on what it does.
*
* Results:
* A standard Tcl result.
@@ -969,7 +1127,7 @@ SetDdeError(
* Side effects:
* See the user documentation.
*
- *--------------------------------------------------------------
+ *----------------------------------------------------------------------
*/
int
@@ -977,49 +1135,45 @@ Tcl_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 */
{
- enum {
- DDE_SERVERNAME,
- DDE_EXECUTE,
- DDE_POKE,
- DDE_REQUEST,
- DDE_SERVICES,
+ static CONST char *ddeCommands[] = {
+ "servername", "execute", "poke", "request", "services", "eval",
+ (char *) NULL
+ };
+ enum DdeSubcommands {
+ DDE_SERVERNAME, DDE_EXECUTE, DDE_POKE, DDE_REQUEST, DDE_SERVICES,
DDE_EVAL
};
+ static CONST char *ddeSrvOptions[] = {
+ "-force", "-handler", "--", NULL
+ };
+ enum DdeSrvOptions {
+ DDE_SERVERNAME_EXACT, DDE_SERVERNAME_HANDLER, DDE_SERVERNAME_LAST,
+ };
+ static CONST char *ddeExecOptions[] = {
+ "-async", NULL
+ };
+ static CONST char *ddeReqOptions[] = {
+ "-binary", NULL
+ };
- static CONST char *ddeCommands[] = {"servername", "execute", "poke",
- "request", "services", "eval",
- (char *) NULL};
- static CONST char *ddeOptions[] = {"-async", (char *) NULL};
- static CONST char *ddeReqOptions[] = {"-binary", (char *) NULL};
- int index, argIndex;
- int async = 0, binary = 0;
- int result = TCL_OK;
- HSZ ddeService = NULL;
- HSZ ddeTopic = NULL;
- HSZ ddeItem = NULL;
- HDDEDATA ddeData = NULL;
- HDDEDATA ddeItemData = NULL;
+ int index, i, length;
+ int async = 0, binary = 0, exact = 0;
+ int result = TCL_OK, firstArg = 0;
+ HSZ ddeService = NULL, ddeTopic = NULL, ddeItem = NULL, ddeCookie = NULL;
+ HDDEDATA ddeData = NULL, ddeItemData = NULL, ddeReturn;
HCONV hConv = NULL;
- HSZ ddeCookie = 0;
- char *serviceName, *topicName = NULL, *itemString;
- char *string;
- int firstArg = 0, length, dataLength;
+ char *serviceName = NULL, *topicName = NULL, *string;
DWORD ddeResult;
- HDDEDATA ddeReturn;
- RegisteredInterp *riPtr;
- Tcl_Interp *sendInterp;
- Tcl_Obj *objPtr;
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ Tcl_Obj *objPtr, *handlerPtr = NULL;
/*
* Initialize DDE server/client
*/
-
+
if (objc < 2) {
- Tcl_WrongNumArgs(interp, 1, objv,
- "?-async? serviceName topicName value");
+ Tcl_WrongNumArgs(interp, 1, objv, "command ?arg ...?");
return TCL_ERROR;
}
@@ -1028,105 +1182,124 @@ Tcl_DdeObjCmd(
return TCL_ERROR;
}
- switch (index) {
- case DDE_SERVERNAME:
- if ((objc != 3) && (objc != 2)) {
- Tcl_WrongNumArgs(interp, 1, objv, "servername ?serverName?");
- return TCL_ERROR;
- }
- firstArg = (objc - 1);
- break;
- case DDE_EXECUTE:
- if ((objc < 5) || (objc > 6)) {
- Tcl_WrongNumArgs(interp, 1, objv,
- "execute ?-async? serviceName topicName value");
- return TCL_ERROR;
- }
- if (Tcl_GetIndexFromObj(NULL, objv[2], ddeOptions, "option", 0,
- &argIndex) != TCL_OK) {
- if (objc != 5) {
- Tcl_WrongNumArgs(interp, 1, objv,
- "execute ?-async? serviceName topicName value");
+ switch ((enum DdeSubcommands) index) {
+ case DDE_SERVERNAME:
+ for (i = 2; i < objc; i++) {
+ int argIndex;
+ if (Tcl_GetIndexFromObj(interp, objv[i], ddeSrvOptions,
+ "option", 0, &argIndex) != TCL_OK) {
+ /*
+ * If it is the last argument, it might be a server name
+ * instead of a bad argument.
+ */
+
+ if (i != objc-1) {
return TCL_ERROR;
}
- async = 0;
- firstArg = 2;
- } else {
- if (objc != 6) {
- Tcl_WrongNumArgs(interp, 1, objv,
- "execute ?-async? serviceName topicName value");
- return TCL_ERROR;
+ Tcl_ResetResult(interp);
+ break;
+ }
+ if (argIndex == DDE_SERVERNAME_EXACT) {
+ exact = 1;
+ } else if (argIndex == DDE_SERVERNAME_HANDLER) {
+ if ((objc - i) == 1) { /* return current handler */
+ RegisteredInterp *riPtr = DdeGetRegistrationPtr(interp);
+
+ if (riPtr && riPtr->handlerPtr) {
+ Tcl_SetObjResult(interp, riPtr->handlerPtr);
+ } else {
+ Tcl_ResetResult(interp);
+ }
+ return TCL_OK;
}
- async = 1;
- firstArg = 3;
+ handlerPtr = objv[++i];
+ } else if (argIndex == DDE_SERVERNAME_LAST) {
+ i++;
+ break;
}
+ }
+
+ if ((objc - i) > 1) {
+ Tcl_ResetResult(interp);
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "?-force? ?-handler proc? ?--? ?serverName?");
+ return TCL_ERROR;
+ }
+
+ firstArg = (objc == i) ? 1 : i;
+ break;
+ case DDE_EXECUTE:
+ if (objc == 5) {
+ firstArg = 2;
break;
- case DDE_POKE:
- if (objc != 6) {
- Tcl_WrongNumArgs(interp, 1, objv,
- "poke serviceName topicName item value");
- return TCL_ERROR;
+ } else if (objc == 6) {
+ int dummy;
+ if (Tcl_GetIndexFromObj(NULL, objv[2], ddeExecOptions, "option", 0,
+ &dummy) == TCL_OK) {
+ async = 1;
+ firstArg = 3;
+ break;
}
+ }
+ /* otherwise... */
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "?-async? serviceName topicName value");
+ return TCL_ERROR;
+ case DDE_POKE:
+ if (objc != 6) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "serviceName topicName item value");
+ return TCL_ERROR;
+ }
+ firstArg = 2;
+ break;
+ case DDE_REQUEST:
+ if (objc == 5) {
firstArg = 2;
break;
- case DDE_REQUEST:
- if ((objc < 5) || (objc > 6)) {
- Tcl_WrongNumArgs(interp, 1, objv,
- "request ?-binary? serviceName topicName value");
- return TCL_ERROR;
- }
+ } else if (objc == 6) {
+ int dummy;
if (Tcl_GetIndexFromObj(NULL, objv[2], ddeReqOptions, "option", 0,
- &argIndex) != TCL_OK) {
- if (objc != 5) {
- Tcl_WrongNumArgs(interp, 1, objv,
- "request ?-binary? serviceName topicName value");
- return TCL_ERROR;
- }
- binary = 0;
- firstArg = 2;
- } else {
- if (objc != 6) {
- Tcl_WrongNumArgs(interp, 1, objv,
- "request ?-binary? serviceName topicName value");
- return TCL_ERROR;
- }
+ &dummy) == TCL_OK) {
binary = 1;
firstArg = 3;
+ break;
}
- break;
- case DDE_SERVICES:
- if (objc != 4) {
- Tcl_WrongNumArgs(interp, 1, objv,
- "services serviceName topicName");
- return TCL_ERROR;
- }
+ }
+
+ /*
+ * Otherwise ...
+ */
+
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "?-binary? serviceName topicName value");
+ return TCL_ERROR;
+ case DDE_SERVICES:
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "serviceName topicName");
+ return TCL_ERROR;
+ }
+ firstArg = 2;
+ break;
+ case DDE_EVAL:
+ if (objc < 4) {
+ wrongDdeEvalArgs:
+ Tcl_WrongNumArgs(interp, 2, objv, "?-async? serviceName args");
+ return TCL_ERROR;
+ } else {
+ int dummy;
+
firstArg = 2;
- break;
- case DDE_EVAL:
- if (objc < 4) {
- Tcl_WrongNumArgs(interp, 1, objv,
- "eval ?-async? serviceName args");
- return TCL_ERROR;
- }
- if (Tcl_GetIndexFromObj(NULL, objv[2], ddeOptions, "option", 0,
- &argIndex) != TCL_OK) {
- if (objc < 4) {
- Tcl_WrongNumArgs(interp, 1, objv,
- "eval ?-async? serviceName args");
- return TCL_ERROR;
- }
- async = 0;
- firstArg = 2;
- } else {
+ if (Tcl_GetIndexFromObj(NULL, objv[2], ddeExecOptions, "option", 0,
+ &dummy) == TCL_OK) {
if (objc < 5) {
- Tcl_WrongNumArgs(interp, 1, objv,
- "eval ?-async? serviceName args");
- return TCL_ERROR;
+ goto wrongDdeEvalArgs;
}
async = 1;
- firstArg = 3;
+ firstArg++;
}
break;
+ }
}
Initialize();
@@ -1140,351 +1313,368 @@ Tcl_DdeObjCmd(
if (length == 0) {
serviceName = NULL;
} else if ((index != DDE_SERVERNAME) && (index != DDE_EVAL)) {
- ddeService = DdeCreateStringHandle(ddeInstance, serviceName,
+ ddeService = DdeCreateStringHandle(ddeInstance, (void *) serviceName,
CP_WINANSI);
}
- if ((index != DDE_SERVERNAME) &&(index != DDE_EVAL)) {
+ if ((index != DDE_SERVERNAME) && (index != DDE_EVAL)) {
topicName = Tcl_GetStringFromObj(objv[firstArg + 1], &length);
if (length == 0) {
topicName = NULL;
} else {
- ddeTopic = DdeCreateStringHandle(ddeInstance,
- topicName, CP_WINANSI);
+ ddeTopic = DdeCreateStringHandle(ddeInstance, (void *) topicName,
+ CP_WINANSI);
}
}
- switch (index) {
- case DDE_SERVERNAME: {
- serviceName = DdeSetServerName(interp, serviceName);
- if (serviceName != NULL) {
- Tcl_SetStringObj(Tcl_GetObjResult(interp),
- serviceName, -1);
- } else {
- Tcl_ResetResult(interp);
- }
+ switch ((enum DdeSubcommands) index) {
+ case DDE_SERVERNAME:
+ serviceName = DdeSetServerName(interp, serviceName, exact, handlerPtr);
+ if (serviceName != NULL) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(serviceName, -1));
+ } else {
+ Tcl_ResetResult(interp);
+ }
+ break;
+
+ case DDE_EXECUTE: {
+ int dataLength;
+ BYTE *dataString = (BYTE *) Tcl_GetStringFromObj(
+ objv[firstArg + 2], &dataLength);
+
+ if (dataLength == 0) {
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj("cannot execute null data", -1));
+ result = TCL_ERROR;
break;
}
- case DDE_EXECUTE: {
- BYTE *dataString = (BYTE *) Tcl_GetStringFromObj(
- objv[firstArg + 2], &dataLength);
- if (dataLength == 0) {
- Tcl_SetStringObj(Tcl_GetObjResult(interp),
- "cannot execute null data", -1);
- result = TCL_ERROR;
- break;
- }
- hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL);
- DdeFreeStringHandle(ddeInstance, ddeService);
- DdeFreeStringHandle(ddeInstance, ddeTopic);
+ hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL);
+ DdeFreeStringHandle(ddeInstance, ddeService);
+ DdeFreeStringHandle(ddeInstance, ddeTopic);
- if (hConv == NULL) {
- SetDdeError(interp);
- result = TCL_ERROR;
- break;
+ if (hConv == NULL) {
+ SetDdeError(interp);
+ result = TCL_ERROR;
+ break;
+ }
+
+ ddeData = DdeCreateDataHandle(ddeInstance, dataString,
+ (DWORD) dataLength+1, 0, 0, CF_TEXT, 0);
+ if (ddeData != NULL) {
+ if (async) {
+ DdeClientTransaction((LPBYTE) ddeData, 0xFFFFFFFF, hConv, 0,
+ CF_TEXT, XTYP_EXECUTE, TIMEOUT_ASYNC, &ddeResult);
+ DdeAbandonTransaction(ddeInstance, hConv, ddeResult);
+ } else {
+ ddeReturn = DdeClientTransaction((LPBYTE) ddeData, 0xFFFFFFFF,
+ hConv, 0, CF_TEXT, XTYP_EXECUTE, 30000, NULL);
+ if (ddeReturn == 0) {
+ SetDdeError(interp);
+ result = TCL_ERROR;
+ }
}
+ DdeFreeDataHandle(ddeData);
+ } else {
+ SetDdeError(interp);
+ result = TCL_ERROR;
+ }
+ break;
+ }
+ case DDE_REQUEST: {
+ char *itemString = Tcl_GetStringFromObj(objv[firstArg + 2], &length);
+
+ if (length == 0) {
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj("cannot request value of null data", -1));
+ result = TCL_ERROR;
+ goto cleanup;
+ }
+ hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL);
+ DdeFreeStringHandle(ddeInstance, ddeService);
+ DdeFreeStringHandle(ddeInstance, ddeTopic);
- ddeData = DdeCreateDataHandle(ddeInstance, dataString,
- (DWORD) dataLength+1, 0, 0, CF_TEXT, 0);
- if (ddeData != NULL) {
- if (async) {
- DdeClientTransaction((LPBYTE) ddeData, 0xFFFFFFFF, hConv, 0,
- CF_TEXT, XTYP_EXECUTE, TIMEOUT_ASYNC, &ddeResult);
- DdeAbandonTransaction(ddeInstance, hConv,
- ddeResult);
+ if (hConv == NULL) {
+ SetDdeError(interp);
+ result = TCL_ERROR;
+ } else {
+ Tcl_Obj *returnObjPtr;
+ ddeItem = DdeCreateStringHandle(ddeInstance, (void *)itemString,
+ CP_WINANSI);
+ if (ddeItem != NULL) {
+ ddeData = DdeClientTransaction(NULL, 0, hConv, ddeItem,
+ CF_TEXT, XTYP_REQUEST, 5000, NULL);
+ if (ddeData == NULL) {
+ SetDdeError(interp);
+ result = TCL_ERROR;
} else {
- ddeReturn = DdeClientTransaction((LPBYTE) ddeData, 0xFFFFFFFF,
- hConv, 0, CF_TEXT, XTYP_EXECUTE, 30000, NULL);
- if (ddeReturn == 0) {
- SetDdeError(interp);
- result = TCL_ERROR;
+ DWORD tmp;
+ const BYTE *dataString = DdeAccessData(ddeData, &tmp);
+
+ if (binary) {
+ returnObjPtr = Tcl_NewByteArrayObj(dataString,
+ (int) tmp);
+ } else {
+ returnObjPtr = Tcl_NewStringObj((const char *)dataString, -1);
}
+ DdeUnaccessData(ddeData);
+ DdeFreeDataHandle(ddeData);
+ Tcl_SetObjResult(interp, returnObjPtr);
}
- DdeFreeDataHandle(ddeData);
} else {
SetDdeError(interp);
result = TCL_ERROR;
}
- break;
}
- case DDE_REQUEST: {
- itemString = Tcl_GetStringFromObj(objv[firstArg + 2], &length);
- if (length == 0) {
- Tcl_SetStringObj(Tcl_GetObjResult(interp),
- "cannot request value of null data", -1);
- goto errorNoResult;
- }
- hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL);
- DdeFreeStringHandle(ddeInstance, ddeService);
- DdeFreeStringHandle(ddeInstance, ddeTopic);
-
- if (hConv == NULL) {
- SetDdeError(interp);
- result = TCL_ERROR;
- } else {
- Tcl_Obj *returnObjPtr;
- ddeItem = DdeCreateStringHandle(ddeInstance,
- itemString, CP_WINANSI);
- if (ddeItem != NULL) {
- ddeData = DdeClientTransaction(NULL, 0, hConv, ddeItem,
- CF_TEXT, XTYP_REQUEST, 5000, NULL);
- if (ddeData == NULL) {
- SetDdeError(interp);
- result = TCL_ERROR;
- } else {
- DWORD tmp;
- BYTE *dataString = (BYTE *) DdeAccessData(ddeData, &tmp);
- dataLength = tmp;
- if (binary) {
- returnObjPtr = Tcl_NewByteArrayObj(dataString,
- dataLength);
- } else {
- returnObjPtr = Tcl_NewStringObj((char *) dataString, -1);
- }
- DdeUnaccessData(ddeData);
- DdeFreeDataHandle(ddeData);
- Tcl_SetObjResult(interp, returnObjPtr);
- }
- } else {
- SetDdeError(interp);
- result = TCL_ERROR;
- }
- }
- break;
+ break;
+ }
+ case DDE_POKE: {
+ char *itemString = Tcl_GetStringFromObj(objv[firstArg + 2], &length);
+ BYTE *dataString;
+
+ if (length == 0) {
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj("cannot have a null item", -1));
+ result = TCL_ERROR;
+ goto cleanup;
}
- case DDE_POKE: {
- BYTE *dataString;
- itemString = Tcl_GetStringFromObj(objv[firstArg + 2], &length);
- if (length == 0) {
- Tcl_SetStringObj(Tcl_GetObjResult(interp),
- "cannot have a null item", -1);
- goto errorNoResult;
- }
- dataString = (BYTE *) Tcl_GetStringFromObj(objv[firstArg + 3], &length);
-
- hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL);
- DdeFreeStringHandle(ddeInstance, ddeService);
- DdeFreeStringHandle(ddeInstance, ddeTopic);
+ dataString = (BYTE *) Tcl_GetStringFromObj(objv[firstArg + 3],
+ &length);
- if (hConv == NULL) {
- SetDdeError(interp);
- result = TCL_ERROR;
- } else {
- ddeItem = DdeCreateStringHandle(ddeInstance, itemString,
- CP_WINANSI);
- if (ddeItem != NULL) {
- ddeData = DdeClientTransaction(dataString, (DWORD) length+1,
- hConv, ddeItem, CF_TEXT, XTYP_POKE, 5000, NULL);
- if (ddeData == NULL) {
- SetDdeError(interp);
- result = TCL_ERROR;
- }
- } else {
+ hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL);
+ DdeFreeStringHandle(ddeInstance, ddeService);
+ DdeFreeStringHandle(ddeInstance, ddeTopic);
+
+ if (hConv == NULL) {
+ SetDdeError(interp);
+ result = TCL_ERROR;
+ } else {
+ ddeItem = DdeCreateStringHandle(ddeInstance, (void *) itemString,
+ CP_WINANSI);
+ if (ddeItem != NULL) {
+ ddeData = DdeClientTransaction(dataString, (DWORD) length+1,
+ hConv, ddeItem, CF_TEXT, XTYP_POKE, 5000, NULL);
+ if (ddeData == NULL) {
SetDdeError(interp);
result = TCL_ERROR;
}
+ } else {
+ SetDdeError(interp);
+ result = TCL_ERROR;
}
- break;
}
+ break;
+ }
- case DDE_SERVICES: {
- result = DdeGetServicesList(interp, serviceName, topicName);
- break;
+ case DDE_SERVICES:
+ result = DdeGetServicesList(interp, serviceName, topicName);
+ break;
+
+ case DDE_EVAL: {
+ RegisteredInterp *riPtr;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ if (serviceName == NULL) {
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj("invalid service name \"\"", -1));
+ result = TCL_ERROR;
+ goto cleanup;
}
- case DDE_EVAL: {
- if (serviceName == NULL) {
- Tcl_SetStringObj(Tcl_GetObjResult(interp),
- "invalid service name \"\"", -1);
- goto errorNoResult;
+
+ objc -= (async + 3);
+ objv += (async + 3);
+
+ /*
+ * See if the target interpreter is local. If so, execute the command
+ * directly without going through the DDE server. Don't exchange
+ * objects between interps. The target interp could compile an object,
+ * producing a bytecode structure that refers to other objects owned
+ * by the target interp. If the target interp is then deleted, the
+ * bytecode structure would be referring to deallocated objects.
+ */
+
+ for (riPtr = tsdPtr->interpListPtr; riPtr != NULL;
+ riPtr = riPtr->nextPtr) {
+ if (stricmp(serviceName, riPtr->name) == 0) {
+ break;
}
+ }
+
+ if (riPtr != NULL) {
+ Tcl_Interp *sendInterp;
- objc -= (async + 3);
- objv += (async + 3);
-
- /*
- * See if the target interpreter is local. If so, execute
- * the command directly without going through the DDE server.
- * Don't exchange objects between interps. The target interp could
- * compile an object, producing a bytecode structure that refers to
- * other objects owned by the target interp. If the target interp
- * is then deleted, the bytecode structure would be referring to
- * deallocated objects.
+ /*
+ * This command is to a local interp. No need to go through the
+ * server.
*/
-
- for (riPtr = tsdPtr->interpListPtr; riPtr != NULL;
- riPtr = riPtr->nextPtr) {
- if (stricmp(serviceName, riPtr->name) == 0) {
- break;
- }
- }
- if (riPtr != NULL) {
- /*
- * This command is to a local interp. No need to go through
- * the server.
- */
-
- Tcl_Preserve((ClientData) riPtr);
- sendInterp = riPtr->interp;
- Tcl_Preserve((ClientData) sendInterp);
-
- /*
- * Don't exchange objects between interps. The target interp
- * would compile an object, producing a bytecode structure that
- * refers to other objects owned by the target interp. If the
- * target interp is then deleted, the bytecode structure would
- * be referring to deallocated objects.
- */
+ Tcl_Preserve((ClientData) riPtr);
+ sendInterp = riPtr->interp;
+ Tcl_Preserve((ClientData) sendInterp);
- if (objc == 1) {
- result = Tcl_EvalObjEx(sendInterp, objv[0],
- TCL_EVAL_GLOBAL);
- } else {
+ /*
+ * Don't exchange objects between interps. The target interp would
+ * compile an object, producing a bytecode structure that refers
+ * to other objects owned by the target interp. If the target
+ * interp is then deleted, the bytecode structure would be
+ * referring to deallocated objects.
+ */
+
+ if (Tcl_IsSafe(riPtr->interp) && riPtr->handlerPtr == NULL) {
+ Tcl_SetResult(riPtr->interp, "permission denied: "
+ "a handler procedure must be defined for use in "
+ "a safe interp", TCL_STATIC);
+ result = TCL_ERROR;
+ }
+
+ if (result == TCL_OK) {
+ if (objc == 1)
+ objPtr = objv[0];
+ else {
objPtr = Tcl_ConcatObj(objc, objv);
- Tcl_IncrRefCount(objPtr);
- result = Tcl_EvalObjEx(sendInterp, objPtr,
- TCL_EVAL_GLOBAL);
- Tcl_DecrRefCount(objPtr);
}
- if (interp != sendInterp) {
- if (result == TCL_ERROR) {
- /*
- * An error occurred, so transfer error information
- * from the destination interpreter back to our
- * interpreter.
- */
-
- Tcl_ResetResult(interp);
- objPtr = Tcl_GetVar2Ex(sendInterp, "errorInfo", NULL,
- TCL_GLOBAL_ONLY);
+ if (riPtr->handlerPtr != NULL) {
+ /* add the dde request data to the handler proc list */
+ /*
+ *result = Tcl_ListObjReplace(sendInterp, objPtr, 0, 0, 1,
+ * &(riPtr->handlerPtr));
+ */
+ Tcl_Obj *cmdPtr = Tcl_DuplicateObj(riPtr->handlerPtr);
+ result = Tcl_ListObjAppendElement(sendInterp, cmdPtr,
+ objPtr);
+ if (result == TCL_OK) {
+ objPtr = cmdPtr;
+ }
+ }
+ }
+ if (result == TCL_OK) {
+ Tcl_IncrRefCount(objPtr);
+ result = Tcl_EvalObjEx(sendInterp, objPtr, TCL_EVAL_GLOBAL);
+ Tcl_DecrRefCount(objPtr);
+ }
+ if (interp != sendInterp) {
+ if (result == TCL_ERROR) {
+ /*
+ * An error occurred, so transfer error information from
+ * the destination interpreter back to our interpreter.
+ */
+
+ Tcl_ResetResult(interp);
+ objPtr = Tcl_GetVar2Ex(sendInterp, "errorInfo", NULL,
+ TCL_GLOBAL_ONLY);
+ if (objPtr) {
string = Tcl_GetStringFromObj(objPtr, &length);
Tcl_AddObjErrorInfo(interp, string, length);
-
- objPtr = Tcl_GetVar2Ex(sendInterp, "errorCode", NULL,
- TCL_GLOBAL_ONLY);
+ }
+
+ objPtr = Tcl_GetVar2Ex(sendInterp, "errorCode", NULL,
+ TCL_GLOBAL_ONLY);
+ if (objPtr) {
Tcl_SetObjErrorCode(interp, objPtr);
}
- Tcl_SetObjResult(interp, Tcl_GetObjResult(sendInterp));
}
- Tcl_Release((ClientData) riPtr);
- Tcl_Release((ClientData) sendInterp);
+ Tcl_SetObjResult(interp, Tcl_GetObjResult(sendInterp));
+ }
+ Tcl_Release((ClientData) riPtr);
+ Tcl_Release((ClientData) sendInterp);
+ } else {
+ /*
+ * This is a non-local request. Send the script to the server and
+ * poll it for a result.
+ */
+
+ if (MakeDdeConnection(interp, serviceName, &hConv) != TCL_OK) {
+ invalidServerResponse:
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj("invalid data returned from server",
+ -1));
+ result = TCL_ERROR;
+ goto cleanup;
+ }
+
+ objPtr = Tcl_ConcatObj(objc, objv);
+ string = Tcl_GetStringFromObj(objPtr, &length);
+ ddeItemData = DdeCreateDataHandle(ddeInstance,
+ (BYTE *) string, (DWORD) length+1, 0, 0, CF_TEXT, 0);
+
+ if (async) {
+ ddeData = DdeClientTransaction((LPBYTE) ddeItemData,
+ 0xFFFFFFFF, hConv, 0,
+ CF_TEXT, XTYP_EXECUTE, TIMEOUT_ASYNC, &ddeResult);
+ DdeAbandonTransaction(ddeInstance, hConv, ddeResult);
} else {
+ ddeData = DdeClientTransaction((LPBYTE) ddeItemData,
+ 0xFFFFFFFF, hConv, 0,
+ CF_TEXT, XTYP_EXECUTE, 30000, NULL);
+ if (ddeData != 0) {
+ ddeCookie = DdeCreateStringHandle(ddeInstance,
+ TCL_DDE_EXECUTE_RESULT, CP_WINANSI);
+ ddeData = DdeClientTransaction(NULL, 0, hConv, ddeCookie,
+ CF_TEXT, XTYP_REQUEST, 30000, NULL);
+ }
+ }
+
+ Tcl_DecrRefCount(objPtr);
+
+ if (ddeData == 0) {
+ SetDdeError(interp);
+ result = TCL_ERROR;
+ }
+
+ if (async == 0) {
+ Tcl_Obj *resultPtr;
+
/*
- * This is a non-local request. Send the script to the server
- * and poll it for a result.
+ * The return handle has a two or four element list in it. The
+ * first element is the return code (TCL_OK, TCL_ERROR, etc.).
+ * The second is the result of the script. If the return code
+ * is TCL_ERROR, then the third element is the value of the
+ * variable "errorCode", and the fourth is the value of the
+ * variable "errorInfo".
*/
-
- if (MakeDdeConnection(interp, serviceName, &hConv) != TCL_OK) {
- goto error;
+
+ resultPtr = Tcl_NewObj();
+ length = DdeGetData(ddeData, NULL, 0, 0);
+ Tcl_SetObjLength(resultPtr, length);
+ string = Tcl_GetString(resultPtr);
+ DdeGetData(ddeData, (BYTE *) string, (DWORD) length, 0);
+ Tcl_SetObjLength(resultPtr, (int) strlen(string));
+
+ if (Tcl_ListObjIndex(NULL, resultPtr, 0, &objPtr) != TCL_OK) {
+ Tcl_DecrRefCount(resultPtr);
+ goto invalidServerResponse;
}
-
- objPtr = Tcl_ConcatObj(objc, objv);
- string = Tcl_GetStringFromObj(objPtr, &length);
- ddeItemData = DdeCreateDataHandle(ddeInstance, (BYTE *) string,
- (DWORD) length+1, 0, 0, CF_TEXT, 0);
-
- if (async) {
- ddeData = DdeClientTransaction((LPBYTE) ddeItemData,
- 0xFFFFFFFF, hConv, 0,
- CF_TEXT, XTYP_EXECUTE, TIMEOUT_ASYNC, &ddeResult);
- DdeAbandonTransaction(ddeInstance, hConv, ddeResult);
- } else {
- ddeData = DdeClientTransaction((LPBYTE) ddeItemData,
- 0xFFFFFFFF, hConv, 0,
- CF_TEXT, XTYP_EXECUTE, 30000, NULL);
- if (ddeData != 0) {
-
- ddeCookie = DdeCreateStringHandle(ddeInstance,
- "$TCLEVAL$EXECUTE$RESULT", CP_WINANSI);
- ddeData = DdeClientTransaction(NULL, 0, hConv,
- ddeCookie, CF_TEXT, XTYP_REQUEST, 30000, NULL);
- }
+ if (Tcl_GetIntFromObj(NULL, objPtr, &result) != TCL_OK) {
+ Tcl_DecrRefCount(resultPtr);
+ goto invalidServerResponse;
}
+ if (result == TCL_ERROR) {
+ Tcl_ResetResult(interp);
- Tcl_DecrRefCount(objPtr);
-
- if (ddeData == 0) {
- SetDdeError(interp);
- goto errorNoResult;
- }
-
- if (async == 0) {
- Tcl_Obj *resultPtr;
-
- /*
- * The return handle has a two or four element list in
- * it. The first element is the return code (TCL_OK,
- * TCL_ERROR, etc.). The second is the result of the
- * script. If the return code is TCL_ERROR, then the third
- * element is the value of the variable "errorCode", and
- * the fourth is the value of the variable "errorInfo".
- */
-
- resultPtr = Tcl_NewObj();
- length = DdeGetData(ddeData, NULL, 0, 0);
- Tcl_SetObjLength(resultPtr, length);
- string = Tcl_GetString(resultPtr);
- DdeGetData(ddeData, (BYTE *) string, (DWORD) length, 0);
- Tcl_SetObjLength(resultPtr, (int) strlen(string));
-
- if (Tcl_ListObjIndex(NULL, resultPtr, 0, &objPtr)
- != TCL_OK) {
+ if (Tcl_ListObjIndex(NULL, resultPtr, 3,
+ &objPtr) != TCL_OK) {
Tcl_DecrRefCount(resultPtr);
- goto error;
+ goto invalidServerResponse;
}
- if (Tcl_GetIntFromObj(NULL, objPtr, &result) != TCL_OK) {
- Tcl_DecrRefCount(resultPtr);
- goto error;
- }
- if (result == TCL_ERROR) {
- Tcl_ResetResult(interp);
+ length = -1;
+ string = Tcl_GetStringFromObj(objPtr, &length);
+ Tcl_AddObjErrorInfo(interp, string, length);
- if (Tcl_ListObjIndex(NULL, resultPtr, 3, &objPtr)
- != TCL_OK) {
- Tcl_DecrRefCount(resultPtr);
- goto error;
- }
- length = -1;
- string = Tcl_GetStringFromObj(objPtr, &length);
- Tcl_AddObjErrorInfo(interp, string, length);
-
- Tcl_ListObjIndex(NULL, resultPtr, 2, &objPtr);
- Tcl_SetObjErrorCode(interp, objPtr);
- }
- if (Tcl_ListObjIndex(NULL, resultPtr, 1, &objPtr)
- != TCL_OK) {
- Tcl_DecrRefCount(resultPtr);
- goto error;
- }
- Tcl_SetObjResult(interp, objPtr);
+ Tcl_ListObjIndex(NULL, resultPtr, 2, &objPtr);
+ Tcl_SetObjErrorCode(interp, objPtr);
+ }
+ if (Tcl_ListObjIndex(NULL, resultPtr, 1, &objPtr) != TCL_OK) {
Tcl_DecrRefCount(resultPtr);
+ goto invalidServerResponse;
}
+ Tcl_SetObjResult(interp, objPtr);
+ Tcl_DecrRefCount(resultPtr);
}
}
}
- if (ddeCookie != NULL) {
- DdeFreeStringHandle(ddeInstance, ddeCookie);
- }
- if (ddeItem != NULL) {
- DdeFreeStringHandle(ddeInstance, ddeItem);
- }
- if (ddeItemData != NULL) {
- DdeFreeDataHandle(ddeItemData);
- }
- if (ddeData != NULL) {
- DdeFreeDataHandle(ddeData);
}
- if (hConv != NULL) {
- DdeDisconnect(hConv);
- }
- return result;
- error:
- Tcl_SetStringObj(Tcl_GetObjResult(interp),
- "invalid data returned from server", -1);
-
- errorNoResult:
+ cleanup:
if (ddeCookie != NULL) {
DdeFreeStringHandle(ddeInstance, ddeCookie);
}
@@ -1500,5 +1690,15 @@ Tcl_DdeObjCmd(
if (hConv != NULL) {
DdeDisconnect(hConv);
}
- return TCL_ERROR;
+ return result;
}
+
+/*
+ * Local variables:
+ * mode: c
+ * indent-tabs-mode: t
+ * tab-width: 8
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/win/tclWinFCmd.c b/win/tclWinFCmd.c
index 2aeed16..d918b4a 100644
--- a/win/tclWinFCmd.c
+++ b/win/tclWinFCmd.c
@@ -1,13 +1,13 @@
/*
* tclWinFCmd.c
*
- * This file implements the Windows specific portion of file manipulation
- * subcommands of the "file" command.
+ * This file implements the Windows specific portion of file manipulation
+ * subcommands of the "file" command.
*
* Copyright (c) 1996-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.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#include "tclWinInt.h"
@@ -17,29 +17,25 @@
* TraverseWinTree() calls the traverseProc()
*/
-#define DOTREE_PRED 1 /* pre-order directory */
-#define DOTREE_POSTD 2 /* post-order directory */
-#define DOTREE_F 3 /* regular file */
+#define DOTREE_PRED 1 /* pre-order directory */
+#define DOTREE_POSTD 2 /* post-order directory */
+#define DOTREE_F 3 /* regular file */
+#define DOTREE_LINK 4 /* symbolic link */
/*
* Callbacks for file attributes code.
*/
-static int GetWinFileAttributes _ANSI_ARGS_((Tcl_Interp *interp,
- int objIndex, Tcl_Obj *fileName,
- Tcl_Obj **attributePtrPtr));
-static int GetWinFileLongName _ANSI_ARGS_((Tcl_Interp *interp,
- int objIndex, Tcl_Obj *fileName,
- Tcl_Obj **attributePtrPtr));
-static int GetWinFileShortName _ANSI_ARGS_((Tcl_Interp *interp,
- int objIndex, Tcl_Obj *fileName,
- Tcl_Obj **attributePtrPtr));
-static int SetWinFileAttributes _ANSI_ARGS_((Tcl_Interp *interp,
- int objIndex, Tcl_Obj *fileName,
- Tcl_Obj *attributePtr));
-static int CannotSetAttribute _ANSI_ARGS_((Tcl_Interp *interp,
- int objIndex, Tcl_Obj *fileName,
- Tcl_Obj *attributePtr));
+static int GetWinFileAttributes(Tcl_Interp *interp, int objIndex,
+ Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr);
+static int GetWinFileLongName(Tcl_Interp *interp, int objIndex,
+ Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr);
+static int GetWinFileShortName(Tcl_Interp *interp, int objIndex,
+ Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr);
+static int SetWinFileAttributes(Tcl_Interp *interp, int objIndex,
+ Tcl_Obj *fileName, Tcl_Obj *attributePtr);
+static int CannotSetAttribute(Tcl_Interp *interp, int objIndex,
+ Tcl_Obj *fileName, Tcl_Obj *attributePtr);
/*
* Constants and variables necessary for file attributes subcommand.
@@ -74,18 +70,17 @@ CONST TclFileAttrProcs tclpFileAttrProcs[] = {
#ifdef HAVE_NO_SEH
/*
- * Unlike Borland and Microsoft, we don't register exception handlers
- * by pushing registration records onto the runtime stack. Instead, we
- * register them by creating an EXCEPTION_REGISTRATION within the activation
- * record.
+ * Unlike Borland and Microsoft, we don't register exception handlers by
+ * pushing registration records onto the runtime stack. Instead, we register
+ * them by creating an EXCEPTION_REGISTRATION within the activation record.
*/
typedef struct EXCEPTION_REGISTRATION {
- struct EXCEPTION_REGISTRATION* link;
- EXCEPTION_DISPOSITION (*handler)( struct _EXCEPTION_RECORD*, void*,
- struct _CONTEXT*, void* );
- void* ebp;
- void* esp;
+ struct EXCEPTION_REGISTRATION *link;
+ EXCEPTION_DISPOSITION (*handler)(
+ struct _EXCEPTION_RECORD *, void *, struct _CONTEXT *, void *);
+ void *ebp;
+ void *esp;
int status;
} EXCEPTION_REGISTRATION;
@@ -95,91 +90,91 @@ 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);
/*
- * Declarations for local procedures defined in this file:
+ * Declarations for local functions defined in this file:
*/
static void StatError(Tcl_Interp *interp, Tcl_Obj *fileName);
-static int ConvertFileNameFormat(Tcl_Interp *interp,
+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 DoRemoveJustDirectory(CONST TCHAR *nativeSrc,
int ignoreError, Tcl_DString *errorPtr);
-static int DoRemoveDirectory(Tcl_DString *pathPtr, int recursive,
+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,
- int type, Tcl_DString *errorPtr);
-static int TraversalDelete(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,
+ Tcl_DString *errorPtr);
static int TraverseWinTree(TraversalProc *traverseProc,
- Tcl_DString *sourcePtr, Tcl_DString *dstPtr,
+ Tcl_DString *sourcePtr, Tcl_DString *dstPtr,
Tcl_DString *errorPtr);
-
/*
*---------------------------------------------------------------------------
*
* TclpObjRenameFile, DoRenameFile --
*
- * Changes the name of an existing file or directory, from src to dst.
- * If src and dst refer to the same file or directory, does nothing
- * and returns success. Otherwise if dst already exists, it will be
- * deleted and replaced by src subject to the following conditions:
+ * Changes the name of an existing file or directory, from src to dst.
+ * If src and dst refer to the same file or directory, does nothing and
+ * returns success. Otherwise if dst already exists, it will be deleted
+ * and replaced by src subject to the following conditions:
* If src is a directory, dst may be an empty directory.
* If src is a file, dst may be a file.
- * In any other situation where dst already exists, the rename will
- * fail.
+ * In any other situation where dst already exists, the rename will fail.
*
* Results:
* If the file or directory was successfully renamed, returns TCL_OK.
- * Otherwise the return value is TCL_ERROR and errno is set to
- * indicate the error. Some possible values for errno are:
+ * Otherwise the return value is TCL_ERROR and errno is set to indicate
+ * the error. Some possible values for errno are:
*
* ENAMETOOLONG: src or dst names are too long.
- * EACCES: src or dst parent directory can't be read and/or written.
+ * EACCES: src or dst parent directory can't be read and/or written.
* EEXIST: dst is a non-empty directory.
* EINVAL: src is a root directory or dst is a subdirectory of src.
* EISDIR: dst is a directory, but src is not.
- * ENOENT: src doesn't exist. src or dst is "".
- * ENOTDIR: src is a directory, but dst is not.
+ * ENOENT: src doesn't exist. src or dst is "".
+ * ENOTDIR: src is a directory, but dst is not.
* EXDEV: src and dst are on different filesystems.
*
- * EACCES: exists an open file already referring to src or dst.
- * EACCES: src or dst specify the current working directory (NT).
- * EACCES: src specifies a char device (nul:, com1:, etc.)
+ * EACCES: exists an open file already referring to src or dst.
+ * EACCES: src or dst specify the current working directory (NT).
+ * EACCES: src specifies a char device (nul:, com1:, etc.)
* EEXIST: dst specifies a char device (nul:, com1:, etc.) (NT)
* EACCES: dst specifies a char device (nul:, com1:, etc.) (95)
- *
+ *
* Side effects:
- * The implementation supports cross-filesystem renames of files,
- * but the caller should be prepared to emulate cross-filesystem
- * renames of directories if errno is EXDEV.
+ * The implementation supports cross-filesystem renames of files, but the
+ * caller should be prepared to emulate cross-filesystem renames of
+ * directories if errno is EXDEV.
*
*---------------------------------------------------------------------------
*/
-int
-TclpObjRenameFile(srcPathPtr, destPathPtr)
- Tcl_Obj *srcPathPtr;
- Tcl_Obj *destPathPtr;
+int
+TclpObjRenameFile(
+ Tcl_Obj *srcPathPtr,
+ Tcl_Obj *destPathPtr)
{
- return DoRenameFile(Tcl_FSGetNativePath(srcPathPtr),
- Tcl_FSGetNativePath(destPathPtr));
+ return DoRenameFile(Tcl_FSGetNativePath(srcPathPtr),
+ Tcl_FSGetNativePath(destPathPtr));
}
static int
DoRenameFile(
CONST TCHAR *nativeSrc, /* Pathname of file or dir to be renamed
- * (native). */
+ * (native). */
CONST TCHAR *nativeDst) /* New pathname for file or directory
* (native). */
-{
+{
#if defined(HAVE_NO_SEH) && !defined(_WIN64)
EXCEPTION_REGISTRATION registration;
#endif
@@ -187,99 +182,103 @@ DoRenameFile(
int retval = -1;
/*
- * The MoveFile API acts differently under Win95/98 and NT
- * WRT NULL and "". Avoid passing these values.
+ * The MoveFile API acts differently under Win95/98 and NT WRT NULL and
+ * "". Avoid passing these values.
*/
if (nativeSrc == NULL || nativeSrc[0] == '\0' ||
- nativeDst == NULL || nativeDst[0] == '\0') {
+ nativeDst == NULL || nativeDst[0] == '\0') {
Tcl_SetErrno(ENOENT);
return TCL_ERROR;
}
/*
- * The MoveFile API would throw an exception under NT
- * if one of the arguments is a char block device.
+ * The MoveFile API would throw an exception under NT if one of the
+ * arguments is a char block device.
*/
#if defined(HAVE_NO_SEH) && !defined(_WIN64)
-
/*
- * Don't have SEH available, do things the hard way.
- * Note that this needs to be one block of asm, to avoid stack
- * imbalance; also, it is illegal for one asm block to contain
- * a jump to another.
+ * Don't have SEH available, do things the hard way. Note that this needs
+ * to be one block of asm, to avoid stack imbalance; also, it is illegal
+ * for one asm block to contain a jump to another.
*/
__asm__ __volatile__ (
/*
- * Pick up params before messing with the stack */
+ * Pick up params before messing with the stack.
+ */
"movl %[nativeDst], %%ebx" "\n\t"
- "movl %[nativeSrc], %%ecx" "\n\t"
+ "movl %[nativeSrc], %%ecx" "\n\t"
/*
- * Construct an EXCEPTION_REGISTRATION to protect the
- * call to MoveFile
+ * Construct an EXCEPTION_REGISTRATION to protect the call to
+ * MoveFile.
*/
- "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 $0, 0x10(%%edx)" "\n\t" /* status */
-
- /* Link the EXCEPTION_REGISTRATION on the chain */
-
- "movl %%edx, %%fs:0" "\n\t"
-
- /* Call MoveFile( nativeSrc, nativeDst ) */
-
+
+ "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 $0, 0x10(%%edx)" "\n\t" /* status */
+
+ /*
+ * Link the EXCEPTION_REGISTRATION on the chain.
+ */
+
+ "movl %%edx, %%fs:0" "\n\t"
+
+ /*
+ * Call MoveFile(nativeSrc, nativeDst)
+ */
+
"pushl %%ebx" "\n\t"
"pushl %%ecx" "\n\t"
"movl %[moveFile], %%eax" "\n\t"
"call *%%eax" "\n\t"
-
- /*
- * Come here on normal exit. Recover the EXCEPTION_REGISTRATION
- * and put the status return from MoveFile into it.
+
+ /*
+ * Come here on normal exit. Recover the EXCEPTION_REGISTRATION and
+ * put the status return from MoveFile into it.
*/
-
+
"movl %%fs:0, %%edx" "\n\t"
"movl %%eax, 0x10(%%edx)" "\n\t"
"jmp 2f" "\n"
-
+
/*
- * Come here on an exception. Recover the EXCEPTION_REGISTRATION
+ * Come here on an exception. Recover the EXCEPTION_REGISTRATION
*/
-
+
"1:" "\t"
- "movl %%fs:0, %%edx" "\n\t"
- "movl 0x8(%%edx), %%edx" "\n\t"
-
- /*
- * Come here however we exited. Restore context from the
+ "movl %%fs:0, %%edx" "\n\t"
+ "movl 0x8(%%edx), %%edx" "\n\t"
+
+ /*
+ * 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"
-
+
+ "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),
- [nativeDst] "m" (nativeDst),
- [nativeSrc] "m" (nativeSrc),
- [moveFile] "r" (tclWinProcs->moveFileProc)
- :
+ :
+ [registration] "m" (registration),
+ [nativeDst] "m" (nativeDst),
+ [nativeSrc] "m" (nativeSrc),
+ [moveFile] "r" (tclWinProcs->moveFileProc)
+ :
"%eax", "%ebx", "%ecx", "%edx", "memory"
- );
+ );
if (registration.status != FALSE) {
retval = TCL_OK;
}
@@ -295,22 +294,25 @@ DoRenameFile(
#endif
#endif
- if (retval != -1)
- return retval;
+ if (retval != -1) {
+ return retval;
+ }
TclWinConvertError(GetLastError());
srcAttr = (*tclWinProcs->getFileAttributesProc)(nativeSrc);
dstAttr = (*tclWinProcs->getFileAttributesProc)(nativeDst);
if (srcAttr == 0xffffffff) {
- if ((*tclWinProcs->getFullPathNameProc)(nativeSrc, 0, NULL, NULL) >= MAX_PATH) {
+ if ((*tclWinProcs->getFullPathNameProc)(nativeSrc, 0, NULL,
+ NULL) >= MAX_PATH) {
errno = ENAMETOOLONG;
return TCL_ERROR;
}
srcAttr = 0;
}
if (dstAttr == 0xffffffff) {
- if ((*tclWinProcs->getFullPathNameProc)(nativeDst, 0, NULL, NULL) >= MAX_PATH) {
+ if ((*tclWinProcs->getFullPathNameProc)(nativeDst, 0, NULL,
+ NULL) >= MAX_PATH) {
errno = ENAMETOOLONG;
return TCL_ERROR;
}
@@ -322,7 +324,7 @@ DoRenameFile(
return TCL_ERROR;
}
if (errno == EACCES) {
- decode:
+ decode:
if (srcAttr & FILE_ATTRIBUTE_DIRECTORY) {
TCHAR *nativeSrcRest, *nativeDstRest;
CONST char **srcArgv, **dstArgv;
@@ -332,12 +334,12 @@ DoRenameFile(
Tcl_DString srcString, dstString;
CONST char *src, *dst;
- size = (*tclWinProcs->getFullPathNameProc)(nativeSrc, MAX_PATH,
+ size = (*tclWinProcs->getFullPathNameProc)(nativeSrc, MAX_PATH,
nativeSrcPath, &nativeSrcRest);
if ((size == 0) || (size > MAX_PATH)) {
return TCL_ERROR;
}
- size = (*tclWinProcs->getFullPathNameProc)(nativeDst, MAX_PATH,
+ size = (*tclWinProcs->getFullPathNameProc)(nativeDst, MAX_PATH,
nativeDstPath, &nativeDstRest);
if ((size == 0) || (size > MAX_PATH)) {
return TCL_ERROR;
@@ -347,7 +349,17 @@ DoRenameFile(
src = Tcl_WinTCharToUtf((TCHAR *) nativeSrcPath, -1, &srcString);
dst = Tcl_WinTCharToUtf((TCHAR *) nativeDstPath, -1, &dstString);
- if (strncmp(src, dst, (size_t) Tcl_DStringLength(&srcString)) == 0) {
+
+ /*
+ * Check whether the destination path is actually inside the
+ * source path. This is true if the prefix matches, and the next
+ * character is either end-of-string or a directory separator
+ */
+
+ if ((strncmp(src, dst, (size_t) Tcl_DStringLength(&srcString))==0)
+ && (dst[Tcl_DStringLength(&srcString)] == '\\'
+ || dst[Tcl_DStringLength(&srcString)] == '/'
+ || dst[Tcl_DStringLength(&srcString)] == '\0')) {
/*
* Trying to move a directory into itself.
*/
@@ -364,22 +376,20 @@ DoRenameFile(
if (srcArgc == 1) {
/*
- * They are trying to move a root directory. Whether
- * or not it is across filesystems, this cannot be
- * done.
+ * They are trying to move a root directory. Whether or not it
+ * is across filesystems, this cannot be done.
*/
Tcl_SetErrno(EINVAL);
} else if ((srcArgc > 0) && (dstArgc > 0) &&
(strcmp(srcArgv[0], dstArgv[0]) != 0)) {
/*
- * If src is a directory and dst filesystem != src
- * filesystem, errno should be EXDEV. It is very
- * important to get this behavior, so that the caller
- * can respond to a cross filesystem rename by
- * simulating it with copy and delete. The MoveFile
- * system call already handles the case of moving a
- * file between filesystems.
+ * If src is a directory and dst filesystem != src filesystem,
+ * errno should be EXDEV. It is very important to get this
+ * behavior, so that the caller can respond to a cross
+ * filesystem rename by simulating it with copy and delete.
+ * The MoveFile system call already handles the case of moving
+ * a file between filesystems.
*/
Tcl_SetErrno(EXDEV);
@@ -391,39 +401,40 @@ DoRenameFile(
/*
* Other types of access failure is that dst is a read-only
- * filesystem, that an open file referred to src or dest, or that
- * src or dest specified the current working directory on the
- * current filesystem. EACCES is returned for those cases.
+ * filesystem, that an open file referred to src or dest, or that src
+ * or dest specified the current working directory on the current
+ * filesystem. EACCES is returned for those cases.
*/
} else if (Tcl_GetErrno() == EEXIST) {
/*
- * Reports EEXIST any time the target already exists. If it makes
+ * Reports EEXIST any time the target already exists. If it makes
* sense, remove the old file and try renaming again.
*/
if (srcAttr & FILE_ATTRIBUTE_DIRECTORY) {
if (dstAttr & FILE_ATTRIBUTE_DIRECTORY) {
/*
- * Overwrite empty dst directory with src directory. The
- * following call will remove an empty directory. If it
- * fails, it's because it wasn't empty.
+ * Overwrite empty dst directory with src directory. The
+ * following call will remove an empty directory. If it fails,
+ * it's because it wasn't empty.
*/
if (DoRemoveJustDirectory(nativeDst, 0, NULL) == TCL_OK) {
/*
* Now that that empty directory is gone, we can try
- * renaming again. If that fails, we'll put this empty
+ * renaming again. If that fails, we'll put this empty
* directory back, for completeness.
*/
- if ((*tclWinProcs->moveFileProc)(nativeSrc, nativeDst) != FALSE) {
+ if ((*tclWinProcs->moveFileProc)(nativeSrc,
+ nativeDst) != FALSE) {
return TCL_OK;
}
/*
- * Some new error has occurred. Don't know what it
- * could be, but report this one.
+ * Some new error has occurred. Don't know what it could
+ * be, but report this one.
*/
TclWinConvertError(GetLastError());
@@ -446,18 +457,18 @@ DoRenameFile(
} else {
/*
* Overwrite existing file by:
- *
+ *
* 1. Rename existing file to temp name.
* 2. Rename old file to new name.
- * 3. If success, delete temp file. If failure,
- * put temp file back to old name.
+ * 3. If success, delete temp file. If failure, put temp file
+ * back to old name.
*/
TCHAR *nativeRest, *nativeTmp, *nativePrefix;
int result, size;
WCHAR tempBuf[MAX_PATH];
-
- size = (*tclWinProcs->getFullPathNameProc)(nativeDst, MAX_PATH,
+
+ size = (*tclWinProcs->getFullPathNameProc)(nativeDst, MAX_PATH,
tempBuf, &nativeRest);
if ((size == 0) || (size > MAX_PATH) || (nativeRest == NULL)) {
return TCL_ERROR;
@@ -467,9 +478,9 @@ DoRenameFile(
((char *) nativeRest)[1] = '\0'; /* In case it's Unicode. */
result = TCL_ERROR;
- nativePrefix = (tclWinProcs->useWide)
+ nativePrefix = (tclWinProcs->useWide)
? (TCHAR *) L"tclr" : (TCHAR *) "tclr";
- if ((*tclWinProcs->getTempFileNameProc)(nativeTmp,
+ if ((*tclWinProcs->getTempFileNameProc)(nativeTmp,
nativePrefix, 0, tempBuf) != 0) {
/*
* Strictly speaking, need the following DeleteFile and
@@ -477,12 +488,14 @@ DoRenameFile(
* other app comes along in the meantime and creates the
* same temp file.
*/
-
+
nativeTmp = (TCHAR *) tempBuf;
(*tclWinProcs->deleteFileProc)(nativeTmp);
- if ((*tclWinProcs->moveFileProc)(nativeDst, nativeTmp) != FALSE) {
- if ((*tclWinProcs->moveFileProc)(nativeSrc, nativeDst) != FALSE) {
- (*tclWinProcs->setFileAttributesProc)(nativeTmp,
+ if ((*tclWinProcs->moveFileProc)(nativeDst,
+ nativeTmp) != FALSE) {
+ if ((*tclWinProcs->moveFileProc)(nativeSrc,
+ nativeDst) != FALSE) {
+ (*tclWinProcs->setFileAttributesProc)(nativeTmp,
FILE_ATTRIBUTE_NORMAL);
(*tclWinProcs->deleteFileProc)(nativeTmp);
return TCL_OK;
@@ -490,11 +503,11 @@ DoRenameFile(
(*tclWinProcs->deleteFileProc)(nativeDst);
(*tclWinProcs->moveFileProc)(nativeTmp, nativeDst);
}
- }
+ }
/*
- * Can't backup dst file or move src file. Return that
- * error. Could happen if an open file refers to dst.
+ * Can't backup dst file or move src file. Return that
+ * error. Could happen if an open file refers to dst.
*/
TclWinConvertError(GetLastError());
@@ -518,19 +531,19 @@ DoRenameFile(
*
* TclpObjCopyFile, DoCopyFile --
*
- * Copy a single file (not a directory). If dst already exists and
- * is not a directory, it is removed.
+ * Copy a single file (not a directory). If dst already exists and is not
+ * a directory, it is removed.
*
* Results:
- * If the file was successfully copied, returns TCL_OK. Otherwise
- * the return value is TCL_ERROR and errno is set to indicate the
- * error. Some possible values for errno are:
+ * If the file was successfully copied, returns TCL_OK. Otherwise the
+ * return value is TCL_ERROR and errno is set to indicate the error.
+ * Some possible values for errno are:
*
- * EACCES: src or dst parent directory can't be read and/or written.
+ * EACCES: src or dst parent directory can't be read and/or written.
* EISDIR: src or dst is a directory.
- * ENOENT: src doesn't exist. src or dst is "".
+ * ENOENT: src doesn't exist. src or dst is "".
*
- * EACCES: exists an open file already referring to dst (95).
+ * EACCES: exists an open file already referring to dst (95).
* EACCES: src specifies a char device (nul:, com1:, etc.) (NT)
* ENOENT: src specifies a char device (nul:, com1:, etc.) (95)
*
@@ -540,19 +553,19 @@ DoRenameFile(
*---------------------------------------------------------------------------
*/
-int
-TclpObjCopyFile(srcPathPtr, destPathPtr)
- Tcl_Obj *srcPathPtr;
- Tcl_Obj *destPathPtr;
+int
+TclpObjCopyFile(
+ Tcl_Obj *srcPathPtr,
+ Tcl_Obj *destPathPtr)
{
return DoCopyFile(Tcl_FSGetNativePath(srcPathPtr),
- Tcl_FSGetNativePath(destPathPtr));
+ Tcl_FSGetNativePath(destPathPtr));
}
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;
@@ -560,28 +573,26 @@ DoCopyFile(
int retval = -1;
/*
- * The CopyFile API acts differently under Win95/98 and NT
- * WRT NULL and "". Avoid passing these values.
+ * The CopyFile API acts differently under Win95/98 and NT WRT NULL and
+ * "". Avoid passing these values.
*/
if (nativeSrc == NULL || nativeSrc[0] == '\0' ||
- nativeDst == NULL || nativeDst[0] == '\0') {
+ nativeDst == NULL || nativeDst[0] == '\0') {
Tcl_SetErrno(ENOENT);
return TCL_ERROR;
}
-
+
/*
- * The CopyFile API would throw an exception under NT if one
- * of the arguments is a char block device.
+ * The CopyFile API would throw an exception under NT if one of the
+ * arguments is a char block device.
*/
#if defined(HAVE_NO_SEH) && !defined(_WIN64)
-
/*
- * Don't have SEH available, do things the hard way.
- * Note that this needs to be one block of asm, to avoid stack
- * imbalance; also, it is illegal for one asm block to contain
- * a jump to another.
+ * Don't have SEH available, do things the hard way. Note that this needs
+ * to be one block of asm, to avoid stack imbalance; also, it is illegal
+ * for one asm block to contain a jump to another.
*/
__asm__ __volatile__ (
@@ -590,71 +601,77 @@ DoCopyFile(
* Pick up parameters before messing with the stack
*/
- "movl %[nativeDst], %%ebx" "\n\t"
- "movl %[nativeSrc], %%ecx" "\n\t"
+ "movl %[nativeDst], %%ebx" "\n\t"
+ "movl %[nativeSrc], %%ecx" "\n\t"
+
+ /*
+ * Construct an EXCEPTION_REGISTRATION to protect the call to
+ * CopyFile.
+ */
+
+ "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 $0, 0x10(%%edx)" "\n\t" /* status */
+
/*
- * Construct an EXCEPTION_REGISTRATION to protect the
- * call to CopyFile
+ * Link the EXCEPTION_REGISTRATION on the chain.
*/
- "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 $0, 0x10(%%edx)" "\n\t" /* status */
-
- /* Link the EXCEPTION_REGISTRATION on the chain */
-
- "movl %%edx, %%fs:0" "\n\t"
-
- /* Call CopyFile( nativeSrc, nativeDst, 0 ) */
-
+
+ "movl %%edx, %%fs:0" "\n\t"
+
+ /*
+ * Call CopyFile(nativeSrc, nativeDst, 0)
+ */
+
"movl %[copyFile], %%eax" "\n\t"
- "pushl $0" "\n\t"
+ "pushl $0" "\n\t"
"pushl %%ebx" "\n\t"
"pushl %%ecx" "\n\t"
"call *%%eax" "\n\t"
-
- /*
- * Come here on normal exit. Recover the EXCEPTION_REGISTRATION
- * and put the status return from CopyFile into it.
+
+ /*
+ * Come here on normal exit. Recover the EXCEPTION_REGISTRATION and
+ * put the status return from CopyFile into it.
*/
-
+
"movl %%fs:0, %%edx" "\n\t"
"movl %%eax, 0x10(%%edx)" "\n\t"
"jmp 2f" "\n"
-
+
/*
- * Come here on an exception. Recover the EXCEPTION_REGISTRATION
+ * Come here on an exception. Recover the EXCEPTION_REGISTRATION
*/
-
+
"1:" "\t"
- "movl %%fs:0, %%edx" "\n\t"
- "movl 0x8(%%edx), %%edx" "\n\t"
-
- /*
- * Come here however we exited. Restore context from the
+ "movl %%fs:0, %%edx" "\n\t"
+ "movl 0x8(%%edx), %%edx" "\n\t"
+
+ /*
+ * 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"
-
+
+ "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),
- [nativeDst] "m" (nativeDst),
- [nativeSrc] "m" (nativeSrc),
- [copyFile] "r" (tclWinProcs->copyFileProc)
- :
+ :
+ [registration] "m" (registration),
+ [nativeDst] "m" (nativeDst),
+ [nativeSrc] "m" (nativeSrc),
+ [copyFile] "r" (tclWinProcs->copyFileProc)
+ :
"%eax", "%ebx", "%ecx", "%edx", "memory"
- );
+ );
if (registration.status != FALSE) {
retval = TCL_OK;
}
@@ -670,8 +687,9 @@ DoCopyFile(
#endif
#endif
- if (retval != -1)
- return retval;
+ if (retval != -1) {
+ return retval;
+ }
TclWinConvertError(GetLastError());
if (Tcl_GetErrno() == EBADF) {
@@ -691,21 +709,23 @@ DoCopyFile(
(dstAttr & FILE_ATTRIBUTE_DIRECTORY)) {
if (srcAttr & FILE_ATTRIBUTE_REPARSE_POINT) {
/* Source is a symbolic link -- copy it */
- if (TclWinSymLinkCopyDirectory(nativeSrc, nativeDst) == 0) {
- return TCL_OK;
+ if (TclWinSymLinkCopyDirectory(nativeSrc, nativeDst)==0) {
+ return TCL_OK;
}
}
Tcl_SetErrno(EISDIR);
}
if (dstAttr & FILE_ATTRIBUTE_READONLY) {
- (*tclWinProcs->setFileAttributesProc)(nativeDst,
+ (*tclWinProcs->setFileAttributesProc)(nativeDst,
dstAttr & ~((DWORD)FILE_ATTRIBUTE_READONLY));
- if ((*tclWinProcs->copyFileProc)(nativeSrc, nativeDst, 0) != FALSE) {
+ if ((*tclWinProcs->copyFileProc)(nativeSrc, nativeDst,
+ 0) != FALSE) {
return TCL_OK;
}
+
/*
- * Still can't copy onto dst. Return that error, and
- * restore attributes of dst.
+ * Still can't copy onto dst. Return that error, and restore
+ * attributes of dst.
*/
TclWinConvertError(GetLastError());
@@ -721,29 +741,29 @@ DoCopyFile(
*
* TclpObjDeleteFile, TclpDeleteFile --
*
- * Removes a single file (not a directory).
+ * Removes a single file (not a directory).
*
* Results:
- * If the file was successfully deleted, returns TCL_OK. Otherwise
- * the return value is TCL_ERROR and errno is set to indicate the
- * error. Some possible values for errno are:
+ * If the file was successfully deleted, returns TCL_OK. Otherwise the
+ * return value is TCL_ERROR and errno is set to indicate the error.
+ * Some possible values for errno are:
*
- * EACCES: a parent directory can't be read and/or written.
+ * EACCES: a parent directory can't be read and/or written.
* EISDIR: path is a directory.
* ENOENT: path doesn't exist or is "".
*
- * EACCES: exists an open file already referring to path.
+ * EACCES: exists an open file already referring to path.
* EACCES: path is a char device (nul:, com1:, etc.)
*
* Side effects:
- * The file is deleted, even if it is read-only.
+ * The file is deleted, even if it is read-only.
*
*---------------------------------------------------------------------------
*/
-int
-TclpObjDeleteFile(pathPtr)
- Tcl_Obj *pathPtr;
+int
+TclpObjDeleteFile(
+ Tcl_Obj *pathPtr)
{
return TclpDeleteFile(Tcl_FSGetNativePath(pathPtr));
}
@@ -755,8 +775,8 @@ TclpDeleteFile(
DWORD attr;
/*
- * The DeleteFile API acts differently under Win95/98 and NT
- * WRT NULL and "". Avoid passing these values.
+ * The DeleteFile API acts differently under Win95/98 and NT WRT NULL and
+ * "". Avoid passing these values.
*/
if (nativePath == NULL || nativePath[0] == '\0') {
@@ -770,27 +790,30 @@ TclpDeleteFile(
TclWinConvertError(GetLastError());
if (Tcl_GetErrno() == EACCES) {
- attr = (*tclWinProcs->getFileAttributesProc)(nativePath);
+ attr = (*tclWinProcs->getFileAttributesProc)(nativePath);
if (attr != 0xffffffff) {
if (attr & FILE_ATTRIBUTE_DIRECTORY) {
if (attr & FILE_ATTRIBUTE_REPARSE_POINT) {
- /* It is a symbolic link -- remove it */
+ /*
+ * It is a symbolic link - remove it.
+ */
if (TclWinSymLinkDelete(nativePath, 0) == 0) {
- return TCL_OK;
+ return TCL_OK;
}
}
-
- /*
+
+ /*
* If we fall through here, it is a directory.
- *
+ *
* Windows NT reports removing a directory as EACCES instead
* of EISDIR.
*/
Tcl_SetErrno(EISDIR);
} else if (attr & FILE_ATTRIBUTE_READONLY) {
- int res = (*tclWinProcs->setFileAttributesProc)(nativePath,
+ int res = (*tclWinProcs->setFileAttributesProc)(nativePath,
attr & ~((DWORD)FILE_ATTRIBUTE_READONLY));
+
if ((res != 0) && ((*tclWinProcs->deleteFileProc)(nativePath)
!= FALSE)) {
return TCL_OK;
@@ -802,12 +825,12 @@ TclpDeleteFile(
}
}
} else if (Tcl_GetErrno() == ENOENT) {
- attr = (*tclWinProcs->getFileAttributesProc)(nativePath);
+ attr = (*tclWinProcs->getFileAttributesProc)(nativePath);
if (attr != 0xffffffff) {
if (attr & FILE_ATTRIBUTE_DIRECTORY) {
- /*
- * Windows 95 reports removing a directory as ENOENT instead
- * of EISDIR.
+ /*
+ * Windows 95 reports removing a directory as ENOENT instead
+ * of EISDIR.
*/
Tcl_SetErrno(EISDIR);
@@ -830,29 +853,29 @@ TclpDeleteFile(
*
* TclpObjCreateDirectory --
*
- * Creates the specified directory. All parent directories of the
- * specified directory must already exist. The directory is
- * automatically created with permissions so that user can access
- * the new directory and create new files or subdirectories in it.
+ * Creates the specified directory. All parent directories of the
+ * specified directory must already exist. The directory is automatically
+ * created with permissions so that user can access the new directory and
+ * create new files or subdirectories in it.
*
* Results:
- * If the directory was successfully created, returns TCL_OK.
- * Otherwise the return value is TCL_ERROR and errno is set to
- * indicate the error. Some possible values for errno are:
+ * If the directory was successfully created, returns TCL_OK. Otherwise
+ * the return value is TCL_ERROR and errno is set to indicate the error.
+ * Some possible values for errno are:
*
- * EACCES: a parent directory can't be read and/or written.
+ * EACCES: a parent directory can't be read and/or written.
* EEXIST: path already exists.
* ENOENT: a parent directory doesn't exist.
*
* Side effects:
- * A directory is created.
+ * A directory is created.
*
*---------------------------------------------------------------------------
*/
-int
-TclpObjCreateDirectory(pathPtr)
- Tcl_Obj *pathPtr;
+int
+TclpObjCreateDirectory(
+ Tcl_Obj *pathPtr)
{
return DoCreateDirectory(Tcl_FSGetNativePath(pathPtr));
}
@@ -866,7 +889,7 @@ DoCreateDirectory(
error = GetLastError();
TclWinConvertError(error);
return TCL_ERROR;
- }
+ }
return TCL_OK;
}
@@ -875,32 +898,30 @@ DoCreateDirectory(
*
* TclpObjCopyDirectory --
*
- * Recursively copies a directory. The target directory dst must
- * not already exist. Note that this function does not merge two
- * directory hierarchies, even if the target directory is an an
- * empty directory.
+ * Recursively copies a directory. The target directory dst must not
+ * already exist. Note that this function does not merge two directory
+ * hierarchies, even if the target directory is an an empty directory.
*
* Results:
- * If the directory was successfully copied, returns TCL_OK.
- * Otherwise the return value is TCL_ERROR, errno is set to indicate
- * the error, and the pathname of the file that caused the error
- * is stored in errorPtr. See TclpCreateDirectory and TclpCopyFile
- * for a description of possible values for errno.
+ * If the directory was successfully copied, returns TCL_OK. Otherwise
+ * the return value is TCL_ERROR, errno is set to indicate the error, and
+ * the pathname of the file that caused the error is stored in errorPtr.
+ * See TclpCreateDirectory and TclpCopyFile for a description of possible
+ * values for errno.
*
* Side effects:
- * An exact copy of the directory hierarchy src will be created
- * with the name dst. If an error occurs, the error will
- * be returned immediately, and remaining files will not be
- * processed.
+ * An exact copy of the directory hierarchy src will be created with the
+ * name dst. If an error occurs, the error will be returned immediately,
+ * and remaining files will not be processed.
*
*---------------------------------------------------------------------------
*/
-int
-TclpObjCopyDirectory(srcPathPtr, destPathPtr, errorPtr)
- Tcl_Obj *srcPathPtr;
- Tcl_Obj *destPathPtr;
- Tcl_Obj **errorPtr;
+int
+TclpObjCopyDirectory(
+ Tcl_Obj *srcPathPtr,
+ Tcl_Obj *destPathPtr,
+ Tcl_Obj **errorPtr)
{
Tcl_DString ds;
Tcl_DString srcString, dstString;
@@ -908,14 +929,12 @@ TclpObjCopyDirectory(srcPathPtr, destPathPtr, errorPtr)
int ret;
normSrcPtr = Tcl_FSGetNormalizedPath(NULL,srcPathPtr);
- if (normSrcPtr == NULL) {
- return TCL_ERROR;
- }
- Tcl_WinUtfToTChar(Tcl_GetString(normSrcPtr), -1, &srcString);
normDestPtr = Tcl_FSGetNormalizedPath(NULL,destPathPtr);
- if (normDestPtr == NULL) {
+ if ((normSrcPtr == NULL) || (normDestPtr == NULL)) {
return TCL_ERROR;
}
+
+ Tcl_WinUtfToTChar(Tcl_GetString(normSrcPtr), -1, &srcString);
Tcl_WinUtfToTChar(Tcl_GetString(normDestPtr), -1, &dstString);
ret = TraverseWinTree(TraversalCopy, &srcString, &dstString, &ds);
@@ -924,9 +943,9 @@ TclpObjCopyDirectory(srcPathPtr, destPathPtr, errorPtr)
Tcl_DStringFree(&dstString);
if (ret != TCL_OK) {
- if (!strcmp(Tcl_DStringValue(&ds), Tcl_GetString(normSrcPtr))) {
+ if (!strcmp(Tcl_DStringValue(&ds), TclGetString(normSrcPtr))) {
*errorPtr = srcPathPtr;
- } else if (!strcmp(Tcl_DStringValue(&ds), Tcl_GetString(normDestPtr))) {
+ } else if (!strcmp(Tcl_DStringValue(&ds), TclGetString(normDestPtr))) {
*errorPtr = destPathPtr;
} else {
*errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1);
@@ -940,47 +959,49 @@ TclpObjCopyDirectory(srcPathPtr, destPathPtr, errorPtr)
/*
*----------------------------------------------------------------------
*
- * TclpObjRemoveDirectory, DoRemoveDirectory --
+ * TclpObjRemoveDirectory, DoRemoveDirectory --
*
* Removes directory (and its contents, if the recursive flag is set).
*
* Results:
- * If the directory was successfully removed, returns TCL_OK.
- * Otherwise the return value is TCL_ERROR, errno is set to indicate
- * the error, and the pathname of the file that caused the error
- * is stored in errorPtr. Some possible values for errno are:
+ * If the directory was successfully removed, returns TCL_OK. Otherwise
+ * the return value is TCL_ERROR, errno is set to indicate the error, and
+ * the pathname of the file that caused the error is stored in errorPtr.
+ * Some possible values for errno are:
*
- * EACCES: path directory can't be read and/or written.
+ * EACCES: path directory can't be read and/or written.
* EEXIST: path is a non-empty directory.
* EINVAL: path is root directory or current directory.
* ENOENT: path doesn't exist or is "".
- * ENOTDIR: path is not a directory.
+ * ENOTDIR: path is not a directory.
*
* EACCES: path is a char device (nul:, com1:, etc.) (95)
* EINVAL: path is a char device (nul:, com1:, etc.) (NT)
*
* Side effects:
- * Directory removed. If an error occurs, the error will be returned
+ * Directory removed. If an error occurs, the error will be returned
* immediately, and remaining files will not be deleted.
*
*----------------------------------------------------------------------
*/
-int
-TclpObjRemoveDirectory(pathPtr, recursive, errorPtr)
- Tcl_Obj *pathPtr;
- int recursive;
- Tcl_Obj **errorPtr;
+int
+TclpObjRemoveDirectory(
+ Tcl_Obj *pathPtr,
+ int recursive,
+ Tcl_Obj **errorPtr)
{
Tcl_DString ds;
Tcl_Obj *normPtr = NULL;
int ret;
+
if (recursive) {
- /*
+ /*
* In the recursive case, the string rep is used to construct a
- * Tcl_DString which may be used extensively, so we can't
- * optimize this case easily.
+ * Tcl_DString which may be used extensively, so we can't optimize
+ * this case easily.
*/
+
Tcl_DString native;
normPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr);
if (normPtr == NULL) {
@@ -990,14 +1011,14 @@ TclpObjRemoveDirectory(pathPtr, recursive, errorPtr)
ret = DoRemoveDirectory(&native, recursive, &ds);
Tcl_DStringFree(&native);
} else {
- ret = DoRemoveJustDirectory(Tcl_FSGetNativePath(pathPtr),
- 0, &ds);
+ ret = DoRemoveJustDirectory(Tcl_FSGetNativePath(pathPtr), 0, &ds);
}
+
if (ret != TCL_OK) {
int len = Tcl_DStringLength(&ds);
if (len > 0) {
- if (normPtr != NULL
- && !strcmp(Tcl_DStringValue(&ds), Tcl_GetString(normPtr))) {
+ if (normPtr != NULL &&
+ !strcmp(Tcl_DStringValue(&ds), TclGetString(normPtr))) {
*errorPtr = pathPtr;
} else {
*errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1);
@@ -1006,6 +1027,7 @@ TclpObjRemoveDirectory(pathPtr, recursive, errorPtr)
}
Tcl_DStringFree(&ds);
}
+
return ret;
}
@@ -1013,16 +1035,17 @@ static int
DoRemoveJustDirectory(
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. */
- Tcl_DString *errorPtr) /* If non-NULL, uninitialized or free
- * DString filled with UTF-8 name of file
- * causing error. */
+ int ignoreError, /* If non-zero, don't initialize the errorPtr
+ * under some circumstances on return. */
+ Tcl_DString *errorPtr) /* If non-NULL, uninitialized or free DString
+ * filled with UTF-8 name of file causing
+ * error. */
{
+ DWORD attr;
+
/*
- * The RemoveDirectory API acts differently under Win95/98 and NT
- * WRT NULL and "". Avoid passing these values.
+ * The RemoveDirectory API acts differently under Win95/98 and NT WRT NULL
+ * and "". Avoid passing these values.
*/
if (nativePath == NULL || nativePath[0] == '\0') {
@@ -1030,48 +1053,68 @@ DoRemoveJustDirectory(
goto end;
}
- if ((*tclWinProcs->removeDirectoryProc)(nativePath) != FALSE) {
- return TCL_OK;
+ attr = (*tclWinProcs->getFileAttributesProc)(nativePath);
+
+ if (attr & FILE_ATTRIBUTE_REPARSE_POINT) {
+ /*
+ * It is a symbolic link - remove it.
+ */
+ if (TclWinSymLinkDelete(nativePath, 0) == 0) {
+ return TCL_OK;
+ }
+ } else {
+ /*
+ * Ordinary directory.
+ */
+
+ if ((*tclWinProcs->removeDirectoryProc)(nativePath) != FALSE) {
+ return TCL_OK;
+ }
}
+
TclWinConvertError(GetLastError());
if (Tcl_GetErrno() == EACCES) {
- DWORD attr = (*tclWinProcs->getFileAttributesProc)(nativePath);
+ attr = (*tclWinProcs->getFileAttributesProc)(nativePath);
if (attr != 0xffffffff) {
if ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0) {
- /*
- * Windows 95 reports calling RemoveDirectory on a file as an
+ /*
+ * Windows 95 reports calling RemoveDirectory on a file as an
* EACCES, not an ENOTDIR.
*/
-
+
Tcl_SetErrno(ENOTDIR);
goto end;
}
if (attr & FILE_ATTRIBUTE_REPARSE_POINT) {
- /* It is a symbolic link -- remove it */
+ /*
+ * It is a symbolic link - remove it.
+ */
+
if (TclWinSymLinkDelete(nativePath, 1) != 0) {
goto end;
}
}
-
+
if (attr & FILE_ATTRIBUTE_READONLY) {
attr &= ~FILE_ATTRIBUTE_READONLY;
- if ((*tclWinProcs->setFileAttributesProc)(nativePath, attr) == FALSE) {
+ if ((*tclWinProcs->setFileAttributesProc)(nativePath,
+ attr) == FALSE) {
goto end;
}
if ((*tclWinProcs->removeDirectoryProc)(nativePath) != FALSE) {
return TCL_OK;
}
TclWinConvertError(GetLastError());
- (*tclWinProcs->setFileAttributesProc)(nativePath,
+ (*tclWinProcs->setFileAttributesProc)(nativePath,
attr | FILE_ATTRIBUTE_READONLY);
}
- /*
- * Windows 95 and Win32s report removing a non-empty directory
- * as EACCES, not EEXIST. If the directory is not empty,
- * change errno so caller knows what's going on.
+ /*
+ * Windows 95 and Win32s report removing a non-empty directory as
+ * EACCES, not EEXIST. If the directory is not empty, change errno
+ * so caller knows what's going on.
*/
if (TclWinGetPlatformId() != VER_PLATFORM_WIN32_NT) {
@@ -1112,24 +1155,25 @@ DoRemoveJustDirectory(
}
}
}
+
if (Tcl_GetErrno() == ENOTEMPTY) {
- /*
- * The caller depends on EEXIST to signify that the directory is
- * not empty, not ENOTEMPTY.
+ /*
+ * The caller depends on EEXIST to signify that the directory is not
+ * empty, not ENOTEMPTY.
*/
Tcl_SetErrno(EEXIST);
}
+
if ((ignoreError != 0) && (Tcl_GetErrno() == EEXIST)) {
- /*
- * If we're being recursive, this error may actually
- * be ok, so we don't want to initialise the errorPtr
- * yet.
+ /*
+ * If we're being recursive, this error may actually be ok, so we
+ * don't want to initialise the errorPtr yet.
*/
return TCL_ERROR;
}
- end:
+ end:
if (errorPtr != NULL) {
Tcl_WinTCharToUtf(nativePath, -1, errorPtr);
}
@@ -1141,21 +1185,22 @@ static int
DoRemoveDirectory(
Tcl_DString *pathPtr, /* Pathname of directory to be removed
* (native). */
- int recursive, /* If non-zero, removes directories that
- * are nonempty. Otherwise, will only remove
- * empty directories. */
- Tcl_DString *errorPtr) /* If non-NULL, uninitialized or free
- * DString filled with UTF-8 name of file
- * causing error. */
+ int recursive, /* If non-zero, removes directories that are
+ * nonempty. Otherwise, will only remove empty
+ * directories. */
+ Tcl_DString *errorPtr) /* If non-NULL, uninitialized or free DString
+ * filled with UTF-8 name of file causing
+ * error. */
{
- int res = DoRemoveJustDirectory(Tcl_DStringValue(pathPtr), recursive,
- errorPtr);
-
+ int res = DoRemoveJustDirectory(Tcl_DStringValue(pathPtr), recursive,
+ errorPtr);
+
if ((res == TCL_ERROR) && (recursive != 0) && (Tcl_GetErrno() == EEXIST)) {
/*
* The directory is nonempty, but the recursive flag has been
* specified, so we recursively remove all the files in the directory.
*/
+
return TraverseWinTree(TraversalDelete, pathPtr, NULL, errorPtr);
} else {
return res;
@@ -1167,24 +1212,24 @@ DoRemoveDirectory(
*
* TraverseWinTree --
*
- * Traverse directory tree specified by sourcePtr, calling the function
- * traverseProc for each file and directory encountered. If destPtr
- * is non-null, each of name in the sourcePtr directory is appended to
- * the directory specified by destPtr and passed as the second argument
- * to traverseProc() .
+ * Traverse directory tree specified by sourcePtr, calling the function
+ * traverseProc for each file and directory encountered. If destPtr is
+ * non-null, each of name in the sourcePtr directory is appended to the
+ * directory specified by destPtr and passed as the second argument to
+ * traverseProc().
*
* Results:
- * Standard Tcl result.
+ * Standard Tcl result.
*
* Side effects:
- * None caused by TraverseWinTree, however the user specified
- * traverseProc() may change state. If an error occurs, the error will
- * be returned immediately, and remaining files will not be processed.
+ * None caused by TraverseWinTree, however the user specified
+ * traverseProc() may change state. If an error occurs, the error will be
+ * returned immediately, and remaining files will not be processed.
*
*---------------------------------------------------------------------------
*/
-static int
+static int
TraverseWinTree(
TraversalProc *traverseProc,/* Function to call for every file and
* directory in source hierarchy. */
@@ -1193,9 +1238,9 @@ TraverseWinTree(
Tcl_DString *targetPtr, /* Pathname of directory to traverse in
* parallel with source directory (native),
* may be NULL. */
- Tcl_DString *errorPtr) /* If non-NULL, uninitialized or free
- * DString filled with UTF-8 name of file
- * causing error. */
+ Tcl_DString *errorPtr) /* If non-NULL, uninitialized or free DString
+ * filled with UTF-8 name of file causing
+ * error. */
{
DWORD sourceAttr;
TCHAR *nativeSource, *nativeTarget, *nativeErrfile;
@@ -1208,15 +1253,25 @@ TraverseWinTree(
oldTargetLen = 0; /* lint. */
nativeSource = (TCHAR *) Tcl_DStringValue(sourcePtr);
- nativeTarget = (TCHAR *) (targetPtr == NULL
- ? NULL : Tcl_DStringValue(targetPtr));
-
+ nativeTarget = (TCHAR *)
+ (targetPtr == NULL ? NULL : Tcl_DStringValue(targetPtr));
+
oldSourceLen = Tcl_DStringLength(sourcePtr);
sourceAttr = (*tclWinProcs->getFileAttributesProc)(nativeSource);
if (sourceAttr == 0xffffffff) {
nativeErrfile = nativeSource;
goto end;
}
+
+ if (sourceAttr & FILE_ATTRIBUTE_REPARSE_POINT) {
+ /*
+ * Process the symbolic link
+ */
+
+ return (*traverseProc)(nativeSource, nativeTarget, DOTREE_LINK,
+ errorPtr);
+ }
+
if ((sourceAttr & FILE_ATTRIBUTE_DIRECTORY) == 0) {
/*
* Process the regular file
@@ -1231,11 +1286,12 @@ TraverseWinTree(
} else {
Tcl_DStringAppend(sourcePtr, "\\*.*", 4);
}
+
nativeSource = (TCHAR *) Tcl_DStringValue(sourcePtr);
handle = (*tclWinProcs->findFirstFileProc)(nativeSource, &data);
- if (handle == INVALID_HANDLE_VALUE) {
- /*
- * Can't read directory
+ if (handle == INVALID_HANDLE_VALUE) {
+ /*
+ * Can't read directory.
*/
TclWinConvertError(GetLastError());
@@ -1245,7 +1301,8 @@ TraverseWinTree(
nativeSource[oldSourceLen + 1] = '\0';
Tcl_DStringSetLength(sourcePtr, oldSourceLen);
- result = (*traverseProc)(nativeSource, nativeTarget, DOTREE_PRED, errorPtr);
+ result = (*traverseProc)(nativeSource, nativeTarget, DOTREE_PRED,
+ errorPtr);
if (result != TCL_OK) {
FindClose(handle);
return result;
@@ -1276,7 +1333,7 @@ TraverseWinTree(
}
found = 1;
- for ( ; found; found = (*tclWinProcs->findNextFileProc)(handle, &data)) {
+ for (; found; found = (*tclWinProcs->findNextFileProc)(handle, &data)) {
TCHAR *nativeName;
int len;
@@ -1296,7 +1353,7 @@ TraverseWinTree(
nativeName = (TCHAR *) data.w.cFileName;
len = wcslen(data.w.cFileName) * sizeof(WCHAR);
} else {
- if ((strcmp(data.a.cFileName, ".") == 0)
+ if ((strcmp(data.a.cFileName, ".") == 0)
|| (strcmp(data.a.cFileName, "..") == 0)) {
continue;
}
@@ -1304,8 +1361,8 @@ TraverseWinTree(
len = strlen(data.a.cFileName);
}
- /*
- * Append name after slash, and recurse on the file.
+ /*
+ * Append name after slash, and recurse on the file.
*/
Tcl_DStringAppend(sourcePtr, (char *) nativeName, len + 1);
@@ -1314,7 +1371,7 @@ TraverseWinTree(
Tcl_DStringAppend(targetPtr, (char *) nativeName, len + 1);
Tcl_DStringSetLength(targetPtr, Tcl_DStringLength(targetPtr) - 1);
}
- result = TraverseWinTree(traverseProc, sourcePtr, targetPtr,
+ result = TraverseWinTree(traverseProc, sourcePtr, targetPtr,
errorPtr);
if (result != TCL_OK) {
break;
@@ -1332,7 +1389,7 @@ TraverseWinTree(
FindClose(handle);
/*
- * Strip off the trailing slash we added
+ * Strip off the trailing slash we added.
*/
Tcl_DStringSetLength(sourcePtr, oldSourceLen + 1);
@@ -1347,11 +1404,12 @@ TraverseWinTree(
* files in that directory.
*/
- result = (*traverseProc)(Tcl_DStringValue(sourcePtr),
- (targetPtr == NULL ? NULL : Tcl_DStringValue(targetPtr)),
- DOTREE_POSTD, errorPtr);
+ result = (*traverseProc)(Tcl_DStringValue(sourcePtr),
+ (targetPtr == NULL ? NULL : Tcl_DStringValue(targetPtr)),
+ DOTREE_POSTD, errorPtr);
}
- end:
+
+ end:
if (nativeErrfile != NULL) {
TclWinConvertError(GetLastError());
if (errorPtr != NULL) {
@@ -1368,19 +1426,19 @@ TraverseWinTree(
*
* TraversalCopy
*
- * Called from TraverseUnixTree in order to execute a recursive
- * copy of a directory.
+ * Called from TraverseUnixTree in order to execute a recursive copy of a
+ * directory.
*
* Results:
- * Standard Tcl result.
+ * Standard Tcl result.
*
* Side effects:
- * Depending on the value of type, src may be copied to dst.
- *
+ * Depending on the value of type, src may be copied to dst.
+ *
*----------------------------------------------------------------------
*/
-static int
+static int
TraversalCopy(
CONST TCHAR *nativeSrc, /* Source pathname to copy. */
CONST TCHAR *nativeDst, /* Destination pathname of copy. */
@@ -1389,30 +1447,34 @@ TraversalCopy(
* with UTF-8 name of file causing error. */
{
switch (type) {
- case DOTREE_F: {
- if (DoCopyFile(nativeSrc, nativeDst) == TCL_OK) {
- return TCL_OK;
- }
- break;
- }
- case DOTREE_PRED: {
- if (DoCreateDirectory(nativeDst) == TCL_OK) {
- DWORD attr = (*tclWinProcs->getFileAttributesProc)(nativeSrc);
- if ((*tclWinProcs->setFileAttributesProc)(nativeDst, attr) != FALSE) {
- return TCL_OK;
- }
- TclWinConvertError(GetLastError());
- }
- break;
+ case DOTREE_F:
+ if (DoCopyFile(nativeSrc, nativeDst) == TCL_OK) {
+ return TCL_OK;
}
- case DOTREE_POSTD: {
+ break;
+ case DOTREE_LINK:
+ if (TclWinSymLinkCopyDirectory(nativeSrc, nativeDst) == TCL_OK) {
return TCL_OK;
}
+ break;
+ case DOTREE_PRED:
+ if (DoCreateDirectory(nativeDst) == TCL_OK) {
+ DWORD attr = (tclWinProcs->getFileAttributesProc)(nativeSrc);
+
+ if ((tclWinProcs->setFileAttributesProc)(nativeDst,
+ attr) != FALSE) {
+ return TCL_OK;
+ }
+ TclWinConvertError(GetLastError());
+ }
+ break;
+ case DOTREE_POSTD:
+ return TCL_OK;
}
/*
- * There shouldn't be a problem with src, because we already
- * checked it to get here.
+ * There shouldn't be a problem with src, because we already checked it to
+ * get here.
*/
if (errorPtr != NULL) {
@@ -1426,24 +1488,24 @@ TraversalCopy(
*
* TraversalDelete --
*
- * Called by procedure TraverseWinTree for every file and
- * directory that it encounters in a directory hierarchy. This
- * procedure unlinks files, and removes directories after all the
- * containing files have been processed.
+ * Called by function TraverseWinTree for every file and directory that
+ * it encounters in a directory hierarchy. This function unlinks files,
+ * and removes directories after all the containing files have been
+ * processed.
*
* Results:
- * Standard Tcl result.
+ * Standard Tcl result.
*
* Side effects:
- * Files or directory specified by src will be deleted. If an
- * error occurs, the windows error is converted to a Posix error
- * and errno is set accordingly.
+ * Files or directory specified by src will be deleted. If an error
+ * occurs, the windows error is converted to a Posix error and errno is
+ * set accordingly.
*
*----------------------------------------------------------------------
*/
static int
-TraversalDelete(
+TraversalDelete(
CONST TCHAR *nativeSrc, /* Source pathname to delete. */
CONST TCHAR *dstPtr, /* Not used. */
int type, /* Reason for call - see TraverseWinTree() */
@@ -1451,21 +1513,23 @@ TraversalDelete(
* with UTF-8 name of file causing error. */
{
switch (type) {
- case DOTREE_F: {
- if (TclpDeleteFile(nativeSrc) == TCL_OK) {
- return TCL_OK;
- }
- break;
+ case DOTREE_F:
+ if (TclpDeleteFile(nativeSrc) == TCL_OK) {
+ return TCL_OK;
}
- case DOTREE_PRED: {
+ break;
+ case DOTREE_LINK:
+ if (DoRemoveJustDirectory(nativeSrc, 0, NULL) == TCL_OK) {
return TCL_OK;
}
- case DOTREE_POSTD: {
- if (DoRemoveJustDirectory(nativeSrc, 0, NULL) == TCL_OK) {
- return TCL_OK;
- }
- break;
+ break;
+ case DOTREE_PRED:
+ return TCL_OK;
+ case DOTREE_POSTD:
+ if (DoRemoveJustDirectory(nativeSrc, 0, NULL) == TCL_OK) {
+ return TCL_OK;
}
+ break;
}
if (errorPtr != NULL) {
@@ -1482,11 +1546,11 @@ TraversalDelete(
* Sets the object result with the appropriate error.
*
* Results:
- * None.
+ * None.
*
* Side effects:
- * The interp's object result is set with an error message
- * based on the objIndex, fileName and errno.
+ * The interp's object result is set with an error message based on the
+ * objIndex, fileName and errno.
*
*----------------------------------------------------------------------
*/
@@ -1494,14 +1558,12 @@ TraversalDelete(
static void
StatError(
Tcl_Interp *interp, /* The interp that has the error */
- Tcl_Obj *fileName) /* The name of the file which caused the
+ Tcl_Obj *fileName) /* The name of the file which caused the
* error. */
{
TclWinConvertError(GetLastError());
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "could not read \"", Tcl_GetString(fileName),
- "\": ", Tcl_PosixError(interp),
- (char *) NULL);
+ Tcl_AppendResult(interp, "could not read \"", TclGetString(fileName),
+ "\": ", Tcl_PosixError(interp), (char *) NULL);
}
/*
@@ -1509,16 +1571,16 @@ StatError(
*
* GetWinFileAttributes --
*
- * Returns a Tcl_Obj containing the value of a file attribute.
- * This routine gets the -hidden, -readonly or -system attribute.
+ * Returns a Tcl_Obj containing the value of a file attribute. This
+ * routine gets the -hidden, -readonly or -system attribute.
*
* Results:
- * Standard Tcl result and a Tcl_Obj in attributePtrPtr. The object
- * will have ref count 0. If the return value is not TCL_OK,
- * attributePtrPtr is not touched.
+ * Standard Tcl result and a Tcl_Obj in attributePtrPtr. The object will
+ * have ref count 0. If the return value is not TCL_OK, attributePtrPtr
+ * is not touched.
*
* Side effects:
- * A new object is allocated if the file is valid.
+ * A new object is allocated if the file is valid.
*
*----------------------------------------------------------------------
*/
@@ -1527,13 +1589,13 @@ static int
GetWinFileAttributes(
Tcl_Interp *interp, /* The interp we are using for errors. */
int objIndex, /* The index of the attribute. */
- Tcl_Obj *fileName, /* The name of the file. */
+ Tcl_Obj *fileName, /* The name of the file. */
Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */
{
DWORD result;
CONST TCHAR *nativeName;
int attr;
-
+
nativeName = Tcl_FSGetNativePath(fileName);
result = (*tclWinProcs->getFileAttributesProc)(nativeName);
@@ -1544,31 +1606,39 @@ GetWinFileAttributes(
attr = (int)(result & attributeArray[objIndex]);
if ((objIndex == WIN_HIDDEN_ATTRIBUTE) && (attr != 0)) {
- /*
- * It is hidden. However there is a bug on some Windows
- * OSes in which root volumes (drives) formatted as NTFS
- * are declared hidden when they are not (and cannot be).
- *
+ /*
+ * It is hidden. However there is a bug on some Windows OSes in which
+ * root volumes (drives) formatted as NTFS are declared hidden when
+ * they are not (and cannot be).
+ *
* We test for, and fix that case, here.
*/
+
int len;
char *str = Tcl_GetStringFromObj(fileName,&len);
+
if (len < 4) {
if (len == 0) {
- /*
- * Not sure if this is possible, but we pass it on
- * anyway
+ /*
+ * Not sure if this is possible, but we pass it on anyway.
*/
} else if (len == 1 && (str[0] == '/' || str[0] == '\\')) {
- /* Path is pointing to the root volume */
+ /*
+ * Path is pointing to the root volume.
+ */
+
attr = 0;
- } else if ((str[1] == ':')
- && (len == 2 || (str[2] == '/' || str[2] == '\\'))) {
- /* Path is of the form 'x:' or 'x:/' or 'x:\' */
+ } else if ((str[1] == ':')
+ && (len == 2 || (str[2] == '/' || str[2] == '\\'))) {
+ /*
+ * Path is of the form 'x:' or 'x:/' or 'x:\'
+ */
+
attr = 0;
}
}
}
+
*attributePtrPtr = Tcl_NewBooleanObj(attr);
return TCL_OK;
}
@@ -1578,21 +1648,20 @@ GetWinFileAttributes(
*
* ConvertFileNameFormat --
*
- * Returns a Tcl_Obj containing either the long or short version of the
+ * Returns a Tcl_Obj containing either the long or short version of the
* file name.
*
* Results:
- * Standard Tcl result and a Tcl_Obj in attributePtrPtr. The object
- * will have ref count 0. If the return value is not TCL_OK,
- * attributePtrPtr is not touched.
- *
- * Warning: if you pass this function a drive name like 'c:' it
- * will actually return the current working directory on that
- * drive. To avoid this, make sure the drive name ends in a
- * slash, like this 'c:/'.
+ * Standard Tcl result and a Tcl_Obj in attributePtrPtr. The object will
+ * have ref count 0. If the return value is not TCL_OK, attributePtrPtr
+ * is not touched.
+ *
+ * Warning: if you pass this function a drive name like 'c:' it will
+ * actually return the current working directory on that drive. To avoid
+ * this, make sure the drive name ends in a slash, like this 'c:/'.
*
* Side effects:
- * A new object is allocated if the file is valid.
+ * A new object is allocated if the file is valid.
*
*----------------------------------------------------------------------
*/
@@ -1601,48 +1670,55 @@ static int
ConvertFileNameFormat(
Tcl_Interp *interp, /* The interp we are using for errors. */
int objIndex, /* The index of the attribute. */
- Tcl_Obj *fileName, /* The name of the file. */
+ Tcl_Obj *fileName, /* The name of the file. */
int longShort, /* 0 to short name, 1 to long name. */
Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */
{
int pathc, i;
Tcl_Obj *splitPath;
- int result = TCL_OK;
splitPath = Tcl_FSSplitPath(fileName, &pathc);
if (splitPath == NULL || pathc == 0) {
if (interp != NULL) {
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "could not read \"", Tcl_GetString(fileName),
- "\": no such file or directory",
- (char *) NULL);
+ Tcl_AppendResult(interp, "could not read \"",
+ Tcl_GetString(fileName), "\": no such file or directory",
+ (char *) NULL);
}
- result = TCL_ERROR;
goto cleanup;
}
-
+
+ /*
+ * We will decrement this again at the end. It is safer to do this in
+ * case any of the calls below retain a reference to splitPath.
+ */
+
+ Tcl_IncrRefCount(splitPath);
+
for (i = 0; i < pathc; i++) {
Tcl_Obj *elt;
char *pathv;
int pathLen;
+
Tcl_ListObjIndex(NULL, splitPath, i, &elt);
-
+
pathv = Tcl_GetStringFromObj(elt, &pathLen);
- if ((pathv[0] == '/')
- || ((pathLen == 3) && (pathv[1] == ':'))
- || (strcmp(pathv, ".") == 0)
- || (strcmp(pathv, "..") == 0)) {
+ if ((pathv[0] == '/') || ((pathLen == 3) && (pathv[1] == ':'))
+ || (strcmp(pathv, ".") == 0) || (strcmp(pathv, "..") == 0)) {
/*
* Handle "/", "//machine/export", "c:/", "." or ".." by just
- * copying the string literally. Uppercase the drive letter,
- * just because it looks better under Windows to do so.
+ * copying the string literally. Uppercase the drive letter, just
+ * because it looks better under Windows to do so.
+ */
+
+ simple:
+ /*
+ * Here we are modifying the string representation in place.
+ *
+ * I believe this is legal, since this won't affect any file
+ * representation this thing may have.
*/
- simple:
- /* Here we are modifying the string representation in place */
- /* I believe this is legal, since this won't affect any
- * file representation this thing may have. */
pathv[0] = (char) Tcl_UniCharToUpper(UCHAR(pathv[0]));
} else {
Tcl_Obj *tempPath;
@@ -1657,10 +1733,12 @@ ConvertFileNameFormat(
tempPath = Tcl_FSJoinPath(splitPath, i+1);
Tcl_IncrRefCount(tempPath);
- /*
- * We'd like to call Tcl_FSGetNativePath(tempPath)
- * but that is likely to lead to infinite loops
+
+ /*
+ * We'd like to call Tcl_FSGetNativePath(tempPath) but that is
+ * likely to lead to infinite loops.
*/
+
Tcl_DStringInit(&ds);
tempString = Tcl_GetStringFromObj(tempPath,&tempLen);
nativeName = Tcl_WinUtfToTChar(tempString, tempLen, &ds);
@@ -1668,14 +1746,14 @@ ConvertFileNameFormat(
handle = (*tclWinProcs->findFirstFileProc)(nativeName, &data);
if (handle == INVALID_HANDLE_VALUE) {
/*
- * FindFirstFile() doesn't like root directories. We
- * would only get a root directory here if the caller
- * specified "c:" or "c:." and the current directory on the
- * drive was the root directory
+ * FindFirstFile() doesn't like root directories. We would
+ * only get a root directory here if the caller specified "c:"
+ * or "c:." and the current directory on the drive was the
+ * root directory
*/
attr = (*tclWinProcs->getFileAttributesProc)(nativeName);
- if ((attr != 0xFFFFFFFF) && (attr & FILE_ATTRIBUTE_DIRECTORY)) {
+ if ((attr!=0xFFFFFFFF) && (attr & FILE_ATTRIBUTE_DIRECTORY)) {
Tcl_DStringFree(&ds);
goto simple;
}
@@ -1686,7 +1764,6 @@ ConvertFileNameFormat(
if (interp != NULL) {
StatError(interp, fileName);
}
- result = TCL_ERROR;
goto cleanup;
}
if (tclWinProcs->useWide) {
@@ -1694,7 +1771,7 @@ ConvertFileNameFormat(
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;
@@ -1705,7 +1782,7 @@ ConvertFileNameFormat(
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;
@@ -1714,12 +1791,12 @@ ConvertFileNameFormat(
}
/*
- * Purify reports a extraneous UMR in Tcl_WinTCharToUtf() trying
- * to dereference nativeName as a Unicode string. I have proven
- * to myself that purify is wrong by running the following
- * example when nativeName == data.w.cAlternateFileName and
- * noting that purify doesn't complain about the first line,
- * but does complain about the second.
+ * Purify reports a extraneous UMR in Tcl_WinTCharToUtf() trying
+ * to dereference nativeName as a Unicode string. I have proven to
+ * myself that purify is wrong by running the following example
+ * when nativeName == data.w.cAlternateFileName and noting that
+ * purify doesn't complain about the first line, but does complain
+ * about the second.
*
* fprintf(stderr, "%d\n", data.w.cAlternateFileName[0]);
* fprintf(stderr, "%d\n", ((WCHAR *) nativeName)[0]);
@@ -1727,14 +1804,18 @@ ConvertFileNameFormat(
Tcl_DStringInit(&dsTemp);
Tcl_WinTCharToUtf(nativeName, -1, &dsTemp);
- /* Deal with issues of tildes being absolute */
+
+ /*
+ * Deal with issues of tildes being absolute.
+ */
+
if (Tcl_DStringValue(&dsTemp)[0] == '~') {
tempPath = Tcl_NewStringObj("./",2);
- Tcl_AppendToObj(tempPath, Tcl_DStringValue(&dsTemp),
- Tcl_DStringLength(&dsTemp));
+ Tcl_AppendToObj(tempPath, Tcl_DStringValue(&dsTemp),
+ Tcl_DStringLength(&dsTemp));
} else {
- tempPath = Tcl_NewStringObj(Tcl_DStringValue(&dsTemp),
- Tcl_DStringLength(&dsTemp));
+ tempPath = Tcl_NewStringObj(Tcl_DStringValue(&dsTemp),
+ Tcl_DStringLength(&dsTemp));
}
Tcl_ListObjReplace(NULL, splitPath, i, 1, 1, &tempPath);
Tcl_DStringFree(&ds);
@@ -1745,12 +1826,27 @@ ConvertFileNameFormat(
*attributePtrPtr = Tcl_FSJoinPath(splitPath, -1);
-cleanup:
+ if (splitPath != NULL) {
+ /*
+ * Unfortunately, the object we will return may have its only refCount
+ * as part of the list splitPath. This means if we free splitPath, the
+ * object will disappear. So, we have to be very careful here.
+ * Unfortunately this means we must manipulate the object's refCount
+ * directly.
+ */
+
+ Tcl_IncrRefCount(*attributePtrPtr);
+ Tcl_DecrRefCount(splitPath);
+ --(*attributePtrPtr)->refCount;
+ }
+ return TCL_OK;
+
+ cleanup:
if (splitPath != NULL) {
Tcl_DecrRefCount(splitPath);
}
-
- return result;
+
+ return TCL_ERROR;
}
/*
@@ -1758,16 +1854,15 @@ cleanup:
*
* GetWinFileLongName --
*
- * Returns a Tcl_Obj containing the long version of the file
- * name.
+ * Returns a Tcl_Obj containing the long version of the file name.
*
* Results:
- * Standard Tcl result and a Tcl_Obj in attributePtrPtr. The object
- * will have ref count 0. If the return value is not TCL_OK,
- * attributePtrPtr is not touched.
+ * Standard Tcl result and a Tcl_Obj in attributePtrPtr. The object will
+ * have ref count 0. If the return value is not TCL_OK, attributePtrPtr
+ * is not touched.
*
* Side effects:
- * A new object is allocated if the file is valid.
+ * A new object is allocated if the file is valid.
*
*----------------------------------------------------------------------
*/
@@ -1776,10 +1871,11 @@ static int
GetWinFileLongName(
Tcl_Interp *interp, /* The interp we are using for errors. */
int objIndex, /* The index of the attribute. */
- Tcl_Obj *fileName, /* The name of the file. */
+ Tcl_Obj *fileName, /* The name of the file. */
Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */
{
- return ConvertFileNameFormat(interp, objIndex, fileName, 1, attributePtrPtr);
+ return ConvertFileNameFormat(interp, objIndex, fileName, 1,
+ attributePtrPtr);
}
/*
@@ -1787,16 +1883,15 @@ GetWinFileLongName(
*
* GetWinFileShortName --
*
- * Returns a Tcl_Obj containing the short version of the file
- * name.
+ * Returns a Tcl_Obj containing the short version of the file name.
*
* Results:
- * Standard Tcl result and a Tcl_Obj in attributePtrPtr. The object
- * will have ref count 0. If the return value is not TCL_OK,
- * attributePtrPtr is not touched.
+ * Standard Tcl result and a Tcl_Obj in attributePtrPtr. The object will
+ * have ref count 0. If the return value is not TCL_OK, attributePtrPtr
+ * is not touched.
*
* Side effects:
- * A new object is allocated if the file is valid.
+ * A new object is allocated if the file is valid.
*
*----------------------------------------------------------------------
*/
@@ -1805,10 +1900,11 @@ static int
GetWinFileShortName(
Tcl_Interp *interp, /* The interp we are using for errors. */
int objIndex, /* The index of the attribute. */
- Tcl_Obj *fileName, /* The name of the file. */
+ Tcl_Obj *fileName, /* The name of the file. */
Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */
{
- return ConvertFileNameFormat(interp, objIndex, fileName, 0, attributePtrPtr);
+ return ConvertFileNameFormat(interp, objIndex, fileName, 0,
+ attributePtrPtr);
}
/*
@@ -1816,14 +1912,14 @@ GetWinFileShortName(
*
* SetWinFileAttributes --
*
- * Set the file attributes to the value given by attributePtr.
- * This routine sets the -hidden, -readonly, or -system attributes.
+ * Set the file attributes to the value given by attributePtr. This
+ * routine sets the -hidden, -readonly, or -system attributes.
*
* Results:
- * Standard TCL error.
+ * Standard TCL error.
*
* Side effects:
- * The file's attribute is set.
+ * The file's attribute is set.
*
*----------------------------------------------------------------------
*/
@@ -1832,7 +1928,7 @@ static int
SetWinFileAttributes(
Tcl_Interp *interp, /* The interp we are using for errors. */
int objIndex, /* The index of the attribute. */
- Tcl_Obj *fileName, /* The name of the file. */
+ Tcl_Obj *fileName, /* The name of the file. */
Tcl_Obj *attributePtr) /* The new value of the attribute. */
{
DWORD fileAttributes;
@@ -1872,14 +1968,13 @@ SetWinFileAttributes(
*
* SetWinFileLongName --
*
- * The attribute in question is a readonly attribute and cannot
- * be set.
+ * The attribute in question is a readonly attribute and cannot be set.
*
* Results:
- * TCL_ERROR
+ * TCL_ERROR
*
* Side effects:
- * The object result is set to a pertinent error message.
+ * The object result is set to a pertinent error message.
*
*----------------------------------------------------------------------
*/
@@ -1888,13 +1983,12 @@ static int
CannotSetAttribute(
Tcl_Interp *interp, /* The interp we are using for errors. */
int objIndex, /* The index of the attribute. */
- Tcl_Obj *fileName, /* The name of the file. */
+ Tcl_Obj *fileName, /* The name of the file. */
Tcl_Obj *attributePtr) /* The new value of the attribute. */
{
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "cannot set attribute \"", tclpFileAttrStrings[objIndex],
- "\" for file \"", Tcl_GetString(fileName),
- "\": attribute is readonly",
+ Tcl_AppendResult(interp, "cannot set attribute \"",
+ tclpFileAttrStrings[objIndex], "\" for file \"",
+ Tcl_GetString(fileName), "\": attribute is readonly",
(char *) NULL);
return TCL_ERROR;
}
@@ -1935,11 +2029,11 @@ TclpObjListVolumes(void)
if (GetLogicalDriveStringsA(sizeof(buf), buf) == 0) {
/*
* GetVolumeInformation() will detects all drives, but causes
- * chattering on empty floppy drives. We only do this if
- * GetLogicalDriveStrings() didn't work. It has also been reported
- * that on some laptops it takes a while for GetVolumeInformation()
- * to return when pinging an empty floppy drive, another reason to
- * try to avoid calling it.
+ * chattering on empty floppy drives. We only do this if
+ * GetLogicalDriveStrings() didn't work. It has also been reported
+ * that on some laptops it takes a while for GetVolumeInformation() to
+ * return when pinging an empty floppy drive, another reason to try to
+ * avoid calling it.
*/
buf[1] = ':';
@@ -1948,7 +2042,7 @@ TclpObjListVolumes(void)
for (i = 0; i < 26; i++) {
buf[0] = (char) ('a' + i);
- if (GetVolumeInformationA(buf, NULL, 0, NULL, NULL, NULL, NULL, 0)
+ if (GetVolumeInformationA(buf, NULL, 0, NULL, NULL, NULL, NULL, 0)
|| (GetLastError() == ERROR_NOT_READY)) {
elemPtr = Tcl_NewStringObj(buf, -1);
Tcl_ListObjAppendElement(NULL, resultPtr, elemPtr);
@@ -1961,7 +2055,15 @@ TclpObjListVolumes(void)
Tcl_ListObjAppendElement(NULL, resultPtr, elemPtr);
}
}
-
+
Tcl_IncrRefCount(resultPtr);
return resultPtr;
}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/win/tclWinFile.c b/win/tclWinFile.c
index 69d1838..a9b321d 100644
--- a/win/tclWinFile.c
+++ b/win/tclWinFile.c
@@ -1,24 +1,21 @@
-/*
+/*
* tclWinFile.c --
*
- * This file contains temporary wrappers around UNIX file handling
- * functions. These wrappers map the UNIX functions to Win32 HANDLE-style
- * files, which can be manipulated through the Win32 console redirection
- * interfaces.
+ * This file contains temporary wrappers around UNIX file handling
+ * functions. These wrappers map the UNIX functions to Win32 HANDLE-style
+ * files, which can be manipulated through the Win32 console redirection
+ * interfaces.
*
* Copyright (c) 1995-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.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
-#ifndef _WIN64
-/* See [Bug 2935503]: file mtime sets wrong time */
-# define _USE_32BIT_TIME_T
-#endif
-#include <sys/stat.h>
#include "tclWinInt.h"
+#include "tclFileSystem.h"
#include <winioctl.h>
+#include <sys/stat.h>
#include <shlobj.h>
#include <lmaccess.h> /* For TclpGetUserHome(). */
@@ -27,234 +24,280 @@
* on the proleptic Gregorian calendar) and the Posix epoch (1970-01-01).
*/
-#define POSIX_EPOCH_AS_FILETIME 116444736000000000
+#define POSIX_EPOCH_AS_FILETIME \
+ ((Tcl_WideInt) 116444736 * (Tcl_WideInt) 1000000000)
/*
- * Declarations for 'link' related information. This information
- * should come with VC++ 6.0, but is not in some older SDKs.
- * In any case it is not well documented.
+ * Declarations for 'link' related information. This information should come
+ * with VC++ 6.0, but is not in some older SDKs. In any case it is not well
+ * documented.
*/
+
#ifndef IO_REPARSE_TAG_RESERVED_ONE
-# define IO_REPARSE_TAG_RESERVED_ONE 0x000000001
+# define IO_REPARSE_TAG_RESERVED_ONE 0x000000001
#endif
#ifndef IO_REPARSE_TAG_RESERVED_RANGE
-# define IO_REPARSE_TAG_RESERVED_RANGE 0x000000001
+# define IO_REPARSE_TAG_RESERVED_RANGE 0x000000001
#endif
#ifndef IO_REPARSE_TAG_VALID_VALUES
-# define IO_REPARSE_TAG_VALID_VALUES 0x0E000FFFF
+# define IO_REPARSE_TAG_VALID_VALUES 0x0E000FFFF
#endif
#ifndef IO_REPARSE_TAG_HSM
-# define IO_REPARSE_TAG_HSM 0x0C0000004
+# define IO_REPARSE_TAG_HSM 0x0C0000004
#endif
#ifndef IO_REPARSE_TAG_NSS
-# define IO_REPARSE_TAG_NSS 0x080000005
+# define IO_REPARSE_TAG_NSS 0x080000005
#endif
#ifndef IO_REPARSE_TAG_NSSRECOVER
-# define IO_REPARSE_TAG_NSSRECOVER 0x080000006
+# define IO_REPARSE_TAG_NSSRECOVER 0x080000006
#endif
#ifndef IO_REPARSE_TAG_SIS
-# define IO_REPARSE_TAG_SIS 0x080000007
+# define IO_REPARSE_TAG_SIS 0x080000007
#endif
#ifndef IO_REPARSE_TAG_DFS
-# define IO_REPARSE_TAG_DFS 0x080000008
+# define IO_REPARSE_TAG_DFS 0x080000008
#endif
#ifndef IO_REPARSE_TAG_RESERVED_ZERO
-# define IO_REPARSE_TAG_RESERVED_ZERO 0x00000000
+# define IO_REPARSE_TAG_RESERVED_ZERO 0x00000000
#endif
#ifndef FILE_FLAG_OPEN_REPARSE_POINT
-# define FILE_FLAG_OPEN_REPARSE_POINT 0x00200000
+# define FILE_FLAG_OPEN_REPARSE_POINT 0x00200000
#endif
#ifndef IO_REPARSE_TAG_MOUNT_POINT
-# define IO_REPARSE_TAG_MOUNT_POINT 0xA0000003
+# define IO_REPARSE_TAG_MOUNT_POINT 0xA0000003
#endif
#ifndef IsReparseTagValid
-# define IsReparseTagValid(x) (!((x)&~IO_REPARSE_TAG_VALID_VALUES)&&((x)>IO_REPARSE_TAG_RESERVED_RANGE))
+# define IsReparseTagValid(x) \
+ (!((x)&~IO_REPARSE_TAG_VALID_VALUES)&&((x)>IO_REPARSE_TAG_RESERVED_RANGE))
#endif
#ifndef IO_REPARSE_TAG_SYMBOLIC_LINK
-# define IO_REPARSE_TAG_SYMBOLIC_LINK IO_REPARSE_TAG_RESERVED_ZERO
+# define IO_REPARSE_TAG_SYMBOLIC_LINK IO_REPARSE_TAG_RESERVED_ZERO
#endif
#ifndef FILE_SPECIAL_ACCESS
-# define FILE_SPECIAL_ACCESS (FILE_ANY_ACCESS)
+# define FILE_SPECIAL_ACCESS (FILE_ANY_ACCESS)
#endif
#ifndef FSCTL_SET_REPARSE_POINT
-# define FSCTL_SET_REPARSE_POINT CTL_CODE(FILE_DEVICE_FILE_SYSTEM, 41, METHOD_BUFFERED, FILE_SPECIAL_ACCESS)
-# define FSCTL_GET_REPARSE_POINT CTL_CODE(FILE_DEVICE_FILE_SYSTEM, 42, METHOD_BUFFERED, FILE_ANY_ACCESS)
-# define FSCTL_DELETE_REPARSE_POINT CTL_CODE(FILE_DEVICE_FILE_SYSTEM, 43, METHOD_BUFFERED, FILE_SPECIAL_ACCESS)
+# define FSCTL_SET_REPARSE_POINT \
+ CTL_CODE(FILE_DEVICE_FILE_SYSTEM, 41, METHOD_BUFFERED, FILE_SPECIAL_ACCESS)
+# define FSCTL_GET_REPARSE_POINT \
+ CTL_CODE(FILE_DEVICE_FILE_SYSTEM, 42, METHOD_BUFFERED, FILE_ANY_ACCESS)
+# define FSCTL_DELETE_REPARSE_POINT \
+ CTL_CODE(FILE_DEVICE_FILE_SYSTEM, 43, METHOD_BUFFERED, FILE_SPECIAL_ACCESS)
#endif
#ifndef INVALID_FILE_ATTRIBUTES
-#define INVALID_FILE_ATTRIBUTES ((DWORD)-1)
+#define INVALID_FILE_ATTRIBUTES ((DWORD)-1)
#endif
-/*
- * Maximum reparse buffer info size. The max user defined reparse
- * data is 16KB, plus there's a header.
+/*
+ * Maximum reparse buffer info size. The max user defined reparse data is
+ * 16KB, plus there's a header.
*/
-#define MAX_REPARSE_SIZE 17000
+#define MAX_REPARSE_SIZE 17000
/*
- * Undocumented REPARSE_MOUNTPOINT_HEADER_SIZE structure definition.
- * This is found in winnt.h.
- *
- * IMPORTANT: caution when using this structure, since the actual
- * structures used will want to store a full path in the 'PathBuffer'
- * field, but there isn't room (there's only a single WCHAR!). Therefore
- * one must artificially create a larger space of memory and then cast it
- * to this type. We use the 'DUMMY_REPARSE_BUFFER' struct just below to
- * deal with this problem.
+ * Undocumented REPARSE_MOUNTPOINT_HEADER_SIZE structure definition. This is
+ * found in winnt.h.
+ *
+ * IMPORTANT: caution when using this structure, since the actual structures
+ * used will want to store a full path in the 'PathBuffer' field, but there
+ * isn't room (there's only a single WCHAR!). Therefore one must artificially
+ * create a larger space of memory and then cast it to this type. We use the
+ * 'DUMMY_REPARSE_BUFFER' struct just below to deal with this problem.
*/
-#define REPARSE_MOUNTPOINT_HEADER_SIZE 8
+#define REPARSE_MOUNTPOINT_HEADER_SIZE 8
#ifndef REPARSE_DATA_BUFFER_HEADER_SIZE
typedef struct _REPARSE_DATA_BUFFER {
- DWORD ReparseTag;
- WORD ReparseDataLength;
- WORD Reserved;
+ DWORD ReparseTag;
+ WORD ReparseDataLength;
+ WORD Reserved;
union {
- struct {
- WORD SubstituteNameOffset;
- WORD SubstituteNameLength;
- WORD PrintNameOffset;
- WORD PrintNameLength;
- WCHAR PathBuffer[1];
- } SymbolicLinkReparseBuffer;
- struct {
- WORD SubstituteNameOffset;
- WORD SubstituteNameLength;
- WORD PrintNameOffset;
- WORD PrintNameLength;
- WCHAR PathBuffer[1];
- } MountPointReparseBuffer;
- struct {
- BYTE DataBuffer[1];
- } GenericReparseBuffer;
+ struct {
+ WORD SubstituteNameOffset;
+ WORD SubstituteNameLength;
+ WORD PrintNameOffset;
+ WORD PrintNameLength;
+ ULONG Flags;
+ WCHAR PathBuffer[1];
+ } SymbolicLinkReparseBuffer;
+ struct {
+ WORD SubstituteNameOffset;
+ WORD SubstituteNameLength;
+ WORD PrintNameOffset;
+ WORD PrintNameLength;
+ WCHAR PathBuffer[1];
+ } MountPointReparseBuffer;
+ struct {
+ BYTE DataBuffer[1];
+ } GenericReparseBuffer;
};
} REPARSE_DATA_BUFFER;
#endif
typedef struct {
REPARSE_DATA_BUFFER dummy;
- WCHAR dummyBuf[MAX_PATH*3];
+ WCHAR dummyBuf[MAX_PATH * 3];
} DUMMY_REPARSE_BUFFER;
-#if defined(_MSC_VER) && ( _MSC_VER <= 1100 )
+#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
+ FindExInfoStandard,
+ FindExInfoMaxInfoLevel
} FINDEX_INFO_LEVELS;
typedef enum _FINDEX_SEARCH_OPS {
- FindExSearchNameMatch,
- FindExSearchLimitToDirectories,
- FindExSearchLimitToDevices,
- FindExSearchMaxSearchOp
+ FindExSearchNameMatch,
+ FindExSearchLimitToDirectories,
+ FindExSearchLimitToDevices,
+ FindExSearchMaxSearchOp
} FINDEX_SEARCH_OPS;
#endif /* HAVE_NO_FINDEX_ENUMS */
-/* Other typedefs required by this code */
+/*
+ * Other typedefs required by this code.
+ */
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 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 NETAPIBUFFERFREEPROC(LPVOID Buffer);
-typedef NET_API_STATUS NET_API_FUNCTION NETGETDCNAMEPROC
- (LPWSTR servername, LPWSTR domainname, LPBYTE *bufptr);
+typedef NET_API_STATUS NET_API_FUNCTION NETGETDCNAMEPROC(
+ LPWSTR servername, LPWSTR domainname, LPBYTE *bufptr);
/*
- * Declarations for local procedures defined in this file:
+ * Declarations for local functions defined in this file:
*/
-static int NativeAccess(CONST TCHAR *path, int mode);
-static int NativeStat(CONST TCHAR *path, Tcl_StatBuf *statPtr, int checkLinks);
-static unsigned short NativeStatMode(DWORD attr, int checkLinks, int isExec);
-static int NativeIsExec(CONST TCHAR *path);
-static int NativeReadReparse(CONST TCHAR* LinkDirectory,
- REPARSE_DATA_BUFFER* buffer);
-static int NativeWriteReparse(CONST TCHAR* LinkDirectory,
- REPARSE_DATA_BUFFER* buffer);
-static int NativeMatchType(int isDrive, DWORD attr, CONST TCHAR* nativeName,
- Tcl_GlobTypeData *types);
-static int WinIsDrive(CONST char *name, int nameLen);
-static int WinIsReserved(CONST char *path);
-static Tcl_Obj* WinReadLink(CONST TCHAR* LinkSource);
-static Tcl_Obj* WinReadLinkDirectory(CONST TCHAR* LinkDirectory);
-static int WinLink(CONST TCHAR* LinkSource, CONST TCHAR* LinkTarget,
- int linkAction);
-static int WinSymLinkDirectory(CONST TCHAR* LinkDirectory,
- CONST TCHAR* LinkTarget);
+static int NativeAccess(const TCHAR *path, int mode);
+static int NativeDev(const TCHAR *path);
+static int NativeStat(const TCHAR *path, Tcl_StatBuf *statPtr,
+ int checkLinks);
+static unsigned short NativeStatMode(DWORD attr, int checkLinks,
+ int isExec);
+static int NativeIsExec(const TCHAR *path);
+static int NativeReadReparse(const TCHAR *LinkDirectory,
+ REPARSE_DATA_BUFFER *buffer);
+static int NativeWriteReparse(const TCHAR *LinkDirectory,
+ REPARSE_DATA_BUFFER *buffer);
+static int NativeMatchType(int isDrive, DWORD attr,
+ const TCHAR *nativeName, Tcl_GlobTypeData *types);
+static int WinIsDrive(const char *name, int nameLen);
+static int WinIsReserved(const char *path);
+static Tcl_Obj * WinReadLink(const TCHAR *LinkSource);
+static Tcl_Obj * WinReadLinkDirectory(const TCHAR *LinkDirectory);
+static int WinLink(const TCHAR *LinkSource,
+ const TCHAR *LinkTarget, int linkAction);
+static int WinSymLinkDirectory(const TCHAR *LinkDirectory,
+ const TCHAR *LinkTarget);
/*
*--------------------------------------------------------------------
*
- * WinLink
+ * WinLink --
+ *
+ * Make a link from source to target.
*
- * Make a link from source to target.
*--------------------------------------------------------------------
*/
-static int
-WinLink(LinkSource, LinkTarget, linkAction)
- CONST TCHAR* LinkSource;
- CONST TCHAR* LinkTarget;
- int linkAction;
+
+static int
+WinLink(
+ const TCHAR *linkSourcePath,
+ const TCHAR *linkTargetPath,
+ int linkAction)
{
- WCHAR tempFileName[MAX_PATH];
- TCHAR* tempFilePart;
- int attr;
-
- /* Get the full path referenced by the target */
- if (!(*tclWinProcs->getFullPathNameProc)(LinkTarget,
- MAX_PATH, tempFileName, &tempFilePart)) {
- /* Invalid file */
+ WCHAR tempFileName[MAX_PATH];
+ TCHAR *tempFilePart;
+ DWORD attr;
+
+ /*
+ * Get the full path referenced by the target.
+ */
+
+ if (!(*tclWinProcs->getFullPathNameProc)(linkTargetPath, MAX_PATH,
+ tempFileName, &tempFilePart)) {
+ /*
+ * Invalid file.
+ */
+
TclWinConvertError(GetLastError());
return -1;
}
- /* Make sure source file doesn't exist */
- attr = (*tclWinProcs->getFileAttributesProc)(LinkSource);
- if (attr != -1) {
+ /*
+ * Make sure source file doesn't exist.
+ */
+
+ attr = (*tclWinProcs->getFileAttributesProc)(linkSourcePath);
+ if (attr != INVALID_FILE_ATTRIBUTES) {
Tcl_SetErrno(EEXIST);
return -1;
}
- /* Get the full path referenced by the directory */
- if (!(*tclWinProcs->getFullPathNameProc)(LinkSource,
- MAX_PATH, tempFileName, &tempFilePart)) {
- /* Invalid file */
+ /*
+ * Get the full path referenced by the source file/directory.
+ */
+
+ if (!(*tclWinProcs->getFullPathNameProc)(linkSourcePath, MAX_PATH,
+ tempFileName, &tempFilePart)) {
+ /*
+ * Invalid file.
+ */
+
TclWinConvertError(GetLastError());
return -1;
}
- /* Check the target */
- attr = (*tclWinProcs->getFileAttributesProc)(LinkTarget);
- if (attr == -1) {
- /* The target doesn't exist */
+
+ /*
+ * Check the target.
+ */
+
+ attr = (*tclWinProcs->getFileAttributesProc)(linkTargetPath);
+ if (attr == INVALID_FILE_ATTRIBUTES) {
+ /*
+ * The target doesn't exist.
+ */
+
TclWinConvertError(GetLastError());
return -1;
+
} else if ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0) {
- /* It is a file */
+ /*
+ * It is a file.
+ */
+
if (tclWinProcs->createHardLinkProc == NULL) {
Tcl_SetErrno(ENOTDIR);
return -1;
}
+
if (linkAction & TCL_CREATE_HARD_LINK) {
- if (!(*tclWinProcs->createHardLinkProc)(LinkSource, LinkTarget, NULL)) {
+ if (!(*tclWinProcs->createHardLinkProc)(linkSourcePath,
+ linkTargetPath, NULL)) {
TclWinConvertError(GetLastError());
return -1;
}
return 0;
+
} else if (linkAction & TCL_CREATE_SYMBOLIC_LINK) {
- /* Can't symlink files */
+ /*
+ * Can't symlink files.
+ */
+
Tcl_SetErrno(ENOTDIR);
return -1;
} else {
@@ -262,10 +305,19 @@ WinLink(LinkSource, LinkTarget, linkAction)
return -1;
}
} else {
+ /*
+ * We've got a directory. Now check whether what we're trying to do is
+ * reasonable.
+ */
+
if (linkAction & TCL_CREATE_SYMBOLIC_LINK) {
- return WinSymLinkDirectory(LinkSource, LinkTarget);
+ return WinSymLinkDirectory(linkSourcePath, linkTargetPath);
+
} else if (linkAction & TCL_CREATE_HARD_LINK) {
- /* Can't hard link directories */
+ /*
+ * Can't hard link directories.
+ */
+
Tcl_SetErrno(EISDIR);
return -1;
} else {
@@ -278,169 +330,213 @@ WinLink(LinkSource, LinkTarget, linkAction)
/*
*--------------------------------------------------------------------
*
- * WinReadLink
+ * WinReadLink --
+ *
+ * What does 'LinkSource' point to?
*
- * What does 'LinkSource' point to?
*--------------------------------------------------------------------
*/
-static Tcl_Obj*
-WinReadLink(LinkSource)
- CONST TCHAR* LinkSource;
+
+static Tcl_Obj *
+WinReadLink(
+ const TCHAR *linkSourcePath)
{
- WCHAR tempFileName[MAX_PATH];
- TCHAR* tempFilePart;
- int attr;
-
- /* Get the full path referenced by the target */
- if (!(*tclWinProcs->getFullPathNameProc)(LinkSource,
- MAX_PATH, tempFileName, &tempFilePart)) {
- /* Invalid file */
+ WCHAR tempFileName[MAX_PATH];
+ TCHAR *tempFilePart;
+ DWORD attr;
+
+ /*
+ * Get the full path referenced by the target.
+ */
+
+ if (!(*tclWinProcs->getFullPathNameProc)(linkSourcePath, MAX_PATH,
+ tempFileName, &tempFilePart)) {
+ /*
+ * Invalid file.
+ */
+
TclWinConvertError(GetLastError());
return NULL;
}
- /* Make sure source file does exist */
- attr = (*tclWinProcs->getFileAttributesProc)(LinkSource);
- if (attr == -1) {
- /* The source doesn't exist */
+ /*
+ * Make sure source file does exist.
+ */
+
+ attr = (*tclWinProcs->getFileAttributesProc)(linkSourcePath);
+ if (attr == INVALID_FILE_ATTRIBUTES) {
+ /*
+ * The source doesn't exist.
+ */
+
TclWinConvertError(GetLastError());
return NULL;
+
} else if ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0) {
- /* It is a file - this is not yet supported */
+ /*
+ * It is a file - this is not yet supported.
+ */
+
Tcl_SetErrno(ENOTDIR);
return NULL;
} else {
- return WinReadLinkDirectory(LinkSource);
+ return WinReadLinkDirectory(linkSourcePath);
}
}
/*
*--------------------------------------------------------------------
*
- * WinSymLinkDirectory
+ * WinSymLinkDirectory --
+ *
+ * This routine creates a NTFS junction, using the undocumented
+ * FSCTL_SET_REPARSE_POINT structure Win2K uses for mount points and
+ * junctions.
+ *
+ * Assumption that linkTargetPath is a valid, existing directory.
*
- * This routine creates a NTFS junction, using the undocumented
- * FSCTL_SET_REPARSE_POINT structure Win2K uses for mount points
- * and junctions.
+ * Returns:
+ * Zero on success.
*
- * Assumption that LinkTarget is a valid, existing directory.
- *
- * Returns zero on success.
*--------------------------------------------------------------------
*/
-static int
-WinSymLinkDirectory(LinkDirectory, LinkTarget)
- CONST TCHAR* LinkDirectory;
- CONST TCHAR* LinkTarget;
+
+static int
+WinSymLinkDirectory(
+ const TCHAR *linkDirPath,
+ const TCHAR *linkTargetPath)
{
DUMMY_REPARSE_BUFFER dummy;
- REPARSE_DATA_BUFFER *reparseBuffer = (REPARSE_DATA_BUFFER*)&dummy;
- int len;
- WCHAR nativeTarget[MAX_PATH];
- WCHAR *loop;
-
- /* Make the native target name */
- memcpy((VOID*)nativeTarget, (VOID*)L"\\??\\", 4*sizeof(WCHAR));
- memcpy((VOID*)(nativeTarget + 4), (VOID*)LinkTarget,
- sizeof(WCHAR)*(1+wcslen((WCHAR*)LinkTarget)));
+ REPARSE_DATA_BUFFER *reparseBuffer = (REPARSE_DATA_BUFFER *) &dummy;
+ int len;
+ WCHAR nativeTarget[MAX_PATH];
+ WCHAR *loop;
+
+ /*
+ * Make the native target name.
+ */
+
+ memcpy(nativeTarget, L"\\??\\", 4 * sizeof(WCHAR));
+ memcpy(nativeTarget + 4, linkTargetPath,
+ sizeof(WCHAR) * (1+wcslen((WCHAR *) linkTargetPath)));
len = wcslen(nativeTarget);
- /*
- * We must have backslashes only. This is VERY IMPORTANT.
- * If we have any forward slashes everything appears to work,
- * but the resulting symlink is useless!
+
+ /*
+ * We must have backslashes only. This is VERY IMPORTANT. If we have any
+ * forward slashes everything appears to work, but the resulting symlink
+ * is useless!
*/
+
for (loop = nativeTarget; *loop != 0; loop++) {
- if (*loop == L'/') *loop = L'\\';
+ if (*loop == L'/') {
+ *loop = L'\\';
+ }
}
if ((nativeTarget[len-1] == L'\\') && (nativeTarget[len-2] != L':')) {
nativeTarget[len-1] = 0;
}
-
- /* Build the reparse info */
+
+ /*
+ * Build the reparse info.
+ */
+
memset(reparseBuffer, 0, sizeof(DUMMY_REPARSE_BUFFER));
reparseBuffer->ReparseTag = IO_REPARSE_TAG_MOUNT_POINT;
- reparseBuffer->SymbolicLinkReparseBuffer.SubstituteNameLength =
- wcslen(nativeTarget) * sizeof(WCHAR);
+ reparseBuffer->MountPointReparseBuffer.SubstituteNameLength =
+ wcslen(nativeTarget) * sizeof(WCHAR);
reparseBuffer->Reserved = 0;
- reparseBuffer->SymbolicLinkReparseBuffer.PrintNameLength = 0;
- reparseBuffer->SymbolicLinkReparseBuffer.PrintNameOffset =
- reparseBuffer->SymbolicLinkReparseBuffer.SubstituteNameLength
- + sizeof(WCHAR);
- memcpy(reparseBuffer->SymbolicLinkReparseBuffer.PathBuffer, nativeTarget,
- sizeof(WCHAR)
- + reparseBuffer->SymbolicLinkReparseBuffer.SubstituteNameLength);
- reparseBuffer->ReparseDataLength =
- reparseBuffer->SymbolicLinkReparseBuffer.SubstituteNameLength + 12;
-
- return NativeWriteReparse(LinkDirectory, reparseBuffer);
+ reparseBuffer->MountPointReparseBuffer.PrintNameLength = 0;
+ reparseBuffer->MountPointReparseBuffer.PrintNameOffset =
+ reparseBuffer->MountPointReparseBuffer.SubstituteNameLength
+ + sizeof(WCHAR);
+ memcpy(reparseBuffer->MountPointReparseBuffer.PathBuffer, nativeTarget,
+ sizeof(WCHAR)
+ + reparseBuffer->MountPointReparseBuffer.SubstituteNameLength);
+ reparseBuffer->ReparseDataLength =
+ reparseBuffer->MountPointReparseBuffer.SubstituteNameLength+12;
+
+ return NativeWriteReparse(linkDirPath, reparseBuffer);
}
/*
*--------------------------------------------------------------------
*
- * TclWinSymLinkCopyDirectory
+ * TclWinSymLinkCopyDirectory --
+ *
+ * Copy a Windows NTFS junction. This function assumes that LinkOriginal
+ * exists and is a valid junction point, and that LinkCopy does not
+ * exist.
+ *
+ * Returns:
+ * Zero on success.
*
- * Copy a Windows NTFS junction. This function assumes that
- * LinkOriginal exists and is a valid junction point, and that
- * LinkCopy does not exist.
- *
- * Returns zero on success.
*--------------------------------------------------------------------
*/
-int
-TclWinSymLinkCopyDirectory(LinkOriginal, LinkCopy)
- CONST TCHAR* LinkOriginal; /* Existing junction - reparse point */
- CONST TCHAR* LinkCopy; /* Will become a duplicate junction */
+
+int
+TclWinSymLinkCopyDirectory(
+ const TCHAR *linkOrigPath, /* Existing junction - reparse point */
+ const TCHAR *linkCopyPath) /* Will become a duplicate junction */
{
DUMMY_REPARSE_BUFFER dummy;
- REPARSE_DATA_BUFFER *reparseBuffer = (REPARSE_DATA_BUFFER*)&dummy;
-
- if (NativeReadReparse(LinkOriginal, reparseBuffer)) {
+ REPARSE_DATA_BUFFER *reparseBuffer = (REPARSE_DATA_BUFFER *) &dummy;
+
+ if (NativeReadReparse(linkOrigPath, reparseBuffer)) {
return -1;
}
- return NativeWriteReparse(LinkCopy, reparseBuffer);
+ return NativeWriteReparse(linkCopyPath, reparseBuffer);
}
/*
*--------------------------------------------------------------------
*
- * TclWinSymLinkDelete
+ * TclWinSymLinkDelete --
+ *
+ * Delete a Windows NTFS junction. Once the junction information is
+ * deleted, the filesystem object becomes an ordinary directory. Unless
+ * 'linkOnly' is given, that directory is also removed.
+ *
+ * Assumption that LinkOriginal is a valid, existing junction.
+ *
+ * Returns:
+ * Zero on success.
*
- * Delete a Windows NTFS junction. Once the junction information
- * is deleted, the filesystem object becomes an ordinary directory.
- * Unless 'linkOnly' is given, that directory is also removed.
- *
- * Assumption that LinkOriginal is a valid, existing junction.
- *
- * Returns zero on success.
*--------------------------------------------------------------------
*/
-int
-TclWinSymLinkDelete(LinkOriginal, linkOnly)
- CONST TCHAR* LinkOriginal;
- int linkOnly;
+
+int
+TclWinSymLinkDelete(
+ const TCHAR *linkOrigPath,
+ int linkOnly)
{
- /* It is a symbolic link -- remove it */
+ /*
+ * It is a symbolic link - remove it.
+ */
+
DUMMY_REPARSE_BUFFER dummy;
- REPARSE_DATA_BUFFER *reparseBuffer = (REPARSE_DATA_BUFFER*)&dummy;
+ REPARSE_DATA_BUFFER *reparseBuffer = (REPARSE_DATA_BUFFER *) &dummy;
HANDLE hFile;
DWORD returnedLength;
+
memset(reparseBuffer, 0, sizeof(DUMMY_REPARSE_BUFFER));
reparseBuffer->ReparseTag = IO_REPARSE_TAG_MOUNT_POINT;
- hFile = (*tclWinProcs->createFileProc)(LinkOriginal, GENERIC_WRITE, 0,
- NULL, OPEN_EXISTING,
- FILE_FLAG_OPEN_REPARSE_POINT|FILE_FLAG_BACKUP_SEMANTICS, NULL);
+ hFile = (*tclWinProcs->createFileProc)(linkOrigPath, GENERIC_WRITE, 0,
+ NULL, OPEN_EXISTING,
+ FILE_FLAG_OPEN_REPARSE_POINT|FILE_FLAG_BACKUP_SEMANTICS, NULL);
+
if (hFile != INVALID_HANDLE_VALUE) {
- if (!DeviceIoControl(hFile, FSCTL_DELETE_REPARSE_POINT, reparseBuffer,
- REPARSE_MOUNTPOINT_HEADER_SIZE,
- NULL, 0, &returnedLength, NULL)) {
- /* Error setting junction */
+ if (!DeviceIoControl(hFile, FSCTL_DELETE_REPARSE_POINT, reparseBuffer,
+ REPARSE_MOUNTPOINT_HEADER_SIZE,NULL,0,&returnedLength,NULL)) {
+ /*
+ * Error setting junction.
+ */
+
TclWinConvertError(GetLastError());
CloseHandle(hFile);
} else {
CloseHandle(hFile);
if (!linkOnly) {
- (*tclWinProcs->removeDirectoryProc)(LinkOriginal);
+ (*tclWinProcs->removeDirectoryProc)(linkOrigPath);
}
return 0;
}
@@ -451,123 +547,136 @@ TclWinSymLinkDelete(LinkOriginal, linkOnly)
/*
*--------------------------------------------------------------------
*
- * WinReadLinkDirectory
+ * WinReadLinkDirectory --
*
- * This routine reads a NTFS junction, using the undocumented
- * FSCTL_GET_REPARSE_POINT structure Win2K uses for mount points
- * and junctions.
+ * This routine reads a NTFS junction, using the undocumented
+ * FSCTL_GET_REPARSE_POINT structure Win2K uses for mount points and
+ * junctions.
+ *
+ * Assumption that LinkDirectory is a valid, existing directory.
+ *
+ * Returns:
+ * A Tcl_Obj with refCount of 1 (i.e. owned by the caller), or NULL if
+ * anything went wrong.
+ *
+ * In the future we should enhance this to return a path object rather
+ * than a string.
*
- * Assumption that LinkDirectory is a valid, existing directory.
- *
- * Returns a Tcl_Obj with refCount of 1 (i.e. owned by the caller),
- * or NULL if anything went wrong.
- *
- * In the future we should enhance this to return a path object
- * rather than a string.
*--------------------------------------------------------------------
*/
-static Tcl_Obj*
-WinReadLinkDirectory(LinkDirectory)
- CONST TCHAR* LinkDirectory;
+
+static Tcl_Obj *
+WinReadLinkDirectory(
+ const TCHAR *linkDirPath)
{
- int attr;
+ int attr, len, offset;
DUMMY_REPARSE_BUFFER dummy;
- REPARSE_DATA_BUFFER *reparseBuffer = (REPARSE_DATA_BUFFER*)&dummy;
-
- attr = (*tclWinProcs->getFileAttributesProc)(LinkDirectory);
+ REPARSE_DATA_BUFFER *reparseBuffer = (REPARSE_DATA_BUFFER *) &dummy;
+ Tcl_Obj *retVal;
+ Tcl_DString ds;
+ const char *copy;
+
+ attr = (*tclWinProcs->getFileAttributesProc)(linkDirPath);
if (!(attr & FILE_ATTRIBUTE_REPARSE_POINT)) {
- Tcl_SetErrno(EINVAL);
- return NULL;
+ goto invalidError;
}
- if (NativeReadReparse(LinkDirectory, reparseBuffer)) {
- return NULL;
+ if (NativeReadReparse(linkDirPath, reparseBuffer)) {
+ return NULL;
}
-
+
switch (reparseBuffer->ReparseTag) {
- case 0x80000000|IO_REPARSE_TAG_SYMBOLIC_LINK:
- case IO_REPARSE_TAG_SYMBOLIC_LINK:
- case IO_REPARSE_TAG_MOUNT_POINT: {
- Tcl_Obj *retVal;
- Tcl_DString ds;
- CONST char *copy;
- int len;
- int offset = 0;
-
- /*
- * Certain native path representations on Windows have a
- * special prefix to indicate that they are to be treated
- * specially. For example extremely long paths, or symlinks,
- * or volumes mounted inside directories.
- *
- * There is an assumption in this code that 'wide' interfaces
- * are being used (see tclWin32Dll.c), which is true for the
- * only systems which support reparse tags at present. If
- * that changes in the future, this code will have to be
- * generalised.
+ case 0x80000000|IO_REPARSE_TAG_SYMBOLIC_LINK:
+ case IO_REPARSE_TAG_SYMBOLIC_LINK:
+ case IO_REPARSE_TAG_MOUNT_POINT:
+ /*
+ * Certain native path representations on Windows have a special
+ * prefix to indicate that they are to be treated specially. For
+ * example extremely long paths, or symlinks, or volumes mounted
+ * inside directories.
+ *
+ * There is an assumption in this code that 'wide' interfaces are
+ * being used (see tclWin32Dll.c), which is true for the only systems
+ * which support reparse tags at present. If that changes in the
+ * future, this code will have to be generalised.
+ */
+
+ offset = 0;
+ if (reparseBuffer->MountPointReparseBuffer.PathBuffer[0] == L'\\') {
+ /*
+ * Check whether this is a mounted volume.
*/
- if (reparseBuffer->SymbolicLinkReparseBuffer.PathBuffer[0]
- == L'\\') {
- /* Check whether this is a mounted volume */
- if (wcsncmp(reparseBuffer->SymbolicLinkReparseBuffer.PathBuffer,
- L"\\??\\Volume{",11) == 0) {
- char drive;
- /*
- * There is some confusion between \??\ and \\?\ which
- * we have to fix here. It doesn't seem very well
- * documented.
- */
- reparseBuffer->SymbolicLinkReparseBuffer
- .PathBuffer[1] = L'\\';
- /*
- * Check if a corresponding drive letter exists, and
- * use that if it is found
- */
- drive = TclWinDriveLetterForVolMountPoint(reparseBuffer
- ->SymbolicLinkReparseBuffer.PathBuffer);
- if (drive != -1) {
- char driveSpec[3] = {
- drive, ':', '\0'
- };
- retVal = Tcl_NewStringObj(driveSpec,2);
- Tcl_IncrRefCount(retVal);
- return retVal;
- }
- /*
- * This is actually a mounted drive, which doesn't
- * exists as a DOS drive letter. This means the path
- * isn't actually a link, although we partially treat
- * it like one ('file type' will return 'link'), but
- * then the link will actually just be treated like
- * an ordinary directory. I don't believe any
- * serious inconsistency will arise from this, but it
- * is something to be aware of.
- */
- Tcl_SetErrno(EINVAL);
- return NULL;
- } else if (wcsncmp(reparseBuffer->SymbolicLinkReparseBuffer
- .PathBuffer, L"\\\\?\\",4) == 0) {
- /* Strip off the prefix */
- offset = 4;
- } else if (wcsncmp(reparseBuffer->SymbolicLinkReparseBuffer
- .PathBuffer, L"\\??\\",4) == 0) {
- /* Strip off the prefix */
- offset = 4;
+
+ if (wcsncmp(reparseBuffer->MountPointReparseBuffer.PathBuffer,
+ L"\\??\\Volume{",11) == 0) {
+ char drive;
+
+ /*
+ * There is some confusion between \??\ and \\?\ which we have
+ * to fix here. It doesn't seem very well documented.
+ */
+
+ reparseBuffer->MountPointReparseBuffer.PathBuffer[1]=L'\\';
+
+ /*
+ * Check if a corresponding drive letter exists, and use that
+ * if it is found
+ */
+
+ drive = TclWinDriveLetterForVolMountPoint(
+ reparseBuffer->MountPointReparseBuffer.PathBuffer);
+ if (drive != -1) {
+ char driveSpec[3] = {
+ '\0', ':', '\0'
+ };
+
+ driveSpec[0] = drive;
+ retVal = Tcl_NewStringObj(driveSpec,2);
+ Tcl_IncrRefCount(retVal);
+ return retVal;
}
+
+ /*
+ * This is actually a mounted drive, which doesn't exists as a
+ * DOS drive letter. This means the path isn't actually a
+ * link, although we partially treat it like one ('file type'
+ * will return 'link'), but then the link will actually just
+ * be treated like an ordinary directory. I don't believe any
+ * serious inconsistency will arise from this, but it is
+ * something to be aware of.
+ */
+
+ goto invalidError;
+ } else if (wcsncmp(reparseBuffer->MountPointReparseBuffer
+ .PathBuffer, L"\\\\?\\",4) == 0) {
+ /*
+ * Strip off the prefix.
+ */
+
+ offset = 4;
+ } else if (wcsncmp(reparseBuffer->MountPointReparseBuffer
+ .PathBuffer, L"\\??\\",4) == 0) {
+ /*
+ * Strip off the prefix.
+ */
+
+ offset = 4;
}
-
- Tcl_WinTCharToUtf(
- (CONST char*)reparseBuffer->SymbolicLinkReparseBuffer.PathBuffer,
- (int)reparseBuffer->SymbolicLinkReparseBuffer
- .SubstituteNameLength, &ds);
-
- copy = Tcl_DStringValue(&ds)+offset;
- len = Tcl_DStringLength(&ds)-offset;
- retVal = Tcl_NewStringObj(copy,len);
- Tcl_IncrRefCount(retVal);
- Tcl_DStringFree(&ds);
- return retVal;
}
+
+ Tcl_WinTCharToUtf((const char *)
+ reparseBuffer->MountPointReparseBuffer.PathBuffer,
+ (int) reparseBuffer->MountPointReparseBuffer
+ .SubstituteNameLength, &ds);
+
+ copy = Tcl_DStringValue(&ds)+offset;
+ len = Tcl_DStringLength(&ds)-offset;
+ retVal = Tcl_NewStringObj(copy,len);
+ Tcl_IncrRefCount(retVal);
+ Tcl_DStringFree(&ds);
+ return retVal;
}
+
+ invalidError:
Tcl_SetErrno(EINVAL);
return NULL;
}
@@ -575,42 +684,55 @@ WinReadLinkDirectory(LinkDirectory)
/*
*--------------------------------------------------------------------
*
- * NativeReadReparse
+ * NativeReadReparse --
*
- * Read the junction/reparse information from a given NTFS directory.
+ * Read the junction/reparse information from a given NTFS directory.
+ *
+ * Assumption that linkDirPath is a valid, existing directory.
+ *
+ * Returns:
+ * Zero on success.
*
- * Assumption that LinkDirectory is a valid, existing directory.
- *
- * Returns zero on success.
*--------------------------------------------------------------------
*/
-static int
-NativeReadReparse(LinkDirectory, buffer)
- CONST TCHAR* LinkDirectory; /* The junction to read */
- REPARSE_DATA_BUFFER* buffer; /* Pointer to buffer. Cannot be NULL */
+
+static int
+NativeReadReparse(
+ const TCHAR *linkDirPath, /* The junction to read */
+ REPARSE_DATA_BUFFER *buffer)/* Pointer to buffer. Cannot be NULL */
{
HANDLE hFile;
DWORD returnedLength;
-
- hFile = (*tclWinProcs->createFileProc)(LinkDirectory, GENERIC_READ, 0,
- NULL, OPEN_EXISTING,
- FILE_FLAG_OPEN_REPARSE_POINT|FILE_FLAG_BACKUP_SEMANTICS, NULL);
+
+ hFile = (*tclWinProcs->createFileProc)(linkDirPath, GENERIC_READ, 0,
+ NULL, OPEN_EXISTING,
+ FILE_FLAG_OPEN_REPARSE_POINT|FILE_FLAG_BACKUP_SEMANTICS, NULL);
+
if (hFile == INVALID_HANDLE_VALUE) {
- /* Error creating directory */
+ /*
+ * Error creating directory.
+ */
+
TclWinConvertError(GetLastError());
return -1;
}
- /* Get the link */
- if (!DeviceIoControl(hFile, FSCTL_GET_REPARSE_POINT, NULL,
- 0, buffer, sizeof(DUMMY_REPARSE_BUFFER),
- &returnedLength, NULL)) {
- /* Error setting junction */
+
+ /*
+ * Get the link.
+ */
+
+ if (!DeviceIoControl(hFile, FSCTL_GET_REPARSE_POINT, NULL, 0, buffer,
+ sizeof(DUMMY_REPARSE_BUFFER), &returnedLength, NULL)) {
+ /*
+ * Error setting junction.
+ */
+
TclWinConvertError(GetLastError());
CloseHandle(hFile);
return -1;
}
CloseHandle(hFile);
-
+
if (!IsReparseTagValid(buffer->ReparseTag)) {
Tcl_SetErrno(EINVAL);
return -1;
@@ -621,48 +743,69 @@ NativeReadReparse(LinkDirectory, buffer)
/*
*--------------------------------------------------------------------
*
- * NativeWriteReparse
+ * NativeWriteReparse --
+ *
+ * Write the reparse information for a given directory.
+ *
+ * Assumption that LinkDirectory does not exist.
*
- * Write the reparse information for a given directory.
- *
- * Assumption that LinkDirectory does not exist.
*--------------------------------------------------------------------
*/
-static int
-NativeWriteReparse(LinkDirectory, buffer)
- CONST TCHAR* LinkDirectory;
- REPARSE_DATA_BUFFER* buffer;
+
+static int
+NativeWriteReparse(
+ const TCHAR *linkDirPath,
+ REPARSE_DATA_BUFFER *buffer)
{
HANDLE hFile;
DWORD returnedLength;
-
- /* Create the directory - it must not already exist */
- if ((*tclWinProcs->createDirectoryProc)(LinkDirectory, NULL) == 0) {
- /* Error creating directory */
+
+ /*
+ * Create the directory - it must not already exist.
+ */
+
+ if ((*tclWinProcs->createDirectoryProc)(linkDirPath, NULL) == 0) {
+ /*
+ * Error creating directory.
+ */
+
TclWinConvertError(GetLastError());
return -1;
}
- hFile = (*tclWinProcs->createFileProc)(LinkDirectory, GENERIC_WRITE, 0,
- NULL, OPEN_EXISTING,
- FILE_FLAG_OPEN_REPARSE_POINT|FILE_FLAG_BACKUP_SEMANTICS, NULL);
+ hFile = (*tclWinProcs->createFileProc)(linkDirPath, GENERIC_WRITE, 0,
+ NULL, OPEN_EXISTING,
+ FILE_FLAG_OPEN_REPARSE_POINT|FILE_FLAG_BACKUP_SEMANTICS, NULL);
if (hFile == INVALID_HANDLE_VALUE) {
- /* Error creating directory */
+ /*
+ * Error creating directory.
+ */
+
TclWinConvertError(GetLastError());
return -1;
}
- /* Set the link */
- if (!DeviceIoControl(hFile, FSCTL_SET_REPARSE_POINT, buffer,
- (DWORD) buffer->ReparseDataLength
- + REPARSE_MOUNTPOINT_HEADER_SIZE,
- NULL, 0, &returnedLength, NULL)) {
- /* Error setting junction */
+
+ /*
+ * Set the link.
+ */
+
+ if (!DeviceIoControl(hFile, FSCTL_SET_REPARSE_POINT, buffer,
+ (DWORD) buffer->ReparseDataLength + REPARSE_MOUNTPOINT_HEADER_SIZE,
+ NULL, 0, &returnedLength, NULL)) {
+ /*
+ * Error setting junction.
+ */
+
TclWinConvertError(GetLastError());
CloseHandle(hFile);
- (*tclWinProcs->removeDirectoryProc)(LinkDirectory);
+ (*tclWinProcs->removeDirectoryProc)(linkDirPath);
return -1;
}
CloseHandle(hFile);
- /* We succeeded */
+
+ /*
+ * We succeeded.
+ */
+
return 0;
}
@@ -671,39 +814,26 @@ NativeWriteReparse(LinkDirectory, buffer)
*
* TclpFindExecutable --
*
- * This procedure computes the absolute path name of the current
- * application, given its argv[0] value.
+ * This function computes the absolute path name of the current
+ * application.
*
* Results:
- * A clean UTF string that is the path to the executable. At this
- * point we may not know the system encoding, but we convert the
- * string value to UTF-8 using core Windows functions. The path name
- * contains ASCII string and '/' chars do not conflict with other UTF
- * chars.
+ * None.
*
* Side effects:
- * The variable tclNativeExecutableName gets filled in with the file
- * name for the application, if we figured it out. If we couldn't
- * figure it out, tclNativeExecutableName is set to NULL.
+ * The computed path is stored.
*
*---------------------------------------------------------------------------
*/
-char *
-TclpFindExecutable(argv0)
- CONST char *argv0; /* The value of the application's argv[0]
+void
+TclpFindExecutable(
+ const char *argv0) /* The value of the application's argv[0]
* (native). */
{
WCHAR wName[MAX_PATH];
char name[MAX_PATH * TCL_UTF_MAX];
- if (argv0 == NULL) {
- return NULL;
- }
- if (tclNativeExecutableName != NULL) {
- return tclNativeExecutableName;
- }
-
/*
* Under Windows we ignore argv0, and return the path for the file used to
* create this process.
@@ -711,16 +841,17 @@ TclpFindExecutable(argv0)
if (GetModuleFileNameW(NULL, wName, MAX_PATH) == 0) {
GetModuleFileNameA(NULL, name, sizeof(name));
- } else {
- WideCharToMultiByte(CP_UTF8, 0, wName, -1,
- name, sizeof(name), NULL, NULL);
- }
- tclNativeExecutableName = ckalloc((unsigned) (strlen(name) + 1));
- strcpy(tclNativeExecutableName, name);
+ /*
+ * Convert to WCHAR to get out of ANSI codepage
+ */
- TclWinNoBackslash(tclNativeExecutableName);
- return tclNativeExecutableName;
+ MultiByteToWideChar(CP_ACP, 0, name, -1, wName, MAX_PATH);
+ }
+
+ WideCharToMultiByte(CP_UTF8, 0, wName, -1, name, sizeof(name), NULL,NULL);
+ TclWinNoBackslash(name);
+ TclSetObjNameOfExecutable(Tcl_NewStringObj(name, -1), NULL);
}
/*
@@ -728,42 +859,53 @@ TclpFindExecutable(argv0)
*
* TclpMatchInDirectory --
*
- * This routine is used by the globbing code to search a
- * directory for all files which match a given pattern.
+ * This routine is used by the globbing code to search a directory for
+ * all files which match a given pattern.
*
- * Results:
- *
- * The return value is a standard Tcl result indicating whether an
- * error occurred in globbing. Errors are left in interp, good
- * results are lappended to resultPtr (which must be a valid object)
+ * Results:
+ * The return value is a standard Tcl result indicating whether an error
+ * occurred in globbing. Errors are left in interp, good results are
+ * lappended to resultPtr (which must be a valid object).
*
* Side effects:
* None.
*
- *---------------------------------------------------------------------- */
+ *----------------------------------------------------------------------
+ */
int
-TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types)
- Tcl_Interp *interp; /* Interpreter to receive errors. */
- Tcl_Obj *resultPtr; /* List object to lappend results. */
- Tcl_Obj *pathPtr; /* Contains path to directory to search. */
- CONST char *pattern; /* Pattern to match against. */
- Tcl_GlobTypeData *types; /* Object containing list of acceptable types.
+TclpMatchInDirectory(
+ Tcl_Interp *interp, /* Interpreter to receive errors. */
+ Tcl_Obj *resultPtr, /* List object to lappend results. */
+ Tcl_Obj *pathPtr, /* Contains path to directory to search. */
+ const char *pattern, /* Pattern to match against. */
+ Tcl_GlobTypeData *types) /* Object containing list of acceptable types.
* May be NULL. In particular the directory
* flag is very important. */
{
- CONST TCHAR *native;
+ const TCHAR *native;
+
+ if (types != NULL && types->type == TCL_GLOB_TYPE_MOUNT) {
+ /*
+ * The native filesystem never adds mounts.
+ */
+
+ return TCL_OK;
+ }
if (pattern == NULL || (*pattern == '\0')) {
Tcl_Obj *norm = Tcl_FSGetNormalizedPath(NULL, pathPtr);
if (norm != NULL) {
- /* Match a single file directly */
+ /*
+ * Match a single file directly.
+ */
+
int len;
DWORD attr;
- CONST char *str = Tcl_GetStringFromObj(norm,&len);
+ const char *str = Tcl_GetStringFromObj(norm,&len);
+
+ native = (const TCHAR *) Tcl_FSGetNativePath(pathPtr);
- native = (CONST TCHAR*) Tcl_FSGetNativePath(pathPtr);
-
if (tclWinProcs->getFileAttributesExProc == NULL) {
attr = (*tclWinProcs->getFileAttributesProc)(native);
if (attr == 0xffffffff) {
@@ -777,8 +919,8 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types)
}
attr = data.dwFileAttributes;
}
- if (NativeMatchType(WinIsDrive(str,len), attr,
- native, types)) {
+
+ if (NativeMatchType(WinIsDrive(str,len), attr, native, types)) {
Tcl_ListObjAppendElement(interp, resultPtr, pathPtr);
}
}
@@ -787,94 +929,127 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types)
DWORD attr;
HANDLE handle;
WIN32_FIND_DATAT data;
- CONST char *dirName;
+ const char *dirName; /* UTF-8 dir name, later with pattern
+ * appended. */
int dirLength;
int matchSpecialDots;
- Tcl_DString ds; /* native encoding of dir */
- Tcl_DString dsOrig; /* utf-8 encoding of dir */
- Tcl_DString dirString; /* utf-8 encoding of dir with \'s */
+ Tcl_DString ds; /* Native encoding of dir, also used
+ * temporarily for other things. */
+ Tcl_DString dsOrig; /* UTF-8 encoding of dir. */
Tcl_Obj *fileNamePtr;
+ char lastChar;
/*
- * Convert the path to normalized form since some interfaces only
- * accept backslashes. Also, ensure that the directory ends with a
- * separator character.
+ * Get the normalized path representation (the main thing is we dont
+ * want any '~' sequences).
*/
- fileNamePtr = Tcl_FSGetTranslatedPath(interp, pathPtr);
+ fileNamePtr = Tcl_FSGetNormalizedPath(interp, pathPtr);
if (fileNamePtr == NULL) {
return TCL_ERROR;
}
- Tcl_DStringInit(&dsOrig);
- dirName = Tcl_GetStringFromObj(fileNamePtr, &dirLength);
- Tcl_DStringAppend(&dsOrig, dirName, dirLength);
-
- Tcl_DStringInit(&dirString);
- if (dirLength == 0) {
- Tcl_DStringAppend(&dirString, ".\\", 2);
- } else {
- char *p;
- Tcl_DStringAppend(&dirString, dirName, dirLength);
- for (p = Tcl_DStringValue(&dirString); *p != '\0'; p++) {
- if (*p == '/') {
- *p = '\\';
- }
- }
- p--;
- /* Make sure we have a trailing directory delimiter */
- if ((*p != '\\') && (*p != ':')) {
- Tcl_DStringAppend(&dirString, "\\", 1);
- Tcl_DStringAppend(&dsOrig, "/", 1);
- dirLength++;
- }
- }
- dirName = Tcl_DStringValue(&dirString);
- Tcl_DecrRefCount(fileNamePtr);
-
/*
- * First verify that the specified path is actually a directory.
+ * Verify that the specified path exists and is actually a directory.
*/
- native = Tcl_WinUtfToTChar(dirName, Tcl_DStringLength(&dirString),
- &ds);
+ native = Tcl_FSGetNativePath(pathPtr);
+ if (native == NULL) {
+ return TCL_OK;
+ }
attr = (*tclWinProcs->getFileAttributesProc)(native);
- Tcl_DStringFree(&ds);
if ((attr == 0xffffffff) || ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0)) {
- Tcl_DStringFree(&dirString);
return TCL_OK;
}
/*
- * We need to check all files in the directory, so append a *.*
- * to the path.
+ * Build up the directory name for searching, including a trailing
+ * directory separator.
*/
- dirName = Tcl_DStringAppend(&dirString, "*.*", 3);
+ Tcl_DStringInit(&dsOrig);
+ dirName = Tcl_GetStringFromObj(fileNamePtr, &dirLength);
+ Tcl_DStringAppend(&dsOrig, dirName, dirLength);
+
+ lastChar = dirName[dirLength -1];
+ if ((lastChar != '\\') && (lastChar != '/') && (lastChar != ':')) {
+ Tcl_DStringAppend(&dsOrig, "/", 1);
+ dirLength++;
+ }
+ dirName = Tcl_DStringValue(&dsOrig);
+
+ /*
+ * We need to check all files in the directory, so we append '*.*' to
+ * the path, unless the pattern we've been given is rather simple,
+ * when we can use that instead.
+ */
+
+ if (strpbrk(pattern, "[]\\") == NULL) {
+ /*
+ * The pattern is a simple one containing just '*' and/or '?'.
+ * This means we can get the OS to help us, by passing it the
+ * pattern.
+ */
+
+ dirName = Tcl_DStringAppend(&dsOrig, pattern, -1);
+ } else {
+ dirName = Tcl_DStringAppend(&dsOrig, "*.*", 3);
+ }
+
native = Tcl_WinUtfToTChar(dirName, -1, &ds);
- handle = (*tclWinProcs->findFirstFileProc)(native, &data);
+ if (tclWinProcs->findFirstFileExProc == NULL || (types == NULL)
+ || (types->type != TCL_GLOB_TYPE_DIR)) {
+ handle = (*tclWinProcs->findFirstFileProc)(native, &data);
+ } else {
+ /*
+ * We can be more efficient, for pure directory requests.
+ */
+
+ handle = (*tclWinProcs->findFirstFileExProc)(native,
+ FindExInfoStandard, &data,
+ FindExSearchLimitToDirectories, NULL, 0);
+ }
if (handle == INVALID_HANDLE_VALUE) {
- TclWinConvertError(GetLastError());
+ DWORD err = GetLastError();
Tcl_DStringFree(&ds);
- Tcl_DStringFree(&dirString);
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "couldn't read directory \"",
- Tcl_DStringValue(&dsOrig), "\": ",
- Tcl_PosixError(interp), (char *) NULL);
+ if (err == ERROR_FILE_NOT_FOUND) {
+ /*
+ * We used our 'pattern' above, and matched nothing. This
+ * means we just return TCL_OK, indicating no results found.
+ */
+
+ Tcl_DStringFree(&dsOrig);
+ return TCL_OK;
+ }
+
+ TclWinConvertError(err);
+ if (interp != NULL) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "couldn't read directory \"",
+ Tcl_DStringValue(&dsOrig), "\": ",
+ Tcl_PosixError(interp), NULL);
+ }
Tcl_DStringFree(&dsOrig);
return TCL_ERROR;
}
Tcl_DStringFree(&ds);
/*
- * Check to see if the pattern should match the special
- * . and .. names, referring to the current directory,
- * or the directory above. We need a special check for
- * this because paths beginning with a dot are not considered
- * hidden on Windows, and so otherwise a relative glob like
- * 'glob -join * *' will actually return './. ../..' etc.
+ * We may use this later, so we must restore it to its length
+ * including the directory delimiter.
+ */
+
+ Tcl_DStringSetLength(&dsOrig, dirLength);
+
+ /*
+ * Check to see if the pattern should match the special . and
+ * .. names, referring to the current directory, or the directory
+ * above. We need a special check for this because paths beginning
+ * with a dot are not considered hidden on Windows, and so otherwise a
+ * relative glob like 'glob -join * *' will actually return
+ * './. ../..' etc.
*/
if ((pattern[0] == '.')
@@ -885,51 +1060,53 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types)
}
/*
- * Now iterate over all of the files in the directory, starting
- * with the first one we found.
+ * Now iterate over all of the files in the directory, starting with
+ * the first one we found.
*/
do {
- CONST char *utfname;
- int checkDrive = 0;
- int isDrive;
+ const char *utfname;
+ int checkDrive = 0, isDrive;
DWORD attr;
-
+
if (tclWinProcs->useWide) {
- native = (CONST TCHAR *) data.w.cFileName;
+ native = (const TCHAR *) data.w.cFileName;
attr = data.w.dwFileAttributes;
} else {
- native = (CONST TCHAR *) data.a.cFileName;
+ native = (const TCHAR *) data.a.cFileName;
attr = data.a.dwFileAttributes;
}
-
+
utfname = Tcl_WinTCharToUtf(native, -1, &ds);
if (!matchSpecialDots) {
- /* If it is exactly '.' or '..' then we ignore it */
- if ((utfname[0] == '.') && (utfname[1] == '\0'
+ /*
+ * If it is exactly '.' or '..' then we ignore it.
+ */
+
+ if ((utfname[0] == '.') && (utfname[1] == '\0'
|| (utfname[1] == '.' && utfname[2] == '\0'))) {
Tcl_DStringFree(&ds);
continue;
}
} else if (utfname[0] == '.' && utfname[1] == '.'
&& utfname[2] == '\0') {
- /*
- * Have to check if this is a drive below, so we can
- * correctly match 'hidden' and not hidden files.
+ /*
+ * Have to check if this is a drive below, so we can correctly
+ * match 'hidden' and not hidden files.
*/
+
checkDrive = 1;
}
-
+
/*
- * Check to see if the file matches the pattern. Note that
- * we are ignoring the case sensitivity flag because Windows
- * doesn't honor case even if the volume is case sensitive.
- * If the volume also doesn't preserve case, then we
- * previously returned the lower case form of the name. This
- * didn't seem quite right since there are
- * non-case-preserving volumes that actually return mixed
- * case. So now we are returning exactly what we get from
+ * Check to see if the file matches the pattern. Note that we are
+ * ignoring the case sensitivity flag because Windows doesn't
+ * honor case even if the volume is case sensitive. If the volume
+ * also doesn't preserve case, then we previously returned the
+ * lower case form of the name. This didn't seem quite right since
+ * there are non-case-preserving volumes that actually return
+ * mixed case. So now we are returning exactly what we get from
* the system.
*/
@@ -940,7 +1117,7 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types)
*/
if (checkDrive) {
- CONST char *fullname = Tcl_DStringAppend(&dsOrig, utfname,
+ const char *fullname = Tcl_DStringAppend(&dsOrig, utfname,
Tcl_DStringLength(&ds));
isDrive = WinIsDrive(fullname, Tcl_DStringLength(&dsOrig));
Tcl_DStringSetLength(&dsOrig, dirLength);
@@ -948,7 +1125,7 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types)
isDrive = 0;
}
if (NativeMatchType(isDrive, attr, native, types)) {
- Tcl_ListObjAppendElement(interp, resultPtr,
+ Tcl_ListObjAppendElement(interp, resultPtr,
TclNewFSPathObj(pathPtr, utfname,
Tcl_DStringLength(&ds)));
}
@@ -957,33 +1134,38 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types)
/*
* Free ds here to ensure that native is valid above.
*/
+
Tcl_DStringFree(&ds);
} while ((*tclWinProcs->findNextFileProc)(handle, &data) == TRUE);
FindClose(handle);
- Tcl_DStringFree(&dirString);
Tcl_DStringFree(&dsOrig);
return TCL_OK;
}
}
-/*
- * Does the given path represent a root volume? We need this special
- * case because for NTFS root volumes, the getFileAttributesProc returns
- * a 'hidden' attribute when it should not.
+/*
+ * Does the given path represent a root volume? We need this special case
+ * because for NTFS root volumes, the getFileAttributesProc returns a 'hidden'
+ * attribute when it should not.
*/
+
static int
WinIsDrive(
- CONST char *name, /* Name (UTF-8) */
- int len) /* Length of name */
+ const char *name, /* Name (UTF-8) */
+ int len) /* Length of name */
{
int remove = 0;
+
while (len > 4) {
- if ((name[len-1] != '.' || name[len-2] != '.')
- || (name[len-3] != '/' && name[len-3] != '\\')) {
- /* We don't have '/..' at the end */
+ if ((name[len-1] != '.' || name[len-2] != '.')
+ || (name[len-3] != '/' && name[len-3] != '\\')) {
+ /*
+ * We don't have '/..' at the end.
+ */
+
if (remove == 0) {
- break;
+ break;
}
remove--;
while (len > 0) {
@@ -993,74 +1175,95 @@ WinIsDrive(
}
}
if (len < 4) {
- len++;
+ len++;
break;
}
- } else {
- /* We do have '/..' */
+ } else {
+ /*
+ * We do have '/..'
+ */
+
len -= 3;
remove++;
- }
+ }
}
+
if (len < 4) {
if (len == 0) {
- /*
- * Not sure if this is possible, but we pass it on
- * anyway
+ /*
+ * Not sure if this is possible, but we pass it on anyway.
*/
} else if (len == 1 && (name[0] == '/' || name[0] == '\\')) {
- /* Path is pointing to the root volume */
+ /*
+ * Path is pointing to the root volume.
+ */
+
return 1;
- } else if ((name[1] == ':')
+ } else if ((name[1] == ':')
&& (len == 2 || (name[2] == '/' || name[2] == '\\'))) {
- /* Path is of the form 'x:' or 'x:/' or 'x:\' */
+ /*
+ * Path is of the form 'x:' or 'x:/' or 'x:\'
+ */
+
return 1;
}
}
+
return 0;
}
-/*
- * Does the given path represent a reserved window path name? If not
- * return 0, if true, return the number of characters of the path that
- * we actually want (not any trailing :).
+/*
+ * Does the given path represent a reserved window path name? If not return 0,
+ * if true, return the number of characters of the path that we actually want
+ * (not any trailing :).
*/
-static int WinIsReserved(
- CONST char *path) /* Path in UTF-8 */
+
+static int
+WinIsReserved(
+ const char *path) /* Path in UTF-8 */
{
- if ((path[0] == 'c' || path[0] == 'C')
- && (path[1] == 'o' || path[1] == 'O')) {
+ if ((path[0] == 'c' || path[0] == 'C')
+ && (path[1] == 'o' || path[1] == 'O')) {
if ((path[2] == 'm' || path[2] == 'M')
- && path[3] >= '1' && path[3] <= '4') {
- /* May have match for 'com[1-4]:?', which is a serial port */
+ && path[3] >= '1' && path[3] <= '4') {
+ /*
+ * May have match for 'com[1-4]:?', which is a serial port.
+ */
+
if (path[4] == '\0') {
return 4;
} else if (path [4] == ':' && path[5] == '\0') {
return 4;
}
} else if ((path[2] == 'n' || path[2] == 'N') && path[3] == '\0') {
- /* Have match for 'con' */
+ /*
+ * Have match for 'con'
+ */
+
return 3;
}
+
} else if ((path[0] == 'l' || path[0] == 'L')
- && (path[1] == 'p' || path[1] == 'P')
- && (path[2] == 't' || path[2] == 'T')) {
+ && (path[1] == 'p' || path[1] == 'P')
+ && (path[2] == 't' || path[2] == 'T')) {
if (path[3] >= '1' && path[3] <= '3') {
- /* May have match for 'lpt[1-3]:?' */
+ /*
+ * May have match for 'lpt[1-3]:?'
+ */
+
if (path[4] == '\0') {
return 4;
} else if (path [4] == ':' && path[5] == '\0') {
return 4;
}
}
- } else if (stricmp(path, "prn") == 0) {
- /* Have match for 'prn' */
- return 3;
- } else if (stricmp(path, "nul") == 0) {
- /* Have match for 'nul' */
- return 3;
- } else if (stricmp(path, "aux") == 0) {
- /* Have match for 'aux' */
+
+ } else if (!strcasecmp(path, "prn") || !strcasecmp(path, "nul")
+ || !strcasecmp(path, "aux")) {
+ /*
+ * Have match for 'prn', 'nul' or 'aux'.
+ */
+
return 3;
}
return 0;
@@ -1068,102 +1271,108 @@ static int WinIsReserved(
/*
*----------------------------------------------------------------------
- *
+ *
* NativeMatchType --
- *
- * This function needs a special case for a path which is a root
- * volume, because for NTFS root volumes, the getFileAttributesProc
- * returns a 'hidden' attribute when it should not.
- *
- * We never make any calls to a 'get attributes' routine here,
- * since we have arranged things so that our caller already knows
- * such information.
- *
+ *
+ * This function needs a special case for a path which is a root volume,
+ * because for NTFS root volumes, the getFileAttributesProc returns a
+ * 'hidden' attribute when it should not.
+ *
+ * We never make any calls to a 'get attributes' routine here, since we
+ * have arranged things so that our caller already knows such
+ * information.
+ *
* Results:
- * 0 = file doesn't match
- * 1 = file matches
- *
+ * 0 = file doesn't match
+ * 1 = file matches
+ *
*----------------------------------------------------------------------
*/
-static int
+
+static int
NativeMatchType(
- int isDrive, /* Is this a drive */
- DWORD attr, /* We already know the attributes
- * for the file */
- CONST TCHAR* nativeName, /* Native path to check */
- Tcl_GlobTypeData *types) /* Type description to match against */
+ int isDrive, /* Is this a drive. */
+ DWORD attr, /* We already know the attributes for the
+ * file. */
+ const TCHAR *nativeName, /* Native path to check. */
+ Tcl_GlobTypeData *types) /* Type description to match against. */
{
/*
- * 'attr' represents the attributes of the file, but we only
- * want to retrieve this info if it is absolutely necessary
- * because it is an expensive call. Unfortunately, to deal
- * with hidden files properly, we must always retrieve it.
+ * 'attr' represents the attributes of the file, but we only want to
+ * retrieve this info if it is absolutely necessary because it is an
+ * expensive call. Unfortunately, to deal with hidden files properly, we
+ * must always retrieve it.
*/
if (types == NULL) {
- /* If invisible, don't return the file */
+ /*
+ * If invisible, don't return the file.
+ */
+
if (attr & FILE_ATTRIBUTE_HIDDEN && !isDrive) {
return 0;
}
} else {
if (attr & FILE_ATTRIBUTE_HIDDEN && !isDrive) {
- /* If invisible */
- if ((types->perm == 0) ||
- !(types->perm & TCL_GLOB_PERM_HIDDEN)) {
+ /*
+ * 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 != 0) {
- if (
- ((types->perm & TCL_GLOB_PERM_RONLY) &&
+ if (((types->perm & TCL_GLOB_PERM_RONLY) &&
!(attr & FILE_ATTRIBUTE_READONLY)) ||
- ((types->perm & TCL_GLOB_PERM_R) &&
+ ((types->perm & TCL_GLOB_PERM_R) &&
(0 /* File exists => R_OK on Windows */)) ||
- ((types->perm & TCL_GLOB_PERM_W) &&
+ ((types->perm & TCL_GLOB_PERM_W) &&
(attr & FILE_ATTRIBUTE_READONLY)) ||
- ((types->perm & TCL_GLOB_PERM_X) &&
+ ((types->perm & TCL_GLOB_PERM_X) &&
(!(attr & FILE_ATTRIBUTE_DIRECTORY)
- && !NativeIsExec(nativeName)))
- ) {
+ && !NativeIsExec(nativeName)))) {
return 0;
}
}
- if ((types->type & TCL_GLOB_TYPE_DIR)
- && (attr & FILE_ATTRIBUTE_DIRECTORY)) {
- /* Quicker test for directory, which is a common case */
+ if ((types->type & TCL_GLOB_TYPE_DIR)
+ && (attr & FILE_ATTRIBUTE_DIRECTORY)) {
+ /*
+ * Quicker test for directory, which is a common case.
+ */
+
return 1;
+
} else if (types->type != 0) {
unsigned short st_mode;
int isExec = NativeIsExec(nativeName);
-
+
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)) ||
- ((types->type & TCL_GLOB_TYPE_FILE) &&
- S_ISREG(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
- ) {
- /* Do nothing -- this file is ok */
+ ((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) {
@@ -1175,8 +1384,8 @@ NativeMatchType(
#endif
return 0;
}
- }
- }
+ }
+ }
return 1;
}
@@ -1191,9 +1400,9 @@ NativeMatchType(
* Results:
* The result is a pointer to a string specifying the user's home
* directory, or NULL if the user's home directory could not be
- * determined. Storage for the result string is allocated in
- * bufferPtr; the caller must call Tcl_DStringFree() when the result
- * is no longer needed.
+ * determined. Storage for the result string is allocated in bufferPtr;
+ * the caller must call Tcl_DStringFree() when the result is no longer
+ * needed.
*
* Side effects:
* None.
@@ -1202,16 +1411,15 @@ NativeMatchType(
*/
char *
-TclpGetUserHome(name, bufferPtr)
- CONST char *name; /* User name for desired home directory. */
- Tcl_DString *bufferPtr; /* Uninitialized or free DString filled
- * with name of user's home directory. */
+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;
result = NULL;
-
Tcl_DStringInit(bufferPtr);
netapiInst = LoadLibraryA("netapi32.dll");
@@ -1222,17 +1430,17 @@ TclpGetUserHome(name, bufferPtr)
netApiBufferFreeProc = (NETAPIBUFFERFREEPROC *)
GetProcAddress(netapiInst, "NetApiBufferFree");
- netGetDCNameProc = (NETGETDCNAMEPROC *)
+ netGetDCNameProc = (NETGETDCNAMEPROC *)
GetProcAddress(netapiInst, "NetGetDCName");
- netUserGetInfoProc = (NETUSERGETINFOPROC *)
+ netUserGetInfoProc = (NETUSERGETINFOPROC *)
GetProcAddress(netapiInst, "NetUserGetInfo");
if ((netUserGetInfoProc != NULL) && (netGetDCNameProc != NULL)
&& (netApiBufferFreeProc != NULL)) {
- USER_INFO_1 *uiPtr;
+ USER_INFO_1 *uiPtr, **uiPtrPtr = &uiPtr;
Tcl_DString ds;
int nameLen, badDomain;
char *domain;
- WCHAR *wName, *wHomeDir, *wDomain;
+ WCHAR *wName, *wHomeDir, *wDomain, **wDomainPtr = &wDomain;
WCHAR buf[MAX_PATH];
badDomain = 0;
@@ -1242,23 +1450,23 @@ TclpGetUserHome(name, bufferPtr)
if (domain != NULL) {
Tcl_DStringInit(&ds);
wName = Tcl_UtfToUniCharDString(domain + 1, -1, &ds);
- badDomain = (*netGetDCNameProc)(NULL, wName,
- (LPBYTE *) &wDomain);
+ 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 *) &uiPtr) == 0) {
+ 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
+ /*
+ * User exists but has no home dir. Return
* "{Windows Drive}:/users/default".
*/
@@ -1279,20 +1487,20 @@ TclpGetUserHome(name, bufferPtr)
}
if (result == NULL) {
/*
- * Look in the "Password Lists" section of system.ini for the
- * local user. There are also entries in that section that begin
- * with a "*" character that are used by Windows for other
- * purposes; ignore user names beginning with a "*".
+ * Look in the "Password Lists" section of system.ini for the local
+ * user. There are also entries in that section that begin with a "*"
+ * character that are used by Windows for other purposes; ignore user
+ * names beginning with a "*".
*/
char buf[MAX_PATH];
if (name[0] != '*') {
- if (GetPrivateProfileStringA("Password Lists", name, "", buf,
+ if (GetPrivateProfileStringA("Password Lists", name, "", buf,
MAX_PATH, "system.ini") > 0) {
- /*
- * User exists, but there is no such thing as a home
- * directory in system.ini. Return "{Windows drive}:/".
+ /*
+ * User exists, but there is no such thing as a home directory
+ * in system.ini. Return "{Windows drive}:/".
*/
GetWindowsDirectoryA(buf, MAX_PATH);
@@ -1312,7 +1520,7 @@ TclpGetUserHome(name, bufferPtr)
*
* This function replaces the library version of access(), fixing the
* following bugs:
- *
+ *
* 1. access() returns that all files have execute permission.
*
* Results:
@@ -1326,7 +1534,7 @@ TclpGetUserHome(name, bufferPtr)
static int
NativeAccess(
- CONST TCHAR *nativePath, /* Path of file to access (UTF-8). */
+ const TCHAR *nativePath, /* Path of file to access, native encoding. */
int mode) /* Permission setting. */
{
DWORD attr;
@@ -1394,8 +1602,7 @@ NativeAccess(
SID_IDENTIFIER_AUTHORITY samba_unmapped = {{0, 0, 0, 0, 0, 22}};
GENERIC_MAPPING genMap;
HANDLE hToken = NULL;
- DWORD desiredAccess = 0;
- DWORD grantedAccess = 0;
+ DWORD desiredAccess = 0, grantedAccess = 0;
BOOL accessYesNo = FALSE;
PRIVILEGE_SET privSet;
DWORD privSetSize = sizeof(PRIVILEGE_SET);
@@ -1422,12 +1629,12 @@ NativeAccess(
* to EACCES - just what we want!
*/
- TclWinConvertError((DWORD)error);
+ TclWinConvertError((DWORD) error);
return -1;
}
/*
- * Now size contains the size of buffer needed
+ * Now size contains the size of buffer needed.
*/
sdPtr = (SECURITY_DESCRIPTOR *) HeapAlloc(GetProcessHeap(), 0, size);
@@ -1437,7 +1644,7 @@ NativeAccess(
}
/*
- * Call GetFileSecurity() for real
+ * Call GetFileSecurity() for real.
*/
if (!(*tclWinProcs->getFileSecurityProc)(nativePath,
@@ -1472,28 +1679,28 @@ NativeAccess(
}
/*
- * Perform security impersonation of the user and open the
- * resulting thread token.
+ * Perform security impersonation of the user and open the resulting
+ * thread token.
*/
if (!(*tclWinProcs->impersonateSelfProc)(SecurityImpersonation)) {
/*
* Unable to perform security impersonation.
*/
-
+
goto accessError;
}
- if (!(*tclWinProcs->openThreadTokenProc)(GetCurrentThread (),
+ if (!(*tclWinProcs->openThreadTokenProc)(GetCurrentThread(),
TOKEN_DUPLICATE | TOKEN_QUERY, FALSE, &hToken)) {
/*
* Unable to get current thread's token.
*/
-
+
goto accessError;
}
-
+
(*tclWinProcs->revertToSelfProc)();
-
+
/*
* Setup desiredAccess according to the access priveleges we are
* checking.
@@ -1509,12 +1716,12 @@ NativeAccess(
desiredAccess |= FILE_GENERIC_EXECUTE;
}
- memset (&genMap, 0x0, sizeof (GENERIC_MAPPING));
+ memset(&genMap, 0x0, sizeof(GENERIC_MAPPING));
genMap.GenericRead = FILE_GENERIC_READ;
genMap.GenericWrite = FILE_GENERIC_WRITE;
genMap.GenericExecute = FILE_GENERIC_EXECUTE;
genMap.GenericAll = FILE_ALL_ACCESS;
-
+
/*
* Perform access check using the token.
*/
@@ -1541,12 +1748,13 @@ NativeAccess(
* Clean up.
*/
- HeapFree(GetProcessHeap (), 0, sdPtr);
+ HeapFree(GetProcessHeap(), 0, sdPtr);
CloseHandle(hToken);
if (!accessYesNo) {
Tcl_SetErrno(EACCES);
return -1;
}
+
}
return 0;
}
@@ -1556,25 +1764,22 @@ NativeAccess(
*
* NativeIsExec --
*
- * Determines if a path is executable. On windows this is
- * simply defined by whether the path ends in any of ".exe",
- * ".com", or ".bat"
+ * Determines if a path is executable. On windows this is simply defined
+ * by whether the path ends in any of ".exe", ".com", or ".bat"
*
* Results:
* 1 = executable, 0 = not.
*
*----------------------------------------------------------------------
*/
+
static int
-NativeIsExec(nativePath)
- CONST TCHAR *nativePath;
+NativeIsExec(
+ const TCHAR *nativePath)
{
if (tclWinProcs->useWide) {
- CONST WCHAR *path;
- int len;
-
- path = (CONST WCHAR*)nativePath;
- len = wcslen(path);
+ const WCHAR *path = (const WCHAR *) nativePath;
+ int len = wcslen(path);
if (len < 5) {
return 0;
@@ -1587,26 +1792,31 @@ NativeIsExec(nativePath)
/*
* 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)) {
+
+ 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;
+ const char *p;
- /* We are only looking for pure ascii */
+ /*
+ * We are only looking for pure ascii.
+ */
- p = strrchr((CONST char*)nativePath, '.');
+ 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 ((stricmp(p, "exe") == 0)
- || (stricmp(p, "com") == 0)
- || (stricmp(p, "bat") == 0)) {
+
+ if ((strcasecmp(p, "exe") == 0)
+ || (strcasecmp(p, "com") == 0)
+ || (strcasecmp(p, "bat") == 0)) {
/*
* File that ends with .exe, .com, or .bat is executable.
*/
@@ -1629,19 +1839,20 @@ NativeIsExec(nativePath)
* See chdir() documentation.
*
* Side effects:
- * See chdir() documentation.
+ * See chdir() documentation.
*
*----------------------------------------------------------------------
*/
-int
-TclpObjChdir(pathPtr)
- Tcl_Obj *pathPtr; /* Path to new working directory. */
+int
+TclpObjChdir(
+ Tcl_Obj *pathPtr) /* Path to new working directory. */
{
int result;
- CONST TCHAR *nativePath;
+ const TCHAR *nativePath;
+
+ nativePath = (const TCHAR *) Tcl_FSGetNativePath(pathPtr);
- nativePath = (CONST TCHAR *) Tcl_FSGetNativePath(pathPtr);
result = (*tclWinProcs->setCurrentDirectoryProc)(nativePath);
if (result == 0) {
@@ -1656,15 +1867,16 @@ TclpObjChdir(pathPtr)
*
* TclpGetCwd --
*
- * This function replaces the library version of getcwd().
+ * This function replaces the library version of getcwd(). (Obsolete
+ * function, only retained for old extensions which may call it
+ * directly).
*
* Results:
- * The result is a pointer to a string specifying the current
- * directory, or NULL if the current directory could not be
- * determined. If NULL is returned, an error message is left in the
- * interp's result. Storage for the result string is allocated in
- * bufferPtr; the caller must call Tcl_DStringFree() when the result
- * is no longer needed.
+ * The result is a pointer to a string specifying the current directory,
+ * or NULL if the current directory could not be determined. If NULL is
+ * returned, an error message is left in the interp's result. Storage for
+ * the result string is allocated in bufferPtr; the caller must call
+ * Tcl_DStringFree() when the result is no longer needed.
*
* Side effects:
* None.
@@ -1672,11 +1884,11 @@ TclpObjChdir(pathPtr)
*----------------------------------------------------------------------
*/
-CONST char *
-TclpGetCwd(interp, bufferPtr)
- Tcl_Interp *interp; /* If non-NULL, used for error reporting. */
- Tcl_DString *bufferPtr; /* Uninitialized or free DString filled
- * with name of current directory. */
+const char *
+TclpGetCwd(
+ Tcl_Interp *interp, /* If non-NULL, used for error reporting. */
+ Tcl_DString *bufferPtr) /* Uninitialized or free DString filled with
+ * name of current directory. */
{
WCHAR buffer[MAX_PATH];
char *p;
@@ -1684,9 +1896,8 @@ TclpGetCwd(interp, bufferPtr)
if ((*tclWinProcs->getCurrentDirectoryProc)(MAX_PATH, buffer) == 0) {
TclWinConvertError(GetLastError());
if (interp != NULL) {
- Tcl_AppendResult(interp,
- "error getting working directory name: ",
- Tcl_PosixError(interp), (char *) NULL);
+ Tcl_AppendResult(interp, "error getting working directory name: ",
+ Tcl_PosixError(interp), NULL);
}
return NULL;
}
@@ -1699,7 +1910,7 @@ TclpGetCwd(interp, bufferPtr)
WCHAR *native;
native = (WCHAR *) buffer;
- if ((native[0] != '\0') && (native[1] == ':')
+ if ((native[0] != '\0') && (native[1] == ':')
&& (native[2] == '\\') && (native[3] == '\\')) {
native += 2;
}
@@ -1708,7 +1919,7 @@ TclpGetCwd(interp, bufferPtr)
char *native;
native = (char *) buffer;
- if ((native[0] != '\0') && (native[1] == ':')
+ if ((native[0] != '\0') && (native[1] == ':')
&& (native[2] == '\\') && (native[3] == '\\')) {
native += 2;
}
@@ -1718,7 +1929,7 @@ TclpGetCwd(interp, bufferPtr)
/*
* Convert to forward slashes for easier use in scripts.
*/
-
+
for (p = Tcl_DStringValue(bufferPtr); *p != '\0'; p++) {
if (*p == '\\') {
*p = '/';
@@ -1727,38 +1938,21 @@ TclpGetCwd(interp, bufferPtr)
return Tcl_DStringValue(bufferPtr);
}
-int
-TclpObjStat(pathPtr, statPtr)
- Tcl_Obj *pathPtr; /* Path of file to stat */
- Tcl_StatBuf *statPtr; /* Filled with results of stat call. */
+int
+TclpObjStat(
+ Tcl_Obj *pathPtr, /* Path of file to stat. */
+ Tcl_StatBuf *statPtr) /* Filled with results of stat call. */
{
-#ifdef OLD_API
- Tcl_Obj *transPtr;
- /*
- * Eliminate file names containing wildcard characters, or subsequent
- * call to FindFirstFile() will expand them, matching some other file.
- */
-
- transPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr);
- if (transPtr == NULL || (strpbrk(Tcl_GetString(transPtr), "?*") != NULL)) {
- if (transPtr != NULL) {
- Tcl_DecrRefCount(transPtr);
- }
- Tcl_SetErrno(ENOENT);
- return -1;
- }
- Tcl_DecrRefCount(transPtr);
-#endif
-
/*
- * Ensure correct file sizes by forcing the OS to write any
- * pending data to disk. This is done only for channels which are
- * dirty, i.e. have been written to since the last flush here.
+ * Ensure correct file sizes by forcing the OS to write any pending data
+ * to disk. This is done only for channels which are dirty, i.e. have been
+ * written to since the last flush here.
*/
- TclWinFlushDirtyChannels ();
+ TclWinFlushDirtyChannels();
- return NativeStat((CONST TCHAR*) Tcl_FSGetNativePath(pathPtr), statPtr, 0);
+ return NativeStat((const TCHAR *) Tcl_FSGetNativePath(pathPtr),
+ statPtr, 0);
}
/*
@@ -1766,8 +1960,8 @@ TclpObjStat(pathPtr, statPtr)
*
* NativeStat --
*
- * This function replaces the library version of stat(), fixing
- * the following bugs:
+ * This function replaces the library version of stat(), fixing the
+ * following bugs:
*
* 1. stat("c:") returns an error.
* 2. Borland stat() return time in GMT instead of localtime.
@@ -1784,31 +1978,97 @@ TclpObjStat(pathPtr, statPtr)
*----------------------------------------------------------------------
*/
-static int
-NativeStat(nativePath, statPtr, checkLinks)
- CONST TCHAR *nativePath; /* Path of file to stat */
- Tcl_StatBuf *statPtr; /* Filled with results of stat call. */
- int checkLinks; /* If non-zero, behave like 'lstat' */
+static int
+NativeStat(
+ const TCHAR *nativePath, /* Path of file to stat */
+ Tcl_StatBuf *statPtr, /* Filled with results of stat call. */
+ int checkLinks) /* If non-zero, behave like 'lstat' */
{
- Tcl_DString ds;
DWORD attr;
- WCHAR nativeFullPath[MAX_PATH];
- TCHAR *nativePart;
- CONST char *fullPath;
- int dev;
+ int dev, nlink = 1;
unsigned short mode;
-
- if (tclWinProcs->getFileAttributesExProc == NULL) {
- /*
- * We don't have the faster attributes proc, so we're
- * probably running on Win95
- */
+ unsigned int inode = 0;
+ HANDLE fileHandle;
+
+ /*
+ * If we can use 'createFile' on this, then we can use the resulting
+ * fileHandle to read more information (nlink, ino) than we can get from
+ * other attributes reading APIs. If not, then we try to fall back on the
+ * 'getFileAttributesExProc', and if that isn't available, then on even
+ * simpler routines.
+ */
+
+ fileHandle = (tclWinProcs->createFileProc)(nativePath, GENERIC_READ,
+ FILE_SHARE_READ | FILE_SHARE_WRITE, NULL, OPEN_EXISTING,
+ FILE_FLAG_BACKUP_SEMANTICS | FILE_FLAG_OPEN_REPARSE_POINT, NULL);
+
+ if (fileHandle != INVALID_HANDLE_VALUE) {
+ BY_HANDLE_FILE_INFORMATION data;
+
+ if (GetFileInformationByHandle(fileHandle,&data) != TRUE) {
+ CloseHandle(fileHandle);
+ Tcl_SetErrno(ENOENT);
+ return -1;
+ }
+ CloseHandle(fileHandle);
+
+ 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);
+
+ /*
+ * On Unix, for directories, nlink apparently depends on the number of
+ * files in the directory. We could calculate that, but it would be a
+ * bit of a performance penalty, I think. Hence we just use what
+ * Windows gives us, which is the same as Unix for files, at least.
+ */
+
+ nlink = data.nNumberOfLinks;
+
+ /*
+ * Unfortunately our stat definition's inode field (unsigned short)
+ * will throw away most of the precision we have here, which means we
+ * can't rely on inode as a unique identifier of a file. We'd really
+ * like to do something like how we handle 'st_size'.
+ */
+
+ inode = data.nFileIndexHigh | data.nFileIndexLow;
+ } else if (tclWinProcs->getFileAttributesExProc != NULL) {
+ /*
+ * Fall back on the less capable routines. This means no nlink or ino.
+ */
+
+ WIN32_FILE_ATTRIBUTE_DATA data;
+
+ if ((*tclWinProcs->getFileAttributesExProc)(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.
*/
@@ -1819,9 +2079,9 @@ NativeStat(nativePath, statPtr, checkLinks)
return -1;
}
- /*
- * Make up some fake information for this file. It has the
- * correct file attributes and a time of 0.
+ /*
+ * Make up some fake information for this file. It has the correct
+ * file attributes and a time of 0.
*/
memset(&data, 0, sizeof(data));
@@ -1830,131 +2090,95 @@ NativeStat(nativePath, statPtr, checkLinks)
FindClose(handle);
}
-
- (*tclWinProcs->getFullPathNameProc)(nativePath, MAX_PATH, nativeFullPath,
- &nativePart);
-
- fullPath = Tcl_WinTCharToUtf((TCHAR *) nativeFullPath, -1, &ds);
-
- dev = -1;
- if ((fullPath[0] == '\\') && (fullPath[1] == '\\')) {
- CONST char *p;
- DWORD dw;
- CONST TCHAR *nativeVol;
- Tcl_DString volString;
-
- p = strchr(fullPath + 2, '\\');
- p = strchr(p + 1, '\\');
- if (p == NULL) {
- /*
- * Add terminating backslash to fullpath or
- * GetVolumeInformation() won't work.
- */
-
- fullPath = Tcl_DStringAppend(&ds, "\\", 1);
- p = fullPath + Tcl_DStringLength(&ds);
- } else {
- p++;
- }
- nativeVol = Tcl_WinUtfToTChar(fullPath, p - fullPath, &volString);
- dw = (DWORD) -1;
- (*tclWinProcs->getVolumeInformationProc)(nativeVol, NULL, 0, &dw,
- NULL, NULL, NULL, 0);
- /*
- * GetFullPathName() turns special devices like "NUL" into
- * "\\.\NUL", but GetVolumeInformation() returns failure for
- * "\\.\NUL". This will cause "NUL" to get a drive number of
- * -1, which makes about as much sense as anything since the
- * special devices don't live on any drive.
- */
-
- dev = dw;
- Tcl_DStringFree(&volString);
- } else if ((fullPath[0] != '\0') && (fullPath[1] == ':')) {
- dev = Tcl_UniCharToLower(fullPath[0]) - 'a';
- }
- Tcl_DStringFree(&ds);
-
attr = data.a.dwFileAttributes;
- statPtr->st_size = ((Tcl_WideInt)data.a.nFileSizeLow) |
- (((Tcl_WideInt)data.a.nFileSizeHigh) << 32);
+ 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);
- } else {
- WIN32_FILE_ATTRIBUTE_DATA data;
- if((*tclWinProcs->getFileAttributesExProc)(nativePath,
- GetFileExInfoStandard,
- &data) != TRUE) {
- Tcl_SetErrno(ENOENT);
- return -1;
- }
+ }
-
- (*tclWinProcs->getFullPathNameProc)(nativePath, MAX_PATH,
- nativeFullPath, &nativePart);
+ dev = NativeDev(nativePath);
+ mode = NativeStatMode(attr, checkLinks, NativeIsExec(nativePath));
- fullPath = Tcl_WinTCharToUtf((TCHAR *) nativeFullPath, -1, &ds);
+ statPtr->st_dev = (dev_t) dev;
+ statPtr->st_ino = inode;
+ statPtr->st_mode = mode;
+ statPtr->st_nlink = nlink;
+ statPtr->st_uid = 0;
+ statPtr->st_gid = 0;
+ statPtr->st_rdev = (dev_t) dev;
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NativeDev --
+ *
+ * Calculate just the 'st_dev' field of a 'stat' structure.
+ *
+ *----------------------------------------------------------------------
+ */
- dev = -1;
- if ((fullPath[0] == '\\') && (fullPath[1] == '\\')) {
- CONST char *p;
- DWORD dw;
- CONST TCHAR *nativeVol;
- Tcl_DString volString;
-
- p = strchr(fullPath + 2, '\\');
- p = strchr(p + 1, '\\');
- if (p == NULL) {
- /*
- * Add terminating backslash to fullpath or
- * GetVolumeInformation() won't work.
- */
+static int
+NativeDev(
+ const TCHAR *nativePath) /* Full path of file to stat */
+{
+ int dev;
+ Tcl_DString ds;
+ WCHAR nativeFullPath[MAX_PATH];
+ TCHAR *nativePart;
+ const char *fullPath;
- fullPath = Tcl_DStringAppend(&ds, "\\", 1);
- p = fullPath + Tcl_DStringLength(&ds);
- } else {
- p++;
- }
- nativeVol = Tcl_WinUtfToTChar(fullPath, p - fullPath, &volString);
- dw = (DWORD) -1;
- (*tclWinProcs->getVolumeInformationProc)(nativeVol, NULL, 0, &dw,
- NULL, NULL, NULL, 0);
+ (*tclWinProcs->getFullPathNameProc)(nativePath, MAX_PATH,
+ nativeFullPath, &nativePart);
+
+ fullPath = Tcl_WinTCharToUtf((TCHAR *) nativeFullPath, -1, &ds);
+
+ if ((fullPath[0] == '\\') && (fullPath[1] == '\\')) {
+ const char *p;
+ DWORD dw;
+ const TCHAR *nativeVol;
+ Tcl_DString volString;
+
+ p = strchr(fullPath + 2, '\\');
+ p = strchr(p + 1, '\\');
+ if (p == NULL) {
/*
- * GetFullPathName() turns special devices like "NUL" into
- * "\\.\NUL", but GetVolumeInformation() returns failure for
- * "\\.\NUL". This will cause "NUL" to get a drive number of
- * -1, which makes about as much sense as anything since the
- * special devices don't live on any drive.
+ * Add terminating backslash to fullpath or GetVolumeInformation()
+ * won't work.
*/
- dev = dw;
- Tcl_DStringFree(&volString);
- } else if ((fullPath[0] != '\0') && (fullPath[1] == ':')) {
- dev = Tcl_UniCharToLower(fullPath[0]) - 'a';
+ fullPath = Tcl_DStringAppend(&ds, "\\", 1);
+ p = fullPath + Tcl_DStringLength(&ds);
+ } else {
+ p++;
}
- Tcl_DStringFree(&ds);
-
- 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);
+ nativeVol = Tcl_WinUtfToTChar(fullPath, p - fullPath, &volString);
+ dw = (DWORD) -1;
+ (*tclWinProcs->getVolumeInformationProc)(nativeVol, NULL, 0, &dw,
+ NULL, NULL, NULL, 0);
+
+ /*
+ * GetFullPathName() turns special devices like "NUL" into "\\.\NUL",
+ * but GetVolumeInformation() returns failure for "\\.\NUL". This will
+ * cause "NUL" to get a drive number of -1, which makes about as much
+ * sense as anything since the special devices don't live on any
+ * drive.
+ */
+
+ dev = dw;
+ Tcl_DStringFree(&volString);
+ } else if ((fullPath[0] != '\0') && (fullPath[1] == ':')) {
+ dev = Tcl_UniCharToLower(fullPath[0]) - 'a';
+ } else {
+ dev = -1;
}
+ Tcl_DStringFree(&ds);
- mode = NativeStatMode(attr, checkLinks, NativeIsExec(nativePath));
-
- statPtr->st_dev = (dev_t) dev;
- statPtr->st_ino = 0;
- statPtr->st_mode = mode;
- statPtr->st_nlink = 1;
- statPtr->st_uid = 0;
- statPtr->st_gid = 0;
- statPtr->st_rdev = (dev_t) dev;
- return 0;
+ return dev;
}
/*
@@ -1964,31 +2188,42 @@ NativeStat(nativePath, statPtr, checkLinks)
*
* Calculate just the 'st_mode' field of a 'stat' structure.
*
+ * In many places we don't need the full stat structure, and it's much
+ * faster just to calculate these pieces, if that's all we need.
+ *
*----------------------------------------------------------------------
*/
+
static unsigned short
-NativeStatMode(DWORD attr, int checkLinks, int isExec)
+NativeStatMode(
+ DWORD attr,
+ int checkLinks,
+ int isExec)
{
int mode;
+
if (checkLinks && (attr & FILE_ATTRIBUTE_REPARSE_POINT)) {
- /* It is a link */
+ /*
+ * It is a link.
+ */
+
mode = S_IFLNK;
} else {
- mode = (attr & FILE_ATTRIBUTE_DIRECTORY) ? S_IFDIR | S_IEXEC : S_IFREG;
+ mode = (attr & FILE_ATTRIBUTE_DIRECTORY) ? S_IFDIR|S_IEXEC : S_IFREG;
}
- mode |= (attr & FILE_ATTRIBUTE_READONLY) ? S_IREAD : S_IREAD | S_IWRITE;
+ mode |= (attr & FILE_ATTRIBUTE_READONLY) ? S_IREAD : S_IREAD|S_IWRITE;
if (isExec) {
mode |= S_IEXEC;
}
-
+
/*
- * Propagate the S_IREAD, S_IWRITE, S_IEXEC bits to the group and
- * other positions.
+ * Propagate the S_IREAD, S_IWRITE, S_IEXEC bits to the group and other
+ * positions.
*/
mode |= (mode & (S_IREAD|S_IWRITE|S_IEXEC)) >> 3;
mode |= (mode & (S_IREAD|S_IWRITE|S_IEXEC)) >> 6;
- return (unsigned short)mode;
+ return (unsigned short) mode;
}
/*
@@ -2013,8 +2248,8 @@ ToCTime(
convertedTime.LowPart = fileTime.dwLowDateTime;
convertedTime.HighPart = (LONG) fileTime.dwHighDateTime;
- return (time_t) ((convertedTime.QuadPart
- - (Tcl_WideInt) POSIX_EPOCH_AS_FILETIME) / (Tcl_WideInt) 10000000);
+ return (time_t) ((convertedTime.QuadPart -
+ (Tcl_WideInt) POSIX_EPOCH_AS_FILETIME) / (Tcl_WideInt) 10000000);
}
/*
@@ -2033,7 +2268,7 @@ ToCTime(
static void
FromCTime(
time_t posixTime,
- FILETIME* fileTime) /* UTC Time */
+ FILETIME *fileTime) /* UTC Time */
{
LARGE_INTEGER convertedTime;
convertedTime.QuadPart = ((LONGLONG) posixTime) * 10000000
@@ -2042,136 +2277,105 @@ FromCTime(
fileTime->dwHighDateTime = convertedTime.HighPart;
}
-#if 0
/*
- *-------------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*
- * TclWinResolveShortcut --
+ * TclpGetNativeCwd --
*
- * Resolve a potential Windows shortcut to get the actual file or
- * directory in question.
+ * This function replaces the library version of getcwd().
*
* Results:
- * Returns 1 if the shortcut could be resolved, or 0 if there was
- * an error or if the filename was not a shortcut.
- * If bufferPtr did hold the name of a shortcut, it is modified to
- * hold the resolved target of the shortcut instead.
+ * The input and output are filesystem paths in native form. The result
+ * is either the given clientData, if the working directory hasn't
+ * changed, or a new clientData (owned by our caller), giving the new
+ * native path, or NULL if the current directory could not be determined.
+ * If NULL is returned, the caller can examine the standard posix error
+ * codes to determine the cause of the problem.
*
* Side effects:
- * Loads and unloads OLE package to determine if filename refers to
- * a shortcut.
+ * None.
*
- *-------------------------------------------------------------------------
+ *----------------------------------------------------------------------
*/
-int
-TclWinResolveShortcut(bufferPtr)
- Tcl_DString *bufferPtr; /* Holds name of file to resolve. On
- * return, holds resolved file name. */
+ClientData
+TclpGetNativeCwd(
+ ClientData clientData)
{
- HRESULT hres;
- IShellLink *psl;
- IPersistFile *ppf;
- WIN32_FIND_DATA wfd;
- WCHAR wpath[MAX_PATH];
- char *path, *ext;
- char realFileName[MAX_PATH];
-
- /*
- * Windows system calls do not automatically resolve
- * shortcuts like UNIX automatically will with symbolic links.
- */
+ WCHAR buffer[MAX_PATH];
- path = Tcl_DStringValue(bufferPtr);
- ext = strrchr(path, '.');
- if ((ext == NULL) || (stricmp(ext, ".lnk") != 0)) {
- return 0;
+ if ((*tclWinProcs->getCurrentDirectoryProc)(MAX_PATH, buffer) == 0) {
+ TclWinConvertError(GetLastError());
+ return NULL;
}
- CoInitialize(NULL);
- path = Tcl_DStringValue(bufferPtr);
- realFileName[0] = '\0';
- hres = CoCreateInstance(&CLSID_ShellLink, NULL, CLSCTX_INPROC_SERVER,
- &IID_IShellLink, &psl);
- if (SUCCEEDED(hres)) {
- hres = psl->lpVtbl->QueryInterface(psl, &IID_IPersistFile, &ppf);
- if (SUCCEEDED(hres)) {
- MultiByteToWideChar(CP_ACP, 0, path, -1, wpath, sizeof(wpath));
- hres = ppf->lpVtbl->Load(ppf, wpath, STGM_READ);
- if (SUCCEEDED(hres)) {
- hres = psl->lpVtbl->Resolve(psl, NULL,
- SLR_ANY_MATCH | SLR_NO_UI);
- if (SUCCEEDED(hres)) {
- hres = psl->lpVtbl->GetPath(psl, realFileName, MAX_PATH,
- &wfd, 0);
- }
- }
- ppf->lpVtbl->Release(ppf);
- }
- psl->lpVtbl->Release(psl);
- }
- CoUninitialize();
-
- if (realFileName[0] != '\0') {
- Tcl_DStringSetLength(bufferPtr, 0);
- Tcl_DStringAppend(bufferPtr, realFileName, -1);
- return 1;
+ 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;
+ }
+ }
}
- return 0;
+
+ return TclNativeDupInternalRep((ClientData) buffer);
}
-#endif
-Tcl_Obj*
-TclpObjGetCwd(interp)
- Tcl_Interp *interp;
-{
- Tcl_DString ds;
- if (TclpGetCwd(interp, &ds) != NULL) {
- Tcl_Obj *cwdPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1);
- Tcl_IncrRefCount(cwdPtr);
- Tcl_DStringFree(&ds);
- return cwdPtr;
- } else {
- return NULL;
- }
-}
-
-int
-TclpObjAccess(pathPtr, mode)
- Tcl_Obj *pathPtr;
- int mode;
+int
+TclpObjAccess(
+ Tcl_Obj *pathPtr,
+ int mode)
{
- return NativeAccess((CONST TCHAR*) Tcl_FSGetNativePath(pathPtr), mode);
+ return NativeAccess((const TCHAR *) Tcl_FSGetNativePath(pathPtr), mode);
}
-
-int
-TclpObjLstat(pathPtr, statPtr)
- Tcl_Obj *pathPtr;
- Tcl_StatBuf *statPtr;
+
+int
+TclpObjLstat(
+ Tcl_Obj *pathPtr,
+ Tcl_StatBuf *statPtr)
{
/*
- * Ensure correct file sizes by forcing the OS to write any
- * pending data to disk. This is done only for channels which are
- * dirty, i.e. have been written to since the last flush here.
+ * Ensure correct file sizes by forcing the OS to write any pending data
+ * to disk. This is done only for channels which are dirty, i.e. have been
+ * written to since the last flush here.
*/
- TclWinFlushDirtyChannels ();
+ TclWinFlushDirtyChannels();
- return NativeStat((CONST TCHAR*) Tcl_FSGetNativePath(pathPtr), statPtr, 1);
+ return NativeStat((const TCHAR *) Tcl_FSGetNativePath(pathPtr),
+ statPtr, 1);
}
-
+
#ifdef S_IFLNK
-
-Tcl_Obj*
-TclpObjLink(pathPtr, toPtr, linkAction)
- Tcl_Obj *pathPtr;
- Tcl_Obj *toPtr;
- int linkAction;
+Tcl_Obj *
+TclpObjLink(
+ Tcl_Obj *pathPtr,
+ Tcl_Obj *toPtr,
+ int linkAction)
{
if (toPtr != NULL) {
int res;
- TCHAR* LinkTarget = (TCHAR*)Tcl_FSGetNativePath(toPtr);
- TCHAR* LinkSource = (TCHAR*)Tcl_FSGetNativePath(pathPtr);
+ TCHAR *LinkTarget;
+ TCHAR *LinkSource = (TCHAR *) Tcl_FSGetNativePath(pathPtr);
+ Tcl_Obj *normalizedToPtr = Tcl_FSGetNormalizedPath(NULL, toPtr);
+
+ if (normalizedToPtr == NULL) {
+ return NULL;
+ }
+
+ LinkTarget = (TCHAR *) Tcl_FSGetNativePath(normalizedToPtr);
+
if (LinkSource == NULL || LinkTarget == NULL) {
return NULL;
}
@@ -2182,60 +2386,65 @@ TclpObjLink(pathPtr, toPtr, linkAction)
return NULL;
}
} else {
- TCHAR* LinkSource = (TCHAR*)Tcl_FSGetNativePath(pathPtr);
+ TCHAR *LinkSource = (TCHAR *) Tcl_FSGetNativePath(pathPtr);
+
if (LinkSource == NULL) {
return NULL;
}
return WinReadLink(LinkSource);
}
}
-
#endif
-
/*
*---------------------------------------------------------------------------
*
* TclpFilesystemPathType --
*
- * This function is part of the native filesystem support, and
- * returns the path type of the given path. Returns NTFS or FAT
- * or whatever is returned by the 'volume information' proc.
+ * This function is part of the native filesystem support, and returns
+ * the path type of the given path. Returns NTFS or FAT or whatever is
+ * returned by the 'volume information' proc.
*
* Results:
- * NULL at present.
+ * NULL at present.
*
* Side effects:
* None.
*
*---------------------------------------------------------------------------
*/
-Tcl_Obj*
-TclpFilesystemPathType(pathObjPtr)
- Tcl_Obj* pathObjPtr;
+
+Tcl_Obj *
+TclpFilesystemPathType(
+ Tcl_Obj *pathPtr)
{
#define VOL_BUF_SIZE 32
int found;
WCHAR volType[VOL_BUF_SIZE];
- char* firstSeparator;
- CONST char *path;
-
- Tcl_Obj *normPath = Tcl_FSGetNormalizedPath(NULL, pathObjPtr);
- if (normPath == NULL) return NULL;
+ char *firstSeparator;
+ const char *path;
+ Tcl_Obj *normPath = Tcl_FSGetNormalizedPath(NULL, pathPtr);
+
+ if (normPath == NULL) {
+ return NULL;
+ }
path = Tcl_GetString(normPath);
- if (path == NULL) return NULL;
-
+ if (path == NULL) {
+ return NULL;
+ }
+
firstSeparator = strchr(path, '/');
if (firstSeparator == NULL) {
found = tclWinProcs->getVolumeInformationProc(
- Tcl_FSGetNativePath(pathObjPtr), NULL, 0, NULL, NULL,
- NULL, (WCHAR *)volType, VOL_BUF_SIZE);
+ Tcl_FSGetNativePath(pathPtr), NULL, 0, NULL, NULL, NULL,
+ (WCHAR *) volType, VOL_BUF_SIZE);
} else {
Tcl_Obj *driveName = Tcl_NewStringObj(path, firstSeparator - path+1);
+
Tcl_IncrRefCount(driveName);
found = tclWinProcs->getVolumeInformationProc(
- Tcl_FSGetNativePath(driveName), NULL, 0, NULL, NULL,
- NULL, (WCHAR *)volType, VOL_BUF_SIZE);
+ Tcl_FSGetNativePath(driveName), NULL, 0, NULL, NULL, NULL,
+ (WCHAR *) volType, VOL_BUF_SIZE);
Tcl_DecrRefCount(driveName);
}
@@ -2244,91 +2453,118 @@ TclpFilesystemPathType(pathObjPtr)
} else {
Tcl_DString ds;
Tcl_Obj *objPtr;
-
- Tcl_WinTCharToUtf((CONST char *)volType, -1, &ds);
- objPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds),Tcl_DStringLength(&ds));
+
+ Tcl_WinTCharToUtf((const char *) volType, -1, &ds);
+ objPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds),
+ Tcl_DStringLength(&ds));
Tcl_DStringFree(&ds);
return objPtr;
}
#undef VOL_BUF_SIZE
}
+
+/*
+ * This define can be turned on to experiment with a different way of
+ * normalizing paths (using a different Windows API). Unfortunately the new
+ * path seems to take almost exactly the same amount of time as the old path!
+ * The primary time taken by normalization is in
+ * GetFileAttributesEx/FindFirstFile or GetFileAttributesEx/GetLongPathName.
+ * Conversion to/from native is not a significant factor at all.
+ *
+ * Also, since we have to check for symbolic links (reparse points) then we
+ * have to call GetFileAttributes on each path segment anyway, so there's no
+ * benefit to doing anything clever there.
+ */
+/* #define TclNORM_LONG_PATH */
/*
*---------------------------------------------------------------------------
*
* TclpObjNormalizePath --
*
- * This function scans through a path specification and replaces it,
- * in place, with a normalized version. This means using the
- * 'longname', and expanding any symbolic links contained within the
- * path.
+ * This function scans through a path specification and replaces it, in
+ * place, with a normalized version. This means using the 'longname', and
+ * expanding any symbolic links contained within the path.
*
* Results:
- * The new 'nextCheckpoint' value, giving as far as we could
- * understand in the path.
+ * The new 'nextCheckpoint' value, giving as far as we could understand
+ * in the path.
*
* Side effects:
- * The pathPtr string, which must contain a valid path, is
- * possibly modified in place.
+ * The pathPtr string, which must contain a valid path, is possibly
+ * modified in place.
*
*---------------------------------------------------------------------------
*/
int
-TclpObjNormalizePath(interp, pathPtr, nextCheckpoint)
- Tcl_Interp *interp;
- Tcl_Obj *pathPtr;
- int nextCheckpoint;
+TclpObjNormalizePath(
+ Tcl_Interp *interp,
+ Tcl_Obj *pathPtr,
+ int nextCheckpoint)
{
char *lastValidPathEnd = NULL;
- /* This will hold the normalized string */
- Tcl_DString dsNorm;
- char *path;
- char *currentPathEndPosition;
+ Tcl_DString dsNorm; /* This will hold the normalized string. */
+ char *path, *currentPathEndPosition;
Tcl_Obj *temp = NULL;
Tcl_DStringInit(&dsNorm);
path = Tcl_GetString(pathPtr);
if (TclWinGetPlatformId() == VER_PLATFORM_WIN32_WINDOWS) {
- /*
- * We're on Win95, 98 or ME. There are two assumptions
- * in this block of code. First that the native (NULL)
- * encoding is basically ascii, and second that symbolic
- * links are not possible. Both of these assumptions
- * appear to be true of these operating systems.
+ /*
+ * We're on Win95, 98 or ME. There are two assumptions in this block
+ * of code. First that the native (NULL) encoding is basically ascii,
+ * and second that symbolic links are not possible. Both of these
+ * assumptions appear to be true of these operating systems.
*/
+
int isDrive = 1;
Tcl_DString ds;
currentPathEndPosition = path + nextCheckpoint;
- if (*currentPathEndPosition == '/') {
+ if (*currentPathEndPosition == '/') {
currentPathEndPosition++;
- }
+ }
+
while (1) {
char cur = *currentPathEndPosition;
- if ((cur == '/' || cur == 0) && (path != currentPathEndPosition)) {
- /* Reached directory separator, or end of string */
- CONST char *nativePath = Tcl_UtfToExternalDString(NULL, path,
- currentPathEndPosition - path, &ds);
+ if ((cur=='/' || cur==0) && (path != currentPathEndPosition)) {
/*
- * Now we convert the tail of the current path to its
- * 'long form', and append it to 'dsNorm' which holds
- * the current normalized path, if the file exists.
+ * Reached directory separator, or end of string.
*/
+
+ const char *nativePath = Tcl_UtfToExternalDString(NULL, path,
+ currentPathEndPosition - path, &ds);
+
+ /*
+ * Now we convert the tail of the current path to its 'long
+ * form', and append it to 'dsNorm' which holds the current
+ * normalized path, if the file exists.
+ */
+
if (isDrive) {
- if (GetFileAttributesA(nativePath) == INVALID_FILE_ATTRIBUTES) {
- /* File doesn't exist */
+ if (GetFileAttributesA(nativePath)
+ == INVALID_FILE_ATTRIBUTES) {
+ /*
+ * File doesn't exist.
+ */
+
if (isDrive) {
int len = WinIsReserved(path);
+
if (len > 0) {
- /* Actually it does exist - COM1, etc */
+ /*
+ * Actually it does exist - COM1, etc.
+ */
+
int i;
- for (i=0;i<len;i++) {
+
+ for (i=0 ; i<len ; i++) {
if (nativePath[i] >= 'a') {
- ((char*)nativePath)[i] -= ('a' - 'A');
+ ((char *) nativePath)[i] -= ('a'-'A');
}
}
Tcl_DStringAppend(&dsNorm, nativePath, len);
@@ -2339,33 +2575,74 @@ TclpObjNormalizePath(interp, pathPtr, nextCheckpoint)
break;
}
if (nativePath[0] >= 'a') {
- ((char*)nativePath)[0] -= ('a' - 'A');
+ ((char *) nativePath)[0] -= ('a' - 'A');
}
- Tcl_DStringAppend(&dsNorm,nativePath,Tcl_DStringLength(&ds));
+ Tcl_DStringAppend(&dsNorm, nativePath,
+ Tcl_DStringLength(&ds));
} else {
- WIN32_FIND_DATA fData;
- HANDLE handle;
-
- handle = FindFirstFileA(nativePath, &fData);
- if (handle == INVALID_HANDLE_VALUE) {
- if (GetFileAttributesA(nativePath)
- == INVALID_FILE_ATTRIBUTES) {
- /* File doesn't exist */
- Tcl_DStringFree(&ds);
- break;
+ char *checkDots = NULL;
+
+ if (lastValidPathEnd[1] == '.') {
+ checkDots = lastValidPathEnd + 1;
+ while (checkDots < currentPathEndPosition) {
+ if (*checkDots != '.') {
+ checkDots = NULL;
+ break;
+ }
+ checkDots++;
}
- /* This is usually the '/' in 'c:/' at end of string */
- Tcl_DStringAppend(&dsNorm,"/", 1);
+ }
+ if (checkDots != NULL) {
+ int dotLen = currentPathEndPosition-lastValidPathEnd;
+
+ /*
+ * Path is just dots. We shouldn't really ever see a
+ * path like that. However, to be nice we at least
+ * don't mangle the path - we just add the dots as a
+ * path segment and continue
+ */
+
+ Tcl_DStringAppend(&dsNorm, (TCHAR *)
+ (nativePath + Tcl_DStringLength(&ds)-dotLen),
+ dotLen);
} else {
- char *nativeName;
- if (fData.cFileName[0] != '\0') {
- nativeName = fData.cFileName;
+ /*
+ * Normal path.
+ */
+
+ WIN32_FIND_DATA fData;
+ HANDLE handle;
+
+ handle = FindFirstFileA(nativePath, &fData);
+ if (handle == INVALID_HANDLE_VALUE) {
+ if (GetFileAttributesA(nativePath)
+ == INVALID_FILE_ATTRIBUTES) {
+ /*
+ * File doesn't exist.
+ */
+
+ Tcl_DStringFree(&ds);
+ break;
+ }
+
+ /*
+ * This is usually the '/' in 'c:/' at end of
+ * string.
+ */
+
+ Tcl_DStringAppend(&dsNorm,"/", 1);
} else {
- nativeName = fData.cAlternateFileName;
+ char *nativeName;
+
+ if (fData.cFileName[0] != '\0') {
+ nativeName = fData.cFileName;
+ } else {
+ nativeName = fData.cAlternateFileName;
+ }
+ FindClose(handle);
+ Tcl_DStringAppend(&dsNorm,"/", 1);
+ Tcl_DStringAppend(&dsNorm,nativeName,-1);
}
- FindClose(handle);
- Tcl_DStringAppend(&dsNorm,"/", 1);
- Tcl_DStringAppend(&dsNorm,nativeName,-1);
}
}
Tcl_DStringFree(&ds);
@@ -2373,16 +2650,21 @@ TclpObjNormalizePath(interp, pathPtr, nextCheckpoint)
if (cur == 0) {
break;
}
- /*
- * If we get here, we've got past one directory
- * delimiter, so we know it is no longer a drive
+
+ /*
+ * If we get here, we've got past one directory delimiter, so
+ * we know it is no longer a drive.
*/
+
isDrive = 0;
}
currentPathEndPosition++;
}
} else {
- /* We're on WinNT or 2000 or XP */
+ /*
+ * We're on WinNT (or 2000 or XP; something with an NT core).
+ */
+
int isDrive = 1;
Tcl_DString ds;
@@ -2392,28 +2674,42 @@ TclpObjNormalizePath(interp, pathPtr, nextCheckpoint)
}
while (1) {
char cur = *currentPathEndPosition;
- if ((cur == '/' || cur == 0) && (path != currentPathEndPosition)) {
- /* Reached directory separator, or end of string */
+
+ if ((cur=='/' || cur==0) && (path != currentPathEndPosition)) {
+ /*
+ * Reached directory separator, or end of string.
+ */
+
WIN32_FILE_ATTRIBUTE_DATA data;
- CONST char *nativePath = Tcl_WinUtfToTChar(path,
- currentPathEndPosition - path, &ds);
+ const char *nativePath = Tcl_WinUtfToTChar(path,
+ currentPathEndPosition - path, &ds);
+
if ((*tclWinProcs->getFileAttributesExProc)(nativePath,
- GetFileExInfoStandard, &data) != TRUE) {
- /* File doesn't exist */
+ GetFileExInfoStandard, &data) != TRUE) {
+ /*
+ * File doesn't exist.
+ */
+
if (isDrive) {
int len = WinIsReserved(path);
+
if (len > 0) {
- /* Actually it does exist - COM1, etc */
+ /*
+ * Actually it does exist - COM1, etc.
+ */
+
int i;
- for (i=0;i<len;i++) {
- WCHAR wc = ((WCHAR*)nativePath)[i];
+
+ for (i=0 ; i<len ; i++) {
+ WCHAR wc = ((WCHAR *) nativePath)[i];
+
if (wc >= L'a') {
wc -= (L'a' - L'A');
- ((WCHAR*)nativePath)[i] = wc;
+ ((WCHAR *) nativePath)[i] = wc;
}
}
Tcl_DStringAppend(&dsNorm, nativePath,
- sizeof(WCHAR)*len);
+ (int)(sizeof(WCHAR) * len));
lastValidPathEnd = currentPathEndPosition;
}
}
@@ -2421,31 +2717,46 @@ TclpObjNormalizePath(interp, pathPtr, nextCheckpoint)
break;
}
- /*
- * File 'nativePath' does exist if we get here. We
- * now want to check if it is a symlink and otherwise
- * continue with the rest of the path.
+ /*
+ * File 'nativePath' does exist if we get here. We now want to
+ * check if it is a symlink and otherwise continue with the
+ * rest of the path.
*/
-
- /*
- * Check for symlinks, except at last component
- * of path (we don't follow final symlinks). Also
- * a drive (C:/) for example, may sometimes have
- * the reparse flag set for some reason I don't
- * understand. We therefore don't perform this
+
+ /*
+ * Check for symlinks, except at last component of path (we
+ * don't follow final symlinks). Also a drive (C:/) for
+ * example, may sometimes have the reparse flag set for some
+ * reason I don't understand. We therefore don't perform this
* check for drives.
*/
- if (cur != 0 && !isDrive && (data.dwFileAttributes
- & FILE_ATTRIBUTE_REPARSE_POINT)) {
+
+ if (cur != 0 && !isDrive &&
+ data.dwFileAttributes & FILE_ATTRIBUTE_REPARSE_POINT){
Tcl_Obj *to = WinReadLinkDirectory(nativePath);
+
if (to != NULL) {
- /* Read the reparse point ok */
- /* Tcl_GetStringFromObj(to, &pathLen); */
- nextCheckpoint = 0; /* pathLen */
+ /*
+ * Read the reparse point ok. Now, reparse points need
+ * not be normalized, otherwise we could use:
+ *
+ * Tcl_GetStringFromObj(to, &pathLen);
+ * nextCheckpoint = pathLen
+ *
+ * So, instead we have to start from the beginning.
+ */
+
+ nextCheckpoint = 0;
Tcl_AppendToObj(to, currentPathEndPosition, -1);
- /* Convert link to forward slashes */
+
+ /*
+ * Convert link to forward slashes.
+ */
+
for (path = Tcl_GetString(to); *path != 0; path++) {
- if (*path == '\\') *path = '/';
+ if (*path == '\\') {
+ *path = '/';
+ }
}
path = Tcl_GetString(to);
currentPathEndPosition = path + nextCheckpoint;
@@ -2453,7 +2764,11 @@ TclpObjNormalizePath(interp, pathPtr, nextCheckpoint)
Tcl_DecrRefCount(temp);
}
temp = to;
- /* Reset variables so we can restart normalization */
+
+ /*
+ * Reset variables so we can restart normalization.
+ */
+
isDrive = 1;
Tcl_DStringFree(&dsNorm);
Tcl_DStringInit(&dsNorm);
@@ -2461,21 +2776,25 @@ TclpObjNormalizePath(interp, pathPtr, nextCheckpoint)
continue;
}
}
+
+#ifndef TclNORM_LONG_PATH
/*
- * Now we convert the tail of the current path to its
- * 'long form', and append it to 'dsNorm' which holds
- * the current normalized path
+ * Now we convert the tail of the current path to its 'long
+ * form', and append it to 'dsNorm' which holds the current
+ * normalized path
*/
+
if (isDrive) {
- WCHAR drive = ((WCHAR*)nativePath)[0];
+ WCHAR drive = ((WCHAR *) nativePath)[0];
if (drive >= L'a') {
- drive -= (L'a' - L'A');
- ((WCHAR*)nativePath)[0] = drive;
+ drive -= (L'a' - L'A');
+ ((WCHAR *) nativePath)[0] = drive;
}
- Tcl_DStringAppend(&dsNorm,nativePath,Tcl_DStringLength(&ds));
+ Tcl_DStringAppend(&dsNorm, nativePath,
+ Tcl_DStringLength(&ds));
} else {
char *checkDots = NULL;
-
+
if (lastValidPathEnd[1] == '.') {
checkDots = lastValidPathEnd + 1;
while (checkDots < currentPathEndPosition) {
@@ -2487,86 +2806,132 @@ TclpObjNormalizePath(interp, pathPtr, nextCheckpoint)
}
}
if (checkDots != NULL) {
- int dotLen = currentPathEndPosition - lastValidPathEnd;
- /*
- * Path is just dots. We shouldn't really
- * ever see a path like that. However, to be
- * nice we at least don't mangle the path --
- * we just add the dots as a path segment and
- * continue
+ int dotLen = currentPathEndPosition-lastValidPathEnd;
+
+ /*
+ * Path is just dots. We shouldn't really ever see a
+ * path like that. However, to be nice we at least
+ * don't mangle the path - we just add the dots as a
+ * path segment and continue.
*/
- Tcl_DStringAppend(&dsNorm,
- (TCHAR*)((WCHAR*)(nativePath
- + Tcl_DStringLength(&ds))
- - dotLen),
- (int)(dotLen * sizeof(WCHAR)));
+
+ Tcl_DStringAppend(&dsNorm, (TCHAR *)
+ ((WCHAR*)(nativePath + Tcl_DStringLength(&ds))
+ - dotLen), (int)(dotLen * sizeof(WCHAR)));
} else {
- /* Normal path */
+ /*
+ * Normal path.
+ */
+
WIN32_FIND_DATAW fData;
HANDLE handle;
-
- handle = FindFirstFileW((WCHAR*)nativePath, &fData);
+
+ handle = FindFirstFileW((WCHAR *) nativePath, &fData);
if (handle == INVALID_HANDLE_VALUE) {
- /* This is usually the '/' in 'c:/' at end of string */
- Tcl_DStringAppend(&dsNorm,(CONST char*)L"/",
- sizeof(WCHAR));
+ /*
+ * This is usually the '/' in 'c:/' at end of
+ * string.
+ */
+
+ Tcl_DStringAppend(&dsNorm, (const char *) L"/",
+ sizeof(WCHAR));
} else {
WCHAR *nativeName;
+
if (fData.cFileName[0] != '\0') {
nativeName = fData.cFileName;
} else {
nativeName = fData.cAlternateFileName;
}
FindClose(handle);
- Tcl_DStringAppend(&dsNorm,(CONST char*)L"/",
- sizeof(WCHAR));
- Tcl_DStringAppend(&dsNorm,(TCHAR*)nativeName,
- (int) (wcslen(nativeName)*sizeof(WCHAR)));
+ Tcl_DStringAppend(&dsNorm, (const char *) L"/",
+ sizeof(WCHAR));
+ Tcl_DStringAppend(&dsNorm, (TCHAR *) nativeName,
+ (int) (wcslen(nativeName)*sizeof(WCHAR)));
}
}
}
+#endif
Tcl_DStringFree(&ds);
lastValidPathEnd = currentPathEndPosition;
if (cur == 0) {
break;
}
- /*
- * If we get here, we've got past one directory
- * delimiter, so we know it is no longer a drive
+
+ /*
+ * If we get here, we've got past one directory delimiter, so
+ * we know it is no longer a drive.
*/
+
isDrive = 0;
}
currentPathEndPosition++;
}
+
+#ifdef TclNORM_LONG_PATH
+ /*
+ * Convert the entire known path to long form.
+ */
+
+ if (1) {
+ WCHAR wpath[MAX_PATH];
+ const char *nativePath =
+ Tcl_WinUtfToTChar(path, lastValidPathEnd - path, &ds);
+ DWORD wpathlen = (*tclWinProcs->getLongPathNameProc)(
+ nativePath, (TCHAR *) wpath, MAX_PATH);
+
+ /*
+ * We have to make the drive letter uppercase.
+ */
+
+ if (wpath[0] >= L'a') {
+ wpath[0] -= (L'a' - L'A');
+ }
+ Tcl_DStringAppend(&dsNorm, (TCHAR*)wpath, wpathlen*sizeof(WCHAR));
+ Tcl_DStringFree(&ds);
+ }
+#endif
}
- /* Common code path for all Windows platforms */
+
+ /*
+ * Common code path for all Windows platforms.
+ */
+
nextCheckpoint = currentPathEndPosition - path;
if (lastValidPathEnd != NULL) {
- /*
- * Concatenate the normalized string in dsNorm with the
- * tail of the path which we didn't recognise. The
- * string in dsNorm is in the native encoding, so we
- * have to convert it to Utf.
+ /*
+ * Concatenate the normalized string in dsNorm with the tail of the
+ * path which we didn't recognise. The string in dsNorm is in the
+ * native encoding, so we have to convert it to Utf.
*/
+
Tcl_DString dsTemp;
- Tcl_WinTCharToUtf(Tcl_DStringValue(&dsNorm),
- Tcl_DStringLength(&dsNorm), &dsTemp);
+
+ Tcl_WinTCharToUtf(Tcl_DStringValue(&dsNorm),
+ Tcl_DStringLength(&dsNorm), &dsTemp);
nextCheckpoint = Tcl_DStringLength(&dsTemp);
if (*lastValidPathEnd != 0) {
- /* Not the end of the string */
+ /*
+ * Not the end of the string.
+ */
+
int len;
char *path;
Tcl_Obj *tmpPathPtr;
- tmpPathPtr = Tcl_NewStringObj(Tcl_DStringValue(&dsTemp),
- nextCheckpoint);
+
+ tmpPathPtr = Tcl_NewStringObj(Tcl_DStringValue(&dsTemp),
+ nextCheckpoint);
Tcl_AppendToObj(tmpPathPtr, lastValidPathEnd, -1);
path = Tcl_GetStringFromObj(tmpPathPtr, &len);
Tcl_SetStringObj(pathPtr, path, len);
Tcl_DecrRefCount(tmpPathPtr);
} else {
- /* End of string was reached above */
+ /*
+ * End of string was reached above.
+ */
+
Tcl_SetStringObj(pathPtr, Tcl_DStringValue(&dsTemp),
- nextCheckpoint);
+ nextCheckpoint);
}
Tcl_DStringFree(&dsTemp);
}
@@ -2580,13 +2945,303 @@ TclpObjNormalizePath(interp, pathPtr, nextCheckpoint)
if (temp != NULL) {
Tcl_DecrRefCount(temp);
}
-
return nextCheckpoint;
}
/*
*---------------------------------------------------------------------------
*
+ * TclWinVolumeRelativeNormalize --
+ *
+ * Only Windows has volume-relative paths. These paths are rather rare,
+ * but it is nice if Tcl can handle them. It is much better if we can
+ * handle them here, rather than in the native fs code, because we really
+ * need to have a real absolute path just below.
+ *
+ * We do not let this block compile on non-Windows platforms because the
+ * test suite's manual forcing of tclPlatform can otherwise cause this
+ * code path to be executed, causing various errors because
+ * volume-relative paths really do not exist.
+ *
+ * Results:
+ * A valid normalized path.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclWinVolumeRelativeNormalize(
+ Tcl_Interp *interp,
+ const char *path,
+ Tcl_Obj **useThisCwdPtr)
+{
+ Tcl_Obj *absolutePath, *useThisCwd;
+
+ useThisCwd = Tcl_FSGetCwd(interp);
+ if (useThisCwd == NULL) {
+ return NULL;
+ }
+
+ if (path[0] == '/') {
+ /*
+ * Path of form /foo/bar which is a path in the root directory of the
+ * current volume.
+ */
+
+ const char *drive = Tcl_GetString(useThisCwd);
+
+ absolutePath = Tcl_NewStringObj(drive,2);
+ Tcl_AppendToObj(absolutePath, path, -1);
+ Tcl_IncrRefCount(absolutePath);
+
+ /*
+ * We have a refCount on the cwd.
+ */
+ } else {
+ /*
+ * Path of form C:foo/bar, but this only makes sense if the cwd is
+ * also on drive C.
+ */
+
+ int cwdLen;
+ const char *drive =
+ Tcl_GetStringFromObj(useThisCwd, &cwdLen);
+ char drive_cur = path[0];
+
+ if (drive_cur >= 'a') {
+ drive_cur -= ('a' - 'A');
+ }
+ if (drive[0] == drive_cur) {
+ absolutePath = Tcl_DuplicateObj(useThisCwd);
+
+ /*
+ * We have a refCount on the cwd, which we will release later.
+ */
+
+ if (drive[cwdLen-1] != '/' && (path[2] != '\0')) {
+ /*
+ * Only add a trailing '/' if needed, which is if there isn't
+ * one already, and if we are going to be adding some more
+ * characters.
+ */
+
+ Tcl_AppendToObj(absolutePath, "/", 1);
+ }
+ } else {
+ Tcl_DecrRefCount(useThisCwd);
+ useThisCwd = NULL;
+
+ /*
+ * The path is not in the current drive, but is volume-relative.
+ * The way Tcl 8.3 handles this is that it treats such a path as
+ * relative to the root of the drive. We therefore behave the same
+ * here. This behaviour is, however, different to that of the
+ * windows command-line. If we want to fix this at some point in
+ * the future (at the expense of a behaviour change to Tcl), we
+ * could use the '_dgetdcwd' Win32 API to get the drive's cwd.
+ */
+
+ absolutePath = Tcl_NewStringObj(path, 2);
+ Tcl_AppendToObj(absolutePath, "/", 1);
+ }
+ Tcl_IncrRefCount(absolutePath);
+ Tcl_AppendToObj(absolutePath, path+2, -1);
+ }
+ *useThisCwdPtr = useThisCwd;
+ return absolutePath;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclpNativeToNormalized --
+ *
+ * Convert native format to a normalized path object, with refCount of
+ * zero.
+ *
+ * Currently assumes all native paths are actually normalized already, so
+ * if the path given is not normalized this will actually just convert to
+ * a valid string path, but not necessarily a normalized one.
+ *
+ * Results:
+ * A valid normalized path.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclpNativeToNormalized(
+ ClientData clientData)
+{
+ Tcl_DString ds;
+ Tcl_Obj *objPtr;
+ int len;
+ char *copy, *p;
+
+ Tcl_WinTCharToUtf((const char *) clientData, -1, &ds);
+ copy = Tcl_DStringValue(&ds);
+ len = Tcl_DStringLength(&ds);
+
+ /*
+ * Certain native path representations on Windows have this special prefix
+ * to indicate that they are to be treated specially. For example
+ * extremely long paths, or symlinks.
+ */
+
+ if (*copy == '\\') {
+ if (0 == strncmp(copy,"\\??\\",4)) {
+ copy += 4;
+ len -= 4;
+ } else if (0 == strncmp(copy,"\\\\?\\",4)) {
+ copy += 4;
+ len -= 4;
+ }
+ }
+
+ /*
+ * Ensure we are using forward slashes only.
+ */
+
+ for (p = copy; *p != '\0'; p++) {
+ if (*p == '\\') {
+ *p = '/';
+ }
+ }
+
+ objPtr = Tcl_NewStringObj(copy,len);
+ Tcl_DStringFree(&ds);
+
+ return objPtr;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclNativeCreateNativeRep --
+ *
+ * Create a native representation for the given path.
+ *
+ * Results:
+ * The nativePath representation.
+ *
+ * Side effects:
+ * Memory will be allocated. The path may need to be normalized.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+ClientData
+TclNativeCreateNativeRep(
+ Tcl_Obj *pathPtr)
+{
+ char *nativePathPtr, *str;
+ Tcl_DString ds;
+ Tcl_Obj *validPathPtr;
+ int len;
+
+ if (TclFSCwdIsNative()) {
+ /*
+ * The cwd is native, which means we can use the translated path
+ * without worrying about normalization (this will also usually be
+ * shorter so the utf-to-external conversion will be somewhat faster).
+ */
+
+ validPathPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr);
+ if (validPathPtr == NULL) {
+ return NULL;
+ }
+ } else {
+ /*
+ * Make sure the normalized path is set.
+ */
+
+ validPathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr);
+ if (validPathPtr == NULL) {
+ return NULL;
+ }
+ Tcl_IncrRefCount(validPathPtr);
+ }
+
+ str = Tcl_GetStringFromObj(validPathPtr, &len);
+ if (str[0] == '/' && str[1] == '/' && str[2] == '?' && str[3] == '/') {
+ char *p;
+
+ for (p = str; p && *p; ++p) {
+ if (*p == '/') {
+ *p = '\\';
+ }
+ }
+ }
+ Tcl_WinUtfToTChar(str, len, &ds);
+ if (tclWinProcs->useWide) {
+ len = Tcl_DStringLength(&ds) + sizeof(WCHAR);
+ } else {
+ len = Tcl_DStringLength(&ds) + sizeof(char);
+ }
+ Tcl_DecrRefCount(validPathPtr);
+ nativePathPtr = ckalloc((unsigned) len);
+ memcpy(nativePathPtr, Tcl_DStringValue(&ds), (size_t) len);
+
+ Tcl_DStringFree(&ds);
+ return (ClientData) nativePathPtr;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclNativeDupInternalRep --
+ *
+ * Duplicate the native representation.
+ *
+ * Results:
+ * The copied native representation, or NULL if it is not possible to
+ * copy the representation.
+ *
+ * Side effects:
+ * Memory allocation for the copy.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+ClientData
+TclNativeDupInternalRep(
+ ClientData clientData)
+{
+ char *copy;
+ size_t len;
+
+ if (clientData == NULL) {
+ 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);
+ }
+
+ copy = (char *) ckalloc(len);
+ memcpy(copy, clientData, len);
+ return (ClientData) copy;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
* TclpUtime --
*
* Set the modification date for a file.
@@ -2608,7 +3263,7 @@ TclpUtime(
{
int res = 0;
HANDLE fileHandle;
- CONST TCHAR *native;
+ const TCHAR *native;
DWORD attr = 0;
DWORD flags = FILE_ATTRIBUTE_NORMAL;
FILETIME lastAccessTime, lastModTime;
@@ -2616,7 +3271,7 @@ TclpUtime(
FromCTime(tval->actime, &lastAccessTime);
FromCTime(tval->modtime, &lastModTime);
- native = (CONST TCHAR *)Tcl_FSGetNativePath(pathPtr);
+ native = (const TCHAR *) Tcl_FSGetNativePath(pathPtr);
attr = (*tclWinProcs->getFileAttributesProc)(native);
@@ -2629,9 +3284,8 @@ TclpUtime(
* savings complications that utime gets wrong.
*/
- fileHandle = (tclWinProcs->createFileProc) (
- native, FILE_WRITE_ATTRIBUTES, 0, NULL,
- OPEN_EXISTING, flags, NULL);
+ fileHandle = (tclWinProcs->createFileProc)(native, FILE_WRITE_ATTRIBUTES,
+ 0, NULL, OPEN_EXISTING, flags, NULL);
if (fileHandle == INVALID_HANDLE_VALUE ||
!SetFileTime(fileHandle, NULL, &lastAccessTime, &lastModTime)) {
@@ -2643,3 +3297,11 @@ TclpUtime(
}
return res;
}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/win/tclWinInit.c b/win/tclWinInit.c
index fc09ef5..d80fa28 100644
--- a/win/tclWinInit.c
+++ b/win/tclWinInit.c
@@ -1,4 +1,4 @@
-/*
+/*
* tclWinInit.c --
*
* Contains the Windows-specific interpreter initialization functions.
@@ -6,6 +6,9 @@
* Copyright (c) 1994-1997 Sun Microsystems, Inc.
* Copyright (c) 1998-1999 by Scriptics Corporation.
* All rights reserved.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#include "tclWinInt.h"
@@ -14,10 +17,17 @@
#include <lmcons.h>
/*
+ * GetUserName() is found in advapi32.dll
+ */
+#ifdef _MSC_VER
+# pragma comment(lib, "advapi32.lib")
+#endif
+
+/*
* The following declaration is a workaround for some Microsoft brain damage.
* The SYSTEM_INFO structure is different in various releases, even though the
- * layout is the same. So we overlay our own structure on top of it so we
- * can access the interesting slots in a uniform way.
+ * layout is the same. So we overlay our own structure on top of it so we can
+ * access the interesting slots in a uniform way.
*/
typedef struct {
@@ -30,40 +40,40 @@ typedef struct {
*/
#ifndef PROCESSOR_ARCHITECTURE_INTEL
-#define PROCESSOR_ARCHITECTURE_INTEL 0
+#define PROCESSOR_ARCHITECTURE_INTEL 0
#endif
#ifndef PROCESSOR_ARCHITECTURE_MIPS
-#define PROCESSOR_ARCHITECTURE_MIPS 1
+#define PROCESSOR_ARCHITECTURE_MIPS 1
#endif
#ifndef PROCESSOR_ARCHITECTURE_ALPHA
-#define PROCESSOR_ARCHITECTURE_ALPHA 2
+#define PROCESSOR_ARCHITECTURE_ALPHA 2
#endif
#ifndef PROCESSOR_ARCHITECTURE_PPC
-#define PROCESSOR_ARCHITECTURE_PPC 3
+#define PROCESSOR_ARCHITECTURE_PPC 3
#endif
-#ifndef PROCESSOR_ARCHITECTURE_SHX
-#define PROCESSOR_ARCHITECTURE_SHX 4
+#ifndef PROCESSOR_ARCHITECTURE_SHX
+#define PROCESSOR_ARCHITECTURE_SHX 4
#endif
#ifndef PROCESSOR_ARCHITECTURE_ARM
-#define PROCESSOR_ARCHITECTURE_ARM 5
+#define PROCESSOR_ARCHITECTURE_ARM 5
#endif
#ifndef PROCESSOR_ARCHITECTURE_IA64
-#define PROCESSOR_ARCHITECTURE_IA64 6
+#define PROCESSOR_ARCHITECTURE_IA64 6
#endif
#ifndef PROCESSOR_ARCHITECTURE_ALPHA64
-#define PROCESSOR_ARCHITECTURE_ALPHA64 7
+#define PROCESSOR_ARCHITECTURE_ALPHA64 7
#endif
#ifndef PROCESSOR_ARCHITECTURE_MSIL
-#define PROCESSOR_ARCHITECTURE_MSIL 8
+#define PROCESSOR_ARCHITECTURE_MSIL 8
#endif
#ifndef PROCESSOR_ARCHITECTURE_AMD64
-#define PROCESSOR_ARCHITECTURE_AMD64 9
+#define PROCESSOR_ARCHITECTURE_AMD64 9
#endif
#ifndef PROCESSOR_ARCHITECTURE_IA32_ON_WIN64
-#define PROCESSOR_ARCHITECTURE_IA32_ON_WIN64 10
+#define PROCESSOR_ARCHITECTURE_IA32_ON_WIN64 10
#endif
#ifndef PROCESSOR_ARCHITECTURE_UNKNOWN
-#define PROCESSOR_ARCHITECTURE_UNKNOWN 0xFFFF
+#define PROCESSOR_ARCHITECTURE_UNKNOWN 0xFFFF
#endif
/*
@@ -83,21 +93,15 @@ static char* processors[NUMPROCESSORS] = {
"amd64", "ia32_on_win64"
};
-/* Used to store the encoding used for binary files */
-static Tcl_Encoding binaryEncoding = NULL;
-/* Has the basic library path encoding issue been fixed */
-static int libraryPathEncodingFixed = 0;
-
/*
- * The Init script (common to Windows and Unix platforms) is
- * defined in tkInitScript.h
+ * The default directory in which the init.tcl file is expected to be found.
*/
-#include "tclInitScript.h"
+static TclInitProcessGlobalValueProc InitializeDefaultLibraryDir;
+static ProcessGlobalValue defaultLibraryDir =
+ {0, 0, NULL, NULL, InitializeDefaultLibraryDir, NULL, NULL};
static void AppendEnvironment(Tcl_Obj *listPtr, CONST char *lib);
-static void AppendDllPath(Tcl_Obj *listPtr, HMODULE hModule,
- CONST char *lib);
static int ToUtf(CONST WCHAR *wSrc, char *dst);
/*
@@ -120,19 +124,18 @@ static int ToUtf(CONST WCHAR *wSrc, char *dst);
*/
void
-TclpInitPlatform()
+TclpInitPlatform(void)
{
tclPlatform = TCL_PLATFORM_WINDOWS;
/*
- * The following code stops Windows 3.X and Windows NT 3.51 from
- * automatically putting up Sharing Violation dialogs, e.g, when
- * someone tries to access a file that is locked or a drive with no
- * disk in it. Tcl already returns the appropriate error to the
- * caller, and they can decide to put up their own dialog in response
- * to that failure.
+ * The following code stops Windows 3.X and Windows NT 3.51 from
+ * automatically putting up Sharing Violation dialogs, e.g, when someone
+ * tries to access a file that is locked or a drive with no disk in it.
+ * Tcl already returns the appropriate error to the caller, and they can
+ * decide to put up their own dialog in response to that failure.
*
- * Under 95 and NT 4.0, this is a NOOP because the system doesn't
+ * Under 95 and NT 4.0, this is a NOOP because the system doesn't
* automatically put up dialogs when the above operations fail.
*/
@@ -140,9 +143,9 @@ TclpInitPlatform()
#ifdef STATIC_BUILD
/*
- * If we are in a statically linked executable, then we need to
- * explicitly initialize the Windows function tables here since
- * DllMain() will not be invoked.
+ * If we are in a statically linked executable, then we need to explicitly
+ * initialize the Windows function tables here since DllMain() will not be
+ * invoked.
*/
TclWinInit(GetModuleHandle(NULL));
@@ -150,186 +153,64 @@ TclpInitPlatform()
}
/*
- *---------------------------------------------------------------------------
+ *-------------------------------------------------------------------------
*
* TclpInitLibraryPath --
*
- * Initialize the library path at startup.
- *
- * This call sets the library path to strings in UTF-8. Any
- * pre-existing library path information is assumed to have been
- * in the native multibyte encoding.
- *
- * Called at process initialization time.
+ * This is the fallback routine that sets the library path if the
+ * application has not set one by the first time it is needed.
*
* Results:
- * Return 0, indicating that the UTF is clean.
+ * None.
*
* Side effects:
- * None.
+ * Sets the library path to an initial value.
*
- *---------------------------------------------------------------------------
+ *-------------------------------------------------------------------------
*/
-int
-TclpInitLibraryPath(path)
- CONST char *path; /* Potentially dirty UTF string that is */
- /* the path to the executable name. */
+void
+TclpInitLibraryPath(
+ char **valuePtr,
+ int *lengthPtr,
+ Tcl_Encoding *encodingPtr)
{
#define LIBRARY_SIZE 32
- Tcl_Obj *pathPtr, *objPtr;
- CONST char *str;
- Tcl_DString ds;
- int pathc;
- CONST char **pathv;
- char installLib[LIBRARY_SIZE], developLib[LIBRARY_SIZE];
+ Tcl_Obj *pathPtr;
+ char installLib[LIBRARY_SIZE];
+ char *bytes;
- Tcl_DStringInit(&ds);
pathPtr = Tcl_NewObj();
/*
- * Initialize the substrings used when locating an executable. The
- * installLib variable computes the path as though the executable
- * is installed. The developLib computes the path as though the
- * executable is run from a develpment directory.
+ * Initialize the substring used when locating the script library. The
+ * installLib variable computes the script library path relative to the
+ * installed DLL.
*/
sprintf(installLib, "lib/tcl%s", TCL_VERSION);
- sprintf(developLib, "tcl%s/library", TCL_PATCH_LEVEL);
-
- /*
- * Look for the library relative to default encoding dir.
- */
-
- str = Tcl_GetDefaultEncodingDir();
- if ((str != NULL) && (str[0] != '\0')) {
- objPtr = Tcl_NewStringObj(str, -1);
- Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
- }
/*
- * Look for the library relative to the TCL_LIBRARY env variable.
- * If the last dirname in the TCL_LIBRARY path does not match the
- * last dirname in the installLib variable, use the last dir name
- * of installLib in addition to the orginal TCL_LIBRARY path.
+ * Look for the library relative to the TCL_LIBRARY env variable. If the
+ * last dirname in the TCL_LIBRARY path does not match the last dirname in
+ * the installLib variable, use the last dir name of installLib in
+ * addition to the orginal TCL_LIBRARY path.
*/
AppendEnvironment(pathPtr, installLib);
/*
- * Look for the library relative to the DLL. Only use the installLib
- * because in practice, the DLL is always installed.
+ * Look for the library in its default location.
*/
- AppendDllPath(pathPtr, TclWinGetTclInstance(), installLib);
-
+ Tcl_ListObjAppendElement(NULL, pathPtr,
+ TclGetProcessGlobalValue(&defaultLibraryDir));
- /*
- * Look for the library relative to the executable. This algorithm
- * should be the same as the one in the tcl_findLibrary procedure.
- *
- * This code looks in the following directories:
- *
- * <bindir>/../<installLib>
- * (e.g. /usr/local/bin/../lib/tcl8.4)
- * <bindir>/../../<installLib>
- * (e.g. /usr/local/TclPro/solaris-sparc/bin/../../lib/tcl8.4)
- * <bindir>/../library
- * (e.g. /usr/src/tcl8.4.0/unix/../library)
- * <bindir>/../../library
- * (e.g. /usr/src/tcl8.4.0/unix/solaris-sparc/../../library)
- * <bindir>/../../<developLib>
- * (e.g. /usr/src/tcl8.4.0/unix/../../tcl8.4.0/library)
- * <bindir>/../../../<developLib>
- * (e.g. /usr/src/tcl8.4.0/unix/solaris-sparc/../../../tcl8.4.0/library)
- */
-
- /*
- * The variable path holds an absolute path. Take care not to
- * overwrite pathv[0] since that might produce a relative path.
- */
-
- if (path != NULL) {
- int i, origc;
- CONST char **origv;
-
- Tcl_SplitPath(path, &origc, &origv);
- pathc = 0;
- pathv = (CONST char **) ckalloc((unsigned int)(origc * sizeof(char *)));
- for (i=0; i< origc; i++) {
- if (origv[i][0] == '.') {
- if (strcmp(origv[i], ".") == 0) {
- /* do nothing */
- } else if (strcmp(origv[i], "..") == 0) {
- pathc--;
- } else {
- pathv[pathc++] = origv[i];
- }
- } else {
- pathv[pathc++] = origv[i];
- }
- }
- if (pathc > 2) {
- str = pathv[pathc - 2];
- pathv[pathc - 2] = installLib;
- path = Tcl_JoinPath(pathc - 1, pathv, &ds);
- pathv[pathc - 2] = str;
- objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
- Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
- Tcl_DStringFree(&ds);
- }
- if (pathc > 3) {
- str = pathv[pathc - 3];
- pathv[pathc - 3] = installLib;
- path = Tcl_JoinPath(pathc - 2, pathv, &ds);
- pathv[pathc - 3] = str;
- objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
- Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
- Tcl_DStringFree(&ds);
- }
- if (pathc > 2) {
- str = pathv[pathc - 2];
- pathv[pathc - 2] = "library";
- path = Tcl_JoinPath(pathc - 1, pathv, &ds);
- pathv[pathc - 2] = str;
- objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
- Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
- Tcl_DStringFree(&ds);
- }
- if (pathc > 3) {
- str = pathv[pathc - 3];
- pathv[pathc - 3] = "library";
- path = Tcl_JoinPath(pathc - 2, pathv, &ds);
- pathv[pathc - 3] = str;
- objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
- Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
- Tcl_DStringFree(&ds);
- }
- if (pathc > 3) {
- str = pathv[pathc - 3];
- pathv[pathc - 3] = developLib;
- path = Tcl_JoinPath(pathc - 2, pathv, &ds);
- pathv[pathc - 3] = str;
- objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
- Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
- Tcl_DStringFree(&ds);
- }
- if (pathc > 4) {
- str = pathv[pathc - 4];
- pathv[pathc - 4] = developLib;
- path = Tcl_JoinPath(pathc - 3, pathv, &ds);
- pathv[pathc - 4] = str;
- objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
- Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
- Tcl_DStringFree(&ds);
- }
- ckfree((char *) origv);
- ckfree((char *) pathv);
- }
-
- TclSetLibraryPath(pathPtr);
-
- return 0; /* 0 indicates that pathPtr is clean (true) utf */
+ *encodingPtr = NULL;
+ bytes = Tcl_GetStringFromObj(pathPtr, lengthPtr);
+ *valuePtr = ckalloc((unsigned int)(*lengthPtr)+1);
+ memcpy(*valuePtr, bytes, (size_t)(*lengthPtr)+1);
+ Tcl_DecrRefCount(pathPtr);
}
/*
@@ -337,9 +218,9 @@ TclpInitLibraryPath(path)
*
* AppendEnvironment --
*
- * Append the value of the TCL_LIBRARY environment variable onto the
- * path pointer. If the env variable points to another version of
- * tcl (e.g. "tcl7.6") also append the path to this version (e.g.,
+ * Append the value of the TCL_LIBRARY environment variable onto the path
+ * pointer. If the env variable points to another version of tcl (e.g.
+ * "tcl7.6") also append the path to this version (e.g.,
* "tcl7.6/../tcl8.2")
*
* Results:
@@ -365,30 +246,30 @@ AppendEnvironment(
char *shortlib;
/*
- * The shortlib value needs to be the tail component of the
- * lib path. For example, "lib/tcl8.4" -> "tcl8.4" while
- * "usr/share/tcl8.5" -> "tcl8.5".
+ * The shortlib value needs to be the tail component of the lib path. For
+ * example, "lib/tcl8.4" -> "tcl8.4" while "usr/share/tcl8.5" -> "tcl8.5".
*/
- for (shortlib = (char *) (lib + strlen(lib) - 1); shortlib > lib ; shortlib--) {
- if (*shortlib == '/') {
- if (shortlib == (lib + strlen(lib) - 1)) {
- Tcl_Panic("last character in lib cannot be '/'");
- }
- shortlib++;
- break;
- }
+
+ for (shortlib = (char *) &lib[strlen(lib)-1]; shortlib>lib ; shortlib--) {
+ if (*shortlib == '/') {
+ if ((unsigned)(shortlib - lib) == strlen(lib) - 1) {
+ Tcl_Panic("last character in lib cannot be '/'");
+ }
+ shortlib++;
+ break;
+ }
}
if (shortlib == lib) {
- Tcl_Panic("no '/' character found in lib");
+ Tcl_Panic("no '/' character found in lib");
}
/*
- * The "L" preceeding the TCL_LIBRARY string is used to tell VC++
- * that this is a unicode string.
+ * The "L" preceeding the TCL_LIBRARY string is used to tell VC++ that
+ * this is a unicode string.
*/
-
+
if (GetEnvironmentVariableW(L"TCL_LIBRARY", wBuf, MAX_PATH) == 0) {
- buf[0] = '\0';
+ buf[0] = '\0';
GetEnvironmentVariableA("TCL_LIBRARY", buf, MAX_PATH);
} else {
ToUtf(wBuf, buf);
@@ -401,21 +282,21 @@ AppendEnvironment(
TclWinNoBackslash(buf);
Tcl_SplitPath(buf, &pathc, &pathv);
- /*
- * The lstrcmpi() will work even if pathv[pathc - 1] is random
- * UTF-8 chars because I know shortlib is ascii.
+ /*
+ * The lstrcmpi() will work even if pathv[pathc-1] is random UTF-8
+ * chars because I know shortlib is ascii.
*/
if ((pathc > 0) && (lstrcmpiA(shortlib, pathv[pathc - 1]) != 0)) {
CONST char *str;
+
/*
- * TCL_LIBRARY is set but refers to a different tcl
- * installation than the current version. Try fiddling with the
- * specified directory to make it refer to this installation by
- * removing the old "tclX.Y" and substituting the current
- * version string.
+ * TCL_LIBRARY is set but refers to a different tcl installation
+ * than the current version. Try fiddling with the specified
+ * directory to make it refer to this installation by removing the
+ * old "tclX.Y" and substituting the current version string.
*/
-
+
pathv[pathc - 1] = shortlib;
Tcl_DStringInit(&ds);
str = Tcl_JoinPath(pathc, pathv, &ds);
@@ -432,10 +313,10 @@ AppendEnvironment(
/*
*---------------------------------------------------------------------------
*
- * AppendDllPath --
+ * InitializeDefaultLibraryDir --
*
- * Append a path onto the path pointer that tries to locate the Tcl
- * library relative to the location of the Tcl DLL.
+ * Locate the Tcl script library default location relative to the
+ * location of the Tcl DLL.
*
* Results:
* None.
@@ -446,34 +327,37 @@ AppendEnvironment(
*---------------------------------------------------------------------------
*/
-static void
-AppendDllPath(
- Tcl_Obj *pathPtr,
- HMODULE hModule,
- CONST char *lib)
+static void
+InitializeDefaultLibraryDir(
+ char **valuePtr,
+ int *lengthPtr,
+ Tcl_Encoding *encodingPtr)
{
+ HMODULE hModule = TclWinGetTclInstance();
WCHAR wName[MAX_PATH + LIBRARY_SIZE];
char name[(MAX_PATH + LIBRARY_SIZE) * TCL_UTF_MAX];
+ char *end, *p;
if (GetModuleFileNameW(hModule, wName, MAX_PATH) == 0) {
GetModuleFileNameA(hModule, name, MAX_PATH);
} else {
ToUtf(wName, name);
}
- if (lib != NULL) {
- char *end, *p;
-
- end = strrchr(name, '\\');
- *end = '\0';
- p = strrchr(name, '\\');
- if (p != NULL) {
- end = p;
- }
- *end = '\\';
- strcpy(end + 1, lib);
+
+ end = strrchr(name, '\\');
+ *end = '\0';
+ p = strrchr(name, '\\');
+ if (p != NULL) {
+ end = p;
}
+ *end = '\\';
+
TclWinNoBackslash(name);
- Tcl_ListObjAppendElement(NULL, pathPtr, Tcl_NewStringObj(name, -1));
+ sprintf(end + 1, "lib/tcl%s", TCL_VERSION);
+ *lengthPtr = strlen(name);
+ *valuePtr = ckalloc((unsigned int) *lengthPtr + 1);
+ *encodingPtr = NULL;
+ memcpy(*valuePtr, name, (size_t) *lengthPtr + 1);
}
/*
@@ -481,7 +365,7 @@ AppendDllPath(
*
* ToUtf --
*
- * Convert a char string to a UTF string.
+ * Convert a char string to a UTF string.
*
* Results:
* None.
@@ -513,10 +397,10 @@ 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.
+ * 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.
@@ -528,14 +412,9 @@ ToUtf(
*/
void
-TclWinEncodingsCleanup()
+TclWinEncodingsCleanup(void)
{
TclWinResetInterfaceEncodings();
- libraryPathEncodingFixed = 0;
- if (binaryEncoding != NULL) {
- Tcl_FreeEncoding(binaryEncoding);
- binaryEncoding = NULL;
- }
}
/*
@@ -543,79 +422,56 @@ TclWinEncodingsCleanup()
*
* TclpSetInitialEncodings --
*
- * Based on the locale, determine the encoding of the operating
- * system and the default encoding for newly opened files.
+ * Based on the locale, determine the encoding of the operating system
+ * and the default encoding for newly opened files.
*
- * Called at process initialization time, and part way through
- * startup, we verify that the initial encodings were correctly
- * setup. Depending on Tcl's environment, there may not have been
- * enough information first time through (above).
+ * Called at process initialization time, and part way through startup,
+ * we verify that the initial encodings were correctly setup. Depending
+ * on Tcl's environment, there may not have been enough information first
+ * time through (above).
*
* Results:
* None.
*
* Side effects:
- * The Tcl library path is converted from native encoding to UTF-8,
- * on the first call, and the encodings may be changed on first or
- * second call.
+ * The Tcl library path is converted from native encoding to UTF-8, on
+ * the first call, and the encodings may be changed on first or second
+ * call.
*
*---------------------------------------------------------------------------
*/
void
-TclpSetInitialEncodings()
+TclpSetInitialEncodings(void)
{
- CONST char *encoding;
- char buf[4 + TCL_INTEGER_SPACE];
-
- if (libraryPathEncodingFixed == 0) {
- int platformId, useWide;
-
- platformId = TclWinGetPlatformId();
- useWide = ((platformId == VER_PLATFORM_WIN32_NT)
- || (platformId == VER_PLATFORM_WIN32_CE));
- TclWinSetInterfaces(useWide);
-
- wsprintfA(buf, "cp%d", GetACP());
- Tcl_SetSystemEncoding(NULL, buf);
-
- if (!useWide) {
- Tcl_Obj *pathPtr = TclGetLibraryPath();
- if (pathPtr != NULL) {
- int i, objc;
- Tcl_Obj **objv;
-
- objc = 0;
- Tcl_ListObjGetElements(NULL, pathPtr, &objc, &objv);
- for (i = 0; i < objc; i++) {
- int length;
- char *string;
- Tcl_DString ds;
-
- string = Tcl_GetStringFromObj(objv[i], &length);
- Tcl_ExternalToUtfDString(NULL, string, length, &ds);
- Tcl_SetStringObj(objv[i], Tcl_DStringValue(&ds),
- Tcl_DStringLength(&ds));
- Tcl_DStringFree(&ds);
- }
- }
- }
-
- libraryPathEncodingFixed = 1;
- } else {
- wsprintfA(buf, "cp%d", GetACP());
- Tcl_SetSystemEncoding(NULL, buf);
- }
+ Tcl_DString encodingName;
- /* This is only ever called from the startup thread */
- if (binaryEncoding == NULL) {
- /*
- * Keep this encoding preloaded. The IO package uses it for
- * gets on a binary channel.
- */
- encoding = "iso8859-1";
- binaryEncoding = Tcl_GetEncoding(NULL, encoding);
- }
+ TclpSetInterfaces();
+ Tcl_SetSystemEncoding(NULL,
+ Tcl_GetEncodingNameFromEnvironment(&encodingName));
+ Tcl_DStringFree(&encodingName);
+}
+
+void
+TclpSetInterfaces(void)
+{
+ int platformId, useWide;
+
+ platformId = TclWinGetPlatformId();
+ useWide = ((platformId == VER_PLATFORM_WIN32_NT)
+ || (platformId == VER_PLATFORM_WIN32_CE));
+ TclWinSetInterfaces(useWide);
+}
+
+CONST char *
+Tcl_GetEncodingNameFromEnvironment(
+ Tcl_DString *bufPtr)
+{
+ Tcl_DStringInit(bufPtr);
+ Tcl_DStringSetLength(bufPtr, 2+TCL_INTEGER_SPACE);
+ wsprintfA(Tcl_DStringValue(bufPtr), "cp%d", GetACP());
+ Tcl_DStringSetLength(bufPtr, strlen(Tcl_DStringValue(bufPtr)));
+ return Tcl_DStringValue(bufPtr);
}
/*
@@ -623,9 +479,8 @@ TclpSetInitialEncodings()
*
* TclpSetVariables --
*
- * Performs platform-specific interpreter initialization related to
- * the tcl_platform and env variables, and other platform-specific
- * things.
+ * Performs platform-specific interpreter initialization related to the
+ * tcl_platform and env variables, and other platform-specific things.
*
* Results:
* None.
@@ -637,23 +492,27 @@ TclpSetInitialEncodings()
*/
void
-TclpSetVariables(interp)
- Tcl_Interp *interp; /* Interp to initialize. */
-{
+TclpSetVariables(
+ Tcl_Interp *interp) /* Interp to initialize. */
+{
CONST char *ptr;
char buffer[TCL_INTEGER_SPACE * 2];
- SYSTEM_INFO sysInfo;
- OemId *oemId;
+ union {
+ SYSTEM_INFO info;
+ OemId oemId;
+ } sys;
OSVERSIONINFOA osInfo;
Tcl_DString ds;
- TCHAR szUserName[ UNLEN+1 ];
- DWORD dwUserNameLen = sizeof(szUserName);
+ WCHAR szUserName[UNLEN+1];
+ DWORD cchUserNameLen = UNLEN;
+
+ Tcl_SetVar2Ex(interp, "tclDefaultLibrary", NULL,
+ TclGetProcessGlobalValue(&defaultLibraryDir), TCL_GLOBAL_ONLY);
osInfo.dwOSVersionInfoSize = sizeof(OSVERSIONINFOA);
GetVersionExA(&osInfo);
- oemId = (OemId *) &sysInfo;
- GetSystemInfo(&sysInfo);
+ GetSystemInfo(&sys.info);
/*
* Define the tcl_platform array.
@@ -667,18 +526,19 @@ TclpSetVariables(interp)
}
wsprintfA(buffer, "%d.%d", osInfo.dwMajorVersion, osInfo.dwMinorVersion);
Tcl_SetVar2(interp, "tcl_platform", "osVersion", buffer, TCL_GLOBAL_ONLY);
- if (oemId->wProcessorArchitecture < NUMPROCESSORS) {
+ if (sys.oemId.wProcessorArchitecture < NUMPROCESSORS) {
Tcl_SetVar2(interp, "tcl_platform", "machine",
- processors[oemId->wProcessorArchitecture],
+ processors[sys.oemId.wProcessorArchitecture],
TCL_GLOBAL_ONLY);
}
#ifndef NDEBUG
/*
- * The existence of the "debug" element of the tcl_platform array indicates
- * that this particular Tcl shell has been compiled with debug information.
- * Using "info exists tcl_platform(debug)" a Tcl script can direct the
- * interpreter to load debug versions of DLLs with the load command.
+ * The existence of the "debug" element of the tcl_platform array
+ * indicates that this particular Tcl shell has been compiled with debug
+ * information. Using "info exists tcl_platform(debug)" a Tcl script can
+ * direct the interpreter to load debug versions of DLLs with the load
+ * command.
*/
Tcl_SetVar2(interp, "tcl_platform", "debug", "1",
@@ -712,14 +572,16 @@ TclpSetVariables(interp)
/*
* Initialize the user name from the environment first, since this is much
* faster than asking the system.
+ * Note: cchUserNameLen is number of characters including nul terminator.
*/
- Tcl_DStringInit( &ds );
+ Tcl_DStringInit(&ds);
if (TclGetEnv("USERNAME", &ds) == NULL) {
-
- if ( GetUserName( szUserName, &dwUserNameLen ) != 0 ) {
- Tcl_WinTCharToUtf( szUserName, dwUserNameLen, &ds );
- }
+ if (tclWinProcs->getUserName((LPTSTR)szUserName, &cchUserNameLen) != 0) {
+ int cbUserNameLen = cchUserNameLen - 1;
+ if (tclWinProcs->useWide) cbUserNameLen *= sizeof(WCHAR);
+ Tcl_WinTCharToUtf((LPTSTR)szUserName, cbUserNameLen, &ds);
+ }
}
Tcl_SetVar2(interp, "tcl_platform", "user", Tcl_DStringValue(&ds),
TCL_GLOBAL_ONLY);
@@ -731,15 +593,14 @@ TclpSetVariables(interp)
*
* TclpFindVariable --
*
- * Locate the entry in environ for a given name. On Unix this
- * routine is case sensetive, on Windows this matches mioxed case.
+ * Locate the entry in environ for a given name. On Unix this routine is
+ * case sensitive, on Windows this matches mioxed case.
*
* Results:
- * The return value is the index in environ of an entry with the
- * name "name", or -1 if there is no such entry. The integer at
- * *lengthPtr is filled in with the length of name (if a matching
- * entry is found) or the length of the environ array (if no matching
- * entry is found).
+ * The return value is the index in environ of an entry with the name
+ * "name", or -1 if there is no such entry. The integer at *lengthPtr is
+ * filled in with the length of name (if a matching entry is found) or
+ * the length of the environ array (if no matching entry is found).
*
* Side effects:
* None.
@@ -748,10 +609,10 @@ TclpSetVariables(interp)
*/
int
-TclpFindVariable(name, lengthPtr)
- CONST char *name; /* Name of desired environment variable
+TclpFindVariable(
+ CONST char *name, /* Name of desired environment variable
* (UTF-8). */
- int *lengthPtr; /* Used to return length of name (for
+ int *lengthPtr) /* Used to return length of name (for
* successful searches) or number of non-NULL
* entries in environ (for unsuccessful
* searches). */
@@ -762,23 +623,22 @@ TclpFindVariable(name, lengthPtr)
Tcl_DString envString;
/*
- * Convert the name to all upper case for the case insensitive
- * comparison.
+ * Convert the name to all upper case for the case insensitive comparison.
*/
length = strlen(name);
nameUpper = (char *) ckalloc((unsigned) length+1);
- memcpy((VOID *) nameUpper, (VOID *) name, (size_t) length+1);
+ memcpy(nameUpper, name, (size_t) length+1);
Tcl_UtfToUpper(nameUpper);
-
+
Tcl_DStringInit(&envString);
for (i = 0, env = environ[i]; env != NULL; i++, env = environ[i]) {
/*
- * Chop the env string off after the equal sign, then Convert
- * the name to all upper case, so we do not have to convert
- * all the characters after the equal sign.
+ * Chop the env string off after the equal sign, then Convert the name
+ * to all upper case, so we do not have to convert all the characters
+ * after the equal sign.
*/
-
+
envUpper = Tcl_ExternalToUtfDString(NULL, env, -1, &envString);
p1 = strchr(envUpper, '=');
if (p1 == NULL) {
@@ -798,117 +658,22 @@ TclpFindVariable(name, lengthPtr)
result = i;
goto done;
}
-
+
Tcl_DStringFree(&envString);
}
-
+
*lengthPtr = i;
- done:
+ done:
Tcl_DStringFree(&envString);
ckfree(nameUpper);
return result;
}
/*
- *----------------------------------------------------------------------
- *
- * Tcl_Init --
- *
- * This procedure is typically invoked by Tcl_AppInit procedures
- * to perform additional initialization for a Tcl interpreter,
- * such as sourcing the "init.tcl" script.
- *
- * Results:
- * Returns a standard Tcl completion code and sets the interp's
- * result if there is an error.
- *
- * Side effects:
- * Depends on what's in the init.tcl script.
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_Init(interp)
- Tcl_Interp *interp; /* Interpreter to initialize. */
-{
- Tcl_Obj *pathPtr;
-
- if (tclPreInitScript != NULL) {
- if (Tcl_Eval(interp, tclPreInitScript) == TCL_ERROR) {
- return (TCL_ERROR);
- };
- }
-
- pathPtr = TclGetLibraryPath();
- if (pathPtr == NULL) {
- pathPtr = Tcl_NewObj();
- }
- Tcl_IncrRefCount(pathPtr);
- Tcl_SetVar2Ex(interp, "tcl_libPath", NULL, pathPtr, TCL_GLOBAL_ONLY);
- Tcl_DecrRefCount(pathPtr);
- return Tcl_Eval(interp, initScript);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_SourceRCFile --
- *
- * This procedure is typically invoked by Tcl_Main of Tk_Main
- * procedure to source an application specific rc file into the
- * interpreter at startup time.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Depends on what's in the rc script.
- *
- *----------------------------------------------------------------------
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
*/
-
-void
-Tcl_SourceRCFile(interp)
- Tcl_Interp *interp; /* Interpreter to source rc file into. */
-{
- Tcl_DString temp;
- CONST char *fileName;
- Tcl_Channel errChannel;
-
- fileName = Tcl_GetVar(interp, "tcl_rcFileName", TCL_GLOBAL_ONLY);
-
- if (fileName != NULL) {
- Tcl_Channel c;
- CONST char *fullName;
-
- Tcl_DStringInit(&temp);
- fullName = Tcl_TranslateFileName(interp, fileName, &temp);
- if (fullName == NULL) {
- /*
- * Couldn't translate the file name (e.g. it referred to a
- * bogus user or there was no HOME environment variable).
- * Just do nothing.
- */
- } else {
-
- /*
- * Test for the existence of the rc file before trying to read it.
- */
-
- c = Tcl_OpenFileChannel(NULL, fullName, "r", 0);
- if (c != (Tcl_Channel) NULL) {
- Tcl_Close(NULL, c);
- if (Tcl_EvalFile(interp, fullName) != TCL_OK) {
- errChannel = Tcl_GetStdChannel(TCL_STDERR);
- if (errChannel) {
- Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
- Tcl_WriteChars(errChannel, "\n", 1);
- }
- }
- }
- }
- Tcl_DStringFree(&temp);
- }
-}
diff --git a/win/tclWinInt.h b/win/tclWinInt.h
index 2e80afa..a76865d 100644
--- a/win/tclWinInt.h
+++ b/win/tclWinInt.h
@@ -12,12 +12,7 @@
#ifndef _TCLWININT
#define _TCLWININT
-#ifndef _TCLINT
#include "tclInt.h"
-#endif
-#ifndef _TCLPORT
-#include "tclPort.h"
-#endif
/*
* The following specifies how much stack space TclpCheckStackSpace()
@@ -27,11 +22,6 @@
#define TCL_WIN_STACK_THRESHOLD 0x8000
-#ifdef BUILD_tcl
-# undef TCL_STORAGE_CLASS
-# define TCL_STORAGE_CLASS DLLEXPORT
-#endif
-
/*
* Some versions of Borland C have a define for the OSVERSIONINFO for
* Win32s and for NT, but not for Windows 95.
@@ -83,7 +73,7 @@ typedef struct TclWinProcs {
DWORD (WINAPI *getTempPathProc)(DWORD, WCHAR *);
BOOL (WINAPI *getVolumeInformationProc)(CONST TCHAR *, WCHAR *, DWORD,
LPDWORD, LPDWORD, LPDWORD, WCHAR *, DWORD);
- HINSTANCE (WINAPI *loadLibraryExProc)(const TCHAR *, HANDLE, 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 *);
@@ -103,13 +93,12 @@ typedef struct TclWinProcs {
BOOL (WINAPI *createHardLinkProc)(CONST TCHAR*, CONST TCHAR*,
LPSECURITY_ATTRIBUTES);
- INT (__cdecl *utimeProc)(CONST TCHAR*, struct _utimbuf *);
+ /* 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
@@ -136,42 +125,57 @@ typedef struct TclWinProcs {
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);
+ /*
+ * 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;
-EXTERN TclWinProcs *tclWinProcs;
+MODULE_SCOPE TclWinProcs *tclWinProcs;
/*
* Declarations of functions that are not accessible by way of the
* stubs table.
*/
-EXTERN void TclWinEncodingsCleanup();
-EXTERN void TclWinResetInterfaceEncodings();
-EXTERN void TclWinInit(HINSTANCE hInst);
-EXTERN int TclWinSymLinkCopyDirectory(CONST TCHAR* LinkOriginal,
- CONST TCHAR* LinkCopy);
-EXTERN int TclWinSymLinkDelete(CONST TCHAR* LinkOriginal,
- int linkOnly);
-EXTERN char TclWinDriveLetterForVolMountPoint(CONST WCHAR *mountPoint);
+MODULE_SCOPE char TclWinDriveLetterForVolMountPoint(
+ CONST WCHAR *mountPoint);
+MODULE_SCOPE void TclWinEncodingsCleanup();
+MODULE_SCOPE void TclWinInit(HINSTANCE hInst);
+MODULE_SCOPE TclFile TclWinMakeFile(HANDLE handle);
+MODULE_SCOPE Tcl_Channel TclWinOpenConsoleChannel(HANDLE handle,
+ char *channelName, int permissions);
+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,
+ DWORD access);
+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)
-EXTERN void TclWinFreeAllocCache(void);
-EXTERN void TclFreeAllocCache(void *);
-EXTERN Tcl_Mutex *TclpNewAllocMutex(void);
-EXTERN void *TclpGetAllocCache(void);
-EXTERN void TclpSetAllocCache(void *);
+MODULE_SCOPE void TclWinFreeAllocCache(void);
+MODULE_SCOPE void TclFreeAllocCache(void *);
+MODULE_SCOPE Tcl_Mutex *TclpNewAllocMutex(void);
+MODULE_SCOPE void * TclpGetAllocCache(void);
+MODULE_SCOPE void TclpSetAllocCache(void *);
#endif /* TCL_THREADS */
/* Needed by tclWinFile.c and tclWinFCmd.c */
@@ -179,9 +183,4 @@ EXTERN void TclpSetAllocCache(void *);
#define FILE_ATTRIBUTE_REPARSE_POINT 0x00000400
#endif
-#include "tclIntPlatDecls.h"
-
-# undef TCL_STORAGE_CLASS
-# define TCL_STORAGE_CLASS DLLIMPORT
-
#endif /* _TCLWININT */
diff --git a/win/tclWinLoad.c b/win/tclWinLoad.c
index 09ade9b..c4d08e8 100644
--- a/win/tclWinLoad.c
+++ b/win/tclWinLoad.c
@@ -1,14 +1,14 @@
-/*
+/*
* tclWinLoad.c --
*
- * This procedure provides a version of the TclLoadFile that
- * works with the Windows "LoadLibrary" and "GetProcAddress"
- * API for dynamic loading.
+ * This function provides a version of the TclLoadFile that works with
+ * the Windows "LoadLibrary" and "GetProcAddress" API for dynamic
+ * loading.
*
* Copyright (c) 1995-1997 Sun Microsystems, Inc.
*
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#include "tclWinInt.h"
@@ -19,12 +19,12 @@
*
* TclpDlopen --
*
- * Dynamically loads a binary code file into memory and returns
- * a handle to the new code.
+ * Dynamically loads a binary code file into memory and returns a handle
+ * to the new code.
*
* Results:
- * A standard Tcl completion code. If an error occurs, an error
- * message is left in the interp's result.
+ * A standard Tcl completion code. If an error occurs, an error message
+ * is left in the interp's result.
*
* Side effects:
* New code suddenly appears in memory.
@@ -33,92 +33,100 @@
*/
int
-TclpDlopen(interp, pathPtr, loadHandle, unloadProcPtr)
- Tcl_Interp *interp; /* Used for error reporting. */
- Tcl_Obj *pathPtr; /* Name of the file containing the desired
+TclpDlopen(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ Tcl_Obj *pathPtr, /* Name of the file containing the desired
* code (UTF-8). */
- Tcl_LoadHandle *loadHandle; /* Filled with token for dynamically loaded
- * file which will be passed back to
+ Tcl_LoadHandle *loadHandle, /* Filled with token for dynamically loaded
+ * file which will be passed back to
* (*unloadProcPtr)() to unload the file. */
- Tcl_FSUnloadFileProc **unloadProcPtr;
+ Tcl_FSUnloadFileProc **unloadProcPtr)
/* Filled with address of Tcl_FSUnloadFileProc
- * function which should be used for
- * this file. */
+ * function which should be used for this
+ * file. */
{
HINSTANCE handle;
CONST TCHAR *nativeName;
- /*
- * First try the full path the user gave us. This is particularly
- * important if the cwd is inside a vfs, and we are trying to load
- * using a relative path.
+ /*
+ * First try the full path the user gave us. This is particularly
+ * important if the cwd is inside a vfs, and we are trying to load using a
+ * relative path.
*/
+
nativeName = Tcl_FSGetNativePath(pathPtr);
handle = (*tclWinProcs->loadLibraryExProc)(nativeName, NULL,
- LOAD_WITH_ALTERED_SEARCH_PATH);
+ LOAD_WITH_ALTERED_SEARCH_PATH);
if (handle == NULL) {
- /*
- * Let the OS loader examine the binary search path for
- * whatever string the user gave us which hopefully refers
- * to a file on the binary path
+ /*
+ * Let the OS loader examine the binary search path for whatever
+ * string the user gave us which hopefully refers to a file on the
+ * binary path.
*/
+
Tcl_DString ds;
- char *fileName = Tcl_GetString(pathPtr);
+ char *fileName = Tcl_GetString(pathPtr);
+
nativeName = Tcl_WinUtfToTChar(fileName, -1, &ds);
handle = (*tclWinProcs->loadLibraryExProc)(nativeName, NULL,
- LOAD_WITH_ALTERED_SEARCH_PATH);
+ LOAD_WITH_ALTERED_SEARCH_PATH);
Tcl_DStringFree(&ds);
}
*loadHandle = (Tcl_LoadHandle) handle;
-
+
if (handle == NULL) {
DWORD lastError = GetLastError();
+
#if 0
/*
- * It would be ideal if the FormatMessage stuff worked better,
- * but unfortunately it doesn't seem to want to...
+ * It would be ideal if the FormatMessage stuff worked better, but
+ * unfortunately it doesn't seem to want to...
*/
+
LPTSTR lpMsgBuf;
char *buf;
int size;
+
size = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM |
FORMAT_MESSAGE_ALLOCATE_BUFFER, NULL, lastError, 0,
(LPTSTR) &lpMsgBuf, 0, NULL);
buf = (char *) ckalloc((unsigned) TCL_INTEGER_SPACE + size + 1);
sprintf(buf, "%d %s", lastError, (char *)lpMsgBuf);
#endif
+
Tcl_AppendResult(interp, "couldn't load library \"",
- Tcl_GetString(pathPtr), "\": ", (char *) NULL);
+ Tcl_GetString(pathPtr), "\": ", NULL);
+
/*
- * Check for possible DLL errors. This doesn't work quite right,
- * because Windows seems to only return ERROR_MOD_NOT_FOUND for
- * just about any problem, but it's better than nothing. It'd be
- * even better if there was a way to get what DLLs
+ * Check for possible DLL errors. This doesn't work quite right,
+ * because Windows seems to only return ERROR_MOD_NOT_FOUND for just
+ * about any problem, but it's better than nothing. It'd be even
+ * better if there was a way to get what DLLs
*/
+
switch (lastError) {
- case ERROR_MOD_NOT_FOUND:
- case ERROR_DLL_NOT_FOUND:
- Tcl_AppendResult(interp, "this library or a dependent library",
- " could not be found in library path",
- (char *) NULL);
- break;
- case ERROR_PROC_NOT_FOUND:
- Tcl_AppendResult(interp, "could not find specified procedure",
- (char *) NULL);
- break;
- case ERROR_INVALID_DLL:
- Tcl_AppendResult(interp, "this library or a dependent library",
- " is damaged", (char *) NULL);
- break;
- case ERROR_DLL_INIT_FAILED:
- Tcl_AppendResult(interp, "the library initialization",
- " routine failed", (char *) NULL);
- break;
- default:
- TclWinConvertError(lastError);
- Tcl_AppendResult(interp, Tcl_PosixError(interp),
- (char *) NULL);
+ case ERROR_MOD_NOT_FOUND:
+ case ERROR_DLL_NOT_FOUND:
+ Tcl_AppendResult(interp, "this library or a dependent library"
+ " could not be found in library path", NULL);
+ break;
+ case ERROR_PROC_NOT_FOUND:
+ Tcl_AppendResult(interp, "A function specified in the import"
+ " table could not be resolved by the system. Windows"
+ " is not telling which one, I'm sorry.", NULL);
+ break;
+ case ERROR_INVALID_DLL:
+ Tcl_AppendResult(interp, "this library or a dependent library"
+ " is damaged", NULL);
+ break;
+ case ERROR_DLL_INIT_FAILED:
+ Tcl_AppendResult(interp, "the library initialization"
+ " routine failed", NULL);
+ break;
+ default:
+ TclWinConvertError(lastError);
+ Tcl_AppendResult(interp, Tcl_PosixError(interp), NULL);
}
return TCL_ERROR;
} else {
@@ -132,21 +140,22 @@ TclpDlopen(interp, pathPtr, loadHandle, unloadProcPtr)
*
* TclpFindSymbol --
*
- * Looks up a symbol, by name, through a handle associated with
- * a previously loaded piece of code (shared library).
+ * Looks up a symbol, by name, through a handle associated with a
+ * previously loaded piece of code (shared library).
*
* Results:
- * Returns a pointer to the function associated with 'symbol' if
- * it is found. Otherwise returns NULL and may leave an error
- * message in the interp's result.
+ * Returns a pointer to the function associated with 'symbol' if it is
+ * found. Otherwise returns NULL and may leave an error message in the
+ * interp's result.
*
*----------------------------------------------------------------------
*/
-Tcl_PackageInitProc*
-TclpFindSymbol(interp, loadHandle, symbol)
- Tcl_Interp *interp;
- Tcl_LoadHandle loadHandle;
- CONST char *symbol;
+
+Tcl_PackageInitProc *
+TclpFindSymbol(
+ Tcl_Interp *interp,
+ Tcl_LoadHandle loadHandle,
+ CONST char *symbol)
{
Tcl_PackageInitProc *proc = NULL;
HINSTANCE handle = (HINSTANCE)loadHandle;
@@ -159,6 +168,7 @@ TclpFindSymbol(interp, loadHandle, symbol)
proc = (Tcl_PackageInitProc *) GetProcAddress(handle, symbol);
if (proc == NULL) {
Tcl_DString ds;
+
Tcl_DStringInit(&ds);
Tcl_DStringAppend(&ds, "_", 1);
symbol = Tcl_DStringAppend(&ds, symbol, -1);
@@ -173,9 +183,9 @@ TclpFindSymbol(interp, loadHandle, symbol)
*
* TclpUnloadFile --
*
- * Unloads a dynamically loaded binary code file from memory.
- * Code pointers in the formerly loaded file are no longer valid
- * after calling this function.
+ * Unloads a dynamically loaded binary code file from memory. Code
+ * pointers in the formerly loaded file are no longer valid after calling
+ * this function.
*
* Results:
* None.
@@ -187,11 +197,10 @@ TclpFindSymbol(interp, loadHandle, symbol)
*/
void
-TclpUnloadFile(loadHandle)
- Tcl_LoadHandle loadHandle; /* loadHandle returned by a previous call
- * to TclpDlopen(). The loadHandle is
- * a token that represents the loaded
- * file. */
+TclpUnloadFile(
+ Tcl_LoadHandle loadHandle) /* loadHandle returned by a previous call to
+ * TclpDlopen(). The loadHandle is a token
+ * that represents the loaded file. */
{
HINSTANCE handle;
@@ -204,14 +213,14 @@ TclpUnloadFile(loadHandle)
*
* TclGuessPackageName --
*
- * If the "load" command is invoked without providing a package
- * name, this procedure is invoked to try to figure it out.
+ * If the "load" command is invoked without providing a package name,
+ * this function is invoked to try to figure it out.
*
* Results:
- * Always returns 0 to indicate that we couldn't figure out a
- * package name; generic code will then try to guess the package
- * from the file name. A return value of 1 would have meant that
- * we figured out the package name and put it in bufPtr.
+ * Always returns 0 to indicate that we couldn't figure out a package
+ * name; generic code will then try to guess the package from the file
+ * name. A return value of 1 would have meant that we figured out the
+ * package name and put it in bufPtr.
*
* Side effects:
* None.
@@ -220,11 +229,19 @@ TclpUnloadFile(loadHandle)
*/
int
-TclGuessPackageName(fileName, bufPtr)
- CONST char *fileName; /* Name of file containing package (already
+TclGuessPackageName(
+ 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. */
+ Tcl_DString *bufPtr) /* Initialized empty dstring. Append package
+ * name to this if possible. */
{
return 0;
}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/win/tclWinMtherr.c b/win/tclWinMtherr.c
deleted file mode 100644
index 269a363..0000000
--- a/win/tclWinMtherr.c
+++ /dev/null
@@ -1,55 +0,0 @@
-/*
- * tclWinMtherr.c --
- *
- * This function provides a default implementation of the
- * _matherr function for Borland C++.
- *
- * Copyright (c) 1995 Sun Microsystems, Inc.
- *
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
- */
-
-#include "tclWinInt.h"
-#include <math.h>
-
-
-#ifndef __MINGW32__
-/*
- *----------------------------------------------------------------------
- *
- * _matherr --
- *
- * This procedure is invoked by Borland C++ when certain
- * errors occur in mathematical functions. This procedure
- * replaces the default implementation which generates pop-up
- * warnings.
- *
- * Results:
- * Returns 1 to indicate that we've handled the error
- * locally.
- *
- * Side effects:
- * Sets errno based on what's in xPtr.
- *
- *----------------------------------------------------------------------
- */
-
-int
-_matherr(xPtr)
- struct exception *xPtr; /* Describes error that occurred. */
-{
- if ((xPtr->type == DOMAIN)
-#ifdef __BORLANDC__
- || (xPtr->type == TLOSS)
-#endif
- || (xPtr->type == SING)) {
- errno = EDOM;
- } else {
- errno = ERANGE;
- }
- return 1;
-}
-
-#endif /* !__MINGW__ */
-
diff --git a/win/tclWinNotify.c b/win/tclWinNotify.c
index 3ac1c6c..1cd5823 100644
--- a/win/tclWinNotify.c
+++ b/win/tclWinNotify.c
@@ -1,30 +1,30 @@
-/*
+/*
* tclWinNotify.c --
*
- * This file contains Windows-specific procedures for the notifier,
- * which is the lowest-level part of the Tcl event loop. This file
- * works together with ../generic/tclNotify.c.
+ * This file contains Windows-specific procedures for the notifier, which
+ * is the lowest-level part of the Tcl event loop. This file works
+ * together with ../generic/tclNotify.c.
*
* Copyright (c) 1995-1997 Sun Microsystems, Inc.
*
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
-#include "tclWinInt.h"
+#include "tclInt.h"
/*
* The follwing static indicates whether this module has been initialized.
*/
-#define INTERVAL_TIMER 1 /* Handle of interval timer. */
+#define INTERVAL_TIMER 1 /* Handle of interval timer. */
-#define WM_WAKEUP WM_USER /* Message that is send by
+#define WM_WAKEUP WM_USER /* Message that is send by
* Tcl_AlertNotifier. */
/*
* The following static structure contains the state information for the
- * Windows implementation of the Tcl notifier. One of these structures
- * is created for each thread that is using the notifier.
+ * Windows implementation of the Tcl notifier. One of these structures is
+ * created for each thread that is using the notifier.
*/
typedef struct ThreadSpecificData {
@@ -33,8 +33,8 @@ typedef struct ThreadSpecificData {
* notifier. */
HANDLE event; /* Event object used to wake up the notifier
* thread. */
- int pending; /* Alert message pending, this field is
- * locked by the notifierMutex. */
+ int pending; /* Alert message pending, this field is locked
+ * by the notifierMutex. */
HWND hwnd; /* Messaging window. */
int timeout; /* Current timeout value. */
int timerActive; /* 1 if interval timer is running. */
@@ -46,9 +46,8 @@ 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.
+ * The following static indicates the number of threads that have initialized
+ * notifiers. It controls the lifetime of the TclNotifier window class.
*
* You must hold the notifierMutex lock before accessing this variable.
*/
@@ -60,9 +59,8 @@ TCL_DECLARE_MUTEX(notifierMutex)
* Static routines defined in this file.
*/
-static LRESULT CALLBACK NotifierProc(HWND hwnd, UINT message,
- WPARAM wParam, LPARAM lParam);
-
+static LRESULT CALLBACK NotifierProc(HWND hwnd, UINT message,
+ WPARAM wParam, LPARAM lParam);
/*
*----------------------------------------------------------------------
@@ -81,14 +79,14 @@ static LRESULT CALLBACK NotifierProc(HWND hwnd, UINT message,
*/
ClientData
-Tcl_InitNotifier()
+Tcl_InitNotifier(void)
{
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);
@@ -105,7 +103,7 @@ Tcl_InitNotifier()
class.hCursor = NULL;
if (!RegisterClassA(&class)) {
- panic("Unable to register TclNotifier window class");
+ Tcl_Panic("Unable to register TclNotifier window class");
}
}
notifierCount++;
@@ -129,8 +127,8 @@ Tcl_InitNotifier()
*
* Tcl_FinalizeNotifier --
*
- * This function is called to cleanup the notifier state before
- * a thread is terminated.
+ * This function is called to cleanup the notifier state before a thread
+ * is terminated.
*
* Results:
* None.
@@ -142,21 +140,22 @@ Tcl_InitNotifier()
*/
void
-Tcl_FinalizeNotifier(clientData)
- ClientData clientData; /* Pointer to notifier data. */
+Tcl_FinalizeNotifier(
+ ClientData clientData) /* Pointer to notifier data. */
{
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.
+ * 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;
}
@@ -174,8 +173,8 @@ Tcl_FinalizeNotifier(clientData)
}
/*
- * 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);
@@ -191,34 +190,33 @@ Tcl_FinalizeNotifier(clientData)
*
* Tcl_AlertNotifier --
*
- * Wake up the specified notifier from any thread. This routine
- * is called by the platform independent notifier code whenever
- * the Tcl_ThreadAlert routine is called. This routine is
- * guaranteed not to be called on a given notifier after
- * Tcl_FinalizeNotifier is called for that notifier. This routine
- * is typically called from a thread other than the notifier's
- * thread.
+ * Wake up the specified notifier from any thread. This routine is called
+ * by the platform independent notifier code whenever the Tcl_ThreadAlert
+ * routine is called. This routine is guaranteed not to be called on a
+ * given notifier after Tcl_FinalizeNotifier is called for that notifier.
+ * This routine is typically called from a thread other than the
+ * notifier's thread.
*
* Results:
* None.
*
* Side effects:
- * Sends a message to the messaging window for the notifier
- * if there isn't already one pending.
+ * Sends a message to the messaging window for the notifier if there
+ * isn't already one pending.
*
*----------------------------------------------------------------------
*/
void
-Tcl_AlertNotifier(clientData)
- ClientData clientData; /* Pointer to thread data. */
+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.
+ * Note that we do not need to lock around access to the hwnd because the
+ * race condition has no effect since any race condition implies that the
+ * notifier thread is already awake.
*/
if (tsdPtr->hwnd) {
@@ -242,9 +240,9 @@ Tcl_AlertNotifier(clientData)
*
* Tcl_SetTimer --
*
- * This procedure sets the current notifier timer value. The
- * notifier will ensure that Tcl_ServiceAll() is called after
- * the specified interval, even if no events have occurred.
+ * This procedure sets the current notifier timer value. The notifier
+ * will ensure that Tcl_ServiceAll() is called after the specified
+ * interval, even if no events have occurred.
*
* Results:
* None.
@@ -263,8 +261,8 @@ Tcl_SetTimer(
UINT timeout;
/*
- * Allow the notifier to be hooked. This may not make sense
- * on Windows, but mirrors the UNIX hook.
+ * Allow the notifier to be hooked. This may not make sense on Windows,
+ * but mirrors the UNIX hook.
*/
if (tclStubs.tcl_SetTimer != tclOriginalNotifier.setTimerProc) {
@@ -273,10 +271,9 @@ Tcl_SetTimer(
}
/*
- * We only need to set up an interval timer if we're being called
- * from an external event loop. If we don't have a window handle
- * then we just return immediately and let Tcl_WaitForEvent handle
- * timeouts.
+ * We only need to set up an interval timer if we're being called from an
+ * external event loop. If we don't have a window handle then we just
+ * return immediately and let Tcl_WaitForEvent handle timeouts.
*/
if (!tsdPtr->hwnd) {
@@ -299,8 +296,8 @@ Tcl_SetTimer(
tsdPtr->timeout = timeout;
if (timeout != 0) {
tsdPtr->timerActive = 1;
- SetTimer(tsdPtr->hwnd, INTERVAL_TIMER,
- (unsigned long) tsdPtr->timeout, NULL);
+ SetTimer(tsdPtr->hwnd, INTERVAL_TIMER, (unsigned long) tsdPtr->timeout,
+ NULL);
} else {
tsdPtr->timerActive = 0;
KillTimer(tsdPtr->hwnd, INTERVAL_TIMER);
@@ -318,37 +315,37 @@ Tcl_SetTimer(
* None.
*
* Side effects:
- * If this is the first time the notifier is set into
- * TCL_SERVICE_ALL, then the communication window is created.
+ * If this is the first time the notifier is set into TCL_SERVICE_ALL,
+ * then the communication window is created.
*
*----------------------------------------------------------------------
*/
void
-Tcl_ServiceModeHook(mode)
- int mode; /* Either TCL_SERVICE_ALL, or
+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 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);
+
/*
* 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.
+ * 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((ClientData)tsdPtr);
@@ -360,10 +357,9 @@ Tcl_ServiceModeHook(mode)
*
* NotifierProc --
*
- * This procedure is invoked by Windows to process events on
- * the notifier window. Messages will be sent to this window
- * in response to external timer events or calls to
- * TclpAlertTsdPtr->
+ * This procedure is invoked by Windows to process events on the notifier
+ * window. Messages will be sent to this window in response to external
+ * timer events or calls to TclpAlertTsdPtr->
*
* Results:
* A standard windows result.
@@ -376,10 +372,10 @@ Tcl_ServiceModeHook(mode)
static LRESULT CALLBACK
NotifierProc(
- HWND hwnd,
- UINT message,
- WPARAM wParam,
- LPARAM lParam)
+ HWND hwnd, /* Passed on... */
+ UINT message, /* What messsage is this? */
+ WPARAM wParam, /* Passed on... */
+ LPARAM lParam) /* Passed on... */
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -390,7 +386,7 @@ NotifierProc(
} else if (message != WM_TIMER) {
return DefWindowProc(hwnd, message, wParam, lParam);
}
-
+
/*
* Process all of the runnable events.
*/
@@ -404,17 +400,16 @@ NotifierProc(
*
* Tcl_WaitForEvent --
*
- * This function is called by Tcl_DoOneEvent to wait for new
- * events on the message queue. If the block time is 0, then
- * Tcl_WaitForEvent just polls the event queue without blocking.
+ * This function is called by Tcl_DoOneEvent to wait for new events on
+ * the message queue. If the block time is 0, then Tcl_WaitForEvent just
+ * polls the event queue without blocking.
*
* Results:
- * Returns -1 if a WM_QUIT message is detected, returns 1 if
- * a message was dispatched, otherwise returns 0.
+ * Returns -1 if a WM_QUIT message is detected, returns 1 if a message
+ * was dispatched, otherwise returns 0.
*
* Side effects:
- * Dispatches a message to a window procedure, which could do
- * anything.
+ * Dispatches a message to a window procedure, which could do anything.
*
*----------------------------------------------------------------------
*/
@@ -429,8 +424,8 @@ Tcl_WaitForEvent(
int status;
/*
- * Allow the notifier to be hooked. This may not make
- * sense on windows, but mirrors the UNIX hook.
+ * Allow the notifier to be hooked. This may not make sense on windows,
+ * but mirrors the UNIX hook.
*/
if (tclStubs.tcl_WaitForEvent != tclOriginalNotifier.waitForEventProc) {
@@ -442,7 +437,21 @@ Tcl_WaitForEvent(
*/
if (timePtr) {
- timeout = timePtr->sec * 1000 + timePtr->usec / 1000;
+ /*
+ * TIP #233 (Virtualized Time). Convert virtual domain delay to
+ * real-time.
+ */
+
+ Tcl_Time myTime;
+
+ myTime.sec = timePtr->sec;
+ myTime.usec = timePtr->usec;
+
+ if (myTime.sec != 0 || myTime.usec != 0) {
+ (*tclScaleTimeProcPtr) (&myTime, tclTimeClientData);
+ }
+
+ timeout = myTime.sec * 1000 + myTime.usec / 1000;
} else {
timeout = INFINITE;
}
@@ -456,11 +465,19 @@ Tcl_WaitForEvent(
if (!PeekMessage(&msg, NULL, 0, 0, PM_NOREMOVE)) {
/*
* Wait for something to happen (a signal from another thread, a
- * message, or timeout).
+ * message, or timeout) or loop servicing asynchronous procedure calls
+ * queued to this thread.
*/
- result = MsgWaitForMultipleObjects(1, &tsdPtr->event, FALSE, timeout,
- QS_ALLINPUT);
+ 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;
+ }
}
/*
@@ -483,7 +500,7 @@ Tcl_WaitForEvent(
status = -1;
} else if (result == (DWORD)-1) {
/*
- * We got an error from the system. I have no idea why this would
+ * We got an error from the system. I have no idea why this would
* happen, so we'll just unwind.
*/
@@ -497,6 +514,7 @@ Tcl_WaitForEvent(
status = 0;
}
+ end:
ResetEvent(tsdPtr->event);
return status;
}
@@ -518,42 +536,64 @@ Tcl_WaitForEvent(
*/
void
-Tcl_Sleep(ms)
- int ms; /* Number of milliseconds to sleep. */
+Tcl_Sleep(
+ int ms) /* Number of milliseconds to sleep. */
{
/*
- * Simply calling 'Sleep' for the requisite number of milliseconds
- * can make the process appear to wake up early because it isn't
- * synchronized with the CPU performance counter that is used in
- * tclWinTime.c. This behavior is probably benign, but messes
- * up some of the corner cases in the test suite. We get around
- * this problem by repeating the 'Sleep' call as many times
- * as necessary to make the clock advance by the requisite amount.
+ * Simply calling 'Sleep' for the requisite number of milliseconds can
+ * make the process appear to wake up early because it isn't synchronized
+ * with the CPU performance counter that is used in tclWinTime.c. This
+ * behavior is probably benign, but messes up some of the corner cases in
+ * the test suite. We get around this problem by repeating the 'Sleep'
+ * call as many times as necessary to make the clock advance by the
+ * requisite amount.
*/
- Tcl_Time now; /* Current wall clock time */
- Tcl_Time desired; /* Desired wakeup time */
- DWORD sleepTime = ms; /* Time to sleep */
+ Tcl_Time now; /* Current wall clock time. */
+ Tcl_Time desired; /* Desired wakeup time. */
+ Tcl_Time vdelay; /* Time to sleep, for scaling virtual ->
+ * real. */
+ DWORD sleepTime; /* Time to sleep, real-time */
+
+ vdelay.sec = ms / 1000;
+ vdelay.usec = (ms % 1000) * 1000;
- Tcl_GetTime( &now );
- desired.sec = now.sec + ( ms / 1000 );
- desired.usec = now.usec + 1000 * ( ms % 1000 );
- if ( desired.usec > 1000000 ) {
+ Tcl_GetTime(&now);
+ desired.sec = now.sec + vdelay.sec;
+ desired.usec = now.usec + vdelay.usec;
+ if (desired.usec > 1000000) {
++desired.sec;
desired.usec -= 1000000;
}
-
- for ( ; ; ) {
- Sleep( sleepTime );
- Tcl_GetTime( &now );
- if ( now.sec > desired.sec ) {
+
+ /*
+ * TIP #233: Scale delay from virtual to real-time.
+ */
+
+ (*tclScaleTimeProcPtr) (&vdelay, tclTimeClientData);
+ sleepTime = vdelay.sec * 1000 + vdelay.usec / 1000;
+
+ for (;;) {
+ Sleep(sleepTime);
+ Tcl_GetTime(&now);
+ if (now.sec > desired.sec) {
break;
- } else if ( ( now.sec == desired.sec )
- && ( now.usec >= desired.usec ) ) {
+ } else if ((now.sec == desired.sec) && (now.usec >= desired.usec)) {
break;
}
- sleepTime = ( ( 1000 * ( desired.sec - now.sec ) )
- + ( ( desired.usec - now.usec ) / 1000 ) );
- }
+ vdelay.sec = desired.sec - now.sec;
+ vdelay.usec = desired.usec - now.usec;
+
+ (*tclScaleTimeProcPtr) (&vdelay, tclTimeClientData);
+ sleepTime = vdelay.sec * 1000 + vdelay.usec / 1000;
+ }
}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c
index 4c530e3..b1affe3 100644
--- a/win/tclWinPipe.c
+++ b/win/tclWinPipe.c
@@ -1,19 +1,17 @@
-/*
+/*
* tclWinPipe.c --
*
- * This file implements the Windows-specific exec pipeline functions,
- * the "pipe" channel driver, and the "pid" Tcl command.
+ * This file implements the Windows-specific exec pipeline functions, the
+ * "pipe" channel driver, and the "pid" Tcl command.
*
* Copyright (c) 1996-1997 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.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#include "tclWinInt.h"
-#include <fcntl.h>
-#include <io.h>
#include <sys/stat.h>
/*
@@ -24,16 +22,16 @@
static int initialized = 0;
/*
- * The pipeMutex locks around access to the initialized and procList variables,
- * and it is used to protect background threads from being terminated while
- * they are using APIs that hold locks.
+ * The pipeMutex locks around access to the initialized and procList
+ * variables, and it is used to protect background threads from being
+ * terminated while they are using APIs that hold locks.
*/
TCL_DECLARE_MUTEX(pipeMutex)
/*
- * The following defines identify the various types of applications that
- * run under windows. There is special case code for the various types.
+ * The following defines identify the various types of applications that run
+ * under windows. There is special case code for the various types.
*/
#define APPL_NONE 0
@@ -42,16 +40,16 @@ TCL_DECLARE_MUTEX(pipeMutex)
#define APPL_WIN32 3
/*
- * The following constants and structures are used to encapsulate the state
- * of various types of files used in a pipeline.
- * This used to have a 1 && 2 that supported Win32s.
+ * The following constants and structures are used to encapsulate the state of
+ * various types of files used in a pipeline. This used to have a 1 && 2 that
+ * supported Win32s.
*/
-#define WIN_FILE 3 /* Basic Win32 file. */
+#define WIN_FILE 3 /* Basic Win32 file. */
/*
- * This structure encapsulates the common state associated with all file
- * types used in a pipeline.
+ * This structure encapsulates the common state associated with all file types
+ * used in a pipeline.
*/
typedef struct WinFile {
@@ -110,66 +108,64 @@ typedef struct PipeInfo {
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. */
+ * 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 pipe. */
+ * signal when the writer thread should
+ * attempt to write to the pipe. */
HANDLE stopWriter; /* Manual-reset event used to alert the reader
* thread to fall-out and exit */
HANDLE startReader; /* Auto-reset event used by the main thread to
- * signal when the reader thread should attempt
- * to read from the pipe. */
+ * signal when the reader thread should
+ * attempt to read from the pipe. */
HANDLE stopReader; /* Manual-reset event used to alert the reader
* thread to fall-out and exit */
DWORD writeError; /* An error caused by the last background
- * write. Set to 0 if no error has been
- * detected. This word is shared with the
+ * write. Set to 0 if no error has been
+ * detected. This word is shared with the
* writer thread so access must be
* synchronized with the writable object.
*/
- char *writeBuf; /* Current background output buffer.
- * Access is synchronized with the writable
- * object. */
- int writeBufLen; /* Size of write buffer. Access is
- * synchronized with the writable
- * object. */
- int toWrite; /* Current amount to be written. Access is
+ char *writeBuf; /* Current background output buffer. Access is
+ * synchronized with the writable object. */
+ int writeBufLen; /* Size of write buffer. Access is
+ * synchronized with the writable object. */
+ int toWrite; /* Current amount to be written. Access is
* synchronized with the writable object. */
int readFlags; /* Flags that are shared with the reader
- * thread. Access is synchronized with the
+ * thread. Access is synchronized with the
* readable object. */
char extraByte; /* Buffer for extra character consumed by
- * reader thread. This byte is shared with
- * the reader thread so access must be
+ * reader thread. This byte is shared with the
+ * reader thread so access must be
* synchronized with the readable object. */
} PipeInfo;
typedef struct ThreadSpecificData {
/*
- * The following pointer refers to the head of the list of pipes
- * that are being watched for file events.
+ * The following pointer refers to the head of the list of pipes that are
+ * being watched for file events.
*/
-
+
PipeInfo *firstPipePtr;
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;
/*
- * The following structure is what is added to the Tcl event queue when
- * pipe events are generated.
+ * The following structure is what is added to the Tcl event queue when pipe
+ * events are generated.
*/
typedef struct PipeEvent {
- Tcl_Event header; /* Information that is standard for
- * all events. */
- PipeInfo *infoPtr; /* Pointer to pipe info structure. Note
- * that we still have to verify that the
- * pipe exists before dereferencing this
+ Tcl_Event header; /* Information that is standard for all
+ * events. */
+ PipeInfo *infoPtr; /* Pointer to pipe info structure. Note that
+ * we still have to verify that the pipe
+ * exists before dereferencing this
* pointer. */
} PipeEvent;
@@ -179,8 +175,8 @@ typedef struct PipeEvent {
static int ApplicationType(Tcl_Interp *interp,
const char *fileName, char *fullName);
-static void BuildCommandLine(const char *executable, int argc,
- CONST char **argv, Tcl_DString *linePtr);
+static void BuildCommandLine(const char *executable, int argc,
+ const char **argv, Tcl_DString *linePtr);
static BOOL HasConsole(void);
static int PipeBlockModeProc(ClientData instanceData, int mode);
static void PipeCheckProc(ClientData clientData, int flags);
@@ -193,25 +189,24 @@ static void PipeInit(void);
static int PipeInputProc(ClientData instanceData, char *buf,
int toRead, int *errorCode);
static int PipeOutputProc(ClientData instanceData,
- CONST char *buf, int toWrite, int *errorCode);
+ const char *buf, int toWrite, int *errorCode);
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 WaitForRead(PipeInfo *infoPtr, int blocking);
-
-static void PipeThreadActionProc _ANSI_ARGS_ ((
- ClientData instanceData, int action));
+static void PipeThreadActionProc(ClientData instanceData,
+ int action);
/*
- * This structure describes the channel type structure for command pipe
- * based IO.
+ * This structure describes the channel type structure for command pipe based
+ * I/O.
*/
static Tcl_ChannelType pipeChannelType = {
"pipe", /* Type name. */
- TCL_CHANNEL_VERSION_4, /* v4 channel */
+ TCL_CHANNEL_VERSION_5, /* v5 channel */
TCL_CLOSE2PROC, /* Close proc. */
PipeInputProc, /* Input proc. */
PipeOutputProc, /* Output proc. */
@@ -224,8 +219,9 @@ static Tcl_ChannelType pipeChannelType = {
PipeBlockModeProc, /* Set blocking or non-blocking mode.*/
NULL, /* flush proc. */
NULL, /* handler proc. */
- NULL, /* wide seek proc */
- PipeThreadActionProc, /* thread action proc */
+ NULL, /* wide seek proc */
+ PipeThreadActionProc, /* thread action proc */
+ NULL, /* truncate */
};
/*
@@ -245,13 +241,13 @@ static Tcl_ChannelType pipeChannelType = {
*/
static void
-PipeInit()
+PipeInit(void)
{
ThreadSpecificData *tsdPtr;
/*
- * Check the initialized flag first, then check again in the mutex.
- * This is a speed enhancement.
+ * Check the initialized flag first, then check again in the mutex. This
+ * is a speed enhancement.
*/
if (!initialized) {
@@ -276,7 +272,7 @@ PipeInit()
*
* TclpFinalizePipes --
*
- * This function is called from Tcl_FinalizeThread to finalize the
+ * This function is called from Tcl_FinalizeThread to finalize the
* platform specific pipe subsystem.
*
* Results:
@@ -289,8 +285,8 @@ PipeInit()
*/
void
-TclpFinalizePipes()
-{
+TclpFinalizePipes(void)
+{
ThreadSpecificData *tsdPtr;
tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
@@ -304,8 +300,8 @@ TclpFinalizePipes()
*
* PipeSetupProc --
*
- * This procedure is invoked before Tcl_DoOneEvent blocks waiting
- * for an event.
+ * This function is invoked before Tcl_DoOneEvent blocks waiting for an
+ * event.
*
* Results:
* None.
@@ -329,12 +325,12 @@ PipeSetupProc(
if (!(flags & TCL_FILE_EVENTS)) {
return;
}
-
+
/*
* Look to see if any events are already pending. If they are, poll.
*/
- for (infoPtr = tsdPtr->firstPipePtr; infoPtr != NULL;
+ for (infoPtr = tsdPtr->firstPipePtr; infoPtr != NULL;
infoPtr = infoPtr->nextPtr) {
if (infoPtr->watchMask & TCL_WRITABLE) {
if (WaitForSingleObject(infoPtr->writable, 0) != WAIT_TIMEOUT) {
@@ -357,8 +353,8 @@ PipeSetupProc(
*
* PipeCheckProc --
*
- * This procedure is called by Tcl_DoOneEvent to check the pipe
- * event source for events.
+ * This function is called by Tcl_DoOneEvent to check the pipe event
+ * source for events.
*
* Results:
* None.
@@ -382,18 +378,17 @@ PipeCheckProc(
if (!(flags & TCL_FILE_EVENTS)) {
return;
}
-
+
/*
- * Queue events for any ready pipes that don't already have events
- * queued.
+ * Queue events for any ready pipes that don't already have events queued.
*/
- for (infoPtr = tsdPtr->firstPipePtr; infoPtr != NULL;
+ for (infoPtr = tsdPtr->firstPipePtr; infoPtr != NULL;
infoPtr = infoPtr->nextPtr) {
if (infoPtr->flags & PIPE_PENDING) {
continue;
}
-
+
/*
* Queue an event if the pipe is signaled for reading or writing.
*/
@@ -403,7 +398,7 @@ PipeCheckProc(
(WaitForSingleObject(infoPtr->writable, 0) != WAIT_TIMEOUT)) {
needEvent = 1;
}
-
+
if ((infoPtr->watchMask & TCL_READABLE) &&
(WaitForRead(infoPtr, 0) >= 0)) {
needEvent = 1;
@@ -424,8 +419,8 @@ PipeCheckProc(
*
* TclWinMakeFile --
*
- * This function constructs a new TclFile from a given data and
- * type value.
+ * This function constructs a new TclFile from a given data and type
+ * value.
*
* Results:
* Returns a newly allocated WinFile as a TclFile.
@@ -454,15 +449,14 @@ TclWinMakeFile(
*
* TempFileName --
*
- * Gets a temporary file name and deals with the fact that the
- * temporary file path provided by Windows may not actually exist
- * if the TMP or TEMP environment variables refer to a
- * non-existent directory.
+ * Gets a temporary file name and deals with the fact that the temporary
+ * file path provided by Windows may not actually exist if the TMP or
+ * TEMP environment variables refer to a non-existent directory.
*
- * Results:
- * 0 if error, non-zero otherwise. If non-zero is returned, the
- * name buffer will be filled with a name that can be used to
- * construct a temporary file.
+ * Results:
+ * 0 if error, non-zero otherwise. If non-zero is returned, the name
+ * buffer will be filled with a name that can be used to construct a
+ * temporary file.
*
* Side effects:
* None.
@@ -471,15 +465,15 @@ TclWinMakeFile(
*/
static int
-TempFileName(name)
- WCHAR name[MAX_PATH]; /* Buffer in which name for temporary
- * file gets stored. */
+TempFileName(
+ WCHAR 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,
+ if ((*tclWinProcs->getTempFileNameProc)((TCHAR *) name, prefix, 0,
name) != 0) {
return 1;
}
@@ -491,7 +485,7 @@ TempFileName(name)
((char *) name)[0] = '.';
((char *) name)[1] = '\0';
}
- return (*tclWinProcs->getTempFileNameProc)((TCHAR *) name, prefix, 0,
+ return (*tclWinProcs->getTempFileNameProc)((TCHAR *) name, prefix, 0,
name);
}
@@ -512,13 +506,13 @@ TempFileName(name)
*/
TclFile
-TclpMakeFile(channel, direction)
- Tcl_Channel channel; /* Channel to get file from. */
- int direction; /* Either TCL_READABLE or TCL_WRITABLE. */
+TclpMakeFile(
+ Tcl_Channel channel, /* Channel to get file from. */
+ int direction) /* Either TCL_READABLE or TCL_WRITABLE. */
{
HANDLE handle;
- if (Tcl_GetChannelHandle(channel, direction,
+ if (Tcl_GetChannelHandle(channel, direction,
(ClientData *) &handle) == TCL_OK) {
return TclWinMakeFile(handle);
} else {
@@ -534,8 +528,8 @@ TclpMakeFile(channel, direction)
* This function opens files for use in a pipeline.
*
* Results:
- * Returns a newly allocated TclFile structure containing the
- * file handle.
+ * Returns a newly allocated TclFile structure containing the file
+ * handle.
*
* Side effects:
* None.
@@ -544,32 +538,32 @@ TclpMakeFile(channel, direction)
*/
TclFile
-TclpOpenFile(path, mode)
- CONST char *path; /* The name of the file to open. */
- int mode; /* In what mode to open the file? */
+TclpOpenFile(
+ const char *path, /* The name of the file to open. */
+ int mode) /* In what mode to open the file? */
{
HANDLE handle;
DWORD accessMode, createMode, shareMode, flags;
Tcl_DString ds;
- CONST TCHAR *nativePath;
-
+ const TCHAR *nativePath;
+
/*
* Map the access bits to the NT access mode.
*/
switch (mode & (O_RDONLY | O_WRONLY | O_RDWR)) {
- case O_RDONLY:
- accessMode = GENERIC_READ;
- break;
- case O_WRONLY:
- accessMode = GENERIC_WRITE;
- break;
- case O_RDWR:
- accessMode = (GENERIC_READ | GENERIC_WRITE);
- break;
- default:
- TclWinConvertError(ERROR_INVALID_FUNCTION);
- return NULL;
+ case O_RDONLY:
+ accessMode = GENERIC_READ;
+ break;
+ case O_WRONLY:
+ accessMode = GENERIC_WRITE;
+ break;
+ case O_RDWR:
+ accessMode = (GENERIC_READ | GENERIC_WRITE);
+ break;
+ default:
+ TclWinConvertError(ERROR_INVALID_FUNCTION);
+ return NULL;
}
/*
@@ -577,23 +571,23 @@ TclpOpenFile(path, mode)
*/
switch (mode & (O_CREAT | O_EXCL | O_TRUNC)) {
- case (O_CREAT | O_EXCL):
- case (O_CREAT | O_EXCL | O_TRUNC):
- createMode = CREATE_NEW;
- break;
- case (O_CREAT | O_TRUNC):
- createMode = CREATE_ALWAYS;
- break;
- case O_CREAT:
- createMode = OPEN_ALWAYS;
- break;
- case O_TRUNC:
- case (O_TRUNC | O_EXCL):
- createMode = TRUNCATE_EXISTING;
- break;
- default:
- createMode = OPEN_EXISTING;
- break;
+ case (O_CREAT | O_EXCL):
+ case (O_CREAT | O_EXCL | O_TRUNC):
+ createMode = CREATE_NEW;
+ break;
+ case (O_CREAT | O_TRUNC):
+ createMode = CREATE_ALWAYS;
+ break;
+ case O_CREAT:
+ createMode = OPEN_ALWAYS;
+ break;
+ case O_TRUNC:
+ case (O_TRUNC | O_EXCL):
+ createMode = TRUNCATE_EXISTING;
+ break;
+ default:
+ createMode = OPEN_EXISTING;
+ break;
}
nativePath = Tcl_WinUtfToTChar(path, -1, &ds);
@@ -620,19 +614,19 @@ TclpOpenFile(path, mode)
* Now we get to create the file.
*/
- handle = (*tclWinProcs->createFileProc)(nativePath, accessMode,
+ handle = (*tclWinProcs->createFileProc)(nativePath, accessMode,
shareMode, NULL, createMode, flags, NULL);
Tcl_DStringFree(&ds);
if (handle == INVALID_HANDLE_VALUE) {
DWORD err;
-
+
err = GetLastError();
if ((err & 0xffffL) == ERROR_OPEN_FAILED) {
err = (mode & O_CREAT) ? ERROR_FILE_EXISTS : ERROR_FILE_NOT_FOUND;
}
- TclWinConvertError(err);
- return NULL;
+ TclWinConvertError(err);
+ return NULL;
}
/*
@@ -651,9 +645,9 @@ TclpOpenFile(path, mode)
*
* TclpCreateTempFile --
*
- * This function opens a unique file with the property that it
- * will be deleted when its file handle is closed. The temporary
- * file is created in the system temporary directory.
+ * This function opens a unique file with the property that it will be
+ * deleted when its file handle is closed. The temporary file is created
+ * in the system temporary directory.
*
* Results:
* Returns a valid TclFile, or NULL on failure.
@@ -665,11 +659,11 @@ TclpOpenFile(path, mode)
*/
TclFile
-TclpCreateTempFile(contents)
- CONST char *contents; /* String to write into temp file, or NULL. */
+TclpCreateTempFile(
+ const char *contents) /* String to write into temp file, or NULL. */
{
WCHAR name[MAX_PATH];
- CONST char *native;
+ const char *native;
Tcl_DString dstring;
HANDLE handle;
@@ -677,8 +671,8 @@ TclpCreateTempFile(contents)
return NULL;
}
- handle = (*tclWinProcs->createFileProc)((TCHAR *) name,
- GENERIC_READ | GENERIC_WRITE, 0, NULL, CREATE_ALWAYS,
+ handle = (*tclWinProcs->createFileProc)((TCHAR *) name,
+ GENERIC_READ | GENERIC_WRITE, 0, NULL, CREATE_ALWAYS,
FILE_ATTRIBUTE_TEMPORARY|FILE_FLAG_DELETE_ON_CLOSE, NULL);
if (handle == INVALID_HANDLE_VALUE) {
goto error;
@@ -690,13 +684,14 @@ TclpCreateTempFile(contents)
if (contents != NULL) {
DWORD result, length;
- CONST char *p;
+ const char *p;
/*
* Convert the contents from UTF to native encoding
*/
+
native = Tcl_UtfToExternalDString(NULL, contents, -1, &dstring);
-
+
for (p = native; *p != '\0'; p++) {
if (*p == '\n') {
length = p - native;
@@ -726,7 +721,10 @@ TclpCreateTempFile(contents)
return TclWinMakeFile(handle);
error:
- /* Free the native representation of the contents if necessary */
+ /*
+ * Free the native representation of the contents if necessary.
+ */
+
if (contents != NULL) {
Tcl_DStringFree(&dstring);
}
@@ -753,8 +751,8 @@ TclpCreateTempFile(contents)
*----------------------------------------------------------------------
*/
-Tcl_Obj*
-TclpTempFileName()
+Tcl_Obj *
+TclpTempFileName(void)
{
WCHAR fileName[MAX_PATH];
@@ -770,23 +768,23 @@ TclpTempFileName()
*
* TclpCreatePipe --
*
- * Creates an anonymous pipe.
+ * Creates an anonymous pipe.
*
* Results:
- * Returns 1 on success, 0 on failure.
+ * Returns 1 on success, 0 on failure.
*
* Side effects:
- * Creates a pipe.
+ * Creates a pipe.
*
*----------------------------------------------------------------------
*/
int
TclpCreatePipe(
- TclFile *readPipe, /* Location to store file handle for
- * read side of pipe. */
- TclFile *writePipe) /* Location to store file handle for
- * write side of pipe. */
+ TclFile *readPipe, /* Location to store file handle for read side
+ * of pipe. */
+ TclFile *writePipe) /* Location to store file handle for write
+ * side of pipe. */
{
HANDLE readHandle, writeHandle;
@@ -805,7 +803,7 @@ TclpCreatePipe(
*
* TclpCloseFile --
*
- * Closes a pipeline file handle. These handles are created by
+ * Closes a pipeline file handle. These handles are created by
* TclpOpenFile, TclpCreatePipe, or TclpMakeFile.
*
* Results:
@@ -819,33 +817,33 @@ TclpCreatePipe(
int
TclpCloseFile(
- TclFile file) /* The file to close. */
+ TclFile file) /* The file to close. */
{
WinFile *filePtr = (WinFile *) file;
switch (filePtr->type) {
- case WIN_FILE:
- /*
- * 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 another.
- */
+ case WIN_FILE:
+ /*
+ * 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 another.
+ */
- if (!TclInThreadExit()
- || ((GetStdHandle(STD_INPUT_HANDLE) != filePtr->handle)
- && (GetStdHandle(STD_OUTPUT_HANDLE) != filePtr->handle)
- && (GetStdHandle(STD_ERROR_HANDLE) != filePtr->handle))) {
- if (filePtr->handle != NULL &&
- CloseHandle(filePtr->handle) == FALSE) {
- TclWinConvertError(GetLastError());
- ckfree((char *) filePtr);
- return -1;
- }
+ if (!TclInThreadExit()
+ || ((GetStdHandle(STD_INPUT_HANDLE) != filePtr->handle)
+ && (GetStdHandle(STD_OUTPUT_HANDLE) != filePtr->handle)
+ && (GetStdHandle(STD_ERROR_HANDLE) != filePtr->handle))) {
+ if (filePtr->handle != NULL &&
+ CloseHandle(filePtr->handle) == FALSE) {
+ TclWinConvertError(GetLastError());
+ ckfree((char *) filePtr);
+ return -1;
}
- break;
+ }
+ break;
- default:
- panic("TclpCloseFile: unexpected file type");
+ default:
+ Tcl_Panic("TclpCloseFile: unexpected file type");
}
ckfree((char *) filePtr);
@@ -861,9 +859,9 @@ TclpCloseFile(
* child process.
*
* Results:
- * Returns the process id for the child process. If the pid was not
- * known by Tcl, either because the pid was not created by Tcl or the
- * child process has already been reaped, -1 is returned.
+ * Returns the process id for the child process. If the pid was not known
+ * by Tcl, either because the pid was not created by Tcl or the child
+ * process has already been reaped, -1 is returned.
*
* Side effects:
* None.
@@ -895,25 +893,25 @@ TclpGetPid(
*
* TclpCreateProcess --
*
- * Create a child process that has the specified files as its
- * standard input, output, and error. The child process runs
- * asynchronously under Windows NT and Windows 9x, and runs
- * with the same environment variables as the creating process.
+ * Create a child process that has the specified files as its standard
+ * input, output, and error. The child process runs asynchronously under
+ * Windows NT and Windows 9x, and runs with the same environment
+ * variables as the creating process.
*
- * The complete Windows search path is searched to find the specified
- * executable. If an executable by the given name is not found,
- * automatically tries appending ".com", ".exe", and ".bat" to the
+ * The complete Windows search path is searched to find the specified
+ * executable. If an executable by the given name is not found,
+ * automatically tries appending ".com", ".exe", and ".bat" to the
* executable name.
*
* Results:
- * The return value is TCL_ERROR and an error message is left in
- * the interp's result if there was a problem creating the child
- * process. Otherwise, the return value is TCL_OK and *pidPtr is
- * filled with the process id of the child process.
- *
+ * The return value is TCL_ERROR and an error message is left in the
+ * interp's result if there was a problem creating the child process.
+ * Otherwise, the return value is TCL_OK and *pidPtr is filled with the
+ * process id of the child process.
+ *
* Side effects:
* A process is created.
- *
+ *
*----------------------------------------------------------------------
*/
@@ -924,27 +922,27 @@ TclpCreateProcess(
* Error messages from the child process
* itself are sent to errorFile. */
int argc, /* Number of arguments in following array. */
- CONST char **argv, /* Array of argument strings. argv[0]
- * contains the name of the executable
- * converted to native format (using the
- * Tcl_TranslateFileName call). Additional
+ const char **argv, /* Array of argument strings. argv[0] contains
+ * the name of the executable converted to
+ * native format (using the
+ * Tcl_TranslateFileName call). Additional
* arguments have not been converted. */
- TclFile inputFile, /* If non-NULL, gives the file to use as
- * input for the child process. If inputFile
- * file is not readable or is NULL, the child
- * will receive no standard input. */
- TclFile outputFile, /* If non-NULL, gives the file that
- * receives output from the child process. If
+ TclFile inputFile, /* If non-NULL, gives the file to use as input
+ * for the child process. If inputFile file is
+ * not readable or is NULL, the child will
+ * receive no standard input. */
+ TclFile outputFile, /* If non-NULL, gives the file that receives
+ * output from the child process. If
* outputFile file is not writeable or is
* NULL, output from the child will be
* discarded. */
- TclFile errorFile, /* If non-NULL, gives the file that
- * receives errors from the child process. If
- * errorFile file is not writeable or is NULL,
- * errors from the child will be discarded.
- * errorFile may be the same as outputFile. */
- Tcl_Pid *pidPtr) /* If this procedure is successful, pidPtr
- * is filled with the process id of the child
+ TclFile errorFile, /* If non-NULL, gives the file that receives
+ * errors from the child process. If errorFile
+ * file is not writeable or is NULL, errors
+ * from the child will be discarded. errorFile
+ * may be the same as outputFile. */
+ Tcl_Pid *pidPtr) /* If this function is successful, pidPtr is
+ * filled with the process id of the child
* process. */
{
int result, applType, createFlags;
@@ -969,13 +967,13 @@ TclpCreateProcess(
/*
* STARTF_USESTDHANDLES must be used to pass handles to child process.
- * Using SetStdHandle() and/or dup2() only works when a console mode
+ * Using SetStdHandle() and/or dup2() only works when a console mode
* parent process is spawning an attached console mode child process.
*/
ZeroMemory(&startInfo, sizeof(startInfo));
startInfo.cb = sizeof(startInfo);
- startInfo.dwFlags = STARTF_USESTDHANDLES;
+ startInfo.dwFlags = STARTF_USESTDHANDLES;
startInfo.hStdInput = INVALID_HANDLE_VALUE;
startInfo.hStdOutput= INVALID_HANDLE_VALUE;
startInfo.hStdError = INVALID_HANDLE_VALUE;
@@ -985,8 +983,8 @@ TclpCreateProcess(
secAtts.bInheritHandle = TRUE;
/*
- * We have to check the type of each file, since we cannot duplicate
- * some file types.
+ * We have to check the type of each file, since we cannot duplicate some
+ * file types.
*/
inputHandle = INVALID_HANDLE_VALUE;
@@ -1012,23 +1010,22 @@ TclpCreateProcess(
}
/*
- * Duplicate all the handles which will be passed off as stdin, stdout
- * and stderr of the child process. The duplicate handles are set to
- * be inheritable, so the child process can use them.
+ * Duplicate all the handles which will be passed off as stdin, stdout and
+ * stderr of the child process. The duplicate handles are set to be
+ * inheritable, so the child process can use them.
*/
if (inputHandle == INVALID_HANDLE_VALUE) {
- /*
- * If handle was not set, stdin should return immediate EOF.
- * Under Windows95, some applications (both 16 and 32 bit!)
- * cannot read from the NUL device; they read from console
- * instead. When running tk, this is fatal because the child
- * process would hang forever waiting for EOF from the unmapped
- * console window used by the helper application.
+ /*
+ * If handle was not set, stdin should return immediate EOF. Under
+ * Windows95, some applications (both 16 and 32 bit!) cannot read from
+ * the NUL device; they read from console instead. When running tk,
+ * this is fatal because the child process would hang forever waiting
+ * for EOF from the unmapped console window used by the helper
+ * application.
*
- * Fortunately, the helper application detects a closed pipe
- * as an immediate EOF and can pass that information to the
- * child process.
+ * Fortunately, the helper application detects a closed pipe as an
+ * immediate EOF and can pass that information to the child process.
*/
if (CreatePipe(&startInfo.hStdInput, &h, &secAtts, 0) != FALSE) {
@@ -1047,21 +1044,20 @@ TclpCreateProcess(
if (outputHandle == INVALID_HANDLE_VALUE) {
/*
- * If handle was not set, output should be sent to an infinitely
- * deep sink. Under Windows 95, some 16 bit applications cannot
- * have stdout redirected to NUL; they send their output to
- * the console instead. Some applications, like "more" or "dir /p",
- * when outputting multiple pages to the console, also then try and
- * read from the console to go the next page. When running tk, this
- * is fatal because the child process would hang forever waiting
- * for input from the unmapped console window used by the helper
- * application.
+ * If handle was not set, output should be sent to an infinitely deep
+ * sink. Under Windows 95, some 16 bit applications cannot have stdout
+ * redirected to NUL; they send their output to the console instead.
+ * Some applications, like "more" or "dir /p", when outputting
+ * multiple pages to the console, also then try and read from the
+ * console to go the next page. When running tk, this is fatal because
+ * the child process would hang forever waiting for input from the
+ * unmapped console window used by the helper application.
*
- * Fortunately, the helper application will detect a closed pipe
- * as a sink.
+ * Fortunately, the helper application will detect a closed pipe as a
+ * sink.
*/
- if ((TclWinGetPlatformId() == VER_PLATFORM_WIN32_WINDOWS)
+ if ((TclWinGetPlatformId() == VER_PLATFORM_WIN32_WINDOWS)
&& (applType == APPL_DOS)) {
if (CreatePipe(&h, &startInfo.hStdOutput, &secAtts, 0) != FALSE) {
CloseHandle(h);
@@ -1071,8 +1067,8 @@ TclpCreateProcess(
&secAtts, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, NULL);
}
} else {
- DuplicateHandle(hProcess, outputHandle, hProcess, &startInfo.hStdOutput,
- 0, TRUE, DUPLICATE_SAME_ACCESS);
+ DuplicateHandle(hProcess, outputHandle, hProcess,
+ &startInfo.hStdOutput, 0, TRUE, DUPLICATE_SAME_ACCESS);
}
if (startInfo.hStdOutput == INVALID_HANDLE_VALUE) {
TclWinConvertError(GetLastError());
@@ -1083,35 +1079,34 @@ TclpCreateProcess(
if (errorHandle == INVALID_HANDLE_VALUE) {
/*
- * If handle was not set, errors should be sent to an infinitely
- * deep sink.
+ * If handle was not set, errors should be sent to an infinitely deep
+ * sink.
*/
startInfo.hStdError = CreateFileA("NUL:", GENERIC_WRITE, 0,
&secAtts, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL);
} else {
- DuplicateHandle(hProcess, errorHandle, hProcess, &startInfo.hStdError,
+ DuplicateHandle(hProcess, errorHandle, hProcess, &startInfo.hStdError,
0, TRUE, DUPLICATE_SAME_ACCESS);
- }
+ }
if (startInfo.hStdError == INVALID_HANDLE_VALUE) {
TclWinConvertError(GetLastError());
Tcl_AppendResult(interp, "couldn't duplicate error handle: ",
Tcl_PosixError(interp), (char *) NULL);
goto end;
}
- /*
- * If we do not have a console window, then we must run DOS and
- * WIN32 console mode applications as detached processes. This tells
- * the loader that the child application should not inherit the
- * console, and that it should not create a new console window for
- * the child application. The child application should get its stdio
- * from the redirection handles provided by this application, and run
- * in the background.
+
+ /*
+ * If we do not have a console window, then we must run DOS and WIN32
+ * console mode applications as detached processes. This tells the loader
+ * that the child application should not inherit the console, and that it
+ * should not create a new console window for the child application. The
+ * child application should get its stdio from the redirection handles
+ * provided by this application, and run in the background.
*
- * If we are starting a GUI process, they don't automatically get a
+ * If we are starting a GUI process, they don't automatically get a
* console, so it doesn't matter if they are started as foreground or
- * detached processes. The GUI window will still pop up to the
- * foreground.
+ * detached processes. The GUI window will still pop up to the foreground.
*/
if (TclWinGetPlatformId() == VER_PLATFORM_WIN32_NT) {
@@ -1119,11 +1114,11 @@ TclpCreateProcess(
createFlags = 0;
} else if (applType == APPL_DOS) {
/*
- * Under NT, 16-bit DOS applications will not run unless they
- * can be attached to a console. If we are running without a
- * console, run the 16-bit program as an normal process inside
- * of a hidden console application, and then run that hidden
- * console as a detached process.
+ * Under NT, 16-bit DOS applications will not run unless they can
+ * be attached to a console. If we are running without a console,
+ * run the 16-bit program as an normal process inside of a hidden
+ * console application, and then run that hidden console as a
+ * detached process.
*/
startInfo.wShowWindow = SW_HIDE;
@@ -1132,42 +1127,46 @@ TclpCreateProcess(
Tcl_DStringAppend(&cmdLine, "cmd.exe /c", -1);
} else {
createFlags = DETACHED_PROCESS;
- }
+ }
} else {
if (HasConsole()) {
createFlags = 0;
} else {
createFlags = DETACHED_PROCESS;
}
-
+
if (applType == APPL_DOS) {
/*
- * Under Windows 95, 16-bit DOS applications do not work well
- * with pipes:
+ * 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.
+ * 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
+ * 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 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.
+ * 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;
@@ -1175,63 +1174,69 @@ TclpCreateProcess(
createFlags = CREATE_NEW_CONSOLE;
}
- {
- Tcl_Obj *tclExePtr, *pipeDllPtr;
- int i, fileExists;
- char *start,*end;
- Tcl_DString pipeDll;
- Tcl_DStringInit(&pipeDll);
- Tcl_DStringAppend(&pipeDll, TCL_PIPE_DLL, -1);
- tclExePtr = Tcl_NewStringObj(TclpFindExecutable(""), -1);
- start = Tcl_GetStringFromObj(tclExePtr, &i);
- for (end = start + (i-1); end > start; end--) {
- if (*end == '/')
- break;
- }
- if (*end != '/')
- panic("no / in executable path name");
- 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)
- panic("Tcl_FSConvertToPathType failed");
- fileExists = (Tcl_FSAccess(pipeDllPtr, F_OK) == 0);
- if (!fileExists) {
- panic("Tcl pipe dll \"%s\" not found",
- Tcl_DStringValue(&pipeDll));
+ 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;
}
- Tcl_DStringAppend(&cmdLine, Tcl_DStringValue(&pipeDll), -1);
+ }
+ 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);
}
}
-
+
/*
* cmdLine gets the full command line used to invoke the executable,
- * including the name of the executable itself. The command line
- * arguments in argv[] are stored in cmdLine separated by spaces.
- * Special characters in individual arguments from argv[] must be
- * quoted when being stored in cmdLine.
+ * including the name of the executable itself. The command line arguments
+ * in argv[] are stored in cmdLine separated by spaces. Special characters
+ * in individual arguments from argv[] must be quoted when being stored in
+ * cmdLine.
*
- * When calling any application, bear in mind that arguments that
- * specify a path name are not converted. If an argument contains
- * forward slashes as path separators, it may or may not be
- * recognized as a path name, depending on the program. In general,
- * most applications accept forward slashes only as option
- * delimiters and backslashes only as paths.
+ * When calling any application, bear in mind that arguments that specify
+ * a path name are not converted. If an argument contains forward slashes
+ * as path separators, it may or may not be recognized as a path name,
+ * depending on the program. In general, most applications accept forward
+ * slashes only as option delimiters and backslashes only as paths.
*
- * Additionally, when calling a 16-bit dos or windows application,
- * all path names must use the short, cryptic, path format (e.g.,
- * using ab~1.def instead of "a b.default").
+ * Additionally, when calling a 16-bit dos or windows application, all
+ * path names must use the short, cryptic, path format (e.g., using
+ * ab~1.def instead of "a b.default").
*/
BuildCommandLine(execPath, argc, argv, &cmdLine);
- if ((*tclWinProcs->createProcessProc)(NULL,
- (TCHAR *) Tcl_DStringValue(&cmdLine), NULL, NULL, TRUE,
+ if ((*tclWinProcs->createProcessProc)(NULL,
+ (TCHAR *) Tcl_DStringValue(&cmdLine), NULL, NULL, TRUE,
(DWORD) createFlags, NULL, NULL, &startInfo, &procInfo) == 0) {
TclWinConvertError(GetLastError());
Tcl_AppendResult(interp, "couldn't execute \"", argv[0],
@@ -1240,21 +1245,20 @@ TclpCreateProcess(
}
/*
- * This wait is used to force the OS to give some time to the DOS
- * process.
+ * This wait is used to force the OS to give some time to the DOS process.
*/
if (applType == APPL_DOS) {
WaitForSingleObject(procInfo.hProcess, 50);
}
- /*
- * "When an application spawns a process repeatedly, a new thread
- * instance will be created for each process but the previous
- * instances may not be cleaned up. This results in a significant
- * virtual memory loss each time the process is spawned. If there
- * is a WaitForInputIdle() call between CreateProcess() and
- * CloseHandle(), the problem does not occur." PSS ID Number: Q124121
+ /*
+ * "When an application spawns a process repeatedly, a new thread instance
+ * will be created for each process but the previous instances may not be
+ * cleaned up. This results in a significant virtual memory loss each time
+ * the process is spawned. If there is a WaitForInputIdle() call between
+ * CreateProcess() and CloseHandle(), the problem does not occur." PSS ID
+ * Number: Q124121
*/
WaitForInputIdle(procInfo.hProcess, 5000);
@@ -1266,13 +1270,13 @@ TclpCreateProcess(
}
result = TCL_OK;
- end:
+ end:
Tcl_DStringFree(&cmdLine);
if (startInfo.hStdInput != INVALID_HANDLE_VALUE) {
- CloseHandle(startInfo.hStdInput);
+ CloseHandle(startInfo.hStdInput);
}
if (startInfo.hStdOutput != INVALID_HANDLE_VALUE) {
- CloseHandle(startInfo.hStdOutput);
+ CloseHandle(startInfo.hStdOutput);
}
if (startInfo.hStdError != INVALID_HANDLE_VALUE) {
CloseHandle(startInfo.hStdError);
@@ -1286,8 +1290,7 @@ TclpCreateProcess(
*
* HasConsole --
*
- * Determines whether the current application is attached to a
- * console.
+ * Determines whether the current application is attached to a console.
*
* Results:
* Returns TRUE if this application has a console, else FALSE.
@@ -1299,18 +1302,18 @@ TclpCreateProcess(
*/
static BOOL
-HasConsole()
+HasConsole(void)
{
HANDLE handle;
-
+
handle = CreateFileA("CONOUT$", GENERIC_WRITE, FILE_SHARE_WRITE,
NULL, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL);
if (handle != INVALID_HANDLE_VALUE) {
- CloseHandle(handle);
+ CloseHandle(handle);
return TRUE;
} else {
- return FALSE;
+ return FALSE;
}
}
@@ -1320,29 +1323,28 @@ HasConsole()
* ApplicationType --
*
* Search for the specified program and identify if it refers to a DOS,
- * Windows 3.X, or Win32 program. Used to determine how to invoke
- * a program, or if it can even be invoked.
- *
- * It is possible to almost positively identify DOS and Windows
- * applications that contain the appropriate magic numbers. However,
- * DOS .com files do not seem to contain a magic number; if the program
- * name ends with .com and could not be identified as a Windows .com
- * file, it will be assumed to be a DOS application, even if it was
- * just random data. If the program name does not end with .com, no
- * such assumption is made.
- *
- * The Win32 procedure GetBinaryType incorrectly identifies any
- * junk file that ends with .exe as a dos executable and some
- * executables that don't end with .exe as not executable. Plus it
- * doesn't exist under win95, so I won't feel bad about reimplementing
- * functionality.
+ * Windows 3.X, or Win32 program. Used to determine how to invoke a
+ * program, or if it can even be invoked.
+ *
+ * It is possible to almost positively identify DOS and Windows
+ * applications that contain the appropriate magic numbers. However, DOS
+ * .com files do not seem to contain a magic number; if the program name
+ * ends with .com and could not be identified as a Windows .com file, it
+ * will be assumed to be a DOS application, even if it was just random
+ * data. If the program name does not end with .com, no such assumption
+ * is made.
+ *
+ * The Win32 function GetBinaryType incorrectly identifies any junk file
+ * that ends with .exe as a dos executable and some executables that
+ * don't end with .exe as not executable. Plus it doesn't exist under
+ * win95, so I won't feel bad about reimplementing functionality.
*
* Results:
- * The return value is one of APPL_DOS, APPL_WIN3X, or APPL_WIN32
- * if the filename referred to the corresponding application type.
- * If the file name could not be found or did not refer to any known
- * application type, APPL_NONE is returned and an error message is
- * left in interp. .bat files are identified as APPL_DOS.
+ * The return value is one of APPL_DOS, APPL_WIN3X, or APPL_WIN32 if the
+ * filename referred to the corresponding application type. If the file
+ * name could not be found or did not refer to any known application
+ * type, APPL_NONE is returned and an error message is left in interp.
+ * .bat files are identified as APPL_DOS.
*
* Side effects:
* None.
@@ -1351,10 +1353,10 @@ HasConsole()
*/
static int
-ApplicationType(interp, originalName, fullName)
- Tcl_Interp *interp; /* Interp, for error message. */
- const char *originalName; /* Name of the application to find. */
- char fullName[]; /* Filled with complete path to
+ApplicationType(
+ Tcl_Interp *interp, /* Interp, for error message. */
+ const char *originalName, /* Name of the application to find. */
+ char fullName[]) /* Filled with complete path to
* application. */
{
int applType, i, nameLen, found;
@@ -1365,21 +1367,21 @@ ApplicationType(interp, originalName, fullName)
DWORD attr, read;
IMAGE_DOS_HEADER header;
Tcl_DString nameBuf, ds;
- CONST TCHAR *nativeName;
+ const TCHAR *nativeName;
WCHAR nativeFullPath[MAX_PATH];
static const char extensions[][5] = {"", ".com", ".exe", ".bat"};
- /* Look for the program as an external program. First try the name
- * as it is, then try adding .com, .exe, and .bat, in that order, to
- * the name, looking for an executable.
+ /*
+ * Look for the program as an external program. First try the name as it
+ * is, then try adding .com, .exe, and .bat, in that order, to the name,
+ * looking for an executable.
*
- * Using the raw SearchPath() procedure doesn't do quite what is
- * necessary. If the name of the executable already contains a '.'
- * character, it will not try appending the specified extension when
- * searching (in other words, SearchPath will not find the program
- * "a.b.exe" if the arguments specified "a.b" and ".exe").
- * So, first look for the file as it is named. Then manually append
- * the extensions, looking for a match.
+ * Using the raw SearchPath() function doesn't do quite what is necessary.
+ * If the name of the executable already contains a '.' character, it will
+ * not try appending the specified extension when searching (in other
+ * words, SearchPath will not find the program "a.b.exe" if the arguments
+ * specified "a.b" and ".exe"). So, first look for the file as it is
+ * named. Then manually append the extensions, looking for a match.
*/
applType = APPL_NONE;
@@ -1390,9 +1392,9 @@ ApplicationType(interp, originalName, fullName)
for (i = 0; i < (int) (sizeof(extensions) / sizeof(extensions[0])); i++) {
Tcl_DStringSetLength(&nameBuf, nameLen);
Tcl_DStringAppend(&nameBuf, extensions[i], -1);
- nativeName = Tcl_WinUtfToTChar(Tcl_DStringValue(&nameBuf),
+ nativeName = Tcl_WinUtfToTChar(Tcl_DStringValue(&nameBuf),
Tcl_DStringLength(&nameBuf), &ds);
- found = (*tclWinProcs->searchPathProc)(NULL, nativeName, NULL,
+ found = (*tclWinProcs->searchPathProc)(NULL, nativeName, NULL,
MAX_PATH, nativeFullPath, &rest);
Tcl_DStringFree(&ds);
if (found == 0) {
@@ -1400,8 +1402,8 @@ ApplicationType(interp, originalName, fullName)
}
/*
- * Ignore matches on directories or data files, return if identified
- * a known type.
+ * Ignore matches on directories or data files, return if identified a
+ * known type.
*/
attr = (*tclWinProcs->getFileAttributesProc)((TCHAR *) nativeFullPath);
@@ -1412,13 +1414,13 @@ ApplicationType(interp, originalName, fullName)
Tcl_DStringFree(&ds);
ext = strrchr(fullName, '.');
- if ((ext != NULL) && (stricmp(ext, ".bat") == 0)) {
+ if ((ext != NULL) && (strcasecmp(ext, ".bat") == 0)) {
applType = APPL_DOS;
break;
}
-
- hFile = (*tclWinProcs->createFileProc)((TCHAR *) nativeFullPath,
- GENERIC_READ, FILE_SHARE_READ, NULL, OPEN_EXISTING,
+
+ hFile = (*tclWinProcs->createFileProc)((TCHAR *) nativeFullPath,
+ GENERIC_READ, FILE_SHARE_READ, NULL, OPEN_EXISTING,
FILE_ATTRIBUTE_NORMAL, NULL);
if (hFile == INVALID_HANDLE_VALUE) {
continue;
@@ -1427,25 +1429,25 @@ ApplicationType(interp, originalName, fullName)
header.e_magic = 0;
ReadFile(hFile, (void *) &header, sizeof(header), &read, NULL);
if (header.e_magic != IMAGE_DOS_SIGNATURE) {
- /*
- * Doesn't have the magic number for relocatable executables. If
+ /*
+ * Doesn't have the magic number for relocatable executables. If
* filename ends with .com, assume it's a DOS application anyhow.
* Note that we didn't make this assumption at first, because some
* supposed .com files are really 32-bit executables with all the
- * magic numbers and everything.
+ * magic numbers and everything.
*/
CloseHandle(hFile);
- if ((ext != NULL) && (stricmp(ext, ".com") == 0)) {
+ if ((ext != NULL) && (strcasecmp(ext, ".com") == 0)) {
applType = APPL_DOS;
break;
}
continue;
}
if (header.e_lfarlc != sizeof(header)) {
- /*
+ /*
* All Windows 3.X and Win32 and some DOS programs have this value
- * set here. If it doesn't, assume that since it already had the
+ * set here. If it doesn't, assume that since it already had the
* other magic number it was a DOS application.
*/
@@ -1454,7 +1456,7 @@ ApplicationType(interp, originalName, fullName)
break;
}
- /*
+ /*
* The DWORD at header.e_lfanew points to yet another magic number.
*/
@@ -1469,11 +1471,11 @@ ApplicationType(interp, originalName, fullName)
applType = APPL_WIN32;
} else {
/*
- * Strictly speaking, there should be a test that there
- * is an 'L' and 'E' at buf[0..1], to identify the type as
- * DOS, but of course we ran into a DOS executable that
- * _doesn't_ have the magic number -- specifically, one
- * compiled using the Lahey Fortran90 compiler.
+ * Strictly speaking, there should be a test that there is an 'L'
+ * and 'E' at buf[0..1], to identify the type as DOS, but of
+ * course we ran into a DOS executable that _doesn't_ have the
+ * magic number - specifically, one compiled using the Lahey
+ * Fortran90 compiler.
*/
applType = APPL_DOS;
@@ -1490,14 +1492,14 @@ ApplicationType(interp, originalName, fullName)
}
if ((applType == APPL_DOS) || (applType == APPL_WIN3X)) {
- /*
- * Replace long path name of executable with short path name for
- * 16-bit applications. Otherwise the application may not be able
- * to correctly parse its own command line to separate off the
+ /*
+ * Replace long path name of executable with short path name for
+ * 16-bit applications. Otherwise the application may not be able to
+ * correctly parse its own command line to separate off the
* application name from the arguments.
*/
- (*tclWinProcs->getShortPathNameProc)((TCHAR *) nativeFullPath,
+ (*tclWinProcs->getShortPathNameProc)((TCHAR *) nativeFullPath,
nativeFullPath, MAX_PATH);
strcpy(fullName, Tcl_WinTCharToUtf((TCHAR *) nativeFullPath, -1, &ds));
Tcl_DStringFree(&ds);
@@ -1505,15 +1507,15 @@ ApplicationType(interp, originalName, fullName)
return applType;
}
-/*
+/*
*----------------------------------------------------------------------
*
* BuildCommandLine --
*
- * The command line arguments are stored in linePtr separated
- * by spaces, in a form that CreateProcess() understands. Special
- * characters in individual arguments from argv[] must be quoted
- * when being stored in cmdLine.
+ * The command line arguments are stored in linePtr separated by spaces,
+ * in a form that CreateProcess() understands. Special characters in
+ * individual arguments from argv[] must be quoted when being stored in
+ * cmdLine.
*
* Results:
* None.
@@ -1526,26 +1528,27 @@ ApplicationType(interp, originalName, fullName)
static void
BuildCommandLine(
- CONST char *executable, /* Full path of executable (including
- * extension). Replacement for argv[0]. */
+ const char *executable, /* Full path of executable (including
+ * extension). Replacement for argv[0]. */
int argc, /* Number of arguments. */
- CONST char **argv, /* Argument strings in UTF. */
+ const char **argv, /* Argument strings in UTF. */
Tcl_DString *linePtr) /* Initialized Tcl_DString that receives the
* command line (TCHAR). */
{
- CONST char *arg, *start, *special;
+ const char *arg, *start, *special;
int quote, i;
Tcl_DString ds;
Tcl_DStringInit(&ds);
/*
- * Prime the path. Add a space separator if we were primed with
- * something.
+ * Prime the path. Add a space separator if we were primed with something.
*/
Tcl_DStringAppend(&ds, Tcl_DStringValue(linePtr), -1);
- if (Tcl_DStringLength(&ds) > 0) Tcl_DStringAppend(&ds, " ", 1);
+ if (Tcl_DStringLength(linePtr) > 0) {
+ Tcl_DStringAppend(&ds, " ", 1);
+ }
for (i = 0; i < argc; i++) {
if (i == 0) {
@@ -1562,8 +1565,8 @@ BuildCommandLine(
int count;
Tcl_UniChar ch;
for (start = arg; *start != '\0'; start += count) {
- count = Tcl_UtfToUniChar(start, &ch);
- if (Tcl_UniCharIsSpace(ch)) { /* INTL: ISO space. */
+ count = Tcl_UtfToUniChar(start, &ch);
+ if (Tcl_UniCharIsSpace(ch)) { /* INTL: ISO space. */
quote = 1;
break;
}
@@ -1572,18 +1575,18 @@ BuildCommandLine(
if (quote) {
Tcl_DStringAppend(&ds, "\"", 1);
}
- start = arg;
+ start = arg;
for (special = arg; ; ) {
- if ((*special == '\\') &&
- (special[1] == '\\' || special[1] == '"' || (quote && special[1] == '\0'))) {
+ if ((*special == '\\') && (special[1] == '\\' ||
+ special[1] == '"' || (quote && special[1] == '\0'))) {
Tcl_DStringAppend(&ds, start, (int) (special - start));
start = special;
while (1) {
special++;
if (*special == '"' || (quote && *special == '\0')) {
- /*
- * N backslashes followed a quote -> insert
- * N * 2 + 1 backslashes then a quote.
+ /*
+ * N backslashes followed a quote -> insert N * 2 + 1
+ * backslashes then a quote.
*/
Tcl_DStringAppend(&ds, start,
@@ -1622,9 +1625,8 @@ BuildCommandLine(
*
* TclpCreateCommandChannel --
*
- * This function is called by Tcl_OpenCommandChannel to perform
- * the platform specific channel initialization for a command
- * channel.
+ * This function is called by Tcl_OpenCommandChannel to perform the
+ * platform specific channel initialization for a command channel.
*
* Results:
* Returns a new channel or NULL on failure.
@@ -1677,8 +1679,8 @@ TclpCreateCommandChannel(
infoPtr->stopReader = CreateEvent(NULL, TRUE, FALSE, NULL);
infoPtr->readThread = CreateThread(NULL, 256, PipeReaderThread,
infoPtr, 0, &id);
- SetThreadPriority(infoPtr->readThread, THREAD_PRIORITY_HIGHEST);
- infoPtr->validMask |= TCL_READABLE;
+ SetThreadPriority(infoPtr->readThread, THREAD_PRIORITY_HIGHEST);
+ infoPtr->validMask |= TCL_READABLE;
} else {
infoPtr->readThread = 0;
}
@@ -1692,26 +1694,25 @@ TclpCreateCommandChannel(
infoPtr->stopWriter = CreateEvent(NULL, TRUE, FALSE, NULL);
infoPtr->writeThread = CreateThread(NULL, 256, PipeWriterThread,
infoPtr, 0, &id);
- SetThreadPriority(infoPtr->readThread, THREAD_PRIORITY_HIGHEST);
- infoPtr->validMask |= TCL_WRITABLE;
+ SetThreadPriority(infoPtr->readThread, THREAD_PRIORITY_HIGHEST);
+ infoPtr->validMask |= TCL_WRITABLE;
}
/*
- * For backward compatibility with previous versions of Tcl, we
- * use "file%d" as the base name for pipes even though it would
- * be more natural to use "pipe%d".
- * Use the pointer to keep the channel names unique, in case
- * channels share handles (stdin/stdout).
+ * For backward compatibility with previous versions of Tcl, we use
+ * "file%d" as the base name for pipes even though it would be more
+ * natural to use "pipe%d". Use the pointer to keep the channel names
+ * unique, in case channels share handles (stdin/stdout).
*/
wsprintfA(channelName, "file%lx", infoPtr);
infoPtr->channel = Tcl_CreateChannel(&pipeChannelType, channelName,
- (ClientData) infoPtr, infoPtr->validMask);
+ (ClientData) infoPtr, infoPtr->validMask);
/*
* Pipes have AUTO translation mode on Windows and ^Z eof char, which
- * means that a ^Z will be appended to them at close. This is needed
- * for Windows programs that expect a ^Z at EOF.
+ * means that a ^Z will be appended to them at close. This is needed for
+ * Windows programs that expect a ^Z at EOF.
*/
Tcl_SetChannelOption((Tcl_Interp *) NULL, infoPtr->channel,
@@ -1726,8 +1727,8 @@ TclpCreateCommandChannel(
*
* TclGetAndDetachPids --
*
- * Stores a list of the command PIDs for a command channel in
- * the interp's result.
+ * Stores a list of the command PIDs for a command channel in the
+ * interp's result.
*
* Results:
* None.
@@ -1744,7 +1745,7 @@ TclGetAndDetachPids(
Tcl_Channel chan)
{
PipeInfo *pipePtr;
- Tcl_ChannelType *chanTypePtr;
+ const Tcl_ChannelType *chanTypePtr;
int i;
char buf[TCL_INTEGER_SPACE];
@@ -1754,18 +1755,18 @@ TclGetAndDetachPids(
chanTypePtr = Tcl_GetChannelType(chan);
if (chanTypePtr != &pipeChannelType) {
- return;
+ return;
}
pipePtr = (PipeInfo *) Tcl_GetChannelInstanceData(chan);
for (i = 0; i < pipePtr->numPids; i++) {
- wsprintfA(buf, "%lu", TclpGetPid(pipePtr->pidPtr[i]));
- Tcl_AppendElement(interp, buf);
- Tcl_DetachPids(1, &(pipePtr->pidPtr[i]));
+ wsprintfA(buf, "%lu", TclpGetPid(pipePtr->pidPtr[i]));
+ Tcl_AppendElement(interp, buf);
+ Tcl_DetachPids(1, &(pipePtr->pidPtr[i]));
}
if (pipePtr->numPids > 0) {
- ckfree((char *) pipePtr->pidPtr);
- pipePtr->numPids = 0;
+ ckfree((char *) pipePtr->pidPtr);
+ pipePtr->numPids = 0;
}
}
@@ -1789,10 +1790,10 @@ static int
PipeBlockModeProc(
ClientData instanceData, /* Instance data for channel. */
int mode) /* TCL_MODE_BLOCKING or
- * TCL_MODE_NONBLOCKING. */
+ * TCL_MODE_NONBLOCKING. */
{
PipeInfo *infoPtr = (PipeInfo *) instanceData;
-
+
/*
* Pipes on Windows can not be switched between blocking and nonblocking,
* hence we have to emulate the behavior. This is done in the input
@@ -1838,18 +1839,19 @@ PipeClose2Proc(
DWORD exitCode;
errorCode = 0;
- if ((!flags || (flags == TCL_CLOSE_READ))
- && (pipePtr->readFile != NULL)) {
+ result = 0;
+
+ if ((!flags || flags == TCL_CLOSE_READ) && (pipePtr->readFile != NULL)) {
/*
- * Clean up the background thread if necessary. Note that this
- * must be done before we can close the file, since the
- * thread may be blocking trying to read from the pipe.
+ * Clean up the background thread if necessary. Note that this must be
+ * done before we can close the file, since the thread may be blocking
+ * trying to read from the pipe.
*/
if (pipePtr->readThread) {
/*
- * The thread may already have closed on it's own. Check it's
- * exit code.
+ * The thread may already have closed on its own. Check its exit
+ * code.
*/
GetExitCodeThread(pipePtr->readThread, &exitCode);
@@ -1864,19 +1866,20 @@ PipeClose2Proc(
SetEvent(pipePtr->stopReader);
/*
- * Wait at most 20 milliseconds for the reader thread to close.
+ * Wait at most 20 milliseconds for the reader thread to
+ * close.
*/
- if (WaitForSingleObject(pipePtr->readThread, 20)
- == WAIT_TIMEOUT) {
+ if (WaitForSingleObject(pipePtr->readThread,
+ 20) == WAIT_TIMEOUT) {
/*
* The thread must be blocked waiting for the pipe to
- * become readable in ReadFile(). There isn't a clean way
- * to exit the thread from this condition. We should
+ * become readable in ReadFile(). There isn't a clean way
+ * to exit the thread from this condition. We should
* terminate the child process instead to get the reader
- * thread to fall out of ReadFile with a FALSE. (below) is
- * not the correct way to do this, but will stay here until
- * a better solution is found.
+ * thread to fall out of ReadFile with a FALSE. (below) is
+ * not the correct way to do this, but will stay here
+ * until a better solution is found.
*
* Note that we need to guard against terminating the
* thread while it is in the middle of Tcl_ThreadAlert
@@ -1903,22 +1906,20 @@ PipeClose2Proc(
pipePtr->validMask &= ~TCL_READABLE;
pipePtr->readFile = NULL;
}
- if ((!flags || (flags & TCL_CLOSE_WRITE))
- && (pipePtr->writeFile != NULL)) {
-
+ if ((!flags || flags & TCL_CLOSE_WRITE)
+ && (pipePtr->writeFile != NULL)) {
if (pipePtr->writeThread) {
/*
- * Wait for the writer thread to finish the current buffer,
- * then terminate the thread and close the handles. If the
- * channel is nonblocking, there should be no pending write
- * operations.
+ * Wait for the writer thread to finish the current buffer, then
+ * terminate the thread and close the handles. If the channel is
+ * nonblocking, there should be no pending write operations.
*/
WaitForSingleObject(pipePtr->writable, INFINITE);
/*
- * The thread may already have closed on it's own. Check it's
- * exit code.
+ * The thread may already have closed on it's own. Check its exit
+ * code.
*/
GetExitCodeThread(pipePtr->writeThread, &exitCode);
@@ -1933,19 +1934,20 @@ PipeClose2Proc(
SetEvent(pipePtr->stopWriter);
/*
- * Wait at most 20 milliseconds for the reader thread to close.
+ * Wait at most 20 milliseconds for the reader thread to
+ * close.
*/
- if (WaitForSingleObject(pipePtr->writeThread, 20)
- == WAIT_TIMEOUT) {
+ if (WaitForSingleObject(pipePtr->writeThread,
+ 20) == WAIT_TIMEOUT) {
/*
* The thread must be blocked waiting for the pipe to
- * consume input in WriteFile(). There isn't a clean way
- * to exit the thread from this condition. We should
+ * consume input in WriteFile(). There isn't a clean way
+ * to exit the thread from this condition. We should
* terminate the child process instead to get the writer
- * thread to fall out of WriteFile with a FALSE. (below) is
- * not the correct way to do this, but will stay here until
- * a better solution is found.
+ * thread to fall out of WriteFile with a FALSE. (below)
+ * is not the correct way to do this, but will stay here
+ * until a better solution is found.
*
* Note that we need to guard against terminating the
* thread while it is in the middle of Tcl_ThreadAlert
@@ -1990,8 +1992,8 @@ PipeClose2Proc(
*/
for (nextPtrPtr = &(tsdPtr->firstPipePtr), infoPtr = *nextPtrPtr;
- infoPtr != NULL;
- nextPtrPtr = &infoPtr->nextPtr, infoPtr = *nextPtrPtr) {
+ infoPtr != NULL;
+ nextPtrPtr = &infoPtr->nextPtr, infoPtr = *nextPtrPtr) {
if (infoPtr == (PipeInfo *)pipePtr) {
*nextPtrPtr = infoPtr->nextPtr;
break;
@@ -2000,9 +2002,9 @@ PipeClose2Proc(
if ((pipePtr->flags & PIPE_ASYNC) || TclInExit()) {
/*
- * If the channel is non-blocking or Tcl is being cleaned up,
- * just detach the children PIDs, reap them (important if we are
- * in a dynamic load module), and discard the errorFile.
+ * If the channel is non-blocking or Tcl is being cleaned up, just
+ * detach the children PIDs, reap them (important if we are in a
+ * dynamic load module), and discard the errorFile.
*/
Tcl_DetachPids(pipePtr->numPids, pipePtr->pidPtr);
@@ -2010,7 +2012,7 @@ PipeClose2Proc(
if (pipePtr->errorFile) {
if (TclpCloseFile(pipePtr->errorFile) != 0) {
- if ( errorCode == 0 ) {
+ if (errorCode == 0) {
errorCode = errno;
}
}
@@ -2027,18 +2029,18 @@ PipeClose2Proc(
filePtr = (WinFile*)pipePtr->errorFile;
errChan = Tcl_MakeFileChannel((ClientData) filePtr->handle,
- TCL_READABLE);
+ TCL_READABLE);
ckfree((char *) filePtr);
} else {
errChan = NULL;
}
result = TclCleanupChildren(interp, pipePtr->numPids,
- pipePtr->pidPtr, errChan);
+ pipePtr->pidPtr, errChan);
}
if (pipePtr->numPids > 0) {
- ckfree((char *) pipePtr->pidPtr);
+ ckfree((char *) pipePtr->pidPtr);
}
if (pipePtr->writeBuf != NULL) {
@@ -2048,7 +2050,7 @@ PipeClose2Proc(
ckfree((char*) pipePtr);
if (errorCode == 0) {
- return result;
+ return result;
}
return errorCode;
}
@@ -2058,8 +2060,8 @@ PipeClose2Proc(
*
* PipeInputProc --
*
- * Reads input from the IO channel into the buffer given. Returns
- * count of how many bytes were actually read, and an error indication.
+ * Reads input from the IO channel into the buffer given. Returns count
+ * of how many bytes were actually read, and an error indication.
*
* Results:
* A count of how many bytes were read is returned and an error
@@ -2073,11 +2075,11 @@ PipeClose2Proc(
static int
PipeInputProc(
- ClientData instanceData, /* Pipe state. */
- char *buf, /* Where to store data read. */
- int bufSize, /* How much space is available
- * in the buffer? */
- int *errorCode) /* Where to store error code. */
+ ClientData instanceData, /* Pipe state. */
+ char *buf, /* Where to store data read. */
+ int bufSize, /* How much space is available in the
+ * buffer? */
+ int *errorCode) /* Where to store error code. */
{
PipeInfo *infoPtr = (PipeInfo *) instanceData;
WinFile *filePtr = (WinFile*) infoPtr->readFile;
@@ -2102,8 +2104,8 @@ PipeInputProc(
if (infoPtr->readFlags & PIPE_EXTRABYTE) {
/*
- * The reader thread consumed 1 byte as a side effect of
- * waiting so we need to move it into the buffer.
+ * The reader thread consumed 1 byte as a side effect of waiting so we
+ * need to move it into the buffer.
*/
*buf = infoPtr->extraByte;
@@ -2122,9 +2124,9 @@ PipeInputProc(
}
/*
- * Attempt to read bufSize bytes. The read will return immediately
- * if there is any data available. Otherwise it will block until
- * at least one byte is available or an EOF occurs.
+ * Attempt to read bufSize bytes. The read will return immediately if
+ * there is any data available. Otherwise it will block until at least one
+ * byte is available or an EOF occurs.
*/
if (ReadFile(filePtr->handle, (LPVOID) buf, (DWORD) bufSize, &count,
@@ -2152,12 +2154,12 @@ PipeInputProc(
*
* PipeOutputProc --
*
- * Writes the given output on the IO channel. Returns count of how
- * many characters were actually written, and an error indication.
+ * Writes the given output on the IO channel. Returns count of how many
+ * characters were actually written, and an error indication.
*
* Results:
- * A count of how many characters were written is returned and an
- * error indication is returned in an output argument.
+ * A count of how many characters were written is returned and an error
+ * indication is returned in an output argument.
*
* Side effects:
* Writes output on the actual channel.
@@ -2167,27 +2169,27 @@ PipeInputProc(
static int
PipeOutputProc(
- ClientData instanceData, /* Pipe state. */
- CONST char *buf, /* The data buffer. */
- int toWrite, /* How many bytes to write? */
- int *errorCode) /* Where to store error code. */
+ ClientData instanceData, /* Pipe state. */
+ const char *buf, /* The data buffer. */
+ int toWrite, /* How many bytes to write? */
+ int *errorCode) /* Where to store error code. */
{
PipeInfo *infoPtr = (PipeInfo *) instanceData;
WinFile *filePtr = (WinFile*) infoPtr->writeFile;
DWORD bytesWritten, timeout;
-
+
*errorCode = 0;
timeout = (infoPtr->flags & PIPE_ASYNC) ? 0 : INFINITE;
if (WaitForSingleObject(infoPtr->writable, timeout) == WAIT_TIMEOUT) {
/*
- * The writer thread is blocked waiting for a write to complete
- * and the channel is in non-blocking mode.
+ * The writer thread is blocked waiting for a write to complete and
+ * the channel is in non-blocking mode.
*/
errno = EAGAIN;
goto error;
}
-
+
/*
* Check for a background error on the last write.
*/
@@ -2200,8 +2202,8 @@ PipeOutputProc(
if (infoPtr->flags & PIPE_ASYNC) {
/*
- * The pipe is non-blocking, so copy the data into the output
- * buffer and restart the writer thread.
+ * The pipe is non-blocking, so copy the data into the output buffer
+ * and restart the writer thread.
*/
if (toWrite > infoPtr->writeBufLen) {
@@ -2222,8 +2224,8 @@ PipeOutputProc(
bytesWritten = toWrite;
} else {
/*
- * In the blocking case, just try to write the buffer directly.
- * This avoids an unnecessary copy.
+ * In the blocking case, just try to write the buffer directly. This
+ * avoids an unnecessary copy.
*/
if (WriteFile(filePtr->handle, (LPVOID) buf, (DWORD) toWrite,
@@ -2234,7 +2236,7 @@ PipeOutputProc(
}
return bytesWritten;
- error:
+ error:
*errorCode = errno;
return -1;
@@ -2245,15 +2247,15 @@ PipeOutputProc(
*
* PipeEventProc --
*
- * This function is invoked by Tcl_ServiceEvent when a file event
- * reaches the front of the event queue. This procedure invokes
- * Tcl_NotifyChannel on the pipe.
+ * This function is invoked by Tcl_ServiceEvent when a file event reaches
+ * the front of the event queue. This function invokes Tcl_NotifyChannel
+ * on the pipe.
*
* Results:
- * Returns 1 if the event was handled, meaning it should be removed
- * from the queue. Returns 0 if the event was not handled, meaning
- * it should stay on the queue. The only time the event isn't
- * handled is if the TCL_FILE_EVENTS flag bit isn't set.
+ * Returns 1 if the event was handled, meaning it should be removed from
+ * the queue. Returns 0 if the event was not handled, meaning it should
+ * stay on the queue. The only time the event isn't handled is if the
+ * TCL_FILE_EVENTS flag bit isn't set.
*
* Side effects:
* Whatever the notifier callback does.
@@ -2278,9 +2280,9 @@ PipeEventProc(
/*
* Search through the list of watched pipes for the one whose handle
- * matches the event. We do this rather than simply dereferencing
- * the handle in the event so that pipes can be deleted while the
- * event is in the queue.
+ * matches the event. We do this rather than simply dereferencing the
+ * handle in the event so that pipes can be deleted while the event is in
+ * the queue.
*/
for (infoPtr = tsdPtr->firstPipePtr; infoPtr != NULL;
@@ -2300,9 +2302,9 @@ PipeEventProc(
}
/*
- * Check to see if the pipe is readable. Note
- * that we can't tell if a pipe is writable, so we always report it
- * as being writable unless we have detected EOF.
+ * Check to see if the pipe is readable. Note that we can't tell if a pipe
+ * is writable, so we always report it as being writable unless we have
+ * detected EOF.
*/
mask = 0;
@@ -2311,8 +2313,7 @@ PipeEventProc(
mask = TCL_WRITABLE;
}
- if ((infoPtr->watchMask & TCL_READABLE) &&
- (WaitForRead(infoPtr, 0) >= 0)) {
+ if ((infoPtr->watchMask & TCL_READABLE) && (WaitForRead(infoPtr,0) >= 0)) {
if (infoPtr->readFlags & PIPE_EOF) {
mask = TCL_READABLE;
} else {
@@ -2333,8 +2334,7 @@ PipeEventProc(
*
* PipeWatchProc --
*
- * Called by the notifier to set up to watch for events on this
- * channel.
+ * Called by the notifier to set up to watch for events on this channel.
*
* Results:
* None.
@@ -2347,10 +2347,10 @@ PipeEventProc(
static void
PipeWatchProc(
- ClientData instanceData, /* Pipe state. */
- int mask) /* What events to watch for, OR-ed
- * combination of TCL_READABLE,
- * TCL_WRITABLE and TCL_EXCEPTION. */
+ ClientData instanceData, /* Pipe state. */
+ int mask) /* What events to watch for, OR-ed combination
+ * of TCL_READABLE, TCL_WRITABLE and
+ * TCL_EXCEPTION. */
{
PipeInfo **nextPtrPtr, *ptr;
PipeInfo *infoPtr = (PipeInfo *) instanceData;
@@ -2358,9 +2358,8 @@ PipeWatchProc(
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
/*
- * Since most of the work is handled by the background threads,
- * we just need to update the watchMask and then force the notifier
- * to poll once.
+ * Since most of the work is handled by the background threads, we just
+ * need to update the watchMask and then force the notifier to poll once.
*/
infoPtr->watchMask = mask & infoPtr->validMask;
@@ -2378,8 +2377,8 @@ PipeWatchProc(
*/
for (nextPtrPtr = &(tsdPtr->firstPipePtr), ptr = *nextPtrPtr;
- ptr != NULL;
- nextPtrPtr = &ptr->nextPtr, ptr = *nextPtrPtr) {
+ ptr != NULL;
+ nextPtrPtr = &ptr->nextPtr, ptr = *nextPtrPtr) {
if (infoPtr == ptr) {
*nextPtrPtr = ptr->nextPtr;
break;
@@ -2394,12 +2393,12 @@ PipeWatchProc(
*
* PipeGetHandleProc --
*
- * Called from Tcl_GetChannelHandle to retrieve OS handles from
- * inside a command pipeline based channel.
+ * Called from Tcl_GetChannelHandle to retrieve OS handles from inside a
+ * command pipeline based channel.
*
* Results:
- * Returns TCL_OK with the fd in handlePtr, or TCL_ERROR if
- * there is no handle for the specified direction.
+ * Returns TCL_OK with the fd in handlePtr, or TCL_ERROR if there is no
+ * handle for the specified direction.
*
* Side effects:
* None.
@@ -2414,7 +2413,7 @@ PipeGetHandleProc(
ClientData *handlePtr) /* Where to store the handle. */
{
PipeInfo *infoPtr = (PipeInfo *) instanceData;
- WinFile *filePtr;
+ WinFile *filePtr;
if (direction == TCL_READABLE && infoPtr->readFile) {
filePtr = (WinFile*) infoPtr->readFile;
@@ -2437,13 +2436,12 @@ PipeGetHandleProc(
* Emulates the waitpid system call.
*
* Results:
- * Returns 0 if the process is still alive, -1 on an error, or
- * the pid on a clean close.
+ * Returns 0 if the process is still alive, -1 on an error, or the pid on
+ * a clean close.
*
* Side effects:
- * Unless WNOHANG is set and the wait times out, the process
- * information record will be deleted and the process handle
- * will be closed.
+ * Unless WNOHANG is set and the wait times out, the process information
+ * record will be deleted and the process handle will be closed.
*
*----------------------------------------------------------------------
*/
@@ -2464,7 +2462,7 @@ Tcl_WaitPid(
/*
* If no pid is specified, do nothing.
*/
-
+
if (pid == 0) {
*statPtr = 0;
return 0;
@@ -2472,12 +2470,6 @@ Tcl_WaitPid(
/*
* Find the process and cut it from the process list.
- * SF Tcl Bug 859820, Backport of its fix.
- * SF Tcl Bug 1381436, asking for the backport.
- *
- * [x] Cutting the infoPtr after the closehandle allows the
- * pointer to become stale. We do it here, and compensate if the
- * process was not done yet.
*/
Tcl_MutexLock(&pipeMutex);
@@ -2495,17 +2487,17 @@ Tcl_WaitPid(
* If the pid is not one of the processes we know about (we started it)
* then do nothing.
*/
-
+
if (infoPtr == NULL) {
- *statPtr = 0;
+ *statPtr = 0;
return 0;
}
/*
- * Officially "wait" for it to finish. We either poll (WNOHANG) or
- * wait for an infinite amount of time.
+ * Officially "wait" for it to finish. We either poll (WNOHANG) or wait
+ * for an infinite amount of time.
*/
-
+
if (options & WNOHANG) {
flags = 0;
} else {
@@ -2516,9 +2508,9 @@ Tcl_WaitPid(
*statPtr = 0;
if (options & WNOHANG) {
/*
- * Re-insert the cut infoPtr back on the list.
- * See [x] for explanation.
+ * Re-insert this infoPtr back on the list.
*/
+
Tcl_MutexLock(&pipeMutex);
infoPtr->nextPtr = procList;
procList = infoPtr;
@@ -2529,54 +2521,71 @@ Tcl_WaitPid(
}
} else if (ret == WAIT_OBJECT_0) {
GetExitCodeProcess(infoPtr->hProcess, &exitCode);
- if (exitCode & 0xC0000000) {
- /*
- * A fatal exception occured.
- */
- switch (exitCode) {
- case EXCEPTION_FLT_DENORMAL_OPERAND:
- case EXCEPTION_FLT_DIVIDE_BY_ZERO:
- case EXCEPTION_FLT_INEXACT_RESULT:
- case EXCEPTION_FLT_INVALID_OPERATION:
- case EXCEPTION_FLT_OVERFLOW:
- case EXCEPTION_FLT_STACK_CHECK:
- case EXCEPTION_FLT_UNDERFLOW:
- case EXCEPTION_INT_DIVIDE_BY_ZERO:
- case EXCEPTION_INT_OVERFLOW:
- *statPtr = 0xC0000000 | SIGFPE;
- break;
- case EXCEPTION_PRIV_INSTRUCTION:
- case EXCEPTION_ILLEGAL_INSTRUCTION:
- *statPtr = 0xC0000000 | SIGILL;
- break;
+ /*
+ * Does the exit code look like one of the exception codes?
+ */
- case EXCEPTION_ACCESS_VIOLATION:
- case EXCEPTION_DATATYPE_MISALIGNMENT:
- case EXCEPTION_ARRAY_BOUNDS_EXCEEDED:
- case EXCEPTION_STACK_OVERFLOW:
- case EXCEPTION_NONCONTINUABLE_EXCEPTION:
- case EXCEPTION_INVALID_DISPOSITION:
- case EXCEPTION_GUARD_PAGE:
- case EXCEPTION_INVALID_HANDLE:
- *statPtr = 0xC0000000 | SIGSEGV;
- break;
+ switch (exitCode) {
+ case EXCEPTION_FLT_DENORMAL_OPERAND:
+ case EXCEPTION_FLT_DIVIDE_BY_ZERO:
+ case EXCEPTION_FLT_INEXACT_RESULT:
+ case EXCEPTION_FLT_INVALID_OPERATION:
+ case EXCEPTION_FLT_OVERFLOW:
+ case EXCEPTION_FLT_STACK_CHECK:
+ case EXCEPTION_FLT_UNDERFLOW:
+ case EXCEPTION_INT_DIVIDE_BY_ZERO:
+ case EXCEPTION_INT_OVERFLOW:
+ *statPtr = 0xC0000000 | SIGFPE;
+ break;
- case CONTROL_C_EXIT:
- *statPtr = 0xC0000000 | SIGINT;
- break;
+ case EXCEPTION_PRIV_INSTRUCTION:
+ case EXCEPTION_ILLEGAL_INSTRUCTION:
+ *statPtr = 0xC0000000 | SIGILL;
+ break;
+
+ case EXCEPTION_ACCESS_VIOLATION:
+ case EXCEPTION_ARRAY_BOUNDS_EXCEEDED:
+ case EXCEPTION_STACK_OVERFLOW:
+ case EXCEPTION_NONCONTINUABLE_EXCEPTION:
+ case EXCEPTION_INVALID_DISPOSITION:
+ case EXCEPTION_GUARD_PAGE:
+ case EXCEPTION_INVALID_HANDLE:
+ *statPtr = 0xC0000000 | SIGSEGV;
+ break;
+
+ case EXCEPTION_DATATYPE_MISALIGNMENT:
+ *statPtr = 0xC0000000 | SIGBUS;
+ break;
+
+ case EXCEPTION_BREAKPOINT:
+ case EXCEPTION_SINGLE_STEP:
+ *statPtr = 0xC0000000 | SIGTRAP;
+ break;
+
+ case CONTROL_C_EXIT:
+ *statPtr = 0xC0000000 | SIGINT;
+ break;
+
+ default:
+ /*
+ * Non-exceptional, normal, exit code. Note that the exit code is
+ * truncated to a signed short range [-32768,32768) whether it
+ * fits into this range or not.
+ *
+ * BUG: Even though the exit code is a DWORD, it is understood by
+ * convention to be a signed integer, yet there isn't enough room
+ * to fit this into the POSIX style waitstatus mask without
+ * truncating it.
+ */
- default:
- *statPtr = 0xC0000000 | SIGABRT;
- break;
- }
- } else {
*statPtr = exitCode;
+ break;
}
result = pid;
} else {
errno = ECHILD;
- *statPtr = 0xC0000000 | ECHILD;
+ *statPtr = 0xC0000000 | ECHILD;
result = (Tcl_Pid) -1;
}
@@ -2595,28 +2604,28 @@ Tcl_WaitPid(
*
* TclWinAddProcess --
*
- * Add a process to the process list so that we can use
- * Tcl_WaitPid on the process.
+ * Add a process to the process list so that we can use Tcl_WaitPid on
+ * the process.
*
* Results:
- * None
+ * None
*
* Side effects:
- * Adds the specified process handle to the process list so
- * Tcl_WaitPid knows about it.
+ * Adds the specified process handle to the process list so Tcl_WaitPid
+ * knows about it.
*
*----------------------------------------------------------------------
*/
void
-TclWinAddProcess(hProcess, id)
- HANDLE hProcess; /* Handle to process */
- DWORD id; /* Global process identifier */
+TclWinAddProcess(
+ void *hProcess, /* Handle to process */
+ unsigned long id) /* Global process identifier */
{
ProcInfo *procPtr = (ProcInfo *) ckalloc(sizeof(ProcInfo));
PipeInit();
-
+
procPtr->hProcess = hProcess;
procPtr->dwProcessId = id;
Tcl_MutexLock(&pipeMutex);
@@ -2630,8 +2639,8 @@ TclWinAddProcess(hProcess, id)
*
* Tcl_PidObjCmd --
*
- * This procedure is invoked to process the "pid" Tcl command.
- * See the user documentation for details on what it does.
+ * This function is invoked to process the "pid" Tcl command. See the
+ * user documentation for details on what it does.
*
* Results:
* A standard Tcl result.
@@ -2648,10 +2657,10 @@ Tcl_PidObjCmd(
ClientData dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
- Tcl_Obj *CONST *objv) /* Argument strings. */
+ Tcl_Obj *const *objv) /* Argument strings. */
{
Tcl_Channel chan;
- Tcl_ChannelType *chanTypePtr;
+ const Tcl_ChannelType *chanTypePtr;
PipeInfo *pipePtr;
int i;
Tcl_Obj *resultPtr;
@@ -2662,13 +2671,12 @@ Tcl_PidObjCmd(
return TCL_ERROR;
}
if (objc == 1) {
- resultPtr = Tcl_GetObjResult(interp);
wsprintfA(buf, "%lu", (unsigned long) getpid());
- Tcl_SetStringObj(resultPtr, buf, -1);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, -1));
} else {
- chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], NULL),
+ chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], NULL),
NULL);
- if (chan == (Tcl_Channel) NULL) {
+ if (chan == (Tcl_Channel) NULL) {
return TCL_ERROR;
}
chanTypePtr = Tcl_GetChannelType(chan);
@@ -2676,13 +2684,14 @@ Tcl_PidObjCmd(
return TCL_OK;
}
- pipePtr = (PipeInfo *) Tcl_GetChannelInstanceData(chan);
- resultPtr = Tcl_GetObjResult(interp);
- for (i = 0; i < pipePtr->numPids; i++) {
+ pipePtr = (PipeInfo *) Tcl_GetChannelInstanceData(chan);
+ resultPtr = Tcl_NewObj();
+ for (i = 0; i < pipePtr->numPids; i++) {
wsprintfA(buf, "%lu", TclpGetPid(pipePtr->pidPtr[i]));
Tcl_ListObjAppendElement(/*interp*/ NULL, resultPtr,
Tcl_NewStringObj(buf, -1));
}
+ Tcl_SetObjResult(interp, resultPtr);
}
return TCL_OK;
}
@@ -2692,20 +2701,19 @@ Tcl_PidObjCmd(
*
* WaitForRead --
*
- * Wait until some data is available, the pipe is at
- * EOF or the reader thread is blocked waiting for data (if the
- * channel is in non-blocking mode).
+ * Wait until some data is available, the pipe is at EOF or the reader
+ * thread is blocked waiting for data (if the channel is in non-blocking
+ * mode).
*
* Results:
- * Returns 1 if pipe is readable. Returns 0 if there is no data
- * on the pipe, but there is buffered data. Returns -1 if an
- * error occurred. If an error occurred, the threads may not
- * be synchronized.
+ * Returns 1 if pipe is readable. Returns 0 if there is no data on the
+ * pipe, but there is buffered data. Returns -1 if an error occurred. If
+ * an error occurred, the threads may not be synchronized.
*
* Side effects:
- * Updates the shared state flags and may consume 1 byte of data
- * from the pipe. If no error occurred, the reader thread is
- * blocked waiting for a signal from the main thread.
+ * Updates the shared state flags and may consume 1 byte of data from the
+ * pipe. If no error occurred, the reader thread is blocked waiting for a
+ * signal from the main thread.
*
*----------------------------------------------------------------------
*/
@@ -2713,8 +2721,8 @@ Tcl_PidObjCmd(
static int
WaitForRead(
PipeInfo *infoPtr, /* Pipe state. */
- int blocking) /* Indicates whether call should be
- * blocking or not. */
+ int blocking) /* Indicates whether call should be blocking
+ * or not. */
{
DWORD timeout, count;
HANDLE *handle = ((WinFile *) infoPtr->readFile)->handle;
@@ -2723,7 +2731,7 @@ WaitForRead(
/*
* Synchronize with the reader thread.
*/
-
+
timeout = blocking ? INFINITE : 0;
if (WaitForSingleObject(infoPtr->readable, timeout) == WAIT_TIMEOUT) {
/*
@@ -2736,11 +2744,10 @@ WaitForRead(
}
/*
- * At this point, the two threads are synchronized, so it is safe
- * to access shared state.
+ * At this point, the two threads are synchronized, so it is safe to
+ * access shared state.
*/
-
/*
* If the pipe has hit EOF, it is always readable.
*/
@@ -2748,7 +2755,7 @@ WaitForRead(
if (infoPtr->readFlags & PIPE_EOF) {
return 1;
}
-
+
/*
* Check to see if there is any data sitting in the pipe.
*/
@@ -2756,6 +2763,7 @@ WaitForRead(
if (PeekNamedPipe(handle, (LPVOID) NULL, (DWORD) 0,
(LPDWORD) NULL, &count, (LPDWORD) NULL) != TRUE) {
TclWinConvertError(GetLastError());
+
/*
* Check to see if the peek failed because of EOF.
*/
@@ -2785,8 +2793,8 @@ WaitForRead(
}
/*
- * The pipe isn't readable, but there is some data sitting
- * in the buffer, so return immediately.
+ * The pipe isn't readable, but there is some data sitting in the
+ * buffer, so return immediately.
*/
if (infoPtr->readFlags & PIPE_EXTRABYTE) {
@@ -2794,10 +2802,9 @@ WaitForRead(
}
/*
- * There wasn't any data available, so reset the thread and
- * try again.
+ * There wasn't any data available, so reset the thread and try again.
*/
-
+
ResetEvent(infoPtr->readable);
SetEvent(infoPtr->startReader);
}
@@ -2808,24 +2815,24 @@ WaitForRead(
*
* PipeReaderThread --
*
- * This function runs in a separate thread and waits for input
- * to become available on a pipe.
+ * This function runs in a separate thread and waits for input to become
+ * available on a pipe.
*
* Results:
* None.
*
* Side effects:
- * Signals the main thread when input become available. May
- * cause the main thread to wake up by posting a message. May
- * consume one byte from the pipe for each wait operation. Will
- * cause a memory leak of ~4k, if forcefully terminated with
- * TerminateThread().
+ * Signals the main thread when input become available. May cause the
+ * main thread to wake up by posting a message. May consume one byte from
+ * the pipe for each wait operation. Will cause a memory leak of ~4k, if
+ * forcefully terminated with TerminateThread().
*
*----------------------------------------------------------------------
*/
static DWORD WINAPI
-PipeReaderThread(LPVOID arg)
+PipeReaderThread(
+ LPVOID arg)
{
PipeInfo *infoPtr = (PipeInfo *)arg;
HANDLE *handle = ((WinFile *) infoPtr->readFile)->handle;
@@ -2839,34 +2846,33 @@ PipeReaderThread(LPVOID arg)
while (!done) {
/*
- * Wait for the main thread to signal before attempting to wait
- * on the pipe becoming readable.
+ * Wait for the main thread to signal before attempting to wait on the
+ * pipe becoming readable.
*/
waitResult = WaitForMultipleObjects(2, wEvents, FALSE, INFINITE);
if (waitResult != (WAIT_OBJECT_0 + 1)) {
/*
- * The start event was not signaled. It might be the stop event
- * or an error, so exit.
+ * The start event was not signaled. It might be the stop event or
+ * an error, so exit.
*/
break;
}
/*
- * Try waiting for 0 bytes. This will block until some data is
- * available on NT, but will return immediately on Win 95. So,
- * if no data is available after the first read, we block until
- * we can read a single byte off of the pipe.
+ * Try waiting for 0 bytes. This will block until some data is
+ * available on NT, but will return immediately on Win 95. So, if no
+ * data is available after the first read, we block until we can read
+ * a single byte off of the pipe.
*/
- if ((ReadFile(handle, NULL, 0, &count, NULL) == FALSE)
- || (PeekNamedPipe(handle, NULL, 0, NULL, &count,
- NULL) == FALSE)) {
+ if (ReadFile(handle, NULL, 0, &count, NULL) == FALSE ||
+ PeekNamedPipe(handle, NULL, 0, NULL, &count, NULL) == FALSE) {
/*
- * The error is a result of an EOF condition, so set the
- * EOF bit before signalling the main thread.
+ * The error is a result of an EOF condition, so set the EOF bit
+ * before signalling the main thread.
*/
err = GetLastError();
@@ -2880,8 +2886,8 @@ PipeReaderThread(LPVOID arg)
if (ReadFile(handle, &(infoPtr->extraByte), 1, &count, NULL)
!= FALSE) {
/*
- * One byte was consumed as a side effect of waiting
- * for the pipe to become readable.
+ * One byte was consumed as a side effect of waiting for the
+ * pipe to become readable.
*/
infoPtr->readFlags |= PIPE_EXTRABYTE;
@@ -2901,23 +2907,27 @@ PipeReaderThread(LPVOID arg)
}
}
-
+
/*
- * Signal the main thread by signalling the readable event and
- * then waking up the notifier thread.
+ * Signal the main thread by signalling the readable event and then
+ * waking up the notifier thread.
*/
SetEvent(infoPtr->readable);
-
+
/*
- * Alert the foreground thread. Note that we need to treat this like
- * a critical section so the foreground thread does not terminate
- * this thread while we are holding a mutex in the notifier code.
+ * Alert the foreground thread. Note that we need to treat this like a
+ * critical section so the foreground thread does not terminate this
+ * thread while we are holding a mutex in the notifier code.
*/
Tcl_MutexLock(&pipeMutex);
if (infoPtr->threadId != NULL) {
- /* TIP #218. When in flight ignore the event, no one will receive it anyway */
+ /*
+ * TIP #218. When in flight ignore the event, no one will receive
+ * it anyway.
+ */
+
Tcl_ThreadAlert(infoPtr->threadId);
}
Tcl_MutexUnlock(&pipeMutex);
@@ -2931,23 +2941,22 @@ PipeReaderThread(LPVOID arg)
*
* PipeWriterThread --
*
- * This function runs in a separate thread and writes data
- * onto a pipe.
+ * This function runs in a separate thread and writes data onto a pipe.
*
* Results:
* Always returns 0.
*
* Side effects:
- * Signals the main thread when an output operation is completed.
- * May cause the main thread to wake up by posting a message.
+ * Signals the main thread when an output operation is completed. May
+ * cause the main thread to wake up by posting a message.
*
*----------------------------------------------------------------------
*/
static DWORD WINAPI
-PipeWriterThread(LPVOID arg)
+PipeWriterThread(
+ LPVOID arg)
{
-
PipeInfo *infoPtr = (PipeInfo *)arg;
HANDLE *handle = ((WinFile *) infoPtr->writeFile)->handle;
DWORD count, toWrite;
@@ -2968,8 +2977,8 @@ PipeWriterThread(LPVOID arg)
if (waitResult != (WAIT_OBJECT_0 + 1)) {
/*
- * The start event was not signaled. It might be the stop event
- * or an error, so exit.
+ * The start event was not signaled. It might be the stop event or
+ * an error, so exit.
*/
break;
@@ -2985,30 +2994,34 @@ PipeWriterThread(LPVOID arg)
while (toWrite > 0) {
if (WriteFile(handle, buf, toWrite, &count, NULL) == FALSE) {
infoPtr->writeError = GetLastError();
- done = 1;
+ done = 1;
break;
} else {
toWrite -= count;
buf += count;
}
}
-
+
/*
- * Signal the main thread by signalling the writable event and
- * then waking up the notifier thread.
+ * Signal the main thread by signalling the writable event and then
+ * waking up the notifier thread.
*/
SetEvent(infoPtr->writable);
/*
- * Alert the foreground thread. Note that we need to treat this like
- * a critical section so the foreground thread does not terminate
- * this thread while we are holding a mutex in the notifier code.
+ * Alert the foreground thread. Note that we need to treat this like a
+ * critical section so the foreground thread does not terminate this
+ * thread while we are holding a mutex in the notifier code.
*/
Tcl_MutexLock(&pipeMutex);
if (infoPtr->threadId != NULL) {
- /* TIP #218. When in flight ignore the event, no one will receive it anyway */
+ /*
+ * TIP #218. When in flight ignore the event, no one will receive
+ * it anyway.
+ */
+
Tcl_ThreadAlert(infoPtr->threadId);
}
Tcl_MutexUnlock(&pipeMutex);
@@ -3016,7 +3029,7 @@ PipeWriterThread(LPVOID arg)
return 0;
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -3034,33 +3047,43 @@ PipeWriterThread(LPVOID arg)
*/
static void
-PipeThreadActionProc (instanceData, action)
- ClientData instanceData;
- int action;
+PipeThreadActionProc(
+ ClientData instanceData,
+ int action)
{
PipeInfo *infoPtr = (PipeInfo *) instanceData;
- /* We do not access firstPipePtr in the thread structures. This is
- * not for all pipes managed by the thread, but only those we are
- * watching. Removal of the filevent handlers before transfer thus
- * takes care of this structure.
+ /*
+ * We do not access firstPipePtr in the thread structures. This is not for
+ * all pipes managed by the thread, but only those we are watching.
+ * Removal of the filevent handlers before transfer thus takes care of
+ * this structure.
*/
Tcl_MutexLock(&pipeMutex);
if (action == TCL_CHANNEL_THREAD_INSERT) {
- /* We can't copy the thread information from the channel when
- * the channel is created. At this time the channel back
- * pointer has not been set yet. However in that case the
- * threadId has already been set by TclpCreateCommandChannel
- * itself, so the structure is still good.
+ /*
+ * We can't copy the thread information from the channel when the
+ * channel is created. At this time the channel back pointer has not
+ * been set yet. However in that case the threadId has already been
+ * set by TclpCreateCommandChannel itself, so the structure is still
+ * good.
*/
- PipeInit ();
- if (infoPtr->channel != NULL) {
- infoPtr->threadId = Tcl_GetChannelThread (infoPtr->channel);
+ PipeInit();
+ if (infoPtr->channel != NULL) {
+ infoPtr->threadId = Tcl_GetChannelThread(infoPtr->channel);
}
} else {
infoPtr->threadId = NULL;
}
Tcl_MutexUnlock(&pipeMutex);
}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/win/tclWinPort.h b/win/tclWinPort.h
index aca3279..da685ad 100644
--- a/win/tclWinPort.h
+++ b/win/tclWinPort.h
@@ -14,10 +14,27 @@
#ifndef _TCLWINPORT
#define _TCLWINPORT
-#ifndef _TCLINT
-# include "tclInt.h"
+#ifndef _WIN64
+/* See [Bug 2935503]: file mtime sets wrong time */
+# define _USE_32BIT_TIME_T
#endif
+#define WIN32_LEAN_AND_MEAN
+#include <windows.h>
+#undef WIN32_LEAN_AND_MEAN
+
+/* Compatibility to older visual studio / windows platform SDK */
+#if !defined(MAXULONG_PTR)
+typedef DWORD DWORD_PTR;
+typedef DWORD_PTR * PDWORD_PTR;
+#endif
+
+/*
+ * Ask for the winsock function typedefs, also.
+ */
+#define INCL_WINSOCK_API_TYPEDEFS 1
+#include <winsock2.h>
+
#ifdef CHECK_UNICODE_CALLS
# define _UNICODE
# define UNICODE
@@ -34,17 +51,24 @@
*---------------------------------------------------------------------------
*/
+#include <io.h>
#include <stdio.h>
#include <stdlib.h>
-
#include <errno.h>
#include <fcntl.h>
#include <float.h>
-#include <io.h>
#include <malloc.h>
#include <process.h>
#include <signal.h>
#include <string.h>
+#include <limits.h>
+
+#ifndef strncasecmp
+# define strncasecmp strnicmp
+#endif
+#ifndef strcasecmp
+# define strcasecmp stricmp
+#endif
/*
* Need to block out these includes for building extensions with MetroWerks
@@ -63,27 +87,6 @@
#include <time.h>
-#define WIN32_LEAN_AND_MEAN
-#include <windows.h>
-#undef WIN32_LEAN_AND_MEAN
-
-/* Compatibility to older visual studio / windows platform SDK */
-#if !defined(MAXULONG_PTR)
-typedef DWORD DWORD_PTR;
-typedef DWORD_PTR * PDWORD_PTR;
-#endif
-
-/*
- * Ask for the winsock function typedefs, also.
- */
-#define INCL_WINSOCK_API_TYPEDEFS 1
-#include <winsock2.h>
-
-#ifdef BUILD_tcl
-# undef TCL_STORAGE_CLASS
-# define TCL_STORAGE_CLASS DLLEXPORT
-#endif /* BUILD_tcl */
-
/*
* Define EINPROGRESS in terms of WSAEINPROGRESS.
*/
@@ -189,6 +192,18 @@ typedef DWORD_PTR * PDWORD_PTR;
#define EOVERFLOW EFBIG /* The object couldn't fit in the datatype */
/*
+ * Signals not known to the standard ANSI signal.h. These are used
+ * by Tcl_WaitPid() and generic/tclPosixStr.c
+ */
+
+#ifndef SIGTRAP
+# define SIGTRAP 5
+#endif
+#ifndef SIGBUS
+# define SIGBUS 10
+#endif
+
+/*
* Supply definitions for macros to query wait status, if not already
* defined in header files above.
*/
@@ -258,7 +273,7 @@ typedef DWORD_PTR * PDWORD_PTR;
*/
#ifndef S_IFLNK
-#define S_IFLNK 0120000 /* Symbolic Link */
+# define S_IFLNK 0120000 /* Symbolic Link */
#endif
#ifndef S_ISREG
@@ -310,11 +325,11 @@ typedef DWORD_PTR * PDWORD_PTR;
*/
#ifndef MAXPATH
-#define MAXPATH MAX_PATH
+# define MAXPATH MAX_PATH
#endif /* MAXPATH */
#ifndef MAXPATHLEN
-#define MAXPATHLEN MAXPATH
+# define MAXPATHLEN MAXPATH
#endif /* MAXPATHLEN */
/*
@@ -335,15 +350,15 @@ typedef DWORD_PTR * PDWORD_PTR;
*/
#if defined(_MSC_VER) || defined(__MINGW32__)
-# define environ _environ
+# define environ _environ
# if defined(_MSC_VER) && (_MSC_VER < 1600)
# define hypot _hypot
# endif
-# define exception _exception
-# undef EDEADLOCK
-# if defined(__MINGW32__) && !defined(__MSVCRT__)
+# define exception _exception
+# undef EDEADLOCK
+# if defined(__MINGW32__) && !defined(__MSVCRT__)
# define timezone _timezone
-# endif
+# endif
#endif /* _MSC_VER || __MINGW32__ */
/*
@@ -355,6 +370,23 @@ typedef DWORD_PTR * PDWORD_PTR;
# define environ _environ
#endif /* __BORLANDC__ */
+#ifdef __WATCOMC__
+# if !defined(__CHAR_SIGNED__)
+# error "You must use the -j switch to ensure char is signed."
+# endif
+#endif
+
+
+/*
+ * MSVC 8.0 started to mark many standard C library functions depreciated
+ * including the *printf family and others. Tell it to shut up.
+ * (_MSC_VER is 1200 for VC6, 1300 or 1310 for vc7.net, 1400 for 8.0)
+ */
+#if _MSC_VER >= 1400
+#pragma warning(disable:4996)
+#endif
+
+
/*
* There is no platform-specific panic routine for Windows in the Tcl internals.
*/
@@ -363,8 +395,8 @@ typedef DWORD_PTR * PDWORD_PTR;
/*
*---------------------------------------------------------------------------
- * The following macros and declarations represent the interface between
- * generic and windows-specific parts of Tcl. Some of the macros may
+ * The following macros and declarations represent the interface between
+ * generic and windows-specific parts of Tcl. Some of the macros may
* override functions declared in tclInt.h.
*---------------------------------------------------------------------------
*/
@@ -399,6 +431,13 @@ typedef DWORD_PTR * PDWORD_PTR;
#endif
/*
+ * Older version of Mingw are known to lack a MWMO_ALERTABLE define.
+ */
+#if !defined(MWMO_ALERTABLE)
+# define MWMO_ALERTABLE 2
+#endif
+
+/*
* The following defines wrap the system memory allocation routines for
* use by tclAlloc.c.
*/
@@ -425,63 +464,19 @@ typedef DWORD_PTR * PDWORD_PTR;
/*
- * The following macros have trivial definitions, allowing generic code to
+ * The following macros have trivial definitions, allowing generic code to
* address platform-specific issues.
*/
#define TclpReleaseFile(file) ckfree((char *) file)
/*
- * The following macros and declarations wrap the C runtime library
+ * The following macros and declarations wrap the C runtime library
* functions.
*/
#define TclpExit exit
-/*
- * Declarations for Windows-only functions.
- */
-
-EXTERN HANDLE TclWinSerialReopen _ANSI_ARGS_(( HANDLE handle,
- CONST TCHAR *name, DWORD access));
-
-EXTERN Tcl_Channel TclWinOpenSerialChannel _ANSI_ARGS_((HANDLE handle,
- char *channelName, int permissions));
-
-EXTERN Tcl_Channel TclWinOpenConsoleChannel _ANSI_ARGS_((HANDLE handle,
- char *channelName, int permissions));
-
-EXTERN Tcl_Channel TclWinOpenFileChannel _ANSI_ARGS_((HANDLE handle,
- char *channelName, int permissions, int appendMode));
-
-EXTERN TclFile TclWinMakeFile _ANSI_ARGS_((HANDLE handle));
-
-/*
- * Platform specific mutex definition used by memory allocators.
- * These mutexes are statically allocated and explicitly initialized.
- * Most modules do not use this, but instead use Tcl_Mutex types and
- * Tcl_MutexLock and Tcl_MutexUnlock that are self-initializing.
- */
-
-#ifdef TCL_THREADS
-typedef CRITICAL_SECTION TclpMutex;
-EXTERN void TclpMutexInit _ANSI_ARGS_((TclpMutex *mPtr));
-EXTERN void TclpMutexLock _ANSI_ARGS_((TclpMutex *mPtr));
-EXTERN void TclpMutexUnlock _ANSI_ARGS_((TclpMutex *mPtr));
-#else /* !TCL_THREADS */
-typedef int TclpMutex;
-#define TclpMutexInit(a)
-#define TclpMutexLock(a)
-#define TclpMutexUnlock(a)
-#endif /* TCL_THREADS */
-
-#ifdef TCL_WIDE_INT_TYPE
-EXTERN Tcl_WideInt strtoll _ANSI_ARGS_((CONST char *string,
- char **endPtr, int base));
-EXTERN Tcl_WideUInt strtoull _ANSI_ARGS_((CONST char *string,
- char **endPtr, int base));
-#endif /* TCL_WIDE_INT_TYPE */
-
#ifndef INVALID_SET_FILE_POINTER
#define INVALID_SET_FILE_POINTER 0xFFFFFFFF
#endif /* INVALID_SET_FILE_POINTER */
@@ -490,10 +485,4 @@ EXTERN Tcl_WideUInt strtoull _ANSI_ARGS_((CONST char *string,
# define LABEL_SECURITY_INFORMATION (0x00000010L)
#endif
-#include "tclPlatDecls.h"
-#include "tclIntPlatDecls.h"
-
-#undef TCL_STORAGE_CLASS
-#define TCL_STORAGE_CLASS DLLIMPORT
-
#endif /* _TCLWINPORT */
diff --git a/win/tclWinReg.c b/win/tclWinReg.c
index 3960fda..f2ac367 100644
--- a/win/tclWinReg.c
+++ b/win/tclWinReg.c
@@ -1,18 +1,21 @@
/*
* tclWinReg.c --
*
- * This file contains the implementation of the "registry" Tcl
- * built-in command. This command is built as a dynamically
- * loadable extension in a separate DLL.
+ * This file contains the implementation of the "registry" Tcl built-in
+ * command. This command is built as a dynamically loadable extension in
+ * a separate DLL.
*
* Copyright (c) 1997 by Sun Microsystems, Inc.
* Copyright (c) 1998-1999 by Scriptics Corporation.
*
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
-#include <tclPort.h>
+#include "tclInt.h"
+#ifdef _MSC_VER
+# pragma comment (lib, "advapi32.lib")
+#endif
#include <stdlib.h>
/*
@@ -32,15 +35,15 @@
#define SWAPLONG(x) MAKELONG(SWAPWORD(HIWORD(x)), SWAPWORD(LOWORD(x)))
/*
- * The following flag is used in OpenKeys to indicate that the specified
- * key should be created if it doesn't currently exist.
+ * The following flag is used in OpenKeys to indicate that the specified key
+ * should be created if it doesn't currently exist.
*/
#define REG_CREATE 1
/*
- * The following tables contain the mapping from registry root names
- * to the system predefined keys.
+ * The following tables contain the mapping from registry root names to the
+ * system predefined keys.
*/
static CONST char *rootKeyNames[] = {
@@ -54,11 +57,12 @@ static const HKEY rootKeys[] = {
HKEY_CURRENT_CONFIG, HKEY_PERFORMANCE_DATA, HKEY_DYN_DATA
};
+static CONST char REGISTRY_ASSOC_KEY[] = "registry::command";
+
/*
- * The following table maps from registry types to strings. Note that
- * the indices for this array are the same as the constants for the
- * known registry types so we don't need a separate table to hold the
- * mapping.
+ * The following table maps from registry types to strings. Note that the
+ * indices for this array are the same as the constants for the known registry
+ * types so we don't need a separate table to hold the mapping.
*/
static CONST char *typeNames[] = {
@@ -70,9 +74,9 @@ 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.
+ * 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 {
@@ -80,7 +84,7 @@ typedef struct RegWinProcs {
LONG (WINAPI *regConnectRegistryProc)(CONST TCHAR *, HKEY, PHKEY);
LONG (WINAPI *regCreateKeyExProc)(HKEY, CONST TCHAR *, DWORD, TCHAR *,
- DWORD, REGSAM, SECURITY_ATTRIBUTES *, HKEY *, DWORD *);
+ 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);
@@ -107,7 +111,7 @@ static RegWinProcs asciiProcs = {
(LONG (WINAPI *)(CONST TCHAR *, HKEY, PHKEY)) RegConnectRegistryA,
(LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD, TCHAR *,
DWORD, REGSAM, SECURITY_ATTRIBUTES *, HKEY *,
- DWORD *)) RegCreateKeyExA,
+ DWORD *)) RegCreateKeyExA,
(LONG (WINAPI *)(HKEY, CONST TCHAR *)) RegDeleteKeyA,
(LONG (WINAPI *)(HKEY, CONST TCHAR *)) RegDeleteValueA,
(LONG (WINAPI *)(HKEY, DWORD, TCHAR *, DWORD)) RegEnumKeyA,
@@ -132,7 +136,7 @@ static RegWinProcs unicodeProcs = {
(LONG (WINAPI *)(CONST TCHAR *, HKEY, PHKEY)) RegConnectRegistryW,
(LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD, TCHAR *,
DWORD, REGSAM, SECURITY_ATTRIBUTES *, HKEY *,
- DWORD *)) RegCreateKeyExW,
+ DWORD *)) RegCreateKeyExW,
(LONG (WINAPI *)(HKEY, CONST TCHAR *)) RegDeleteKeyW,
(LONG (WINAPI *)(HKEY, CONST TCHAR *)) RegDeleteValueW,
(LONG (WINAPI *)(HKEY, DWORD, TCHAR *, DWORD)) RegEnumKeyW,
@@ -160,6 +164,7 @@ static void AppendSystemError(Tcl_Interp *interp, DWORD error);
static int BroadcastValue(Tcl_Interp *interp, int objc,
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 DeleteValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
Tcl_Obj *valueNameObj);
@@ -188,14 +193,15 @@ static int SetValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
Tcl_Obj *valueNameObj, Tcl_Obj *dataObj,
Tcl_Obj *typeObj);
-EXTERN int Registry_Init(Tcl_Interp *interp);
+EXTERN int Registry_Init(Tcl_Interp *interp);
+EXTERN int Registry_Unload(Tcl_Interp *interp, int flags);
/*
*----------------------------------------------------------------------
*
* Registry_Init --
*
- * This procedure initializes the registry command.
+ * This function initializes the registry command.
*
* Results:
* A standard Tcl result.
@@ -210,7 +216,9 @@ int
Registry_Init(
Tcl_Interp *interp)
{
- if (!Tcl_InitStubs(interp, "8.0", 0)) {
+ Tcl_Command cmd;
+
+ if (Tcl_InitStubs(interp, "8.1", 0) == NULL) {
return TCL_ERROR;
}
@@ -225,8 +233,80 @@ Registry_Init(
regWinProcs = &asciiProcs;
}
- Tcl_CreateObjCommand(interp, "registry", RegistryObjCmd, NULL, NULL);
- return Tcl_PkgProvide(interp, "registry", "1.1.5");
+ 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");
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Registry_Unload --
+ *
+ * This function removes the registry command.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * The registry command is deleted and the dll may be unloaded.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Registry_Unload(
+ Tcl_Interp *interp, /* Interpreter for unloading */
+ int flags) /* Flags passed by the unload system */
+{
+ Tcl_Command cmd;
+ Tcl_Obj *objv[3];
+
+ /*
+ * Unregister the registry package. There is no Tcl_PkgForget()
+ */
+
+ objv[0] = Tcl_NewStringObj("package", -1);
+ objv[1] = Tcl_NewStringObj("forget", -1);
+ objv[2] = Tcl_NewStringObj("registry", -1);
+ Tcl_EvalObjv(interp, 3, objv, TCL_EVAL_GLOBAL);
+
+ /*
+ * Delete the originally registered command.
+ */
+
+ cmd = (Tcl_Command)Tcl_GetAssocData(interp, REGISTRY_ASSOC_KEY, NULL);
+ if (cmd != NULL) {
+ Tcl_DeleteCommandFromToken(interp, cmd);
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DeleteCmd --
+ *
+ * Cleanup the interp command token so that unloading doesn't try to
+ * re-delete the command (which will crash).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The unload command will not attempt to delete this command.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DeleteCmd(
+ ClientData clientData)
+{
+ Tcl_Interp *interp = clientData;
+ Tcl_SetAssocData(interp, REGISTRY_ASSOC_KEY, NULL, (ClientData)NULL);
}
/*
@@ -256,8 +336,7 @@ RegistryObjCmd(
char *errString = NULL;
static CONST char *subcommands[] = {
- "broadcast", "delete", "get", "keys", "set", "type", "values",
- (char *) NULL
+ "broadcast", "delete", "get", "keys", "set", "type", "values", NULL
};
enum SubCmdIdx {
BroadcastIdx, DeleteIdx, GetIdx, KeysIdx, SetIdx, TypeIdx, ValuesIdx
@@ -274,65 +353,64 @@ RegistryObjCmd(
}
switch (index) {
- case BroadcastIdx: /* broadcast */
- return BroadcastValue(interp, objc, objv);
- break;
- case DeleteIdx: /* delete */
- if (objc == 3) {
- return DeleteKey(interp, objv[2]);
- } else if (objc == 4) {
- return DeleteValue(interp, objv[2], objv[3]);
- }
- errString = "keyName ?valueName?";
- break;
- case GetIdx: /* get */
- if (objc == 4) {
- return GetValue(interp, objv[2], objv[3]);
- }
- 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]);
- }
- errString = "keyName ?pattern?";
- break;
- case SetIdx: /* set */
- if (objc == 3) {
- HKEY key;
+ case BroadcastIdx: /* broadcast */
+ return BroadcastValue(interp, objc, objv);
+ break;
+ case DeleteIdx: /* delete */
+ if (objc == 3) {
+ return DeleteKey(interp, objv[2]);
+ } else if (objc == 4) {
+ return DeleteValue(interp, objv[2], objv[3]);
+ }
+ errString = "keyName ?valueName?";
+ break;
+ case GetIdx: /* get */
+ if (objc == 4) {
+ return GetValue(interp, objv[2], objv[3]);
+ }
+ 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]);
+ }
+ errString = "keyName ?pattern?";
+ break;
+ case SetIdx: /* set */
+ if (objc == 3) {
+ HKEY key;
- /*
- * Create the key and then close it immediately.
- */
+ /*
+ * Create the key and then close it immediately.
+ */
- if (OpenKey(interp, objv[2], KEY_ALL_ACCESS, 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);
- }
- errString = "keyName ?valueName data ?type??";
- break;
- case TypeIdx: /* type */
- if (objc == 4) {
- return GetType(interp, objv[2], objv[3]);
- }
- 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 (OpenKey(interp, objv[2], KEY_ALL_ACCESS, 1, &key) != TCL_OK) {
+ return TCL_ERROR;
}
- errString = "keyName ?pattern?";
- break;
+ 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);
+ }
+ errString = "keyName ?valueName data ?type??";
+ break;
+ case TypeIdx: /* type */
+ if (objc == 4) {
+ return GetType(interp, objv[2], objv[3]);
+ }
+ 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]);
+ }
+ errString = "keyName ?pattern?";
+ break;
}
Tcl_WrongNumArgs(interp, 2, objv, errString);
return TCL_ERROR;
@@ -364,7 +442,6 @@ DeleteKey(
HKEY rootKey, subkey;
DWORD result;
int length;
- Tcl_Obj *resultPtr;
Tcl_DString buf;
/*
@@ -375,15 +452,15 @@ DeleteKey(
buffer = ckalloc((unsigned int) length + 1);
strcpy(buffer, keyName);
- if (ParseKeyName(interp, buffer, &hostName, &rootKey, &keyName)
- != TCL_OK) {
+ if (ParseKeyName(interp, buffer, &hostName, &rootKey,
+ &keyName) != TCL_OK) {
ckfree(buffer);
return TCL_ERROR;
}
- resultPtr = Tcl_GetObjResult(interp);
if (*keyName == '\0') {
- Tcl_AppendToObj(resultPtr, "bad key: cannot delete root keys", -1);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "bad key: cannot delete root keys", -1));
ckfree(buffer);
return TCL_ERROR;
}
@@ -402,11 +479,11 @@ DeleteKey(
ckfree(buffer);
if (result == ERROR_FILE_NOT_FOUND) {
return TCL_OK;
- } else {
- Tcl_AppendToObj(resultPtr, "unable to delete key: ", -1);
- AppendSystemError(interp, result);
- return TCL_ERROR;
}
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "unable to delete key: ", -1));
+ AppendSystemError(interp, result);
+ return TCL_ERROR;
}
/*
@@ -418,7 +495,8 @@ DeleteKey(
Tcl_DStringFree(&buf);
if (result != ERROR_SUCCESS && result != ERROR_FILE_NOT_FOUND) {
- Tcl_AppendToObj(resultPtr, "unable to delete key: ", -1);
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj("unable to delete key: ", -1));
AppendSystemError(interp, result);
result = TCL_ERROR;
} else {
@@ -456,7 +534,6 @@ DeleteValue(
char *valueName;
int length;
DWORD result;
- Tcl_Obj *resultPtr;
Tcl_DString ds;
/*
@@ -468,13 +545,12 @@ DeleteValue(
return TCL_ERROR;
}
- resultPtr = Tcl_GetObjResult(interp);
valueName = Tcl_GetStringFromObj(valueNameObj, &length);
Tcl_WinUtfToTChar(valueName, length, &ds);
result = (*regWinProcs->regDeleteValueProc)(key, Tcl_DStringValue(&ds));
Tcl_DStringFree(&ds);
if (result != ERROR_SUCCESS) {
- Tcl_AppendStringsToObj(resultPtr, "unable to delete value \"",
+ Tcl_AppendResult(interp, "unable to delete value \"",
Tcl_GetString(valueNameObj), "\" from key \"",
Tcl_GetString(keyNameObj), "\": ", NULL);
AppendSystemError(interp, result);
@@ -491,13 +567,13 @@ DeleteValue(
*
* GetKeyNames --
*
- * This function enumerates the subkeys of a given key. If the
- * optional pattern is supplied, then only keys that match the
- * pattern will be returned.
+ * This function enumerates the subkeys of a given key. If the optional
+ * pattern is supplied, then only keys that match the pattern will be
+ * returned.
*
* Results:
- * Returns the list of subkeys in the result object of the
- * interpreter, or an error message on failure.
+ * Returns the list of subkeys in the result object of the interpreter,
+ * or an error message on failure.
*
* Side effects:
* None.
@@ -537,17 +613,17 @@ GetKeyNames(
return TCL_ERROR;
}
- /*
+ /*
* 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,
+ (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_AppendResult(interp, "unable to query key \"",
Tcl_GetString(keyNameObj), "\": ", NULL);
AppendSystemError(interp, result);
RegCloseKey(key);
@@ -607,8 +683,8 @@ GetKeyNames(
*
* GetType --
*
- * This function gets the type of a given registry value and
- * places it in the interpreter result.
+ * This function gets the type of a given registry value and places it in
+ * the interpreter result.
*
* Results:
* Returns a normal Tcl result.
@@ -626,7 +702,6 @@ GetType(
Tcl_Obj *valueNameObj) /* Name of value to get. */
{
HKEY key;
- Tcl_Obj *resultPtr;
DWORD result;
DWORD type;
Tcl_DString ds;
@@ -647,8 +722,6 @@ GetType(
* Get the type of the value.
*/
- resultPtr = Tcl_GetObjResult(interp);
-
valueName = Tcl_GetStringFromObj(valueNameObj, &length);
nativeValue = Tcl_WinUtfToTChar(valueName, length, &ds);
result = (*regWinProcs->regQueryValueExProc)(key, nativeValue, NULL, &type,
@@ -657,7 +730,7 @@ GetType(
RegCloseKey(key);
if (result != ERROR_SUCCESS) {
- Tcl_AppendStringsToObj(resultPtr, "unable to get type of value \"",
+ Tcl_AppendResult(interp, "unable to get type of value \"",
Tcl_GetString(valueNameObj), "\" from key \"",
Tcl_GetString(keyNameObj), "\": ", NULL);
AppendSystemError(interp, result);
@@ -665,14 +738,14 @@ GetType(
}
/*
- * Set the type into the result. Watch out for unknown types.
- * If we don't know about the type, just use the numeric value.
+ * Set the type into the result. Watch out for unknown types. If we don't
+ * know about the type, just use the numeric value.
*/
if (type > lastType) {
- Tcl_SetIntObj(resultPtr, (int) type);
+ Tcl_SetObjResult(interp, Tcl_NewIntObj((int) type));
} else {
- Tcl_SetStringObj(resultPtr, typeNames[type], -1);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(typeNames[type], -1));
}
return TCL_OK;
}
@@ -682,9 +755,8 @@ GetType(
*
* GetValue --
*
- * This function gets the contents of a registry value and places
- * a list containing the data and the type in the interpreter
- * result.
+ * This function gets the contents of a registry value and places a list
+ * containing the data and the type in the interpreter result.
*
* Results:
* Returns a normal Tcl result.
@@ -705,7 +777,6 @@ GetValue(
char *valueName;
CONST char *nativeValue;
DWORD result, length, type;
- Tcl_Obj *resultPtr;
Tcl_DString data, buf;
int nameLen;
@@ -713,16 +784,15 @@ GetValue(
* Attempt to open the key for reading.
*/
- if (OpenKey(interp, keyNameObj, KEY_QUERY_VALUE, 0, &key)
- != TCL_OK) {
+ if (OpenKey(interp, keyNameObj, KEY_QUERY_VALUE, 0, &key) != TCL_OK) {
return TCL_ERROR;
}
/*
- * Initialize a Dstring to maximum statically allocated size
- * we could get one more byte by avoiding Tcl_DStringSetLength()
- * and just setting length to TCL_DSTRING_STATIC_SIZE, but this
- * should be safer if the implementation of Dstrings changes.
+ * Initialize a Dstring to maximum statically allocated size we could get
+ * one more byte by avoiding Tcl_DStringSetLength() and just setting
+ * length to TCL_DSTRING_STATIC_SIZE, but this should be safer if the
+ * implementation of Dstrings changes.
*
* This allows short values to be read from the registy in one call.
* Longer values need a second call with an expanded DString.
@@ -732,8 +802,6 @@ GetValue(
length = TCL_DSTRING_STATIC_SIZE - 1;
Tcl_DStringSetLength(&data, (int) length);
- resultPtr = Tcl_GetObjResult(interp);
-
valueName = Tcl_GetStringFromObj(valueNameObj, &nameLen);
nativeValue = Tcl_WinUtfToTChar(valueName, nameLen, &buf);
@@ -741,19 +809,20 @@ GetValue(
(BYTE *) Tcl_DStringValue(&data), &length);
while (result == ERROR_MORE_DATA) {
/*
- * The Windows docs say that in this error case, we just need
- * to expand our buffer and request more data.
- * Required for HKEY_PERFORMANCE_DATA
+ * The Windows docs say that in this error case, we just need to
+ * expand our buffer and request more data. Required for
+ * HKEY_PERFORMANCE_DATA
*/
+
length *= 2;
- Tcl_DStringSetLength(&data, (int) length);
- result = (*regWinProcs->regQueryValueExProc)(key, (char *) nativeValue,
+ Tcl_DStringSetLength(&data, (int) length);
+ result = (*regWinProcs->regQueryValueExProc)(key, (char *) nativeValue,
NULL, &type, (BYTE *) Tcl_DStringValue(&data), &length);
}
Tcl_DStringFree(&buf);
RegCloseKey(key);
if (result != ERROR_SUCCESS) {
- Tcl_AppendStringsToObj(resultPtr, "unable to get value \"",
+ Tcl_AppendResult(interp, "unable to get value \"",
Tcl_GetString(valueNameObj), "\" from key \"",
Tcl_GetString(keyNameObj), "\": ", NULL);
AppendSystemError(interp, result);
@@ -762,26 +831,27 @@ GetValue(
}
/*
- * If the data is a 32-bit quantity, store it as an integer object. If it
- * is a multi-string, store it as a list of strings. For null-terminated
- * strings, append up the to first null. Otherwise, store it as a binary
+ * If the data is a 32-bit quantity, store it as an integer object. If it
+ * is a multi-string, store it as a list of strings. For null-terminated
+ * strings, append up the to first null. Otherwise, store it as a binary
* string.
*/
if (type == REG_DWORD || type == REG_DWORD_BIG_ENDIAN) {
- Tcl_SetIntObj(resultPtr, (int) ConvertDWORD(type,
- *((DWORD*) Tcl_DStringValue(&data))));
+ Tcl_SetObjResult(interp, Tcl_NewIntObj((int) ConvertDWORD(type,
+ *((DWORD*) Tcl_DStringValue(&data)))));
} else if (type == REG_MULTI_SZ) {
char *p = Tcl_DStringValue(&data);
char *end = Tcl_DStringValue(&data) + length;
+ Tcl_Obj *resultPtr = Tcl_NewObj();
/*
* Multistrings are stored as an array of null-terminated strings,
- * terminated by two null characters. Also do a bounds check in
- * case we get bogus data.
+ * terminated by two null characters. Also do a bounds check in case
+ * we get bogus data.
*/
-
- while (p < end && ((regWinProcs->useWide)
+
+ while (p < end && ((regWinProcs->useWide)
? *((Tcl_UniChar *)p) : *p) != 0) {
Tcl_WinTCharToUtf((TCHAR *) p, -1, &buf);
Tcl_ListObjAppendElement(interp, resultPtr,
@@ -796,17 +866,17 @@ GetValue(
}
Tcl_DStringFree(&buf);
}
+ Tcl_SetObjResult(interp, resultPtr);
} else if ((type == REG_SZ) || (type == REG_EXPAND_SZ)) {
Tcl_WinTCharToUtf((TCHAR *) Tcl_DStringValue(&data), -1, &buf);
- Tcl_SetStringObj(resultPtr, Tcl_DStringValue(&buf),
- Tcl_DStringLength(&buf));
- Tcl_DStringFree(&buf);
+ Tcl_DStringResult(interp, &buf);
} else {
/*
* Save binary data as a byte array.
*/
- Tcl_SetByteArrayObj(resultPtr, (BYTE *) Tcl_DStringValue(&data), (int) length);
+ Tcl_SetObjResult(interp, Tcl_NewByteArrayObj(
+ (BYTE *) Tcl_DStringValue(&data), (int) length));
}
Tcl_DStringFree(&data);
return result;
@@ -817,9 +887,9 @@ GetValue(
*
* GetValueNames --
*
- * This function enumerates the values of the a given key. If
- * the optional pattern is supplied, then only value names that
- * match the pattern will be returned.
+ * This function enumerates the values of the a given key. If the
+ * optional pattern is supplied, then only value names that match the
+ * pattern will be returned.
*
* Results:
* Returns the list of value names in the result object of the
@@ -852,8 +922,6 @@ GetValueNames(
return TCL_ERROR;
}
- resultPtr = Tcl_GetObjResult(interp);
-
/*
* Query the key to determine the appropriate buffer size to hold the
* largest value name plus the terminating null.
@@ -862,7 +930,7 @@ GetValueNames(
result = (*regWinProcs->regQueryInfoKeyProc)(key, NULL, NULL, NULL, NULL,
NULL, NULL, &index, &maxSize, NULL, NULL, NULL);
if (result != ERROR_SUCCESS) {
- Tcl_AppendStringsToObj(resultPtr, "unable to query key \"",
+ Tcl_AppendResult(interp, "unable to query key \"",
Tcl_GetString(keyNameObj), "\": ", NULL);
AppendSystemError(interp, result);
RegCloseKey(key);
@@ -871,7 +939,7 @@ GetValueNames(
}
maxSize++;
-
+ resultPtr = Tcl_NewObj();
Tcl_DStringInit(&buffer);
Tcl_DStringSetLength(&buffer,
(int) ((regWinProcs->useWide) ? maxSize*2 : maxSize));
@@ -886,8 +954,8 @@ GetValueNames(
/*
* Enumerate the values under the given subkey until we get an error,
- * indicating the end of the list. Note that we need to reset size
- * after each iteration because RegEnumValue smashes the old value.
+ * indicating the end of the list. Note that we need to reset size after
+ * each iteration because RegEnumValue smashes the old value.
*/
size = maxSize;
@@ -899,7 +967,8 @@ GetValueNames(
size *= 2;
}
- Tcl_WinTCharToUtf((TCHAR *) Tcl_DStringValue(&buffer), (int) size, &ds);
+ Tcl_WinTCharToUtf((TCHAR *) Tcl_DStringValue(&buffer), (int) size,
+ &ds);
name = Tcl_DStringValue(&ds);
if (!pattern || Tcl_StringMatch(name, pattern)) {
result = Tcl_ListObjAppendElement(interp, resultPtr,
@@ -914,9 +983,10 @@ GetValueNames(
index++;
size = maxSize;
}
+ Tcl_SetObjResult(interp, resultPtr);
Tcl_DStringFree(&buffer);
- done:
+ done:
RegCloseKey(key);
return result;
}
@@ -926,12 +996,11 @@ GetValueNames(
*
* OpenKey --
*
- * This function opens the specified key. This function is a
- * simple wrapper around ParseKeyName and OpenSubKey.
+ * This function opens the specified key. This function is a simple
+ * wrapper around ParseKeyName and OpenSubKey.
*
* Results:
- * Returns the opened key in the keyPtr argument and a Tcl
- * result code.
+ * Returns the opened key in the keyPtr argument and a Tcl result code.
*
* Side effects:
* None.
@@ -960,8 +1029,8 @@ OpenKey(
if (result == TCL_OK) {
result = OpenSubKey(hostName, rootKey, keyName, mode, flags, keyPtr);
if (result != ERROR_SUCCESS) {
- Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
- Tcl_AppendToObj(resultPtr, "unable to open key: ", -1);
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj("unable to open key: ", -1));
AppendSystemError(interp, result);
result = TCL_ERROR;
} else {
@@ -978,12 +1047,12 @@ OpenKey(
*
* OpenSubKey --
*
- * This function opens a given subkey of a root key on the
- * specified host.
+ * This function opens a given subkey of a root key on the specified
+ * host.
*
* Results:
- * Returns the opened key in the keyPtr and a Windows error code
- * as the return value.
+ * Returns the opened key in the keyPtr and a Windows error code as the
+ * return value.
*
* Side effects:
* None.
@@ -1018,8 +1087,8 @@ OpenSubKey(
}
/*
- * Now open the specified key with the requested permissions. Note
- * that this key must be closed by the caller.
+ * Now open the specified key with the requested permissions. Note that
+ * this key must be closed by the caller.
*/
keyName = (char *) Tcl_WinUtfToTChar(keyName, -1, &buf);
@@ -1027,19 +1096,16 @@ OpenSubKey(
DWORD create;
result = (*regWinProcs->regCreateKeyExProc)(rootKey, keyName, 0, NULL,
REG_OPTION_NON_VOLATILE, mode, NULL, keyPtr, &create);
+ } else if (rootKey == HKEY_PERFORMANCE_DATA) {
+ /*
+ * Here we fudge it for this special root key. See MSDN for more info
+ * on HKEY_PERFORMANCE_DATA and the peculiarities surrounding it.
+ */
+ *keyPtr = HKEY_PERFORMANCE_DATA;
+ result = ERROR_SUCCESS;
} else {
- 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, keyPtr);
- }
+ result = (*regWinProcs->regOpenKeyExProc)(rootKey, keyName, 0, mode,
+ keyPtr);
}
Tcl_DStringFree(&buf);
@@ -1058,15 +1124,12 @@ OpenSubKey(
*
* ParseKeyName --
*
- * This function parses a key name into the host, root, and subkey
- * parts.
+ * This function parses a key name into the host, root, and subkey parts.
*
* Results:
- * The pointers to the start of the host and subkey names are
- * returned in the hostNamePtr and keyNamePtr variables. The
- * specified root HKEY is returned in rootKeyPtr. Returns
- * a standard Tcl result.
- *
+ * The pointers to the start of the host and subkey names are returned in
+ * the hostNamePtr and keyNamePtr variables. The specified root HKEY is
+ * returned in rootKeyPtr. Returns a standard Tcl result.
*
* Side effects:
* Modifies the name string by inserting nulls.
@@ -1084,7 +1147,7 @@ ParseKeyName(
{
char *rootName;
int result, index;
- Tcl_Obj *rootObj, *resultPtr = Tcl_GetObjResult(interp);
+ Tcl_Obj *rootObj;
/*
* Split the key into host and root portions.
@@ -1105,7 +1168,7 @@ ParseKeyName(
rootName = name;
}
if (!rootName) {
- Tcl_AppendStringsToObj(resultPtr, "bad key \"", name,
+ Tcl_AppendResult(interp, "bad key \"", name,
"\": must start with a valid root", NULL);
return TCL_ERROR;
}
@@ -1142,9 +1205,9 @@ ParseKeyName(
*
* RecursiveDeleteKey --
*
- * This function recursively deletes all the keys below a starting
- * key. Although Windows 95 does this automatically, we still need
- * to do this for Windows NT.
+ * This function recursively deletes all the keys below a starting key.
+ * Although Windows 95 does this automatically, we still need to do this
+ * for Windows NT.
*
* Results:
* Returns a Windows error code.
@@ -1214,9 +1277,9 @@ RecursiveDeleteKey(
*
* SetValue --
*
- * This function sets the contents of a registry value. If
- * the key or value does not exist, it will be created. If it
- * does exist, then the data and type will be replaced.
+ * This function sets the contents of a registry value. If the key or
+ * value does not exist, it will be created. If it does exist, then the
+ * data and type will be replaced.
*
* Results:
* Returns a normal Tcl result.
@@ -1235,11 +1298,11 @@ SetValue(
Tcl_Obj *dataObj, /* Data to be written. */
Tcl_Obj *typeObj) /* Type of data to be written. */
{
- DWORD type, result;
+ int type;
+ DWORD result;
HKEY key;
int length;
char *valueName;
- Tcl_Obj *resultPtr;
Tcl_DString nameBuf;
if (typeObj == NULL) {
@@ -1257,19 +1320,19 @@ SetValue(
valueName = Tcl_GetStringFromObj(valueNameObj, &length);
valueName = (char *) Tcl_WinUtfToTChar(valueName, length, &nameBuf);
- resultPtr = Tcl_GetObjResult(interp);
if (type == REG_DWORD || type == REG_DWORD_BIG_ENDIAN) {
- DWORD value;
- if (Tcl_GetIntFromObj(interp, dataObj, (int*) &value) != TCL_OK) {
+ int value;
+
+ if (Tcl_GetIntFromObj(interp, dataObj, &value) != TCL_OK) {
RegCloseKey(key);
Tcl_DStringFree(&nameBuf);
return TCL_ERROR;
}
- value = ConvertDWORD(type, value);
- result = (*regWinProcs->regSetValueExProc)(key, valueName, 0, type,
- (BYTE*) &value, sizeof(DWORD));
+ value = ConvertDWORD((DWORD)type, (DWORD)value);
+ result = (*regWinProcs->regSetValueExProc)(key, valueName, 0,
+ (DWORD) type, (BYTE *) &value, sizeof(DWORD));
} else if (type == REG_MULTI_SZ) {
Tcl_DString data, buf;
int objc, i;
@@ -1282,9 +1345,9 @@ SetValue(
}
/*
- * Append the elements as null terminated strings. Note that
- * we must not assume the length of the string in case there are
- * embedded nulls, which aren't allowed in REG_MULTI_SZ values.
+ * Append the elements as null terminated strings. Note that we must
+ * not assume the length of the string in case there are embedded
+ * nulls, which aren't allowed in REG_MULTI_SZ values.
*/
Tcl_DStringInit(&data);
@@ -1292,8 +1355,8 @@ SetValue(
Tcl_DStringAppend(&data, Tcl_GetString(objv[i]), -1);
/*
- * Add a null character to separate this value from the next.
- * We accomplish this by growing the string by one byte. Since the
+ * Add a null character to separate this value from the next. We
+ * accomplish this by growing the string by one byte. Since the
* DString always tacks on an extra null byte, the new byte will
* already be set to null.
*/
@@ -1303,16 +1366,16 @@ SetValue(
Tcl_WinUtfToTChar(Tcl_DStringValue(&data), Tcl_DStringLength(&data)+1,
&buf);
- result = (*regWinProcs->regSetValueExProc)(key, valueName, 0, type,
- (BYTE *) Tcl_DStringValue(&buf),
+ result = (*regWinProcs->regSetValueExProc)(key, valueName, 0,
+ (DWORD) type, (BYTE *) Tcl_DStringValue(&buf),
(DWORD) Tcl_DStringLength(&buf));
Tcl_DStringFree(&data);
Tcl_DStringFree(&buf);
} else if (type == REG_SZ || type == REG_EXPAND_SZ) {
Tcl_DString buf;
- char *data = Tcl_GetStringFromObj(dataObj, &length);
+ CONST char *data = Tcl_GetStringFromObj(dataObj, &length);
- data = (char *) Tcl_WinUtfToTChar(data, length, &buf);
+ data = Tcl_WinUtfToTChar(data, length, &buf);
/*
* Include the null in the length, padding if needed for Unicode.
@@ -1323,8 +1386,8 @@ SetValue(
}
length = Tcl_DStringLength(&buf) + 1;
- result = (*regWinProcs->regSetValueExProc)(key, valueName, 0, type,
- (BYTE*)data, (DWORD) length);
+ result = (*regWinProcs->regSetValueExProc)(key, valueName, 0,
+ (DWORD) type, (BYTE *) data, (DWORD) length);
Tcl_DStringFree(&buf);
} else {
BYTE *data;
@@ -1333,14 +1396,17 @@ SetValue(
* Store binary data in the registry.
*/
- data = Tcl_GetByteArrayFromObj(dataObj, &length);
- result = (*regWinProcs->regSetValueExProc)(key, valueName, 0, type,
- data, (DWORD) length);
+ data = (BYTE *) Tcl_GetByteArrayFromObj(dataObj, &length);
+ result = (*regWinProcs->regSetValueExProc)(key, valueName, 0,
+ (DWORD) type, data, (DWORD) length);
}
+
Tcl_DStringFree(&nameBuf);
RegCloseKey(key);
+
if (result != ERROR_SUCCESS) {
- Tcl_AppendToObj(resultPtr, "unable to set value: ", -1);
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj("unable to set value: ", -1));
AppendSystemError(interp, result);
return TCL_ERROR;
}
@@ -1352,9 +1418,8 @@ SetValue(
*
* BroadcastValue --
*
- * This function broadcasts a WM_SETTINGCHANGE message to indicate
- * to other programs that we have changed the contents of a registry
- * value.
+ * This function broadcasts a WM_SETTINGCHANGE message to indicate to
+ * other programs that we have changed the contents of a registry value.
*
* Results:
* Returns a normal Tcl result.
@@ -1369,13 +1434,13 @@ 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;
- char *str;
+ CONST char *str;
Tcl_Obj *objPtr;
if ((objc != 3) && (objc != 5)) {
@@ -1385,7 +1450,8 @@ BroadcastValue(
if (objc > 3) {
str = Tcl_GetStringFromObj(objv[3], &len);
- if ((len < 2) || (*str != '-') || strncmp(str, "-timeout", (size_t) len)) {
+ if ((len < 2) || (*str != '-')
+ || strncmp(str, "-timeout", (size_t) len)) {
Tcl_WrongNumArgs(interp, 2, objv, "keyName ?-timeout millisecs?");
return TCL_ERROR;
}
@@ -1402,6 +1468,7 @@ BroadcastValue(
/*
* Use the ignore the result.
*/
+
result = SendMessageTimeout(HWND_BROADCAST, WM_SETTINGCHANGE,
(WPARAM) 0, (LPARAM) str, SMTO_ABORTIFHUNG, timeout, &sendResult);
@@ -1418,8 +1485,8 @@ BroadcastValue(
*
* AppendSystemError --
*
- * This routine formats a Windows system error message and places
- * it into the interpreter result.
+ * This routine formats a Windows system error message and places it into
+ * the interpreter result.
*
* Results:
* None.
@@ -1436,15 +1503,18 @@ AppendSystemError(
DWORD error) /* Result code from error. */
{
int length;
- WCHAR *wMsgPtr;
+ WCHAR *wMsgPtr, **wMsgPtrPtr = &wMsgPtr;
char *msg;
char id[TCL_INTEGER_SPACE], msgBuf[24 + TCL_INTEGER_SPACE];
Tcl_DString ds;
Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
+ if (Tcl_IsShared(resultPtr)) {
+ resultPtr = Tcl_DuplicateObj(resultPtr);
+ }
length = FormatMessageW(FORMAT_MESSAGE_FROM_SYSTEM
| FORMAT_MESSAGE_ALLOCATE_BUFFER, NULL, error,
- MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (WCHAR *) &wMsgPtr,
+ MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (WCHAR *) wMsgPtrPtr,
0, NULL);
if (length == 0) {
char *msgPtr;
@@ -1481,6 +1551,7 @@ AppendSystemError(
/*
* Trim the trailing CR/LF from the system message.
*/
+
if (msg[length-1] == '\n') {
msg[--length] = 0;
}
@@ -1490,8 +1561,9 @@ AppendSystemError(
}
sprintf(id, "%ld", error);
- Tcl_SetErrorCode(interp, "WINDOWS", id, msg, (char *) NULL);
+ Tcl_SetErrorCode(interp, "WINDOWS", id, msg, NULL);
Tcl_AppendToObj(resultPtr, msg, length);
+ Tcl_SetObjResult(interp, resultPtr);
if (length != 0) {
Tcl_DStringFree(&ds);
@@ -1503,8 +1575,8 @@ AppendSystemError(
*
* ConvertDWORD --
*
- * This function determines whether a DWORD needs to be byte
- * swapped, and returns the appropriately swapped value.
+ * This function determines whether a DWORD needs to be byte swapped, and
+ * returns the appropriately swapped value.
*
* Results:
* Returns a converted DWORD.
@@ -1527,6 +1599,14 @@ ConvertDWORD(
* Check to see if the low bit is in the first byte.
*/
- localType = (*((char*)(&order)) == 1) ? REG_DWORD : REG_DWORD_BIG_ENDIAN;
- return (type != localType) ? (DWORD)SWAPLONG(value) : value;
+ localType = (*((char*) &order) == 1) ? REG_DWORD : REG_DWORD_BIG_ENDIAN;
+ return (type != localType) ? (DWORD) SWAPLONG(value) : value;
}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/win/tclWinSerial.c b/win/tclWinSerial.c
index 24c6a67..fb092ff 100644
--- a/win/tclWinSerial.c
+++ b/win/tclWinSerial.c
@@ -1,21 +1,19 @@
/*
* tclWinSerial.c --
*
- * This file implements the Windows-specific serial port functions,
- * and the "serial" channel driver.
+ * This file implements the Windows-specific serial port functions, and
+ * the "serial" channel driver.
*
* Copyright (c) 1999 by Scriptics Corp.
*
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
* Serial functionality implemented by Rolf.Schroedter@dlr.de
*/
#include "tclWinInt.h"
-#include <fcntl.h>
-#include <io.h>
#include <sys/stat.h>
/*
@@ -37,27 +35,30 @@ TCL_DECLARE_MUTEX(serialMutex)
* Bit masks used in the flags field of the SerialInfo structure below.
*/
-#define SERIAL_PENDING (1<<0) /* Message is pending in the queue. */
-#define SERIAL_ASYNC (1<<1) /* Channel is non-blocking. */
+#define SERIAL_PENDING (1<<0) /* Message is pending in the queue. */
+#define SERIAL_ASYNC (1<<1) /* Channel is non-blocking. */
/*
* Bit masks used in the sharedFlags field of the SerialInfo structure below.
*/
-#define SERIAL_EOF (1<<2) /* Serial has reached EOF. */
-#define SERIAL_ERROR (1<<4)
+#define SERIAL_EOF (1<<2) /* Serial has reached EOF. */
+#define SERIAL_ERROR (1<<4)
/*
* Default time to block between checking status on the serial port.
*/
-#define SERIAL_DEFAULT_BLOCKTIME 10 /* 10 msec */
+
+#define SERIAL_DEFAULT_BLOCKTIME 10 /* 10 msec */
/*
* Define Win32 read/write error masks returned by ClearCommError()
*/
-#define SERIAL_READ_ERRORS ( CE_RXOVER | CE_OVERRUN | CE_RXPARITY \
- | CE_FRAME | CE_BREAK )
-#define SERIAL_WRITE_ERRORS ( CE_TXFULL | CE_PTO )
+
+#define SERIAL_READ_ERRORS \
+ (CE_RXOVER | CE_OVERRUN | CE_RXPARITY | CE_FRAME | CE_BREAK)
+#define SERIAL_WRITE_ERRORS \
+ (CE_TXFULL | CE_PTO)
/*
* This structure describes per-instance data for a serial based channel.
@@ -65,68 +66,66 @@ TCL_DECLARE_MUTEX(serialMutex)
typedef struct SerialInfo {
HANDLE handle;
- struct SerialInfo *nextPtr; /* Pointer to next registered serial. */
- Tcl_Channel channel; /* Pointer to channel structure. */
- int validMask; /* OR'ed combination of TCL_READABLE,
- * TCL_WRITABLE, or TCL_EXCEPTION: indicates
- * which operations are valid on the file. */
- int watchMask; /* OR'ed combination of TCL_READABLE,
- * TCL_WRITABLE, or TCL_EXCEPTION: indicates
- * which events should be reported. */
- int flags; /* State flags, see above for a list. */
- int readable; /* flag that the channel is readable */
- int writable; /* flag that the channel is writable */
- int blockTime; /* max. blocktime in msec */
- unsigned int lastEventTime; /* Time in milliseconds since last readable event */
+ struct SerialInfo *nextPtr; /* Pointer to next registered serial. */
+ Tcl_Channel channel; /* Pointer to channel structure. */
+ int validMask; /* OR'ed combination of TCL_READABLE,
+ * TCL_WRITABLE, or TCL_EXCEPTION: indicates
+ * which operations are valid on the file. */
+ int watchMask; /* OR'ed combination of TCL_READABLE,
+ * TCL_WRITABLE, or TCL_EXCEPTION: indicates
+ * which events should be reported. */
+ int flags; /* State flags, see above for a list. */
+ int readable; /* Flag that the channel is readable. */
+ int writable; /* Flag that the channel is writable. */
+ int blockTime; /* Maximum blocktime in msec. */
+ unsigned int lastEventTime; /* Time in milliseconds since last readable
+ * event. */
/* Next readable event only after blockTime */
- DWORD error; /* pending error code returned by
- * ClearCommError() */
- DWORD lastError; /* last error code, can be fetched with
- * fconfigure chan -lasterror */
- DWORD sysBufRead; /* Win32 system buffer size for read ops,
- * default=4096 */
- DWORD sysBufWrite; /* Win32 system buffer size for write ops,
- * default=4096 */
-
- Tcl_ThreadId threadId; /* Thread to which events should be reported.
- * This value is used by the reader/writer
- * threads. */
- OVERLAPPED osRead; /* OVERLAPPED structure for read operations */
- OVERLAPPED osWrite; /* OVERLAPPED structure for write operations */
- HANDLE writeThread; /* Handle to writer thread. */
- CRITICAL_SECTION csWrite; /* Writer thread synchronisation */
- HANDLE evWritable; /* Manual-reset event to signal when the
- * writer thread has finished waiting for
- * the current buffer to be written. */
- HANDLE evStartWriter; /* Auto-reset event used by the main thread to
- * signal when the writer thread should attempt
- * to write to the serial. */
+ DWORD error; /* pending error code returned by
+ * ClearCommError() */
+ DWORD lastError; /* last error code, can be fetched with
+ * fconfigure chan -lasterror */
+ DWORD sysBufRead; /* Win32 system buffer size for read ops,
+ * default=4096 */
+ DWORD sysBufWrite; /* Win32 system buffer size for write ops,
+ * default=4096 */
+
+ Tcl_ThreadId threadId; /* Thread to which events should be reported.
+ * This value is used by the reader/writer
+ * threads. */
+ OVERLAPPED osRead; /* OVERLAPPED structure for read operations. */
+ OVERLAPPED osWrite; /* OVERLAPPED structure for write operations */
+ HANDLE writeThread; /* Handle to writer thread. */
+ CRITICAL_SECTION csWrite; /* Writer thread synchronisation. */
+ HANDLE evWritable; /* Manual-reset event to signal when the
+ * writer thread has finished waiting for the
+ * current buffer to be written. */
+ HANDLE evStartWriter; /* Auto-reset event used by the main thread to
+ * signal when the writer thread should
+ * attempt to write to the serial. */
HANDLE evStopWriter; /* Auto-reset event used by the main thread to
- * signal when the writer thread should close.
+ * signal when the writer thread should close.
*/
- 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
- * writer thread so access must be
- * synchronized with the evWritable object.
- */
- char *writeBuf; /* Current background output buffer.
- * Access is synchronized with the evWritable
- * object. */
- int writeBufLen; /* Size of write buffer. Access is
- * synchronized with the evWritable
- * object. */
- int toWrite; /* Current amount to be written. Access is
- * synchronized with the evWritable object. */
- int writeQueue; /* Number of bytes pending in output queue.
- * Offset to DCB.cbInQue.
- * Used to query [fconfigure -queue] */
+ 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
+ * writer thread so access must be
+ * synchronized with the evWritable object. */
+ char *writeBuf; /* Current background output buffer. Access is
+ * synchronized with the evWritable object. */
+ int writeBufLen; /* Size of write buffer. Access is
+ * synchronized with the evWritable object. */
+ int toWrite; /* Current amount to be written. Access is
+ * synchronized with the evWritable object. */
+ int writeQueue; /* Number of bytes pending in output queue.
+ * Offset to DCB.cbInQue. Used to query
+ * [fconfigure -queue] */
} SerialInfo;
typedef struct ThreadSpecificData {
/*
- * The following pointer refers to the head of the list of serials
- * that are being watched for file events.
+ * The following pointer refers to the head of the list of serials that
+ * are being watched for file events.
*/
SerialInfo *firstSerialPtr;
@@ -135,17 +134,17 @@ typedef struct ThreadSpecificData {
static Tcl_ThreadDataKey dataKey;
/*
- * The following structure is what is added to the Tcl event queue when
- * serial events are generated.
+ * The following structure is what is added to the Tcl event queue when serial
+ * events are generated.
*/
typedef struct SerialEvent {
- Tcl_Event header; /* Information that is standard for
- * all events. */
- SerialInfo *infoPtr; /* Pointer to serial info structure. Note
- * that we still have to verify that the
- * serial exists before dereferencing this
- * pointer. */
+ Tcl_Event header; /* Information that is standard for all
+ * events. */
+ SerialInfo *infoPtr; /* Pointer to serial info structure. Note that
+ * we still have to verify that the serial
+ * exists before dereferencing this
+ * pointer. */
} SerialEvent;
/*
@@ -153,43 +152,47 @@ typedef struct SerialEvent {
*/
static COMMTIMEOUTS no_timeout = {
- 0, /* ReadIntervalTimeout */
- 0, /* ReadTotalTimeoutMultiplier */
- 0, /* ReadTotalTimeoutConstant */
- 0, /* WriteTotalTimeoutMultiplier */
- 0, /* WriteTotalTimeoutConstant */
+ 0, /* ReadIntervalTimeout */
+ 0, /* ReadTotalTimeoutMultiplier */
+ 0, /* ReadTotalTimeoutConstant */
+ 0, /* WriteTotalTimeoutMultiplier */
+ 0, /* WriteTotalTimeoutConstant */
};
/*
* Declarations for functions used only in this file.
*/
-static int SerialBlockProc(ClientData instanceData, int mode);
-static void SerialCheckProc(ClientData clientData, int flags);
-static int SerialCloseProc(ClientData instanceData,
- Tcl_Interp *interp);
-static int SerialEventProc(Tcl_Event *evPtr, int flags);
-static void SerialExitHandler(ClientData clientData);
-static int SerialGetHandleProc(ClientData instanceData,
- int direction, ClientData *handlePtr);
+static int SerialBlockProc(ClientData instanceData, int mode);
+static void SerialCheckProc(ClientData clientData, int flags);
+static int SerialCloseProc(ClientData instanceData,
+ Tcl_Interp *interp);
+static int SerialEventProc(Tcl_Event *evPtr, int flags);
+static void SerialExitHandler(ClientData clientData);
+static int SerialGetHandleProc(ClientData instanceData,
+ int direction, ClientData *handlePtr);
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);
-static void SerialSetupProc(ClientData clientData, int flags);
-static void SerialWatchProc(ClientData instanceData, int mask);
-static void ProcExitHandler(ClientData clientData);
-static int SerialGetOptionProc _ANSI_ARGS_((ClientData instanceData,
- Tcl_Interp *interp, CONST char *optionName,
- Tcl_DString *dsPtr));
-static int SerialSetOptionProc _ANSI_ARGS_((ClientData instanceData,
- Tcl_Interp *interp, CONST char *optionName,
- CONST char *value));
-static DWORD WINAPI SerialWriterThread(LPVOID arg);
-
-static void SerialThreadActionProc _ANSI_ARGS_ ((
- ClientData instanceData, int action));
+static int SerialInputProc(ClientData instanceData, char *buf,
+ int toRead, int *errorCode);
+static int SerialOutputProc(ClientData instanceData,
+ 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_DString *dsPtr);
+static int SerialSetOptionProc(ClientData instanceData,
+ Tcl_Interp *interp, CONST char *optionName,
+ CONST char *value);
+static DWORD WINAPI SerialWriterThread(LPVOID arg);
+static void SerialThreadActionProc(ClientData instanceData,
+ int action);
+static int SerialBlockingRead(SerialInfo *infoPtr, LPVOID buf,
+ DWORD bufSize, LPDWORD lpRead, LPOVERLAPPED osPtr);
+static int SerialBlockingWrite(SerialInfo *infoPtr, LPVOID buf,
+ DWORD bufSize, LPDWORD lpWritten,
+ LPOVERLAPPED osPtr);
/*
* This structure describes the channel type structure for command serial
@@ -197,42 +200,43 @@ static void SerialThreadActionProc _ANSI_ARGS_ ((
*/
static Tcl_ChannelType serialChannelType = {
- "serial", /* Type name. */
- TCL_CHANNEL_VERSION_4, /* v4 channel */
- SerialCloseProc, /* Close proc. */
- SerialInputProc, /* Input proc. */
- SerialOutputProc, /* Output proc. */
- NULL, /* Seek proc. */
- SerialSetOptionProc, /* Set option proc. */
- SerialGetOptionProc, /* Get option proc. */
- SerialWatchProc, /* Set up notifier to watch the channel. */
- SerialGetHandleProc, /* Get an OS handle from channel. */
- NULL, /* close2proc. */
- SerialBlockProc, /* Set blocking or non-blocking mode.*/
- NULL, /* flush proc. */
- NULL, /* handler proc. */
- NULL, /* wide seek proc */
- SerialThreadActionProc, /* thread action proc */
+ "serial", /* Type name. */
+ TCL_CHANNEL_VERSION_5, /* v5 channel */
+ SerialCloseProc, /* Close proc. */
+ SerialInputProc, /* Input proc. */
+ SerialOutputProc, /* Output proc. */
+ NULL, /* Seek proc. */
+ SerialSetOptionProc, /* Set option proc. */
+ SerialGetOptionProc, /* Get option proc. */
+ SerialWatchProc, /* Set up notifier to watch the channel. */
+ SerialGetHandleProc, /* Get an OS handle from channel. */
+ NULL, /* close2proc. */
+ SerialBlockProc, /* Set blocking or non-blocking mode.*/
+ NULL, /* flush proc. */
+ NULL, /* handler proc. */
+ NULL, /* wide seek proc */
+ SerialThreadActionProc, /* thread action proc */
+ NULL, /* truncate */
};
-
+
/*
*----------------------------------------------------------------------
*
* SerialInit --
*
- * This function initializes the static variables for this file.
+ * This function initializes the static variables for this file.
*
* Results:
- * None.
+ * None.
*
* Side effects:
- * Creates a new event source.
+ * Creates a new event source.
*
*----------------------------------------------------------------------
*/
static ThreadSpecificData *
-SerialInit()
+SerialInit(void)
{
ThreadSpecificData *tsdPtr;
@@ -242,104 +246,107 @@ SerialInit()
*/
if (!initialized) {
- Tcl_MutexLock(&serialMutex);
- if (!initialized) {
- initialized = 1;
- Tcl_CreateExitHandler(ProcExitHandler, NULL);
- }
- Tcl_MutexUnlock(&serialMutex);
+ Tcl_MutexLock(&serialMutex);
+ if (!initialized) {
+ initialized = 1;
+ Tcl_CreateExitHandler(ProcExitHandler, NULL);
+ }
+ Tcl_MutexUnlock(&serialMutex);
}
- tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
+ tsdPtr = (ThreadSpecificData *) TclThreadDataKeyGet(&dataKey);
if (tsdPtr == NULL) {
- tsdPtr = TCL_TSD_INIT(&dataKey);
- tsdPtr->firstSerialPtr = NULL;
- Tcl_CreateEventSource(SerialSetupProc, SerialCheckProc, NULL);
- Tcl_CreateThreadExitHandler(SerialExitHandler, NULL);
+ tsdPtr = TCL_TSD_INIT(&dataKey);
+ tsdPtr->firstSerialPtr = NULL;
+ Tcl_CreateEventSource(SerialSetupProc, SerialCheckProc, NULL);
+ Tcl_CreateThreadExitHandler(SerialExitHandler, NULL);
}
return tsdPtr;
}
-
+
/*
*----------------------------------------------------------------------
*
* SerialExitHandler --
*
- * This function is called to cleanup the serial module before
- * Tcl is unloaded.
+ * This function is called to cleanup the serial module before Tcl is
+ * unloaded.
*
* Results:
- * None.
+ * None.
*
* Side effects:
- * Removes the serial event source.
+ * Removes the serial event source.
*
*----------------------------------------------------------------------
*/
static void
SerialExitHandler(
- ClientData clientData) /* Old window proc */
+ ClientData clientData) /* Old window proc */
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
SerialInfo *infoPtr;
/*
- * Clear all eventually pending output.
- * Otherwise Tcl's exit could totally block,
- * because it performs a blocking flush on all open channels.
- * Note that serial write operations may be blocked due to handshake.
+ * Clear all eventually pending output. Otherwise Tcl's exit could totally
+ * block, because it performs a blocking flush on all open channels. Note
+ * that serial write operations may be blocked due to handshake.
*/
- for (infoPtr = tsdPtr->firstSerialPtr; infoPtr != NULL;
- infoPtr = infoPtr->nextPtr) {
- PurgeComm(infoPtr->handle, PURGE_TXABORT | PURGE_RXABORT | PURGE_TXCLEAR
- | PURGE_RXCLEAR);
+ for (infoPtr = tsdPtr->firstSerialPtr; infoPtr != NULL;
+ infoPtr = infoPtr->nextPtr) {
+ PurgeComm(infoPtr->handle,
+ PURGE_TXABORT | PURGE_RXABORT | PURGE_TXCLEAR | PURGE_RXCLEAR);
}
Tcl_DeleteEventSource(SerialSetupProc, SerialCheckProc, NULL);
}
-
+
/*
*----------------------------------------------------------------------
*
* ProcExitHandler --
*
- * This function is called to cleanup the process list before
- * Tcl is unloaded.
+ * This function is called to cleanup the process list before Tcl is
+ * unloaded.
*
* Results:
- * None.
+ * None.
*
* Side effects:
- * Resets the process list.
+ * Resets the process list.
*
*----------------------------------------------------------------------
*/
static void
ProcExitHandler(
- ClientData clientData) /* Old window proc */
+ ClientData clientData) /* Old window proc */
{
Tcl_MutexLock(&serialMutex);
initialized = 0;
Tcl_MutexUnlock(&serialMutex);
}
-
+
/*
*----------------------------------------------------------------------
*
* SerialBlockTime --
*
- * Wrapper to set Tcl's block time in msec
+ * Wrapper to set Tcl's block time in msec
*
* Results:
- * None.
+ * None.
+ *
+ * Side effects:
+ * Updates the maximum blocking time.
+ *
*----------------------------------------------------------------------
*/
static void
SerialBlockTime(
- int msec) /* milli-seconds */
+ int msec) /* milli-seconds */
{
Tcl_Time blockTime;
@@ -347,22 +354,25 @@ SerialBlockTime(
blockTime.usec = (msec % 1000) * 1000;
Tcl_SetMaxBlockTime(&blockTime);
}
+
/*
*----------------------------------------------------------------------
*
* SerialGetMilliseconds --
*
- * Get current time in milliseconds,
- * Don't care about integer overruns
+ * Get current time in milliseconds,ignoring integer overruns.
*
* Results:
- * None.
+ * The current time.
+ *
+ * Side effects:
+ * None.
+ *
*----------------------------------------------------------------------
*/
static unsigned int
-SerialGetMilliseconds(
- void)
+SerialGetMilliseconds(void)
{
Tcl_Time time;
@@ -370,82 +380,83 @@ SerialGetMilliseconds(
return (time.sec * 1000 + time.usec / 1000);
}
+
/*
*----------------------------------------------------------------------
*
* SerialSetupProc --
*
- * This procedure is invoked before Tcl_DoOneEvent blocks waiting
- * for an event.
+ * This procedure is invoked before Tcl_DoOneEvent blocks waiting for an
+ * event.
*
* Results:
- * None.
+ * None.
*
* Side effects:
- * Adjusts the block time if needed.
+ * Adjusts the block time if needed.
*
*----------------------------------------------------------------------
*/
void
SerialSetupProc(
- ClientData data, /* Not used. */
- int flags) /* Event flags as passed to Tcl_DoOneEvent. */
+ ClientData data, /* Not used. */
+ int flags) /* Event flags as passed to Tcl_DoOneEvent. */
{
SerialInfo *infoPtr;
int block = 1;
- int msec = INT_MAX; /* min. found block time */
+ int msec = INT_MAX; /* min. found block time */
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
if (!(flags & TCL_FILE_EVENTS)) {
- return;
+ return;
}
/*
- * Look to see if any events handlers installed. If they are, do not block.
+ * Look to see if any events handlers installed. If they are, do not
+ * block.
*/
- for (infoPtr = tsdPtr->firstSerialPtr; infoPtr != NULL;
- infoPtr = infoPtr->nextPtr) {
-
- if (infoPtr->watchMask & TCL_WRITABLE) {
- if (WaitForSingleObject(infoPtr->evWritable, 0) != WAIT_TIMEOUT) {
- block = 0;
- msec = min( msec, infoPtr->blockTime );
- }
- }
- if( infoPtr->watchMask & TCL_READABLE ) {
- block = 0;
- msec = min( msec, infoPtr->blockTime );
- }
+ for (infoPtr=tsdPtr->firstSerialPtr ; infoPtr!=NULL ;
+ infoPtr=infoPtr->nextPtr) {
+ if (infoPtr->watchMask & TCL_WRITABLE) {
+ if (WaitForSingleObject(infoPtr->evWritable, 0) != WAIT_TIMEOUT) {
+ block = 0;
+ msec = min(msec, infoPtr->blockTime);
+ }
+ }
+ if (infoPtr->watchMask & TCL_READABLE) {
+ block = 0;
+ msec = min(msec, infoPtr->blockTime);
+ }
}
if (!block) {
- SerialBlockTime(msec);
+ SerialBlockTime(msec);
}
}
-
+
/*
*----------------------------------------------------------------------
*
* SerialCheckProc --
*
- * This procedure is called by Tcl_DoOneEvent to check the serial
- * event source for events.
+ * This procedure is called by Tcl_DoOneEvent to check the serial event
+ * source for events.
*
* Results:
- * None.
+ * None.
*
* Side effects:
- * May queue an event.
+ * May queue an event.
*
*----------------------------------------------------------------------
*/
static void
SerialCheckProc(
- ClientData data, /* Not used. */
- int flags) /* Event flags as passed to Tcl_DoOneEvent. */
+ ClientData data, /* Not used. */
+ int flags) /* Event flags as passed to Tcl_DoOneEvent. */
{
SerialInfo *infoPtr;
SerialEvent *evPtr;
@@ -455,7 +466,7 @@ SerialCheckProc(
unsigned int time;
if (!(flags & TCL_FILE_EVENTS)) {
- return;
+ return;
}
/*
@@ -463,81 +474,81 @@ SerialCheckProc(
* queued.
*/
- for (infoPtr = tsdPtr->firstSerialPtr; infoPtr != NULL;
- infoPtr = infoPtr->nextPtr) {
- if (infoPtr->flags & SERIAL_PENDING) {
- continue;
- }
-
- needEvent = 0;
-
- /*
- * If WRITABLE watch mask is set
- * look for infoPtr->evWritable object
- */
- if (infoPtr->watchMask & TCL_WRITABLE) {
- if (WaitForSingleObject(infoPtr->evWritable, 0) != WAIT_TIMEOUT) {
- infoPtr->writable = 1;
- needEvent = 1;
- }
- }
-
- /*
- * If READABLE watch mask is set
- * call ClearCommError to poll cbInQue
- * Window errors are ignored here
- */
-
- if( infoPtr->watchMask & TCL_READABLE ) {
- if( ClearCommError( infoPtr->handle, &infoPtr->error, &cStat ) ) {
- /*
- * Look for characters already pending in windows queue.
- * If they are, poll.
- */
-
- if( infoPtr->watchMask & TCL_READABLE ) {
- /*
- * force fileevent after serial read error
- */
- if( (cStat.cbInQue > 0) ||
- (infoPtr->error & SERIAL_READ_ERRORS) ) {
- infoPtr->readable = 1;
+ for (infoPtr=tsdPtr->firstSerialPtr ; infoPtr!=NULL ;
+ infoPtr=infoPtr->nextPtr) {
+ if (infoPtr->flags & SERIAL_PENDING) {
+ continue;
+ }
+
+ needEvent = 0;
+
+ /*
+ * If WRITABLE watch mask is set look for infoPtr->evWritable object.
+ */
+
+ if (infoPtr->watchMask & TCL_WRITABLE &&
+ WaitForSingleObject(infoPtr->evWritable, 0) != WAIT_TIMEOUT) {
+ infoPtr->writable = 1;
+ needEvent = 1;
+ }
+
+ /*
+ * If READABLE watch mask is set call ClearCommError to poll cbInQue.
+ * Window errors are ignored here.
+ */
+
+ if (infoPtr->watchMask & TCL_READABLE) {
+ if (ClearCommError(infoPtr->handle, &infoPtr->error, &cStat)) {
+ /*
+ * Look for characters already pending in windows queue. If
+ * they are, poll.
+ */
+
+ if (infoPtr->watchMask & TCL_READABLE) {
+ /*
+ * Force fileevent after serial read error.
+ */
+
+ if ((cStat.cbInQue > 0) ||
+ (infoPtr->error & SERIAL_READ_ERRORS)) {
+ infoPtr->readable = 1;
time = SerialGetMilliseconds();
if ((unsigned int) (time - infoPtr->lastEventTime)
>= (unsigned int) infoPtr->blockTime) {
needEvent = 1;
infoPtr->lastEventTime = time;
}
- }
- }
- }
- }
-
- /*
- * Queue an event if the serial is signaled for reading or writing.
- */
- if (needEvent) {
- infoPtr->flags |= SERIAL_PENDING;
- evPtr = (SerialEvent *) ckalloc(sizeof(SerialEvent));
- evPtr->header.proc = SerialEventProc;
- evPtr->infoPtr = infoPtr;
- Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
- }
+ }
+ }
+ }
+ }
+
+ /*
+ * Queue an event if the serial is signaled for reading or writing.
+ */
+
+ if (needEvent) {
+ infoPtr->flags |= SERIAL_PENDING;
+ evPtr = (SerialEvent *) ckalloc(sizeof(SerialEvent));
+ evPtr->header.proc = SerialEventProc;
+ evPtr->infoPtr = infoPtr;
+ Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
+ }
}
}
-
+
/*
*----------------------------------------------------------------------
*
* SerialBlockProc --
*
- * Set blocking or non-blocking mode on channel.
+ * Set blocking or non-blocking mode on channel.
*
* Results:
- * 0 if successful, errno when failed.
+ * 0 if successful, errno when failed.
*
* Side effects:
- * Sets the device into blocking or non-blocking mode.
+ * Sets the device into blocking or non-blocking mode.
*
*----------------------------------------------------------------------
*/
@@ -545,39 +556,38 @@ SerialCheckProc(
static int
SerialBlockProc(
ClientData instanceData, /* Instance data for channel. */
- int mode) /* TCL_MODE_BLOCKING or
- * TCL_MODE_NONBLOCKING. */
+ int mode) /* TCL_MODE_BLOCKING or
+ * TCL_MODE_NONBLOCKING. */
{
int errorCode = 0;
-
SerialInfo *infoPtr = (SerialInfo *) instanceData;
/*
- * Only serial READ can be switched between blocking & nonblocking
- * using COMMTIMEOUTS.
- * Serial write emulates blocking & nonblocking by the SerialWriterThread.
+ * Only serial READ can be switched between blocking & nonblocking using
+ * COMMTIMEOUTS. Serial write emulates blocking & nonblocking by the
+ * SerialWriterThread.
*/
if (mode == TCL_MODE_NONBLOCKING) {
- infoPtr->flags |= SERIAL_ASYNC;
+ infoPtr->flags |= SERIAL_ASYNC;
} else {
- infoPtr->flags &= ~(SERIAL_ASYNC);
+ infoPtr->flags &= ~(SERIAL_ASYNC);
}
return errorCode;
}
-
+
/*
*----------------------------------------------------------------------
*
* SerialCloseProc --
*
- * Closes a serial based IO channel.
+ * Closes a serial based IO channel.
*
* Results:
- * 0 on success, errno otherwise.
+ * 0 on success, errno otherwise.
*
* Side effects:
- * Closes the physical channel.
+ * Closes the physical channel.
*
*----------------------------------------------------------------------
*/
@@ -585,7 +595,7 @@ SerialBlockProc(
static int
SerialCloseProc(
ClientData instanceData, /* Pointer to SerialInfo structure. */
- Tcl_Interp *interp) /* For error reporting. */
+ Tcl_Interp *interp) /* For error reporting. */
{
SerialInfo *serialPtr = (SerialInfo *) instanceData;
int errorCode, result = 0;
@@ -596,48 +606,45 @@ SerialCloseProc(
errorCode = 0;
if (serialPtr->validMask & TCL_READABLE) {
- PurgeComm(serialPtr->handle, PURGE_RXABORT | PURGE_RXCLEAR);
- CloseHandle(serialPtr->osRead.hEvent);
+ PurgeComm(serialPtr->handle, PURGE_RXABORT | PURGE_RXCLEAR);
+ CloseHandle(serialPtr->osRead.hEvent);
}
serialPtr->validMask &= ~TCL_READABLE;
-
- if (serialPtr->validMask & TCL_WRITABLE) {
- /*
- * Generally we cannot wait for a pending write operation
- * because it may hang due to handshake
- * WaitForSingleObject(serialPtr->evWritable, INFINITE);
- */
+ if (serialPtr->validMask & TCL_WRITABLE) {
+ /*
+ * Generally we cannot wait for a pending write operation because it
+ * may hang due to handshake
+ * WaitForSingleObject(serialPtr->evWritable, INFINITE);
+ */
/*
- * The thread may have already closed on it's own. Check it's
- * exit code.
+ * The thread may have already closed on it's own. Check it's exit
+ * code.
*/
GetExitCodeThread(serialPtr->writeThread, &exitCode);
if (exitCode == STILL_ACTIVE) {
/*
- * Set the stop event so that if the writer thread is
- * blocked in SerialWriterThread on WaitForMultipleEvents, it
- * will exit cleanly.
+ * Set the stop event so that if the writer thread is blocked in
+ * SerialWriterThread on WaitForMultipleEvents, it will exit
+ * cleanly.
*/
SetEvent(serialPtr->evStopWriter);
/*
- * Wait at most 20 milliseconds for the writer thread to
- * close.
+ * Wait at most 20 milliseconds for the writer thread to close.
*/
- if (WaitForSingleObject(serialPtr->writeThread, 20)
- == WAIT_TIMEOUT) {
+ if (WaitForSingleObject(serialPtr->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.
+ * 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(&serialMutex);
@@ -649,33 +656,33 @@ SerialCloseProc(
}
}
- CloseHandle(serialPtr->writeThread);
+ CloseHandle(serialPtr->writeThread);
CloseHandle(serialPtr->osWrite.hEvent);
- CloseHandle(serialPtr->evWritable);
- CloseHandle(serialPtr->evStartWriter);
- CloseHandle(serialPtr->evStopWriter);
- serialPtr->writeThread = NULL;
+ CloseHandle(serialPtr->evWritable);
+ CloseHandle(serialPtr->evStartWriter);
+ CloseHandle(serialPtr->evStopWriter);
+ serialPtr->writeThread = NULL;
- PurgeComm(serialPtr->handle, PURGE_TXABORT | PURGE_TXCLEAR);
+ PurgeComm(serialPtr->handle, PURGE_TXABORT | PURGE_TXCLEAR);
}
serialPtr->validMask &= ~TCL_WRITABLE;
DeleteCriticalSection(&serialPtr->csWrite);
/*
- * 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 another.
+ * 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
+ * another.
*/
if (!TclInThreadExit()
- || ((GetStdHandle(STD_INPUT_HANDLE) != serialPtr->handle)
- && (GetStdHandle(STD_OUTPUT_HANDLE) != serialPtr->handle)
- && (GetStdHandle(STD_ERROR_HANDLE) != serialPtr->handle))) {
- if (CloseHandle(serialPtr->handle) == FALSE) {
- TclWinConvertError(GetLastError());
- errorCode = errno;
- }
+ || ((GetStdHandle(STD_INPUT_HANDLE) != serialPtr->handle)
+ && (GetStdHandle(STD_OUTPUT_HANDLE) != serialPtr->handle)
+ && (GetStdHandle(STD_ERROR_HANDLE) != serialPtr->handle))) {
+ if (CloseHandle(serialPtr->handle) == FALSE) {
+ TclWinConvertError(GetLastError());
+ errorCode = errno;
+ }
}
serialPtr->watchMask &= serialPtr->validMask;
@@ -684,148 +691,176 @@ SerialCloseProc(
* Remove the file from the list of watched files.
*/
- for (nextPtrPtr = &(tsdPtr->firstSerialPtr), infoPtr = *nextPtrPtr;
- infoPtr != NULL;
- nextPtrPtr = &infoPtr->nextPtr, infoPtr = *nextPtrPtr) {
- if (infoPtr == (SerialInfo *)serialPtr) {
- *nextPtrPtr = infoPtr->nextPtr;
- break;
- }
+ for (nextPtrPtr=&(tsdPtr->firstSerialPtr), infoPtr=*nextPtrPtr;
+ infoPtr!=NULL;
+ nextPtrPtr=&infoPtr->nextPtr, infoPtr=*nextPtrPtr) {
+ if (infoPtr == (SerialInfo *)serialPtr) {
+ *nextPtrPtr = infoPtr->nextPtr;
+ break;
+ }
}
/*
- * Wrap the error file into a channel and give it to the cleanup
- * routine.
+ * Wrap the error file into a channel and give it to the cleanup routine.
*/
+
if (serialPtr->writeBuf != NULL) {
- ckfree(serialPtr->writeBuf);
- serialPtr->writeBuf = NULL;
+ ckfree(serialPtr->writeBuf);
+ serialPtr->writeBuf = NULL;
}
ckfree((char*) serialPtr);
if (errorCode == 0) {
- return result;
+ return result;
}
return errorCode;
}
-
+
/*
*----------------------------------------------------------------------
*
- * blockingRead --
+ * SerialBlockingRead --
*
- * Perform a blocking read into the buffer given. Returns
- * count of how many bytes were actually read, and an error indication.
+ * Perform a blocking read into the buffer given. Returns count of how
+ * many bytes were actually read, and an error indication.
*
* Results:
- * A count of how many bytes were read is returned and an error
- * indication is returned.
+ * A count of how many bytes were read is returned and an error
+ * indication is returned.
*
* Side effects:
- * Reads input from the actual channel.
+ * Reads input from the actual channel.
*
*----------------------------------------------------------------------
*/
+
static int
-blockingRead(
- SerialInfo *infoPtr, /* Serial info structure */
- LPVOID buf, /* The input buffer pointer */
- DWORD bufSize, /* The number of bytes to read */
- LPDWORD lpRead, /* Returns number of bytes read */
- LPOVERLAPPED osPtr ) /* OVERLAPPED structure */
+SerialBlockingRead(
+ SerialInfo *infoPtr, /* Serial info structure */
+ LPVOID buf, /* The input buffer pointer */
+ DWORD bufSize, /* The number of bytes to read */
+ LPDWORD lpRead, /* Returns number of bytes read */
+ LPOVERLAPPED osPtr) /* OVERLAPPED structure */
{
/*
- * Perform overlapped blocking read.
+ * Perform overlapped blocking read.
* 1. Reset the overlapped event
* 2. Start overlapped read operation
* 3. Wait for completion
*/
- /*
+ /*
* Set Offset to ZERO, otherwise NT4.0 may report an error.
*/
+
osPtr->Offset = osPtr->OffsetHigh = 0;
ResetEvent(osPtr->hEvent);
- if (! ReadFile(infoPtr->handle, buf, bufSize, lpRead, osPtr) ) {
- if (GetLastError() != ERROR_IO_PENDING) {
- /* ReadFile failed, but it isn't delayed. Report error. */
- return FALSE;
- } else {
- /* Read is pending, wait for completion, timeout ? */
- if (! GetOverlappedResult(infoPtr->handle, osPtr, lpRead, TRUE) ) {
- return FALSE;
- }
- }
+ if (!ReadFile(infoPtr->handle, buf, bufSize, lpRead, osPtr)) {
+ if (GetLastError() != ERROR_IO_PENDING) {
+ /*
+ * ReadFile failed, but it isn't delayed. Report error.
+ */
+
+ return FALSE;
+ } else {
+ /*
+ * Read is pending, wait for completion, timeout?
+ */
+
+ if (!GetOverlappedResult(infoPtr->handle, osPtr, lpRead, TRUE)) {
+ return FALSE;
+ }
+ }
} else {
- /* ReadFile completed immediately. */
+ /*
+ * ReadFile completed immediately.
+ */
}
return TRUE;
}
-
+
/*
*----------------------------------------------------------------------
*
- * blockingWrite --
+ * SerialBlockingWrite --
*
- * Perform a blocking write from the buffer given. Returns
- * count of how many bytes were actually written, and an error indication.
+ * Perform a blocking write from the buffer given. Returns count of how
+ * many bytes were actually written, and an error indication.
*
* Results:
- * A count of how many bytes were written is returned and an error
- * indication is returned.
+ * A count of how many bytes were written is returned and an error
+ * indication is returned.
*
* Side effects:
- * Writes output to the actual channel.
+ * Writes output to the actual channel.
*
*----------------------------------------------------------------------
*/
+
static int
-blockingWrite(
- SerialInfo *infoPtr, /* Serial info structure */
- LPVOID buf, /* The output buffer pointer */
- DWORD bufSize, /* The number of bytes to write */
- LPDWORD lpWritten, /* Returns number of bytes written */
- LPOVERLAPPED osPtr ) /* OVERLAPPED structure */
+SerialBlockingWrite(
+ SerialInfo *infoPtr, /* Serial info structure */
+ LPVOID buf, /* The output buffer pointer */
+ DWORD bufSize, /* The number of bytes to write */
+ LPDWORD lpWritten, /* Returns number of bytes written */
+ LPOVERLAPPED osPtr) /* OVERLAPPED structure */
{
int result;
+
/*
- * Perform overlapped blocking write.
- * 1. Reset the overlapped event
- * 2. Remove these bytes from the output queue counter
- * 3. Start overlapped write operation
- * 3. Remove these bytes from the output queue counter
- * 4. Wait for completion
- * 5. Adjust the output queue counter
- */
+ * Perform overlapped blocking write.
+ * 1. Reset the overlapped event
+ * 2. Remove these bytes from the output queue counter
+ * 3. Start overlapped write operation
+ * 3. Remove these bytes from the output queue counter
+ * 4. Wait for completion
+ * 5. Adjust the output queue counter
+ */
+
ResetEvent(osPtr->hEvent);
EnterCriticalSection(&infoPtr->csWrite);
infoPtr->writeQueue -= bufSize;
- /*
- * Set Offset to ZERO, otherwise NT4.0 may report an error
- */
- osPtr->Offset = osPtr->OffsetHigh = 0;
+
+ /*
+ * Set Offset to ZERO, otherwise NT4.0 may report an error
+ */
+
+ osPtr->Offset = osPtr->OffsetHigh = 0;
result = WriteFile(infoPtr->handle, buf, bufSize, lpWritten, osPtr);
LeaveCriticalSection(&infoPtr->csWrite);
- if (result == FALSE ) {
- int err = GetLastError();
- switch (err) {
- case ERROR_IO_PENDING:
- /* Write is pending, wait for completion */
- if (! GetOverlappedResult(infoPtr->handle, osPtr, lpWritten, TRUE) ) {
- return FALSE;
- }
- break;
- case ERROR_COUNTER_TIMEOUT:
- /* Write timeout handled in SerialOutputProc */
- break;
- default:
- /* WriteFile failed, but it isn't delayed. Report error */
- return FALSE;
- }
+ if (result == FALSE) {
+ int err = GetLastError();
+
+ switch (err) {
+ case ERROR_IO_PENDING:
+ /*
+ * Write is pending, wait for completion.
+ */
+
+ if (!GetOverlappedResult(infoPtr->handle, osPtr, lpWritten,
+ TRUE)) {
+ return FALSE;
+ }
+ break;
+ case ERROR_COUNTER_TIMEOUT:
+ /*
+ * Write timeout handled in SerialOutputProc.
+ */
+
+ break;
+ default:
+ /*
+ * WriteFile failed, but it isn't delayed. Report error.
+ */
+
+ return FALSE;
+ }
} else {
- /* WriteFile completed immediately. */
+ /*
+ * WriteFile completed immediately.
+ */
}
EnterCriticalSection(&infoPtr->csWrite);
@@ -834,31 +869,32 @@ blockingWrite(
return TRUE;
}
-
+
/*
*----------------------------------------------------------------------
*
* SerialInputProc --
*
- * Reads input from the IO channel into the buffer given. Returns
- * count of how many bytes were actually read, and an error indication.
+ * Reads input from the IO channel into the buffer given. Returns count
+ * of how many bytes were actually read, and an error indication.
*
* Results:
- * A count of how many bytes were read is returned and an error
- * indication is returned in an output argument.
+ * A count of how many bytes were read is returned and an error
+ * indication is returned in an output argument.
*
* Side effects:
- * Reads input from the actual channel.
+ * Reads input from the actual channel.
*
*----------------------------------------------------------------------
*/
+
static int
SerialInputProc(
- ClientData instanceData, /* Serial state. */
- char *buf, /* Where to store data read. */
- int bufSize, /* How much space is available
- * in the buffer? */
- int *errorCode) /* Where to store error code. */
+ ClientData instanceData, /* Serial state. */
+ char *buf, /* Where to store data read. */
+ int bufSize, /* How much space is available in the
+ * buffer? */
+ int *errorCode) /* Where to store error code. */
{
SerialInfo *infoPtr = (SerialInfo *) instanceData;
DWORD bytesRead = 0;
@@ -869,104 +905,102 @@ SerialInputProc(
/*
* Check if there is a CommError pending from SerialCheckProc
*/
- if( infoPtr->error & SERIAL_READ_ERRORS ){
- goto commError;
+
+ if (infoPtr->error & SERIAL_READ_ERRORS) {
+ goto commError;
}
/*
- * Look for characters already pending in windows queue.
- * This is the mainly restored good old code from Tcl8.0
+ * Look for characters already pending in windows queue. This is the
+ * mainly restored good old code from Tcl8.0
*/
- if( ClearCommError( infoPtr->handle, &infoPtr->error, &cStat ) ) {
- /*
- * Check for errors here, but not in the evSetup/Check procedures
- */
-
- if( infoPtr->error & SERIAL_READ_ERRORS ) {
- goto commError;
- }
- if( infoPtr->flags & SERIAL_ASYNC ) {
- /*
- * NON_BLOCKING mode:
- * Avoid blocking by reading more bytes than available
- * in input buffer
- */
-
- if( cStat.cbInQue > 0 ) {
- if( (DWORD) bufSize > cStat.cbInQue ) {
- bufSize = cStat.cbInQue;
- }
- } else {
- errno = *errorCode = EAGAIN;
- return -1;
- }
- } else {
- /*
- * BLOCKING mode:
- * Tcl trys to read a full buffer of 4 kBytes here
- */
-
- if( cStat.cbInQue > 0 ) {
- if( (DWORD) bufSize > cStat.cbInQue ) {
- bufSize = cStat.cbInQue;
- }
- } else {
- bufSize = 1;
- }
- }
- }
-
- if( bufSize == 0 ) {
- return bytesRead = 0;
+ if (ClearCommError(infoPtr->handle, &infoPtr->error, &cStat)) {
+ /*
+ * Check for errors here, but not in the evSetup/Check procedures.
+ */
+
+ if (infoPtr->error & SERIAL_READ_ERRORS) {
+ goto commError;
+ }
+ if (infoPtr->flags & SERIAL_ASYNC) {
+ /*
+ * NON_BLOCKING mode: Avoid blocking by reading more bytes than
+ * available in input buffer.
+ */
+
+ if (cStat.cbInQue > 0) {
+ if ((DWORD) bufSize > cStat.cbInQue) {
+ bufSize = cStat.cbInQue;
+ }
+ } else {
+ errno = *errorCode = EAGAIN;
+ return -1;
+ }
+ } else {
+ /*
+ * BLOCKING mode: Tcl trys to read a full buffer of 4 kBytes here.
+ */
+
+ if (cStat.cbInQue > 0) {
+ if ((DWORD) bufSize > cStat.cbInQue) {
+ bufSize = cStat.cbInQue;
+ }
+ } else {
+ bufSize = 1;
+ }
+ }
+ }
+
+ if (bufSize == 0) {
+ return bytesRead = 0;
}
/*
- * Perform blocking read. Doesn't block in non-blocking mode,
- * because we checked the number of available bytes.
- */
- if (blockingRead(infoPtr, (LPVOID) buf, (DWORD) bufSize, &bytesRead,
- &infoPtr->osRead) == FALSE) {
- goto error;
+ * Perform blocking read. Doesn't block in non-blocking mode, because we
+ * checked the number of available bytes.
+ */
+
+ if (SerialBlockingRead(infoPtr, (LPVOID) buf, (DWORD) bufSize, &bytesRead,
+ &infoPtr->osRead) == FALSE) {
+ TclWinConvertError(GetLastError());
+ *errorCode = errno;
+ return -1;
}
return bytesRead;
-error:
- TclWinConvertError(GetLastError());
- *errorCode = errno;
- return -1;
-
-commError:
- infoPtr->lastError = infoPtr->error; /* save last error code */
- infoPtr->error = 0; /* reset error code */
- *errorCode = EIO; /* to return read-error only once */
+ commError:
+ infoPtr->lastError = infoPtr->error;
+ /* save last error code */
+ infoPtr->error = 0; /* reset error code */
+ *errorCode = EIO; /* to return read-error only once */
return -1;
}
-
+
/*
*----------------------------------------------------------------------
*
* SerialOutputProc --
*
- * Writes the given output on the IO channel. Returns count of how
- * many characters were actually written, and an error indication.
+ * Writes the given output on the IO channel. Returns count of how many
+ * characters were actually written, and an error indication.
*
* Results:
- * A count of how many characters were written is returned and an
- * error indication is returned in an output argument.
+ * A count of how many characters were written is returned and an error
+ * indication is returned in an output argument.
*
* Side effects:
- * Writes output on the actual channel.
+ * Writes output on the actual channel.
*
*----------------------------------------------------------------------
*/
static int
SerialOutputProc(
- ClientData instanceData, /* Serial state. */
- CONST char *buf, /* The data buffer. */
- int toWrite, /* How many bytes to write? */
- int *errorCode) /* Where to store error code. */
+ ClientData instanceData, /* Serial state. */
+ CONST char *buf, /* The data buffer. */
+ int toWrite, /* How many bytes to write? */
+ int *errorCode) /* Where to store error code. */
{
SerialInfo *infoPtr = (SerialInfo *) instanceData;
DWORD bytesWritten, timeout;
@@ -974,136 +1008,145 @@ SerialOutputProc(
*errorCode = 0;
/*
- * At EXIT Tcl trys to flush all open channels in blocking mode.
- * We avoid blocking output after ExitProc or CloseHandler(chan)
- * has been called by checking the corrresponding variables.
+ * At EXIT Tcl trys to flush all open channels in blocking mode. We avoid
+ * blocking output after ExitProc or CloseHandler(chan) has been called by
+ * checking the corrresponding variables.
*/
- if( ! initialized || TclInExit() ) {
- return toWrite;
+
+ if (!initialized || TclInExit()) {
+ return toWrite;
}
/*
* Check if there is a CommError pending from SerialCheckProc
*/
- if( infoPtr->error & SERIAL_WRITE_ERRORS ){
- infoPtr->lastError = infoPtr->error; /* save last error code */
- infoPtr->error = 0; /* reset error code */
- errno = EIO;
- goto error;
+
+ if (infoPtr->error & SERIAL_WRITE_ERRORS) {
+ infoPtr->lastError = infoPtr->error;
+ /* save last error code */
+ infoPtr->error = 0; /* reset error code */
+ errno = EIO;
+ goto error;
}
timeout = (infoPtr->flags & SERIAL_ASYNC) ? 0 : INFINITE;
if (WaitForSingleObject(infoPtr->evWritable, timeout) == WAIT_TIMEOUT) {
- /*
- * The writer thread is blocked waiting for a write to complete
- * and the channel is in non-blocking mode.
- */
+ /*
+ * The writer thread is blocked waiting for a write to complete and
+ * the channel is in non-blocking mode.
+ */
- errno = EWOULDBLOCK;
- goto error1;
+ errno = EWOULDBLOCK;
+ goto error1;
}
+
/*
* Check for a background error on the last write.
*/
if (infoPtr->writeError) {
- TclWinConvertError(infoPtr->writeError);
- infoPtr->writeError = 0;
- goto error1;
+ TclWinConvertError(infoPtr->writeError);
+ infoPtr->writeError = 0;
+ goto error1;
}
/*
* Remember the number of bytes in output queue
*/
+
EnterCriticalSection(&infoPtr->csWrite);
infoPtr->writeQueue += toWrite;
LeaveCriticalSection(&infoPtr->csWrite);
if (infoPtr->flags & SERIAL_ASYNC) {
- /*
- * The serial is non-blocking, so copy the data into the output
- * buffer and restart the writer thread.
- */
-
- if (toWrite > infoPtr->writeBufLen) {
- /*
- * Reallocate the buffer to be large enough to hold the data.
- */
-
- if (infoPtr->writeBuf) {
- ckfree(infoPtr->writeBuf);
- }
- infoPtr->writeBufLen = toWrite;
- infoPtr->writeBuf = ckalloc((unsigned int) toWrite);
- }
- memcpy(infoPtr->writeBuf, buf, (size_t) toWrite);
- infoPtr->toWrite = toWrite;
- ResetEvent(infoPtr->evWritable);
- SetEvent(infoPtr->evStartWriter);
- bytesWritten = (DWORD) toWrite;
+ /*
+ * The serial is non-blocking, so copy the data into the output buffer
+ * and restart the writer thread.
+ */
+
+ if (toWrite > infoPtr->writeBufLen) {
+ /*
+ * Reallocate the buffer to be large enough to hold the data.
+ */
+
+ if (infoPtr->writeBuf) {
+ ckfree(infoPtr->writeBuf);
+ }
+ infoPtr->writeBufLen = toWrite;
+ infoPtr->writeBuf = ckalloc((unsigned int) toWrite);
+ }
+ memcpy(infoPtr->writeBuf, buf, (size_t) toWrite);
+ infoPtr->toWrite = toWrite;
+ ResetEvent(infoPtr->evWritable);
+ SetEvent(infoPtr->evStartWriter);
+ bytesWritten = (DWORD) toWrite;
} else {
- /*
- * In the blocking case, just try to write the buffer directly.
- * This avoids an unnecessary copy.
- */
- if (! blockingWrite(infoPtr, (LPVOID) buf, (DWORD) toWrite,
- &bytesWritten, &infoPtr->osWrite) ) {
- goto writeError;
- }
- if (bytesWritten != (DWORD) toWrite) {
- /* Write timeout */
- infoPtr->lastError |= CE_PTO;
- errno = EIO;
- goto error;
- }
+ /*
+ * In the blocking case, just try to write the buffer directly. This
+ * avoids an unnecessary copy.
+ */
+
+ if (!SerialBlockingWrite(infoPtr, (LPVOID) buf, (DWORD) toWrite,
+ &bytesWritten, &infoPtr->osWrite)) {
+ goto writeError;
+ }
+ if (bytesWritten != (DWORD) toWrite) {
+ /*
+ * Write timeout.
+ */
+ infoPtr->lastError |= CE_PTO;
+ errno = EIO;
+ goto error;
+ }
}
return (int) bytesWritten;
-writeError:
+ writeError:
TclWinConvertError(GetLastError());
-error:
- /*
- * Reset the output queue counter on error during blocking output
+ error:
+ /*
+ * Reset the output queue counter on error during blocking output
*/
-/*
- EnterCriticalSection(&infoPtr->csWrite);
- infoPtr->writeQueue = 0;
- LeaveCriticalSection(&infoPtr->csWrite);
-*/
- error1:
+
+ /*
+ * EnterCriticalSection(&infoPtr->csWrite);
+ * infoPtr->writeQueue = 0;
+ * LeaveCriticalSection(&infoPtr->csWrite);
+ */
+ error1:
*errorCode = errno;
return -1;
}
-
+
/*
*----------------------------------------------------------------------
*
* SerialEventProc --
*
- * This function is invoked by Tcl_ServiceEvent when a file event
- * reaches the front of the event queue. This procedure invokes
- * Tcl_NotifyChannel on the serial.
+ * This function is invoked by Tcl_ServiceEvent when a file event reaches
+ * the front of the event queue. This procedure invokes Tcl_NotifyChannel
+ * on the serial.
*
* Results:
- * Returns 1 if the event was handled, meaning it should be removed
- * from the queue. Returns 0 if the event was not handled, meaning
- * it should stay on the queue. The only time the event isn't
- * handled is if the TCL_FILE_EVENTS flag bit isn't set.
+ * Returns 1 if the event was handled, meaning it should be removed from
+ * the queue. Returns 0 if the event was not handled, meaning it should
+ * stay on the queue. The only time the event isn't handled is if the
+ * TCL_FILE_EVENTS flag bit isn't set.
*
* Side effects:
- * Whatever the notifier callback does.
+ * Whatever the notifier callback does.
*
*----------------------------------------------------------------------
*/
static int
SerialEventProc(
- Tcl_Event *evPtr, /* Event to service. */
- int flags) /* Flags that indicate what events to
- * handle, such as TCL_FILE_EVENTS. */
+ Tcl_Event *evPtr, /* Event to service. */
+ int flags) /* Flags that indicate what events to handle,
+ * such as TCL_FILE_EVENTS. */
{
SerialEvent *serialEvPtr = (SerialEvent *)evPtr;
SerialInfo *infoPtr;
@@ -1111,22 +1154,22 @@ SerialEventProc(
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
if (!(flags & TCL_FILE_EVENTS)) {
- return 0;
+ return 0;
}
/*
* Search through the list of watched serials for the one whose handle
- * matches the event. We do this rather than simply dereferencing
- * the handle in the event so that serials can be deleted while the
- * event is in the queue.
+ * matches the event. We do this rather than simply dereferencing the
+ * handle in the event so that serials can be deleted while the event is
+ * in the queue.
*/
for (infoPtr = tsdPtr->firstSerialPtr; infoPtr != NULL;
- infoPtr = infoPtr->nextPtr) {
- if (serialEvPtr->infoPtr == infoPtr) {
- infoPtr->flags &= ~(SERIAL_PENDING);
- break;
- }
+ infoPtr = infoPtr->nextPtr) {
+ if (serialEvPtr->infoPtr == infoPtr) {
+ infoPtr->flags &= ~(SERIAL_PENDING);
+ break;
+ }
}
/*
@@ -1134,28 +1177,28 @@ SerialEventProc(
*/
if (!infoPtr) {
- return 1;
+ return 1;
}
/*
- * Check to see if the serial is readable. Note
- * that we can't tell if a serial is writable, so we always report it
- * as being writable unless we have detected EOF.
+ * Check to see if the serial is readable. Note that we can't tell if a
+ * serial is writable, so we always report it as being writable unless we
+ * have detected EOF.
*/
mask = 0;
- if( infoPtr->watchMask & TCL_WRITABLE ) {
- if( infoPtr->writable ) {
- mask |= TCL_WRITABLE;
- infoPtr->writable = 0;
- }
+ if (infoPtr->watchMask & TCL_WRITABLE) {
+ if (infoPtr->writable) {
+ mask |= TCL_WRITABLE;
+ infoPtr->writable = 0;
+ }
}
- if( infoPtr->watchMask & TCL_READABLE ) {
- if( infoPtr->readable ) {
- mask |= TCL_READABLE;
- infoPtr->readable = 0;
- }
+ if (infoPtr->watchMask & TCL_READABLE) {
+ if (infoPtr->readable) {
+ mask |= TCL_READABLE;
+ infoPtr->readable = 0;
+ }
}
/*
@@ -1165,30 +1208,29 @@ SerialEventProc(
Tcl_NotifyChannel(infoPtr->channel, infoPtr->watchMask & mask);
return 1;
}
-
+
/*
*----------------------------------------------------------------------
*
* SerialWatchProc --
*
- * Called by the notifier to set up to watch for events on this
- * channel.
+ * Called by the notifier to set up to watch for events on this channel.
*
* Results:
- * None.
+ * None.
*
* Side effects:
- * None.
+ * None.
*
*----------------------------------------------------------------------
*/
static void
SerialWatchProc(
- ClientData instanceData, /* Serial state. */
- int mask) /* What events to watch for, OR-ed
- * combination of TCL_READABLE,
- * TCL_WRITABLE and TCL_EXCEPTION. */
+ ClientData instanceData, /* Serial state. */
+ int mask) /* What events to watch for, OR-ed combination
+ * of TCL_READABLE, TCL_WRITABLE and
+ * TCL_EXCEPTION. */
{
SerialInfo **nextPtrPtr, *ptr;
SerialInfo *infoPtr = (SerialInfo *) instanceData;
@@ -1196,232 +1238,240 @@ SerialWatchProc(
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
/*
- * Since the file is always ready for events, we set the block time
- * so we will poll.
+ * Since the file is always ready for events, we set the block time so we
+ * will poll.
*/
infoPtr->watchMask = mask & infoPtr->validMask;
if (infoPtr->watchMask) {
- if (!oldMask) {
- infoPtr->nextPtr = tsdPtr->firstSerialPtr;
- tsdPtr->firstSerialPtr = infoPtr;
- }
- SerialBlockTime(infoPtr->blockTime);
- } else {
- if (oldMask) {
- /*
- * Remove the serial port from the list of watched serial ports.
- */
-
- for (nextPtrPtr = &(tsdPtr->firstSerialPtr), ptr = *nextPtrPtr;
- ptr != NULL;
- nextPtrPtr = &ptr->nextPtr, ptr = *nextPtrPtr) {
- if (infoPtr == ptr) {
- *nextPtrPtr = ptr->nextPtr;
- break;
- }
- }
- }
+ if (!oldMask) {
+ infoPtr->nextPtr = tsdPtr->firstSerialPtr;
+ tsdPtr->firstSerialPtr = infoPtr;
+ }
+ SerialBlockTime(infoPtr->blockTime);
+ } else if (oldMask) {
+ /*
+ * Remove the serial port from the list of watched serial ports.
+ */
+
+ for (nextPtrPtr=&(tsdPtr->firstSerialPtr), ptr=*nextPtrPtr; ptr!=NULL;
+ nextPtrPtr=&ptr->nextPtr, ptr=*nextPtrPtr) {
+ if (infoPtr == ptr) {
+ *nextPtrPtr = ptr->nextPtr;
+ break;
+ }
+ }
}
}
-
+
/*
*----------------------------------------------------------------------
*
* SerialGetHandleProc --
*
- * Called from Tcl_GetChannelHandle to retrieve OS handles from
- * inside a command serial port based channel.
+ * Called from Tcl_GetChannelHandle to retrieve OS handles from inside a
+ * command serial port based channel.
*
* Results:
- * Returns TCL_OK with the fd in handlePtr, or TCL_ERROR if
- * there is no handle for the specified direction.
+ * Returns TCL_OK with the fd in handlePtr, or TCL_ERROR if there is no
+ * handle for the specified direction.
*
* Side effects:
- * None.
+ * None.
*
*----------------------------------------------------------------------
*/
static int
SerialGetHandleProc(
- ClientData instanceData, /* The serial state. */
- int direction, /* TCL_READABLE or TCL_WRITABLE */
- ClientData *handlePtr) /* Where to store the handle. */
+ ClientData instanceData, /* The serial state. */
+ int direction, /* TCL_READABLE or TCL_WRITABLE */
+ ClientData *handlePtr) /* Where to store the handle. */
{
SerialInfo *infoPtr = (SerialInfo *) instanceData;
*handlePtr = (ClientData) infoPtr->handle;
return TCL_OK;
}
-
+
/*
*----------------------------------------------------------------------
*
* SerialWriterThread --
*
- * This function runs in a separate thread and writes data
- * onto a serial.
+ * This function runs in a separate thread and writes data onto a serial.
*
* Results:
- * Always returns 0.
+ * Always returns 0.
*
* Side effects:
- * Signals the main thread when an output operation is completed.
- * May cause the main thread to wake up by posting a message.
+ * Signals the main thread when an output operation is completed. May
+ * cause the main thread to wake up by posting a message.
*
*----------------------------------------------------------------------
*/
static DWORD WINAPI
-SerialWriterThread(LPVOID arg)
+SerialWriterThread(
+ LPVOID arg)
{
-
SerialInfo *infoPtr = (SerialInfo *)arg;
DWORD bytesWritten, toWrite, waitResult;
char *buf;
- OVERLAPPED myWrite; /* have an own OVERLAPPED in this thread */
+ OVERLAPPED myWrite; /* Have an own OVERLAPPED in this thread. */
HANDLE wEvents[2];
/*
* The stop event takes precedence by being first in the list.
*/
+
wEvents[0] = infoPtr->evStopWriter;
wEvents[1] = infoPtr->evStartWriter;
for (;;) {
- /*
- * Wait for the main thread to signal before attempting to write.
- */
+ /*
+ * Wait for the main thread to signal before attempting to write.
+ */
waitResult = WaitForMultipleObjects(2, wEvents, FALSE, INFINITE);
if (waitResult != (WAIT_OBJECT_0 + 1)) {
/*
- * The start event was not signaled. It might be the stop event
- * or an error, so exit.
+ * The start event was not signaled. It might be the stop event or
+ * an error, so exit.
*/
break;
}
- buf = infoPtr->writeBuf;
- toWrite = infoPtr->toWrite;
-
- myWrite.hEvent = CreateEvent(NULL, TRUE, FALSE, NULL);
-
- /*
- * Loop until all of the bytes are written or an error occurs.
- */
-
- while (toWrite > 0) {
- /*
- * Check for pending writeError
- * Ignore all write operations until the user has been notified
- */
- if (infoPtr->writeError) {
- break;
- }
- if (blockingWrite(infoPtr, (LPVOID) buf, (DWORD) toWrite,
- &bytesWritten, &myWrite) == FALSE) {
- infoPtr->writeError = GetLastError();
- break;
- }
- if (bytesWritten != toWrite) {
- /* Write timeout */
- infoPtr->writeError = ERROR_WRITE_FAULT;
- break;
- }
- toWrite -= bytesWritten;
- buf += bytesWritten;
- }
-
- CloseHandle(myWrite.hEvent);
- /*
- * Signal the main thread by signalling the evWritable event and
- * then waking up the notifier thread.
- */
- SetEvent(infoPtr->evWritable);
-
- /*
- * Alert the foreground thread. Note that we need to treat this like
- * a critical section so the foreground thread does not terminate
- * this thread while we are holding a mutex in the notifier code.
- */
-
- Tcl_MutexLock(&serialMutex);
+ buf = infoPtr->writeBuf;
+ toWrite = infoPtr->toWrite;
+
+ myWrite.hEvent = CreateEvent(NULL, TRUE, FALSE, NULL);
+
+ /*
+ * Loop until all of the bytes are written or an error occurs.
+ */
+
+ while (toWrite > 0) {
+ /*
+ * Check for pending writeError. Ignore all write operations until
+ * the user has been notified.
+ */
+
+ if (infoPtr->writeError) {
+ break;
+ }
+ if (SerialBlockingWrite(infoPtr, (LPVOID) buf, (DWORD) toWrite,
+ &bytesWritten, &myWrite) == FALSE) {
+ infoPtr->writeError = GetLastError();
+ break;
+ }
+ if (bytesWritten != toWrite) {
+ /*
+ * Write timeout.
+ */
+
+ infoPtr->writeError = ERROR_WRITE_FAULT;
+ break;
+ }
+ toWrite -= bytesWritten;
+ buf += bytesWritten;
+ }
+
+ CloseHandle(myWrite.hEvent);
+
+ /*
+ * Signal the main thread by signalling the evWritable event and then
+ * waking up the notifier thread.
+ */
+
+ SetEvent(infoPtr->evWritable);
+
+ /*
+ * Alert the foreground thread. Note that we need to treat this like a
+ * critical section so the foreground thread does not terminate this
+ * thread while we are holding a mutex in the notifier code.
+ */
+
+ Tcl_MutexLock(&serialMutex);
if (infoPtr->threadId != NULL) {
- /* TIP #218. When in flight ignore the event, no one will receive it anyway */
+ /*
+ * TIP #218: When in flight ignore the event, no one will receive
+ * it anyway.
+ */
+
Tcl_ThreadAlert(infoPtr->threadId);
}
- Tcl_MutexUnlock(&serialMutex);
+ Tcl_MutexUnlock(&serialMutex);
}
return 0;
}
-
-
+
/*
*----------------------------------------------------------------------
*
* TclWinSerialReopen --
*
- * Reopens the serial port with the OVERLAPPED FLAG set
+ * Reopens the serial port with the OVERLAPPED FLAG set
*
* Results:
- * Returns the new handle, or INVALID_HANDLE_VALUE
- * Normally there shouldn't be any error,
- * because the same channel has previously been succeesfully opened.
+ * Returns the new handle, or INVALID_HANDLE_VALUE. Normally there
+ * shouldn't be any error, because the same channel has previously been
+ * succeesfully opened.
*
* Side effects:
- * May close the original handle
+ * May close the original handle
*
*----------------------------------------------------------------------
*/
HANDLE
-TclWinSerialReopen(handle, name, access)
- HANDLE handle;
- CONST TCHAR *name;
- DWORD access;
+TclWinSerialReopen(
+ HANDLE handle,
+ CONST TCHAR *name,
+ DWORD access)
{
SerialInit();
- /*
- * Multithreaded I/O needs the overlapped flag set
- * otherwise ClearCommError blocks under Windows NT/2000 until serial
- * output is finished
- */
+ /*
+ * Multithreaded I/O needs the overlapped flag set otherwise
+ * ClearCommError blocks under Windows NT/2000 until serial output is
+ * finished
+ */
+
if (CloseHandle(handle) == FALSE) {
- return INVALID_HANDLE_VALUE;
+ return INVALID_HANDLE_VALUE;
}
- handle = (*tclWinProcs->createFileProc)(name, access,
- 0, 0, OPEN_EXISTING, FILE_FLAG_OVERLAPPED, 0);
+ handle = (*tclWinProcs->createFileProc)(name, access, 0, 0,
+ OPEN_EXISTING, FILE_FLAG_OVERLAPPED, 0);
return handle;
}
+
/*
*----------------------------------------------------------------------
*
* TclWinOpenSerialChannel --
*
- * Constructs a Serial port channel for the specified standard OS handle.
- * This is a helper function to break up the construction of
- * channels into File, Console, or Serial.
+ * Constructs a Serial port channel for the specified standard OS handle.
+ * This is a helper function to break up the construction of channels
+ * into File, Console, or Serial.
*
* Results:
- * Returns the new channel, or NULL.
+ * Returns the new channel, or NULL.
*
* Side effects:
- * May open the channel
+ * May open the channel
*
*----------------------------------------------------------------------
*/
Tcl_Channel
-TclWinOpenSerialChannel(handle, channelName, permissions)
- HANDLE handle;
- char *channelName;
- int permissions;
+TclWinOpenSerialChannel(
+ HANDLE handle,
+ char *channelName,
+ int permissions)
{
SerialInfo *infoPtr;
DWORD id;
@@ -1431,60 +1481,60 @@ TclWinOpenSerialChannel(handle, channelName, permissions)
infoPtr = (SerialInfo *) ckalloc((unsigned) sizeof(SerialInfo));
memset(infoPtr, 0, sizeof(SerialInfo));
- infoPtr->validMask = permissions;
- infoPtr->handle = handle;
- infoPtr->channel = (Tcl_Channel) NULL;
- infoPtr->readable = 0;
- infoPtr->writable = 1;
- infoPtr->toWrite = infoPtr->writeQueue = 0;
- infoPtr->blockTime = SERIAL_DEFAULT_BLOCKTIME;
+ infoPtr->validMask = permissions;
+ infoPtr->handle = handle;
+ infoPtr->channel = (Tcl_Channel) NULL;
+ infoPtr->readable = 0;
+ infoPtr->writable = 1;
+ infoPtr->toWrite = infoPtr->writeQueue = 0;
+ infoPtr->blockTime = SERIAL_DEFAULT_BLOCKTIME;
infoPtr->lastEventTime = 0;
- infoPtr->lastError = infoPtr->error = 0;
- infoPtr->threadId = Tcl_GetCurrentThread();
- infoPtr->sysBufRead = 4096;
- infoPtr->sysBufWrite = 4096;
+ infoPtr->lastError = infoPtr->error = 0;
+ infoPtr->threadId = Tcl_GetCurrentThread();
+ infoPtr->sysBufRead = 4096;
+ infoPtr->sysBufWrite = 4096;
/*
- * Use the pointer to keep the channel names unique, in case
- * the handles are shared between multiple channels (stdin/stdout).
+ * Use the pointer to keep the channel names unique, in case the handles
+ * are shared between multiple channels (stdin/stdout).
*/
- wsprintfA(channelName, "file%lx", (int) infoPtr);
+ wsprintfA(channelName, "file%lx", PTR2INT(infoPtr));
infoPtr->channel = Tcl_CreateChannel(&serialChannelType, channelName,
- (ClientData) infoPtr, permissions);
+ (ClientData) infoPtr, permissions);
SetupComm(handle, infoPtr->sysBufRead, infoPtr->sysBufWrite);
- PurgeComm(handle, PURGE_TXABORT | PURGE_RXABORT | PURGE_TXCLEAR
- | PURGE_RXCLEAR);
+ PurgeComm(handle,
+ PURGE_TXABORT | PURGE_RXABORT | PURGE_TXCLEAR | PURGE_RXCLEAR);
/*
- * default is blocking
+ * Default is blocking.
*/
+
SetCommTimeouts(handle, &no_timeout);
InitializeCriticalSection(&infoPtr->csWrite);
-
if (permissions & TCL_READABLE) {
- infoPtr->osRead.hEvent = CreateEvent(NULL, TRUE, FALSE, NULL);
+ infoPtr->osRead.hEvent = CreateEvent(NULL, TRUE, FALSE, NULL);
}
if (permissions & TCL_WRITABLE) {
- /*
- * Initially the channel is writable
- * and the writeThread is idle.
- */
- infoPtr->osWrite.hEvent = CreateEvent(NULL, TRUE, FALSE, NULL);
- infoPtr->evWritable = CreateEvent(NULL, TRUE, TRUE, NULL);
- infoPtr->evStartWriter = CreateEvent(NULL, FALSE, FALSE, NULL);
+ /*
+ * Initially the channel is writable and the writeThread is idle.
+ */
+
+ infoPtr->osWrite.hEvent = CreateEvent(NULL, TRUE, FALSE, NULL);
+ infoPtr->evWritable = CreateEvent(NULL, TRUE, TRUE, NULL);
+ infoPtr->evStartWriter = CreateEvent(NULL, FALSE, FALSE, NULL);
infoPtr->evStopWriter = CreateEvent(NULL, FALSE, FALSE, NULL);
- infoPtr->writeThread = CreateThread(NULL, 256, SerialWriterThread,
- infoPtr, 0, &id);
+ infoPtr->writeThread = CreateThread(NULL, 256, SerialWriterThread,
+ infoPtr, 0, &id);
}
/*
- * Files have default translation of AUTO and ^Z eof char, which
- * means that a ^Z will be accepted as EOF when reading.
+ * Files have default translation of AUTO and ^Z eof char, which means
+ * that a ^Z will be accepted as EOF when reading.
*/
Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto");
@@ -1492,61 +1542,77 @@ TclWinOpenSerialChannel(handle, channelName, permissions)
return infoPtr->channel;
}
-
+
/*
*----------------------------------------------------------------------
*
* SerialErrorStr --
*
- * Converts a Win32 serial error code to a list of readable errors
+ * Converts a Win32 serial error code to a list of readable errors.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Generates readable errors in the supplied DString.
*
*----------------------------------------------------------------------
*/
+
static void
-SerialErrorStr(error, dsPtr)
- DWORD error; /* Win32 serial error code */
- Tcl_DString *dsPtr; /* Where to store string */
+SerialErrorStr(
+ DWORD error, /* Win32 serial error code. */
+ Tcl_DString *dsPtr) /* Where to store string. */
{
- if( (error & CE_RXOVER) != 0) {
- Tcl_DStringAppendElement(dsPtr, "RXOVER");
+ if (error & CE_RXOVER) {
+ Tcl_DStringAppendElement(dsPtr, "RXOVER");
}
- if( (error & CE_OVERRUN) != 0) {
- Tcl_DStringAppendElement(dsPtr, "OVERRUN");
+ if (error & CE_OVERRUN) {
+ Tcl_DStringAppendElement(dsPtr, "OVERRUN");
}
- if( (error & CE_RXPARITY) != 0) {
- Tcl_DStringAppendElement(dsPtr, "RXPARITY");
+ if (error & CE_RXPARITY) {
+ Tcl_DStringAppendElement(dsPtr, "RXPARITY");
}
- if( (error & CE_FRAME) != 0) {
- Tcl_DStringAppendElement(dsPtr, "FRAME");
+ if (error & CE_FRAME) {
+ Tcl_DStringAppendElement(dsPtr, "FRAME");
}
- if( (error & CE_BREAK) != 0) {
- Tcl_DStringAppendElement(dsPtr, "BREAK");
+ if (error & CE_BREAK) {
+ Tcl_DStringAppendElement(dsPtr, "BREAK");
}
- if( (error & CE_TXFULL) != 0) {
- Tcl_DStringAppendElement(dsPtr, "TXFULL");
+ if (error & CE_TXFULL) {
+ Tcl_DStringAppendElement(dsPtr, "TXFULL");
}
- if( (error & CE_PTO) != 0) { /* PTO used to signal WRITE-TIMEOUT */
- Tcl_DStringAppendElement(dsPtr, "TIMEOUT");
+ if (error & CE_PTO) { /* PTO used to signal WRITE-TIMEOUT */
+ Tcl_DStringAppendElement(dsPtr, "TIMEOUT");
}
- if( (error & ~((DWORD) (SERIAL_READ_ERRORS | SERIAL_WRITE_ERRORS))) != 0) {
- char buf[TCL_INTEGER_SPACE + 1];
- wsprintfA(buf, "%d", error);
- Tcl_DStringAppendElement(dsPtr, buf);
+ if (error & ~((DWORD) (SERIAL_READ_ERRORS | SERIAL_WRITE_ERRORS))) {
+ char buf[TCL_INTEGER_SPACE + 1];
+
+ wsprintfA(buf, "%d", error);
+ Tcl_DStringAppendElement(dsPtr, buf);
}
}
+
/*
*----------------------------------------------------------------------
*
* SerialModemStatusStr --
*
- * Converts a Win32 modem status list of readable flags
+ * Converts a Win32 modem status list of readable flags
+ *
+ * Result:
+ * None.
+ *
+ * Side effects:
+ * Appends modem status flag strings to the given DString.
*
*----------------------------------------------------------------------
*/
+
static void
-SerialModemStatusStr(status, dsPtr)
- DWORD status; /* Win32 modem status */
- Tcl_DString *dsPtr; /* Where to store string */
+SerialModemStatusStr(
+ DWORD status, /* Win32 modem status. */
+ Tcl_DString *dsPtr) /* Where to store string. */
{
Tcl_DStringAppendElement(dsPtr, "CTS");
Tcl_DStringAppendElement(dsPtr, (status & MS_CTS_ON) ? "1" : "0");
@@ -1557,29 +1623,30 @@ SerialModemStatusStr(status, dsPtr)
Tcl_DStringAppendElement(dsPtr, "DCD");
Tcl_DStringAppendElement(dsPtr, (status & MS_RLSD_ON) ? "1" : "0");
}
-
+
/*
*----------------------------------------------------------------------
*
* SerialSetOptionProc --
*
- * Sets an option on a channel.
+ * Sets an option on a channel.
*
* Results:
- * A standard Tcl result. Also sets the interp's result on error if
- * interp is not NULL.
+ * A standard Tcl result. Also sets the interp's result on error if
+ * interp is not NULL.
*
* Side effects:
- * May modify an option on a device.
+ * May modify an option on a device.
*
*----------------------------------------------------------------------
*/
+
static int
-SerialSetOptionProc(instanceData, interp, optionName, value)
- 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. */
+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. */
{
SerialInfo *infoPtr;
DCB dcb;
@@ -1593,19 +1660,21 @@ SerialSetOptionProc(instanceData, interp, optionName, value)
infoPtr = (SerialInfo *) instanceData;
/*
- * Parse options
+ * Parse options. This would be far easier if we had Tcl_Objs to work with
+ * as that would let us use Tcl_GetIndexFromObj()...
*/
+
len = strlen(optionName);
vlen = strlen(value);
/*
* Option -mode baud,parity,databits,stopbits
*/
+
if ((len > 2) && (strncmp(optionName, "-mode", len) == 0)) {
- if (! GetCommState(infoPtr->handle, &dcb)) {
- if (interp) {
- Tcl_AppendResult(interp,
- "can't get comm state", (char *) NULL);
+ if (!GetCommState(infoPtr->handle, &dcb)) {
+ if (interp != NULL) {
+ Tcl_AppendResult(interp, "can't get comm state", NULL);
}
return TCL_ERROR;
}
@@ -1614,24 +1683,25 @@ SerialSetOptionProc(instanceData, interp, optionName, value)
Tcl_DStringFree(&ds);
if (result == FALSE) {
- if (interp) {
- Tcl_AppendResult(interp,
- "bad value for -mode: should be baud,parity,data,stop",
- (char *) NULL);
+ if (interp != NULL) {
+ Tcl_AppendResult(interp, "bad value \"", value,
+ "\" for -mode: should be baud,parity,data,stop", NULL);
}
return TCL_ERROR;
}
- /* Default settings for serial communications */
+ /*
+ * Default settings for serial communications.
+ */
+
dcb.fBinary = TRUE;
dcb.fErrorChar = FALSE;
dcb.fNull = FALSE;
dcb.fAbortOnError = FALSE;
- if (! SetCommState(infoPtr->handle, &dcb) ) {
- if (interp) {
- Tcl_AppendResult(interp,
- "can't set comm state", (char *) NULL);
+ if (!SetCommState(infoPtr->handle, &dcb)) {
+ if (interp != NULL) {
+ Tcl_AppendResult(interp, "can't set comm state", NULL);
}
return TCL_ERROR;
}
@@ -1641,18 +1711,19 @@ SerialSetOptionProc(instanceData, interp, optionName, value)
/*
* Option -handshake none|xonxoff|rtscts|dtrdsr
*/
+
if ((len > 1) && (strncmp(optionName, "-handshake", len) == 0)) {
- if (! GetCommState(infoPtr->handle, &dcb)) {
- if (interp) {
- Tcl_AppendResult(interp,
- "can't get comm state", (char *) NULL);
+ if (!GetCommState(infoPtr->handle, &dcb)) {
+ if (interp != NULL) {
+ Tcl_AppendResult(interp, "can't get comm state", NULL);
}
return TCL_ERROR;
}
+
/*
- * Reset all handshake options
- * DTR and RTS are ON by default
+ * Reset all handshake options. DTR and RTS are ON by default.
*/
+
dcb.fOutX = dcb.fInX = FALSE;
dcb.fOutxCtsFlow = dcb.fOutxDsrFlow = dcb.fDsrSensitivity = FALSE;
dcb.fDtrControl = DTR_CONTROL_ENABLE;
@@ -1660,35 +1731,37 @@ SerialSetOptionProc(instanceData, interp, optionName, value)
dcb.fTXContinueOnXoff = FALSE;
/*
- * Adjust the handshake limits.
- * Yes, the XonXoff limits seem to influence even hardware handshake
+ * Adjust the handshake limits. Yes, the XonXoff limits seem to
+ * influence even hardware handshake.
*/
+
dcb.XonLim = (WORD) (infoPtr->sysBufRead*1/2);
dcb.XoffLim = (WORD) (infoPtr->sysBufRead*1/4);
- if (strnicmp(value, "NONE", vlen) == 0) {
- /* leave all handshake options disabled */
- } else if (strnicmp(value, "XONXOFF", vlen) == 0) {
+ if (strncasecmp(value, "NONE", vlen) == 0) {
+ /*
+ * Leave all handshake options disabled.
+ */
+ } else if (strncasecmp(value, "XONXOFF", vlen) == 0) {
dcb.fOutX = dcb.fInX = TRUE;
- } else if (strnicmp(value, "RTSCTS", vlen) == 0) {
+ } else if (strncasecmp(value, "RTSCTS", vlen) == 0) {
dcb.fOutxCtsFlow = TRUE;
dcb.fRtsControl = RTS_CONTROL_HANDSHAKE;
- } else if (strnicmp(value, "DTRDSR", vlen) == 0) {
+ } else if (strncasecmp(value, "DTRDSR", vlen) == 0) {
dcb.fOutxDsrFlow = TRUE;
dcb.fDtrControl = DTR_CONTROL_HANDSHAKE;
} else {
- if (interp) {
- Tcl_AppendResult(interp, "bad value for -handshake: ",
- "must be one of xonxoff, rtscts, dtrdsr or none",
- (char *) NULL);
- return TCL_ERROR;
+ if (interp != NULL) {
+ Tcl_AppendResult(interp, "bad value \"", value,
+ "\" for -handshake: must be one of xonxoff, rtscts, "
+ "dtrdsr or none", NULL);
}
+ return TCL_ERROR;
}
- if (! SetCommState(infoPtr->handle, &dcb)) {
- if (interp) {
- Tcl_AppendResult(interp,
- "can't set comm state", (char *) NULL);
+ if (!SetCommState(infoPtr->handle, &dcb)) {
+ if (interp != NULL) {
+ Tcl_AppendResult(interp, "can't set comm state", NULL);
}
return TCL_ERROR;
}
@@ -1698,11 +1771,11 @@ SerialSetOptionProc(instanceData, interp, optionName, value)
/*
* Option -xchar {\x11 \x13}
*/
+
if ((len > 1) && (strncmp(optionName, "-xchar", len) == 0)) {
- if (! GetCommState(infoPtr->handle, &dcb)) {
- if (interp) {
- Tcl_AppendResult(interp,
- "can't get comm state", (char *) NULL);
+ if (!GetCommState(infoPtr->handle, &dcb)) {
+ if (interp != NULL) {
+ Tcl_AppendResult(interp, "can't get comm state", NULL);
}
return TCL_ERROR;
}
@@ -1710,24 +1783,49 @@ SerialSetOptionProc(instanceData, interp, optionName, value)
if (Tcl_SplitList(interp, value, &argc, &argv) == TCL_ERROR) {
return TCL_ERROR;
}
- if (argc == 2) {
- dcb.XonChar = argv[0][0];
- dcb.XoffChar = argv[1][0];
- ckfree((char *) argv);
- } else {
- if (interp) {
- Tcl_AppendResult(interp,
- "bad value for -xchar: should be a list of two elements",
- (char *) NULL);
+ if (argc != 2) {
+ badXchar:
+ if (interp != NULL) {
+ Tcl_AppendResult(interp, "bad value for -xchar: should be "
+ "a list of two elements with each a single character",
+ NULL);
}
ckfree((char *) argv);
return TCL_ERROR;
}
- if (! SetCommState(infoPtr->handle, &dcb)) {
- if (interp) {
- Tcl_AppendResult(interp,
- "can't set comm state", (char *) NULL);
+ /*
+ * These dereferences are safe, even in the zero-length string cases,
+ * because that just makes the xon/xoff character into NUL. When the
+ * character looks like it is UTF-8 encoded, decode it before casting
+ * into the format required for the Win guts. Note that this does not
+ * convert character sets; it is expected that when people set the
+ * control characters to something large and custom, they'll know the
+ * hex/octal value rather than the printable form.
+ */
+
+ dcb.XonChar = argv[0][0];
+ dcb.XoffChar = argv[1][0];
+ if (argv[0][0] & 0x80 || argv[1][0] & 0x80) {
+ Tcl_UniChar character;
+ int charLen;
+
+ charLen = Tcl_UtfToUniChar(argv[0], &character);
+ if (argv[0][charLen]) {
+ goto badXchar;
+ }
+ dcb.XonChar = (char) character;
+ charLen = Tcl_UtfToUniChar(argv[1], &character);
+ if (argv[1][charLen]) {
+ goto badXchar;
+ }
+ dcb.XoffChar = (char) character;
+ }
+ ckfree((char *) argv);
+
+ if (!SetCommState(infoPtr->handle, &dcb)) {
+ if (interp != NULL) {
+ Tcl_AppendResult(interp, "can't set comm state", NULL);
}
return TCL_ERROR;
}
@@ -1737,6 +1835,7 @@ SerialSetOptionProc(instanceData, interp, optionName, value)
/*
* Option -ttycontrol {DTR 1 RTS 0 BREAK 0}
*/
+
if ((len > 4) && (strncmp(optionName, "-ttycontrol", len) == 0)) {
int i, result = TCL_OK;
@@ -1744,53 +1843,52 @@ SerialSetOptionProc(instanceData, interp, optionName, value)
return TCL_ERROR;
}
if ((argc % 2) == 1) {
- if (interp) {
- Tcl_AppendResult(interp,
- "bad value for -ttycontrol: should be a list of signal,value pairs",
- (char *) NULL);
+ if (interp != NULL) {
+ Tcl_AppendResult(interp, "bad value \"", value,
+ "\" for -ttycontrol: should be a list of "
+ "signal,value pairs", NULL);
}
ckfree((char *) argv);
return TCL_ERROR;
}
+
for (i = 0; i < argc - 1; i += 2) {
if (Tcl_GetBoolean(interp, argv[i+1], &flag) == TCL_ERROR) {
result = TCL_ERROR;
break;
}
- if (strnicmp(argv[i], "DTR", strlen(argv[i])) == 0) {
- if (!EscapeCommFunction(infoPtr->handle, flag ?
- (DWORD) SETDTR : (DWORD) CLRDTR)) {
- if (interp) {
- Tcl_AppendResult(interp,
- "can't set DTR signal", (char *) NULL);
+ if (strncasecmp(argv[i], "DTR", strlen(argv[i])) == 0) {
+ if (!EscapeCommFunction(infoPtr->handle,
+ (DWORD) (flag ? SETDTR : CLRDTR))) {
+ if (interp != NULL) {
+ Tcl_AppendResult(interp, "can't set DTR signal", NULL);
}
result = TCL_ERROR;
break;
}
- } else if (strnicmp(argv[i], "RTS", strlen(argv[i])) == 0) {
- if (!EscapeCommFunction(infoPtr->handle, flag ?
- (DWORD) SETRTS : (DWORD) CLRRTS)) {
- if (interp) {
- Tcl_AppendResult(interp,
- "can't set RTS signal", (char *) NULL);
+ } else if (strncasecmp(argv[i], "RTS", strlen(argv[i])) == 0) {
+ if (!EscapeCommFunction(infoPtr->handle,
+ (DWORD) (flag ? SETRTS : CLRRTS))) {
+ if (interp != NULL) {
+ Tcl_AppendResult(interp, "can't set RTS signal", NULL);
}
result = TCL_ERROR;
break;
}
- } else if (strnicmp(argv[i], "BREAK", strlen(argv[i])) == 0) {
- if (!EscapeCommFunction(infoPtr->handle, flag ?
- (DWORD) SETBREAK : (DWORD) CLRBREAK)) {
- if (interp) {
- Tcl_AppendResult(interp,
- "can't set BREAK signal", (char *) NULL);
+ } else if (strncasecmp(argv[i], "BREAK", strlen(argv[i])) == 0) {
+ if (!EscapeCommFunction(infoPtr->handle,
+ (DWORD) (flag ? SETBREAK : CLRBREAK))) {
+ if (interp != NULL) {
+ Tcl_AppendResult(interp,"can't set BREAK signal",NULL);
}
result = TCL_ERROR;
break;
}
} else {
- if (interp) {
- Tcl_AppendResult(interp, "bad signal for -ttycontrol: ",
- "must be DTR, RTS or BREAK", (char *) NULL);
+ if (interp != NULL) {
+ Tcl_AppendResult(interp, "bad signal name \"", argv[i],
+ "\" for -ttycontrol: must be DTR, RTS or BREAK",
+ NULL);
}
result = TCL_ERROR;
break;
@@ -1803,12 +1901,14 @@ SerialSetOptionProc(instanceData, interp, optionName, value)
/*
* Option -sysbuffer {read_size write_size}
- * Option -sysbuffer read_size
+ * Option -sysbuffer read_size
*/
+
if ((len > 1) && (strncmp(optionName, "-sysbuffer", len) == 0)) {
/*
* -sysbuffer 4096 or -sysbuffer {64536 4096}
*/
+
size_t inSize = (size_t) -1, outSize = (size_t) -1;
if (Tcl_SplitList(interp, value, &argc, &argv) == TCL_ERROR) {
@@ -1822,18 +1922,19 @@ SerialSetOptionProc(instanceData, interp, optionName, value)
outSize = atoi(argv[1]);
}
ckfree((char *) argv);
- if ((inSize <= 0) || (outSize <= 0)) {
- if (interp) {
- Tcl_AppendResult(interp,
- "bad value for -sysbuffer: should be a list of one or two integers > 0",
- (char *) NULL);
+
+ 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);
}
return TCL_ERROR;
}
- if (! SetupComm(infoPtr->handle, inSize, outSize)) {
- if (interp) {
- Tcl_AppendResult(interp,
- "can't setup comm buffers", (char *) NULL);
+
+ if (!SetupComm(infoPtr->handle, inSize, outSize)) {
+ if (interp != NULL) {
+ Tcl_AppendResult(interp, "can't setup comm buffers", NULL);
}
return TCL_ERROR;
}
@@ -1841,22 +1942,21 @@ SerialSetOptionProc(instanceData, interp, optionName, value)
infoPtr->sysBufWrite = outSize;
/*
- * Adjust the handshake limits.
- * Yes, the XonXoff limits seem to influence even hardware handshake
+ * Adjust the handshake limits. Yes, the XonXoff limits seem to
+ * influence even hardware handshake.
*/
- if (! GetCommState(infoPtr->handle, &dcb)) {
- if (interp) {
- Tcl_AppendResult(interp,
- "can't get comm state", (char *) NULL);
+
+ if (!GetCommState(infoPtr->handle, &dcb)) {
+ if (interp != NULL) {
+ Tcl_AppendResult(interp, "can't get comm state", NULL);
}
return TCL_ERROR;
}
dcb.XonLim = (WORD) (infoPtr->sysBufRead*1/2);
dcb.XoffLim = (WORD) (infoPtr->sysBufRead*1/4);
- if (! SetCommState(infoPtr->handle, &dcb)) {
- if (interp) {
- Tcl_AppendResult(interp,
- "can't set comm state", (char *) NULL);
+ if (!SetCommState(infoPtr->handle, &dcb)) {
+ if (interp != NULL) {
+ Tcl_AppendResult(interp, "can't set comm state", NULL);
}
return TCL_ERROR;
}
@@ -1866,9 +1966,9 @@ SerialSetOptionProc(instanceData, interp, optionName, value)
/*
* Option -pollinterval msec
*/
- if ((len > 1) && (strncmp(optionName, "-pollinterval", len) == 0)) {
- if ( Tcl_GetInt(interp, value, &(infoPtr->blockTime)) != TCL_OK ) {
+ if ((len > 1) && (strncmp(optionName, "-pollinterval", len) == 0)) {
+ if (Tcl_GetInt(interp, value, &(infoPtr->blockTime)) != TCL_OK) {
return TCL_ERROR;
}
return TCL_OK;
@@ -1877,18 +1977,18 @@ SerialSetOptionProc(instanceData, interp, optionName, value)
/*
* Option -timeout msec
*/
+
if ((len > 2) && (strncmp(optionName, "-timeout", len) == 0)) {
int msec;
COMMTIMEOUTS tout = {0,0,0,0,0};
- if ( Tcl_GetInt(interp, value, &msec) != TCL_OK ) {
+ if (Tcl_GetInt(interp, value, &msec) != TCL_OK) {
return TCL_ERROR;
}
tout.ReadTotalTimeoutConstant = msec;
- if (! SetCommTimeouts(infoPtr->handle, &tout)) {
- if (interp) {
- Tcl_AppendResult(interp,
- "can't set comm timeouts", (char *) NULL);
+ if (!SetCommTimeouts(infoPtr->handle, &tout)) {
+ if (interp != NULL) {
+ Tcl_AppendResult(interp, "can't set comm timeouts", NULL);
}
return TCL_ERROR;
}
@@ -1899,38 +1999,39 @@ SerialSetOptionProc(instanceData, interp, optionName, value)
return Tcl_BadChannelOption(interp, optionName,
"mode handshake pollinterval sysbuffer timeout ttycontrol xchar");
}
-
+
/*
*----------------------------------------------------------------------
*
* SerialGetOptionProc --
*
- * Gets a mode associated with an IO channel. If the optionName arg
- * is non NULL, retrieves the value of that option. If the optionName
- * arg is NULL, retrieves a list of alternating option names and
- * values for the given channel.
+ * Gets a mode associated with an IO channel. If the optionName arg is
+ * non NULL, retrieves the value of that option. If the optionName arg is
+ * NULL, retrieves a list of alternating option names and values for the
+ * given channel.
*
* Results:
- * A standard Tcl result. Also sets the supplied DString to the
- * string value of the option(s) returned.
+ * A standard Tcl result. Also sets the supplied DString to the string
+ * value of the option(s) returned.
*
* Side effects:
- * The string returned by this function is in static storage and
- * may be reused at any time subsequent to the call.
+ * The string returned by this function is in static storage and may be
+ * reused at any time subsequent to the call.
*
*----------------------------------------------------------------------
*/
+
static int
-SerialGetOptionProc(instanceData, interp, optionName, dsPtr)
- ClientData instanceData; /* File state. */
- Tcl_Interp *interp; /* For error reporting - can be NULL. */
- CONST char *optionName; /* Option to get. */
- Tcl_DString *dsPtr; /* Where to store value(s). */
+SerialGetOptionProc(
+ ClientData instanceData, /* File state. */
+ Tcl_Interp *interp, /* For error reporting - can be NULL. */
+ CONST char *optionName, /* Option to get. */
+ Tcl_DString *dsPtr) /* Where to store value(s). */
{
SerialInfo *infoPtr;
DCB dcb;
size_t len;
- int valid = 0; /* flag if valid option parsed */
+ int valid = 0; /* Flag if valid option parsed. */
infoPtr = (SerialInfo *) instanceData;
@@ -1941,23 +2042,20 @@ SerialGetOptionProc(instanceData, interp, optionName, dsPtr)
}
/*
- * get option -mode
+ * Get option -mode
*/
if (len == 0) {
Tcl_DStringAppendElement(dsPtr, "-mode");
}
- if ((len == 0) ||
- ((len > 2) && (strncmp(optionName, "-mode", len) == 0))) {
-
+ if (len==0 || (len>2 && (strncmp(optionName, "-mode", len) == 0))) {
char parity;
char *stop;
char buf[2 * TCL_INTEGER_SPACE + 16];
- if (! GetCommState(infoPtr->handle, &dcb)) {
- if (interp) {
- Tcl_AppendResult(interp,
- "can't get comm state", (char *) NULL);
+ if (!GetCommState(infoPtr->handle, &dcb)) {
+ if (interp != NULL) {
+ Tcl_AppendResult(interp, "can't get comm state", NULL);
}
return TCL_ERROR;
}
@@ -1968,7 +2066,7 @@ SerialGetOptionProc(instanceData, interp, optionName, dsPtr)
parity = "noems"[dcb.Parity];
}
stop = (dcb.StopBits == ONESTOPBIT) ? "1" :
- (dcb.StopBits == ONE5STOPBITS) ? "1.5" : "2";
+ (dcb.StopBits == ONE5STOPBITS) ? "1.5" : "2";
wsprintfA(buf, "%d,%c,%d,%s", dcb.BaudRate, parity,
dcb.ByteSize, stop);
@@ -1976,14 +2074,13 @@ SerialGetOptionProc(instanceData, interp, optionName, dsPtr)
}
/*
- * get option -pollinterval
+ * Get option -pollinterval
*/
if (len == 0) {
Tcl_DStringAppendElement(dsPtr, "-pollinterval");
}
- if ((len == 0) ||
- ((len > 1) && (strncmp(optionName, "-pollinterval", len) == 0))) {
+ if (len==0 || (len>1 && strncmp(optionName, "-pollinterval", len)==0)) {
char buf[TCL_INTEGER_SPACE + 1];
valid = 1;
@@ -1992,16 +2089,14 @@ SerialGetOptionProc(instanceData, interp, optionName, dsPtr)
}
/*
- * get option -sysbuffer
+ * Get option -sysbuffer
*/
if (len == 0) {
Tcl_DStringAppendElement(dsPtr, "-sysbuffer");
Tcl_DStringStartSublist(dsPtr);
}
- if ((len == 0) ||
- ((len > 1) && (strncmp(optionName, "-sysbuffer", len) == 0))) {
-
+ if (len==0 || (len>1 && strncmp(optionName, "-sysbuffer", len) == 0)) {
char buf[TCL_INTEGER_SPACE + 1];
valid = 1;
@@ -2015,23 +2110,20 @@ SerialGetOptionProc(instanceData, interp, optionName, dsPtr)
}
/*
- * get option -xchar
+ * Get option -xchar
*/
if (len == 0) {
Tcl_DStringAppendElement(dsPtr, "-xchar");
Tcl_DStringStartSublist(dsPtr);
}
- if ((len == 0) ||
- ((len > 1) && (strncmp(optionName, "-xchar", len) == 0))) {
-
+ if (len==0 || (len>1 && strncmp(optionName, "-xchar", len) == 0)) {
char buf[4];
valid = 1;
- if (! GetCommState(infoPtr->handle, &dcb)) {
- if (interp) {
- Tcl_AppendResult(interp,
- "can't get comm state", (char *) NULL);
+ if (!GetCommState(infoPtr->handle, &dcb)) {
+ if (interp != NULL) {
+ Tcl_AppendResult(interp, "can't get comm state", NULL);
}
return TCL_ERROR;
}
@@ -2045,22 +2137,24 @@ SerialGetOptionProc(instanceData, interp, optionName, dsPtr)
}
/*
- * get option -lasterror
- * option is readonly and returned by [fconfigure chan -lasterror]
- * but not returned by unnamed [fconfigure chan]
+ * Get option -lasterror
+ *
+ * Option is readonly and returned by [fconfigure chan -lasterror] but not
+ * returned by unnamed [fconfigure chan].
*/
- if ( (len > 1) && (strncmp(optionName, "-lasterror", len) == 0) ) {
+ if (len>1 && strncmp(optionName, "-lasterror", len)==0) {
valid = 1;
SerialErrorStr(infoPtr->lastError, dsPtr);
}
/*
* get option -queue
- * option is readonly and returned by [fconfigure chan -queue]
+ *
+ * Option is readonly and returned by [fconfigure chan -queue].
*/
- if ((len > 1) && (strncmp(optionName, "-queue", len) == 0)) {
+ if (len>1 && strncmp(optionName, "-queue", len)==0) {
char buf[TCL_INTEGER_SPACE + 1];
COMSTAT cStat;
DWORD error;
@@ -2068,9 +2162,10 @@ SerialGetOptionProc(instanceData, interp, optionName, dsPtr)
valid = 1;
- /*
- * Query the pending data in Tcl's internal queues
+ /*
+ * Query the pending data in Tcl's internal queues.
*/
+
inBuffered = Tcl_InputBuffered(infoPtr->channel);
outBuffered = Tcl_OutputBuffered(infoPtr->channel);
@@ -2080,30 +2175,31 @@ SerialGetOptionProc(instanceData, interp, optionName, dsPtr)
* 2. The bytes in the system drivers buffer
* The writer thread should not interfere this action.
*/
+
EnterCriticalSection(&infoPtr->csWrite);
- ClearCommError( infoPtr->handle, &error, &cStat );
- count = (int)cStat.cbOutQue + infoPtr->writeQueue;
+ ClearCommError(infoPtr->handle, &error, &cStat);
+ count = (int) cStat.cbOutQue + infoPtr->writeQueue;
LeaveCriticalSection(&infoPtr->csWrite);
- wsprintfA(buf, "%d", inBuffered + cStat.cbInQue);
+ wsprintfA(buf, "%d", inBuffered + cStat.cbInQue);
Tcl_DStringAppendElement(dsPtr, buf);
- wsprintfA(buf, "%d", outBuffered + count);
+ wsprintfA(buf, "%d", outBuffered + count);
Tcl_DStringAppendElement(dsPtr, buf);
}
/*
* get option -ttystatus
- * option is readonly and returned by [fconfigure chan -ttystatus]
- * but not returned by unnamed [fconfigure chan]
+ *
+ * Option is readonly and returned by [fconfigure chan -ttystatus] but not
+ * returned by unnamed [fconfigure chan].
*/
- if ((len > 4) && (strncmp(optionName, "-ttystatus", len) == 0)) {
+ if (len>4 && strncmp(optionName, "-ttystatus", len)==0) {
DWORD status;
- if (! GetCommModemStatus(infoPtr->handle, &status)) {
- if (interp) {
- Tcl_AppendResult(interp,
- "can't get tty status", (char *) NULL);
+ if (!GetCommModemStatus(infoPtr->handle, &status)) {
+ if (interp != NULL) {
+ Tcl_AppendResult(interp, "can't get tty status", NULL);
}
return TCL_ERROR;
}
@@ -2136,33 +2232,43 @@ SerialGetOptionProc(instanceData, interp, optionName, dsPtr)
*/
static void
-SerialThreadActionProc (instanceData, action)
- ClientData instanceData;
- int action;
+SerialThreadActionProc(
+ ClientData instanceData,
+ int action)
{
SerialInfo *infoPtr = (SerialInfo *) instanceData;
- /* We do not access firstSerialPtr 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.
+ /*
+ * We do not access firstSerialPtr 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.
*/
Tcl_MutexLock(&serialMutex);
if (action == TCL_CHANNEL_THREAD_INSERT) {
- /* We can't copy the thread information from the channel when
- * the channel is created. At this time the channel back
- * pointer has not been set yet. However in that case the
- * threadId has already been set by TclpCreateCommandChannel
- * itself, so the structure is still good.
+ /*
+ * We can't copy the thread information from the channel when the
+ * channel is created. At this time the channel back pointer has not
+ * been set yet. However in that case the threadId has already been
+ * set by TclpCreateCommandChannel itself, so the structure is still
+ * good.
*/
- SerialInit ();
- if (infoPtr->channel != NULL) {
- infoPtr->threadId = Tcl_GetChannelThread (infoPtr->channel);
+ SerialInit();
+ if (infoPtr->channel != NULL) {
+ infoPtr->threadId = Tcl_GetChannelThread(infoPtr->channel);
}
} else {
infoPtr->threadId = NULL;
}
Tcl_MutexUnlock(&serialMutex);
}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index 06d0590..019d8e9 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -1,12 +1,12 @@
-/*
+/*
* tclWinSock.c --
*
* This file contains Windows-specific socket related code.
*
* Copyright (c) 1995-1997 Sun Microsystems, Inc.
*
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
* -----------------------------------------------------------------------
*
@@ -47,10 +47,22 @@
#include "tclWinInt.h"
+#ifdef _MSC_VER
+# pragma comment (lib, "ws2_32")
+#endif
+
+/*
+ * Support for control over sockets' KEEPALIVE and NODELAY behavior is
+ * currently disabled.
+ */
+
+#undef TCL_FEATURE_KEEPALIVE_NAGLE
+
/*
- * Make sure to remove the redirection defines set in tclWinPort.h
- * that is in use in other sections of the core, except for us.
+ * Make sure to remove the redirection defines set in tclWinPort.h that is in
+ * use in other sections of the core, except for us.
*/
+
#undef getservbyname
#undef getsockopt
#undef ntohs
@@ -58,114 +70,21 @@
/*
* The following variable is used to tell whether this module has been
- * initialized.
+ * initialized. If 1, initialization of sockets was successful, if -1 then
+ * socket initialization failed (WSAStartup failed).
*/
static int initialized = 0;
-
-static int hostnameInitialized = 0;
-static char hostname[255]; /* This buffer should be big enough for
- * hostname plus domain name. */
-
TCL_DECLARE_MUTEX(socketMutex)
-
-/*
- * Mingw and Cygwin may not have LPFN_* typedefs.
- */
-
-#ifdef HAVE_NO_LPFN_DECLS
- typedef SOCKET (PASCAL FAR *LPFN_ACCEPT)(SOCKET s,
- struct sockaddr FAR * addr, int FAR * addrlen);
- typedef int (PASCAL FAR *LPFN_BIND)(SOCKET s,
- const struct sockaddr FAR *addr, int namelen);
- typedef int (PASCAL FAR *LPFN_CLOSESOCKET)(SOCKET s);
- typedef int (PASCAL FAR *LPFN_CONNECT)(SOCKET s,
- const struct sockaddr FAR *name, int namelen);
- typedef struct hostent FAR * (PASCAL FAR *LPFN_GETHOSTBYADDR)
- (const char FAR *addr, int addrlen, int addrtype);
- typedef struct hostent FAR * (PASCAL FAR *LPFN_GETHOSTBYNAME)
- (const char FAR * name);
- typedef int (PASCAL FAR *LPFN_GETHOSTNAME)(char FAR * name,
- int namelen);
- typedef int (PASCAL FAR *LPFN_GETPEERNAME)(SOCKET sock,
- struct sockaddr FAR *name, int FAR *namelen);
- typedef struct servent FAR * (PASCAL FAR *LPFN_GETSERVBYNAME)
- (const char FAR * name, const char FAR * proto);
- typedef int (PASCAL FAR *LPFN_GETSOCKNAME)(SOCKET sock,
- struct sockaddr FAR *name, int FAR *namelen);
- typedef int (PASCAL FAR *LPFN_GETSOCKOPT)(SOCKET s, int level,
- int optname, char FAR * optval, int FAR *optlen);
- typedef u_short (PASCAL FAR *LPFN_HTONS)(u_short hostshort);
- typedef unsigned long (PASCAL FAR *LPFN_INET_ADDR)
- (const char FAR * cp);
- typedef char FAR * (PASCAL FAR *LPFN_INET_NTOA)
- (struct in_addr in);
- typedef int (PASCAL FAR *LPFN_IOCTLSOCKET)(SOCKET s,
- long cmd, u_long FAR *argp);
- typedef int (PASCAL FAR *LPFN_LISTEN)(SOCKET s, int backlog);
- typedef u_short (PASCAL FAR *LPFN_NTOHS)(u_short netshort);
- typedef int (PASCAL FAR *LPFN_RECV)(SOCKET s, char FAR * buf,
- int len, int flags);
- typedef int (PASCAL FAR *LPFN_SELECT)(int nfds,
- fd_set FAR * readfds, fd_set FAR * writefds,
- fd_set FAR * exceptfds,
- const struct timeval FAR * timeout);
- typedef int (PASCAL FAR *LPFN_SEND)(SOCKET s,
- const char FAR * buf, int len, int flags);
- typedef int (PASCAL FAR *LPFN_SETSOCKOPT)(SOCKET s,
- int level, int optname, const char FAR * optval,
- int optlen);
- typedef SOCKET (PASCAL FAR *LPFN_SOCKET)(int af,
- int type, int protocol);
- typedef int (PASCAL FAR *LPFN_WSAASYNCSELECT)(SOCKET s,
- HWND hWnd, u_int wMsg, long lEvent);
- typedef int (PASCAL FAR *LPFN_WSACLEANUP)(void);
- typedef int (PASCAL FAR *LPFN_WSAGETLASTERROR)(void);
- typedef int (PASCAL FAR *LPFN_WSASTARTUP)(WORD wVersionRequired,
- LPWSADATA lpWSAData);
-#endif
-
-
/*
- * The following structure contains pointers to all of the WinSock API
- * entry points used by Tcl. It is initialized by InitSockets. Since
- * we dynamically load the Winsock DLL on demand, we must use this
- * function table to refer to functions in the winsock API.
+ * The following variable holds the network name of this host.
*/
-static struct {
- HMODULE hModule; /* Handle to WinSock library. */
-
- /* Winsock 1.1 functions */
- LPFN_ACCEPT accept;
- LPFN_BIND bind;
- LPFN_CLOSESOCKET closesocket;
- LPFN_CONNECT connect;
- LPFN_GETHOSTBYADDR gethostbyaddr;
- LPFN_GETHOSTBYNAME gethostbyname;
- LPFN_GETHOSTNAME gethostname;
- LPFN_GETPEERNAME getpeername;
- LPFN_GETSERVBYNAME getservbyname;
- LPFN_GETSOCKNAME getsockname;
- LPFN_GETSOCKOPT getsockopt;
- LPFN_HTONS htons;
- LPFN_INET_ADDR inet_addr;
- LPFN_INET_NTOA inet_ntoa;
- LPFN_IOCTLSOCKET ioctlsocket;
- LPFN_LISTEN listen;
- LPFN_NTOHS ntohs;
- LPFN_RECV recv;
- LPFN_SELECT select;
- LPFN_SEND send;
- LPFN_SETSOCKOPT setsockopt;
- LPFN_SOCKET socket;
- LPFN_WSAASYNCSELECT WSAAsyncSelect;
- LPFN_WSACLEANUP WSACleanup;
- LPFN_WSAGETLASTERROR WSAGetLastError;
- LPFN_WSASTARTUP WSAStartup;
-
-} winSock;
+static TclInitProcessGlobalValueProc InitializeHostName;
+static ProcessGlobalValue hostName = {
+ 0, 0, NULL, NULL, InitializeHostName, NULL, NULL
+};
/*
* The following defines declare the messages used on socket windows.
@@ -178,52 +97,48 @@ static struct {
#define UNSELECT FALSE
/*
- * The following structure is used to store the data associated with
- * each socket.
+ * The following structure is used to store the data associated with each
+ * socket.
*/
typedef struct SocketInfo {
- Tcl_Channel channel; /* Channel associated with this
- * socket. */
- SOCKET socket; /* Windows SOCKET handle. */
- int flags; /* Bit field comprised of the flags
- * described below. */
- int watchEvents; /* OR'ed combination of FD_READ,
- * FD_WRITE, FD_CLOSE, FD_ACCEPT and
- * FD_CONNECT that indicate which
- * events are interesting. */
- int readyEvents; /* OR'ed combination of FD_READ,
- * FD_WRITE, FD_CLOSE, FD_ACCEPT and
- * FD_CONNECT that indicate which
- * events have occurred. */
- int selectEvents; /* OR'ed combination of FD_READ,
- * FD_WRITE, FD_CLOSE, FD_ACCEPT and
- * FD_CONNECT that indicate which
- * events are currently being
- * selected. */
- int acceptEventCount; /* Count of the current number of
- * FD_ACCEPTs that have arrived and
- * not yet processed. */
- Tcl_TcpAcceptProc *acceptProc; /* Proc to call on accept. */
- ClientData acceptProcData; /* The data for the accept proc. */
- int lastError; /* Error code from last message. */
- struct SocketInfo *nextPtr; /* The next socket on the per-thread
- * socket list. */
+ Tcl_Channel channel; /* Channel associated with this socket. */
+ SOCKET socket; /* Windows SOCKET handle. */
+ int flags; /* Bit field comprised of the flags described
+ * below. */
+ int watchEvents; /* OR'ed combination of FD_READ, FD_WRITE,
+ * FD_CLOSE, FD_ACCEPT and FD_CONNECT that
+ * indicate which events are interesting. */
+ int readyEvents; /* OR'ed combination of FD_READ, FD_WRITE,
+ * FD_CLOSE, FD_ACCEPT and FD_CONNECT that
+ * indicate which events have occurred. */
+ int selectEvents; /* OR'ed combination of FD_READ, FD_WRITE,
+ * FD_CLOSE, FD_ACCEPT and FD_CONNECT that
+ * indicate which events are currently being
+ * selected. */
+ int acceptEventCount; /* Count of the current number of FD_ACCEPTs
+ * that have arrived and not yet processed. */
+ Tcl_TcpAcceptProc *acceptProc;
+ /* Proc to call on accept. */
+ ClientData acceptProcData; /* The data for the accept proc. */
+ 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 socket event occurs.
+ * The following structure is what is added to the Tcl event queue when a
+ * socket event occurs.
*/
typedef struct SocketEvent {
- Tcl_Event header; /* Information that is standard for
- * all events. */
- SOCKET socket; /* Socket descriptor that is ready. Used
- * to find the SocketInfo structure for
- * the file (can't point directly to the
- * SocketInfo structure because it could
- * go away while the event is queued). */
+ Tcl_Event header; /* Information that is standard for all
+ * events. */
+ SOCKET socket; /* Socket descriptor that is ready. Used to
+ * find the SocketInfo structure for the file
+ * (can't point directly to the SocketInfo
+ * structure because it could go away while
+ * the event is queued). */
} SocketEvent;
/*
@@ -233,30 +148,28 @@ typedef struct SocketEvent {
#define TCP_BUFFER_SIZE 4096
/*
- * The following macros may be used to set the flags field of
- * a SocketInfo structure.
+ * The following macros may be used to set the flags field of a SocketInfo
+ * structure.
*/
-#define SOCKET_ASYNC (1<<0) /* The socket is in blocking
- * mode. */
-#define SOCKET_EOF (1<<1) /* A zero read happened on
- * the socket. */
-#define SOCKET_ASYNC_CONNECT (1<<2) /* This socket uses async
- * connect. */
-#define SOCKET_PENDING (1<<3) /* A message has been sent
- * for this socket */
+#define SOCKET_ASYNC (1<<0) /* The socket is in blocking mode. */
+#define SOCKET_EOF (1<<1) /* A zero read happened on the
+ * socket. */
+#define SOCKET_ASYNC_CONNECT (1<<2) /* This socket uses async connect. */
+#define SOCKET_PENDING (1<<3) /* A message has been sent for this
+ * socket */
typedef struct ThreadSpecificData {
- HWND hwnd; /* Handle to window for socket messages. */
- HANDLE socketThread; /* Thread handling the window */
- Tcl_ThreadId threadId; /* Parent thread. */
- HANDLE readyEvent; /* Event indicating that a socket event is
- * ready. Also used to indicate that the
- * socketThread has been initialized and has
- * started. */
- HANDLE socketListLock; /* Win32 Event to lock the socketList */
- SocketInfo *socketList; /* Every open socket in this thread has an
- * entry on this list. */
+ HWND hwnd; /* Handle to window for socket messages. */
+ HANDLE socketThread; /* Thread handling the window */
+ Tcl_ThreadId threadId; /* Parent thread. */
+ HANDLE readyEvent; /* Event indicating that a socket event is
+ * ready. Also used to indicate that the
+ * socketThread has been initialized and has
+ * started. */
+ HANDLE socketListLock; /* Win32 Event to lock the socketList */
+ SocketInfo *socketList; /* Every open socket in this thread has an
+ * entry on this list. */
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;
@@ -266,25 +179,27 @@ static WNDCLASS windowClass;
* Static functions defined in this file.
*/
-static SocketInfo * CreateSocket _ANSI_ARGS_((Tcl_Interp *interp,
- int port, CONST char *host,
- int server, CONST char *myaddr,
- int myport, int async));
-static int CreateSocketAddress _ANSI_ARGS_(
- (LPSOCKADDR_IN sockaddrPtr,
- CONST char *host, int port));
-static void InitSockets _ANSI_ARGS_((void));
-static SocketInfo * NewSocketInfo _ANSI_ARGS_((SOCKET socket));
-static Tcl_EventCheckProc SocketCheckProc;
-static Tcl_EventProc SocketEventProc;
-static void SocketExitHandler _ANSI_ARGS_((
- ClientData clientData));
-static LRESULT CALLBACK SocketProc _ANSI_ARGS_((HWND hwnd,
- UINT message, WPARAM wParam,
- LPARAM lParam));
-static Tcl_EventSetupProc SocketSetupProc;
-static int SocketsEnabled _ANSI_ARGS_((void));
-static void TcpAccept _ANSI_ARGS_((SocketInfo *infoPtr));
+static SocketInfo * CreateSocket(Tcl_Interp *interp, int port,
+ const char *host, int server, const char *myaddr,
+ int myport, int async);
+static int CreateSocketAddress(LPSOCKADDR_IN sockaddrPtr,
+ const char *host, int port);
+static void InitSockets(void);
+static 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 int WaitForSocketEvent(SocketInfo *infoPtr, int events,
+ int *errorCodePtr);
+static DWORD WINAPI SocketThread(LPVOID arg);
+static void TcpThreadActionProc(ClientData instanceData,
+ int action);
+
+static Tcl_EventCheckProc SocketCheckProc;
+static Tcl_EventProc SocketEventProc;
+static Tcl_EventSetupProc SocketSetupProc;
static Tcl_DriverBlockModeProc TcpBlockProc;
static Tcl_DriverCloseProc TcpCloseProc;
static Tcl_DriverSetOptionProc TcpSetOptionProc;
@@ -293,14 +208,6 @@ static Tcl_DriverInputProc TcpInputProc;
static Tcl_DriverOutputProc TcpOutputProc;
static Tcl_DriverWatchProc TcpWatchProc;
static Tcl_DriverGetHandleProc TcpGetHandleProc;
-static int WaitForSocketEvent _ANSI_ARGS_((
- SocketInfo *infoPtr, int events,
- int *errorCodePtr));
-static DWORD WINAPI SocketThread _ANSI_ARGS_((LPVOID arg));
-
-static void TcpThreadActionProc _ANSI_ARGS_ ((
- ClientData instanceData, int action));
-
/*
* This structure describes the channel type structure for TCP socket
@@ -309,7 +216,7 @@ static void TcpThreadActionProc _ANSI_ARGS_ ((
static Tcl_ChannelType tcpChannelType = {
"tcp", /* Type name. */
- TCL_CHANNEL_VERSION_4, /* v4 channel */
+ TCL_CHANNEL_VERSION_5, /* v5 channel */
TcpCloseProc, /* Close proc. */
TcpInputProc, /* Input proc. */
TcpOutputProc, /* Output proc. */
@@ -322,18 +229,17 @@ static Tcl_ChannelType tcpChannelType = {
TcpBlockProc, /* Set socket into (non-)blocking mode. */
NULL, /* flush proc. */
NULL, /* handler proc. */
- NULL, /* wide seek proc */
+ NULL, /* wide seek proc */
TcpThreadActionProc, /* thread action proc */
+ NULL, /* truncate */
};
-
/*
*----------------------------------------------------------------------
*
* InitSockets --
*
- * Initialize the socket module. Attempts to load the wsock32.dll
- * library and set up the winSock function table. If successful,
+ * Initialize the socket module. If winsock startup is successful,
* registers the event window for the socket notifier code.
*
* Assumes socketMutex is held.
@@ -342,132 +248,32 @@ static Tcl_ChannelType tcpChannelType = {
* None.
*
* Side effects:
- * Dynamically loads wsock32.dll, and registers a new window
- * class and creates a window for use in asynchronous socket
- * notification.
+ * Initializes winsock, registers a new window class and creates a
+ * window for use in asynchronous socket notification.
*
*----------------------------------------------------------------------
*/
static void
-InitSockets()
+InitSockets(void)
{
DWORD id;
WSADATA wsaData;
DWORD err;
- ThreadSpecificData *tsdPtr =
- (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ TclThreadDataKeyGet(&dataKey);
if (!initialized) {
initialized = 1;
TclCreateLateExitHandler(SocketExitHandler, (ClientData) NULL);
- winSock.hModule = LoadLibraryA("wsock32.dll");
-
- if (winSock.hModule == NULL) {
- return;
- }
-
/*
- * Initialize the function table.
+ * Create the async notification window with a new class. We must
+ * create a new class to avoid a Windows 95 bug that causes us to get
+ * the wrong message number for socket events if the message window is
+ * a subclass of a static control.
*/
- winSock.accept = (LPFN_ACCEPT)
- GetProcAddress(winSock.hModule, "accept");
- winSock.bind = (LPFN_BIND)
- GetProcAddress(winSock.hModule, "bind");
- winSock.closesocket = (LPFN_CLOSESOCKET)
- GetProcAddress(winSock.hModule, "closesocket");
- winSock.connect = (LPFN_CONNECT)
- GetProcAddress(winSock.hModule, "connect");
- winSock.gethostbyaddr = (LPFN_GETHOSTBYADDR)
- GetProcAddress(winSock.hModule, "gethostbyaddr");
- winSock.gethostbyname = (LPFN_GETHOSTBYNAME)
- GetProcAddress(winSock.hModule, "gethostbyname");
- winSock.gethostname = (LPFN_GETHOSTNAME)
- GetProcAddress(winSock.hModule, "gethostname");
- winSock.getpeername = (LPFN_GETPEERNAME)
- GetProcAddress(winSock.hModule, "getpeername");
- winSock.getservbyname = (LPFN_GETSERVBYNAME)
- GetProcAddress(winSock.hModule, "getservbyname");
- winSock.getsockname = (LPFN_GETSOCKNAME)
- GetProcAddress(winSock.hModule, "getsockname");
- winSock.getsockopt = (LPFN_GETSOCKOPT)
- GetProcAddress(winSock.hModule, "getsockopt");
- winSock.htons = (LPFN_HTONS)
- GetProcAddress(winSock.hModule, "htons");
- winSock.inet_addr = (LPFN_INET_ADDR)
- GetProcAddress(winSock.hModule, "inet_addr");
- winSock.inet_ntoa = (LPFN_INET_NTOA)
- GetProcAddress(winSock.hModule, "inet_ntoa");
- winSock.ioctlsocket = (LPFN_IOCTLSOCKET)
- GetProcAddress(winSock.hModule, "ioctlsocket");
- winSock.listen = (LPFN_LISTEN)
- GetProcAddress(winSock.hModule, "listen");
- winSock.ntohs = (LPFN_NTOHS)
- GetProcAddress(winSock.hModule, "ntohs");
- winSock.recv = (LPFN_RECV)
- GetProcAddress(winSock.hModule, "recv");
- winSock.select = (LPFN_SELECT)
- GetProcAddress(winSock.hModule, "select");
- winSock.send = (LPFN_SEND)
- GetProcAddress(winSock.hModule, "send");
- winSock.setsockopt = (LPFN_SETSOCKOPT)
- GetProcAddress(winSock.hModule, "setsockopt");
- winSock.socket = (LPFN_SOCKET)
- GetProcAddress(winSock.hModule, "socket");
- winSock.WSAAsyncSelect = (LPFN_WSAASYNCSELECT)
- GetProcAddress(winSock.hModule, "WSAAsyncSelect");
- winSock.WSACleanup = (LPFN_WSACLEANUP)
- GetProcAddress(winSock.hModule, "WSACleanup");
- winSock.WSAGetLastError = (LPFN_WSAGETLASTERROR)
- GetProcAddress(winSock.hModule, "WSAGetLastError");
- winSock.WSAStartup = (LPFN_WSASTARTUP)
- GetProcAddress(winSock.hModule, "WSAStartup");
-
- /*
- * Now check that all fields are properly initialized. If not,
- * return zero to indicate that we failed to initialize
- * properly.
- */
-
- if ((winSock.accept == NULL) ||
- (winSock.bind == NULL) ||
- (winSock.closesocket == NULL) ||
- (winSock.connect == NULL) ||
- (winSock.gethostbyname == NULL) ||
- (winSock.gethostbyaddr == NULL) ||
- (winSock.gethostname == NULL) ||
- (winSock.getpeername == NULL) ||
- (winSock.getservbyname == NULL) ||
- (winSock.getsockname == NULL) ||
- (winSock.getsockopt == NULL) ||
- (winSock.htons == NULL) ||
- (winSock.inet_addr == NULL) ||
- (winSock.inet_ntoa == NULL) ||
- (winSock.ioctlsocket == NULL) ||
- (winSock.listen == NULL) ||
- (winSock.ntohs == NULL) ||
- (winSock.recv == NULL) ||
- (winSock.select == NULL) ||
- (winSock.send == NULL) ||
- (winSock.setsockopt == NULL) ||
- (winSock.socket == NULL) ||
- (winSock.WSAAsyncSelect == NULL) ||
- (winSock.WSACleanup == NULL) ||
- (winSock.WSAGetLastError == NULL) ||
- (winSock.WSAStartup == NULL))
- {
- goto unloadLibrary;
- }
-
- /*
- * Create the async notification window with a new class. We
- * must create a new class to avoid a Windows 95 bug that causes
- * us to get the wrong message number for socket events if the
- * message window is a subclass of a static control.
- */
-
windowClass.style = 0;
windowClass.cbClsExtra = 0;
windowClass.cbWndExtra = 0;
@@ -481,35 +287,36 @@ InitSockets()
if (!RegisterClassA(&windowClass)) {
TclWinConvertError(GetLastError());
- goto unloadLibrary;
+ goto initFailure;
}
/*
- * Initialize the winsock library and check the interface
- * version actually loaded. We only ask for the 1.1 interface
- * and do require that it not be less than 1.1.
+ * Initialize the winsock library and check the interface version
+ * actually loaded. We only ask for the 1.1 interface and do require
+ * that it not be less than 1.1.
*/
-#define WSA_VERSION_MAJOR 1
-#define WSA_VERSION_MINOR 1
-#define WSA_VERSION_REQD MAKEWORD(WSA_VERSION_MAJOR, WSA_VERSION_MINOR)
+#define WSA_VERSION_MAJOR 1
+#define WSA_VERSION_MINOR 1
+#define WSA_VERSION_REQD MAKEWORD(WSA_VERSION_MAJOR, WSA_VERSION_MINOR)
- if ((err = winSock.WSAStartup(WSA_VERSION_REQD, &wsaData)) != 0) {
+ err = WSAStartup((WORD)WSA_VERSION_REQD, &wsaData);
+ if (err != 0) {
TclWinConvertWSAError(err);
- goto unloadLibrary;
+ goto initFailure;
}
/*
- * Note the byte positions are swapped for the comparison, so
- * that 0x0002 (2.0, MAKEWORD(2,0)) doesn't look less than 0x0101
- * (1.1). We want the comparison to be 0x0200 < 0x0101.
+ * Note the byte positions are swapped for the comparison, so that
+ * 0x0002 (2.0, MAKEWORD(2,0)) doesn't look less than 0x0101 (1.1).
+ * We want the comparison to be 0x0200 < 0x0101.
*/
if (MAKEWORD(HIBYTE(wsaData.wVersion), LOBYTE(wsaData.wVersion))
< MAKEWORD(WSA_VERSION_MINOR, WSA_VERSION_MAJOR)) {
TclWinConvertWSAError(WSAVERNOTSUPPORTED);
- winSock.WSACleanup();
- goto unloadLibrary;
+ WSACleanup();
+ goto initFailure;
}
#undef WSA_VERSION_REQD
@@ -528,39 +335,38 @@ InitSockets()
tsdPtr->threadId = Tcl_GetCurrentThread();
tsdPtr->readyEvent = CreateEvent(NULL, FALSE, FALSE, NULL);
if (tsdPtr->readyEvent == NULL) {
- goto unloadLibrary;
+ goto initFailure;
}
tsdPtr->socketListLock = CreateEvent(NULL, FALSE, TRUE, NULL);
if (tsdPtr->socketListLock == NULL) {
- goto unloadLibrary;
+ goto initFailure;
}
- tsdPtr->socketThread = CreateThread(NULL, 256, SocketThread,
- tsdPtr, 0, &id);
+ tsdPtr->socketThread = CreateThread(NULL, 256, SocketThread, tsdPtr,
+ 0, &id);
if (tsdPtr->socketThread == NULL) {
- goto unloadLibrary;
+ goto initFailure;
}
SetThreadPriority(tsdPtr->socketThread, THREAD_PRIORITY_HIGHEST);
/*
- * Wait for the thread to signal when the window has
- * been created and if it is ready to go.
+ * Wait for the thread to signal when the window has been created and
+ * if it is ready to go.
*/
WaitForSingleObject(tsdPtr->readyEvent, INFINITE);
if (tsdPtr->hwnd == NULL) {
- goto unloadLibrary; /* Trouble creating the window */
+ goto initFailure; /* Trouble creating the window */
}
Tcl_CreateEventSource(SocketSetupProc, SocketCheckProc, NULL);
}
return;
-unloadLibrary:
+ initFailure:
TclpFinalizeSockets();
- FreeLibrary(winSock.hModule);
- winSock.hModule = NULL;
+ initialized = -1;
return;
}
@@ -569,7 +375,7 @@ unloadLibrary:
*
* SocketsEnabled --
*
- * Check that the WinSock DLL is loaded and ready.
+ * Check that the WinSock was successfully initialized.
*
* Results:
* 1 if it is.
@@ -582,11 +388,11 @@ unloadLibrary:
/* ARGSUSED */
static int
-SocketsEnabled()
+SocketsEnabled(void)
{
int enabled;
Tcl_MutexLock(&socketMutex);
- enabled = (winSock.hModule != NULL);
+ enabled = (initialized == 1);
Tcl_MutexUnlock(&socketMutex);
return enabled;
}
@@ -597,7 +403,7 @@ SocketsEnabled()
*
* SocketExitHandler --
*
- * Callback invoked during app exit clean up to delete the socket
+ * Callback invoked during exit clean up to delete the socket
* communication window and to release the WinSock DLL.
*
* Results:
@@ -611,23 +417,19 @@ SocketsEnabled()
/* ARGSUSED */
static void
-SocketExitHandler(clientData)
- ClientData clientData; /* Not used. */
+SocketExitHandler(
+ ClientData clientData) /* Not used. */
{
Tcl_MutexLock(&socketMutex);
- if (winSock.hModule) {
- /*
- * Make sure the socket event handling window is cleaned-up
- * for, at most, this thread.
- */
- TclpFinalizeSockets();
- UnregisterClass("TclSocket", TclWinGetTclInstance());
- winSock.WSACleanup();
- FreeLibrary(winSock.hModule);
- winSock.hModule = NULL;
- }
+ /*
+ * Make sure the socket event handling window is cleaned-up for, at
+ * most, this thread.
+ */
+
+ TclpFinalizeSockets();
+ UnregisterClass("TclSocket", TclWinGetTclInstance());
+ WSACleanup();
initialized = 0;
- hostnameInitialized = 0;
Tcl_MutexUnlock(&socketMutex);
}
@@ -636,10 +438,10 @@ SocketExitHandler(clientData)
*
* TclpFinalizeSockets --
*
- * This function is called from Tcl_FinalizeThread to finalize
- * the platform specific socket subsystem.
- * Also, it may be called from within this module to cleanup
- * the state if unable to initialize the sockets subsystem.
+ * This function is called from Tcl_FinalizeThread to finalize the
+ * platform specific socket subsystem. Also, it may be called from within
+ * this module to cleanup the state if unable to initialize the sockets
+ * subsystem.
*
* Results:
* None.
@@ -651,19 +453,21 @@ SocketExitHandler(clientData)
*/
void
-TclpFinalizeSockets()
+TclpFinalizeSockets(void)
{
ThreadSpecificData *tsdPtr;
- tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
+ tsdPtr = (ThreadSpecificData *) TclThreadDataKeyGet(&dataKey);
if (tsdPtr != NULL) {
if (tsdPtr->socketThread != NULL) {
if (tsdPtr->hwnd != NULL) {
PostMessage(tsdPtr->hwnd, SOCKET_TERMINATE, 0, 0);
+
/*
* Wait for the thread to exit. This ensures that we are
* completely cleaned up before we leave this function.
*/
+
WaitForSingleObject(tsdPtr->readyEvent, INFINITE);
tsdPtr->hwnd = NULL;
}
@@ -687,25 +491,27 @@ TclpFinalizeSockets()
*
* TclpHasSockets --
*
- * This function determines whether sockets are available on the
- * current system and returns an error in interp if they are not.
- * Note that interp may be NULL.
+ * This function determines whether sockets are available on the current
+ * system and returns an error in interp if they are not. Note that
+ * interp may be NULL.
*
* Results:
- * Returns TCL_OK if the system supports sockets, or TCL_ERROR with
- * an error in interp.
+ * Returns TCL_OK if the system supports sockets, or TCL_ERROR with an
+ * error in interp (if non-NULL).
*
* Side effects:
- * If not already prepared, initializes the TSD structure and
- * socket message handling thread associated to the calling thread
- * for the subsystem of the driver.
+ * If not already prepared, initializes the TSD structure and socket
+ * message handling thread associated to the calling thread for the
+ * subsystem of the driver.
*
*----------------------------------------------------------------------
*/
int
-TclpHasSockets(interp)
- Tcl_Interp *interp;
+TclpHasSockets(
+ Tcl_Interp *interp) /* Where to write an error message if sockets
+ * are not present, or NULL if no such message
+ * is to be written. */
{
Tcl_MutexLock(&socketMutex);
InitSockets();
@@ -726,8 +532,8 @@ TclpHasSockets(interp)
*
* SocketSetupProc --
*
- * This procedure is invoked before Tcl_DoOneEvent blocks waiting
- * for an event.
+ * This function is invoked before Tcl_DoOneEvent blocks waiting for an
+ * event.
*
* Results:
* None.
@@ -739,9 +545,9 @@ TclpHasSockets(interp)
*/
void
-SocketSetupProc(data, flags)
- ClientData data; /* Not used. */
- int flags; /* Event flags as passed to Tcl_DoOneEvent. */
+SocketSetupProc(
+ ClientData data, /* Not used. */
+ int flags) /* Event flags as passed to Tcl_DoOneEvent. */
{
SocketInfo *infoPtr;
Tcl_Time blockTime = { 0, 0 };
@@ -750,13 +556,13 @@ SocketSetupProc(data, flags)
if (!(flags & TCL_FILE_EVENTS)) {
return;
}
-
+
/*
- * Check to see if there is a ready socket. If so, poll.
+ * Check to see if there is a ready socket. If so, poll.
*/
WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
- for (infoPtr = tsdPtr->socketList; infoPtr != NULL;
+ for (infoPtr = tsdPtr->socketList; infoPtr != NULL;
infoPtr = infoPtr->nextPtr) {
if (infoPtr->readyEvents & infoPtr->watchEvents) {
Tcl_SetMaxBlockTime(&blockTime);
@@ -771,8 +577,8 @@ SocketSetupProc(data, flags)
*
* SocketCheckProc --
*
- * This procedure is called by Tcl_DoOneEvent to check the socket
- * event source for events.
+ * This function is called by Tcl_DoOneEvent to check the socket event
+ * source for events.
*
* Results:
* None.
@@ -784,9 +590,9 @@ SocketSetupProc(data, flags)
*/
static void
-SocketCheckProc(data, flags)
- ClientData data; /* Not used. */
- int flags; /* Event flags as passed to Tcl_DoOneEvent. */
+SocketCheckProc(
+ ClientData data, /* Not used. */
+ int flags) /* Event flags as passed to Tcl_DoOneEvent. */
{
SocketInfo *infoPtr;
SocketEvent *evPtr;
@@ -795,7 +601,7 @@ SocketCheckProc(data, flags)
if (!(flags & TCL_FILE_EVENTS)) {
return;
}
-
+
/*
* Queue events for any ready sockets that don't already have events
* queued (caused by persistent states that won't generate WinSock
@@ -803,7 +609,7 @@ SocketCheckProc(data, flags)
*/
WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
- for (infoPtr = tsdPtr->socketList; infoPtr != NULL;
+ for (infoPtr = tsdPtr->socketList; infoPtr != NULL;
infoPtr = infoPtr->nextPtr) {
if ((infoPtr->readyEvents & infoPtr->watchEvents)
&& !(infoPtr->flags & SOCKET_PENDING)) {
@@ -822,27 +628,27 @@ SocketCheckProc(data, flags)
*
* SocketEventProc --
*
- * This procedure is called by Tcl_ServiceEvent when a socket event
- * reaches the front of the event queue. This procedure is
- * responsible for notifying the generic channel code.
+ * This function is called by Tcl_ServiceEvent when a socket event
+ * reaches the front of the event queue. This function is responsible for
+ * notifying the generic channel code.
*
* Results:
- * Returns 1 if the event was handled, meaning it should be removed
- * from the queue. Returns 0 if the event was not handled, meaning
- * it should stay on the queue. The only time the event isn't
- * handled is if the TCL_FILE_EVENTS flag bit isn't set.
+ * Returns 1 if the event was handled, meaning it should be removed from
+ * the queue. Returns 0 if the event was not handled, meaning it should
+ * stay on the queue. The only time the event isn't handled is if the
+ * TCL_FILE_EVENTS flag bit isn't set.
*
* Side effects:
- * Whatever the channel callback procedures do.
+ * Whatever the channel callback functions do.
*
*----------------------------------------------------------------------
*/
static int
-SocketEventProc(evPtr, flags)
- Tcl_Event *evPtr; /* Event to service. */
- int flags; /* Flags that indicate what events to
- * handle, such as TCL_FILE_EVENTS. */
+SocketEventProc(
+ Tcl_Event *evPtr, /* Event to service. */
+ int flags) /* Flags that indicate what events to handle,
+ * such as TCL_FILE_EVENTS. */
{
SocketInfo *infoPtr;
SocketEvent *eventPtr = (SocketEvent *) evPtr;
@@ -859,7 +665,7 @@ SocketEventProc(evPtr, flags)
*/
WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
- for (infoPtr = tsdPtr->socketList; infoPtr != NULL;
+ for (infoPtr = tsdPtr->socketList; infoPtr != NULL;
infoPtr = infoPtr->nextPtr) {
if (infoPtr->socket == eventPtr->socket) {
break;
@@ -887,21 +693,21 @@ SocketEventProc(evPtr, flags)
}
/*
- * Mask off unwanted events and compute the read/write mask so
- * we can notify the channel.
+ * Mask off unwanted events and compute the read/write mask so we can
+ * notify the channel.
*/
events = infoPtr->readyEvents & infoPtr->watchEvents;
if (events & FD_CLOSE) {
/*
- * If the socket was closed and the channel is still interested
- * in read events, then we need to ensure that we keep polling
- * for this event until someone does something with the channel.
- * Note that we do this before calling Tcl_NotifyChannel so we don't
- * have to watch out for the channel being deleted out from under
- * us. This may cause a redundant trip through the event loop, but
- * it's simpler than trying to do unwind protection.
+ * If the socket was closed and the channel is still interested in
+ * read events, then we need to ensure that we keep polling for this
+ * event until someone does something with the channel. Note that we
+ * do this before calling Tcl_NotifyChannel so we don't have to watch
+ * out for the channel being deleted out from under us. This may cause
+ * a redundant trip through the event loop, but it's simpler than
+ * trying to do unwind protection.
*/
Tcl_Time blockTime = { 0, 0 };
@@ -913,10 +719,10 @@ SocketEventProc(evPtr, flags)
/*
* We must check to see if data is really available, since someone
- * could have consumed the data in the meantime. Turn off async
- * notification so select will work correctly. If the socket is
- * still readable, notify the channel driver, otherwise reset the
- * async select handler and keep waiting.
+ * could have consumed the data in the meantime. Turn off async
+ * notification so select will work correctly. If the socket is still
+ * readable, notify the channel driver, otherwise reset the async
+ * select handler and keep waiting.
*/
SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
@@ -926,8 +732,8 @@ SocketEventProc(evPtr, flags)
FD_SET(infoPtr->socket, &readFds);
timeout.tv_usec = 0;
timeout.tv_sec = 0;
-
- if (winSock.select(0, &readFds, NULL, NULL, &timeout) != 0) {
+
+ if (select(0, &readFds, NULL, NULL, &timeout) != 0) {
mask |= TCL_READABLE;
} else {
infoPtr->readyEvents &= ~(FD_READ);
@@ -938,7 +744,10 @@ SocketEventProc(evPtr, flags)
if (events & (FD_WRITE | FD_CONNECT)) {
mask |= TCL_WRITABLE;
if (events & FD_CONNECT && infoPtr->lastError != NO_ERROR) {
- /* connect errors should also fire the readable handler. */
+ /*
+ * Connect errors should also fire the readable handler.
+ */
+
mask |= TCL_READABLE;
}
}
@@ -966,10 +775,10 @@ SocketEventProc(evPtr, flags)
*/
static int
-TcpBlockProc(instanceData, mode)
- ClientData instanceData; /* The socket to block/un-block. */
- int mode; /* TCL_MODE_BLOCKING or
- * TCL_MODE_NONBLOCKING. */
+TcpBlockProc(
+ ClientData instanceData, /* The socket to block/un-block. */
+ int mode) /* TCL_MODE_BLOCKING or
+ * TCL_MODE_NONBLOCKING. */
{
SocketInfo *infoPtr = (SocketInfo *) instanceData;
@@ -986,9 +795,9 @@ TcpBlockProc(instanceData, mode)
*
* TcpCloseProc --
*
- * This procedure is called by the generic IO level to perform
- * channel type specific cleanup on a socket based channel
- * when the channel is closed.
+ * This function is called by the generic IO level to perform channel
+ * type specific cleanup on a socket based channel when the channel is
+ * closed.
*
* Results:
* 0 if successful, the value of errno if failed.
@@ -1001,41 +810,41 @@ TcpBlockProc(instanceData, mode)
/* ARGSUSED */
static int
-TcpCloseProc(instanceData, interp)
- ClientData instanceData; /* The socket to close. */
- Tcl_Interp *interp; /* Unused. */
+TcpCloseProc(
+ ClientData instanceData, /* The socket to close. */
+ Tcl_Interp *interp) /* Unused. */
{
SocketInfo *infoPtr = (SocketInfo *) instanceData;
/* TIP #218 */
int errorCode = 0;
+ /* ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); */
/*
- * Check that WinSock is initialized; do not call it if not, to
- * prevent system crashes. This can happen at exit time if the exit
- * handler for WinSock ran before other exit handlers that want to
- * use sockets.
+ * Check that WinSock is initialized; do not call it if not, to prevent
+ * system crashes. This can happen at exit time if the exit handler for
+ * WinSock ran before other exit handlers that want to use sockets.
*/
if (SocketsEnabled()) {
-
/*
- * Clean up the OS socket handle. The default Windows setting
- * for a socket is SO_DONTLINGER, which does a graceful shutdown
- * in the background.
- */
-
- if (winSock.closesocket(infoPtr->socket) == SOCKET_ERROR) {
- TclWinConvertWSAError((DWORD) winSock.WSAGetLastError());
- errorCode = Tcl_GetErrno();
- }
- }
-
- /* TIP #218. Removed the code removing the structure
- * from the global socket list. This is now done by
- * the thread action callbacks, and only there. This
- * happens before this code is called. We can free
- * without fear of damanging the list.
+ * Clean up the OS socket handle. The default Windows setting for a
+ * socket is SO_DONTLINGER, which does a graceful shutdown in the
+ * background.
+ */
+
+ if (closesocket(infoPtr->socket) == SOCKET_ERROR) {
+ TclWinConvertWSAError((DWORD) WSAGetLastError());
+ errorCode = Tcl_GetErrno();
+ }
+ }
+
+ /*
+ * TIP #218. Removed the code removing the structure from the global
+ * socket list. This is now done by the thread action callbacks, and only
+ * there. This happens before this code is called. We can free without
+ * fear of damaging the list.
*/
+
ckfree((char *) infoPtr);
return errorCode;
}
@@ -1045,8 +854,7 @@ TcpCloseProc(instanceData, interp)
*
* NewSocketInfo --
*
- * This function allocates and initializes a new SocketInfo
- * structure.
+ * This function allocates and initializes a new SocketInfo structure.
*
* Results:
* Returns a newly allocated SocketInfo.
@@ -1058,12 +866,14 @@ TcpCloseProc(instanceData, interp)
*/
static SocketInfo *
-NewSocketInfo(socket)
- SOCKET socket;
+NewSocketInfo(
+ SOCKET socket)
{
SocketInfo *infoPtr;
+ /* ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); */
infoPtr = (SocketInfo *) ckalloc((unsigned) sizeof(SocketInfo));
+ infoPtr->channel = 0;
infoPtr->socket = socket;
infoPtr->flags = 0;
infoPtr->watchEvents = 0;
@@ -1071,14 +881,17 @@ NewSocketInfo(socket)
infoPtr->selectEvents = 0;
infoPtr->acceptEventCount = 0;
infoPtr->acceptProc = NULL;
+ infoPtr->acceptProcData = NULL;
infoPtr->lastError = 0;
- /* TIP #218. Removed the code inserting the new structure
- * into the global list. This is now handled in the thread
- * action callbacks, and only there.
+ /*
+ * TIP #218. Removed the code inserting the new structure into the global
+ * list. This is now handled in the thread action callbacks, and only
+ * there.
*/
+
infoPtr->nextPtr = NULL;
-
+
return infoPtr;
}
@@ -1087,8 +900,8 @@ NewSocketInfo(socket)
*
* CreateSocket --
*
- * This function opens a new socket and initializes the
- * SocketInfo structure.
+ * This function opens a new socket and initializes the SocketInfo
+ * structure.
*
* Results:
* Returns a new SocketInfo, or NULL with an error in interp.
@@ -1100,58 +913,57 @@ NewSocketInfo(socket)
*/
static SocketInfo *
-CreateSocket(interp, port, host, server, myaddr, myport, async)
- Tcl_Interp *interp; /* For error reporting; can be NULL. */
- int port; /* Port number to open. */
- CONST char *host; /* Name of host on which to open port. */
- int server; /* 1 if socket should be a server socket,
- * else 0 for a client socket. */
- CONST char *myaddr; /* Optional client-side address */
- int myport; /* Optional client-side port */
- int async; /* If nonzero, connect client socket
+CreateSocket(
+ Tcl_Interp *interp, /* For error reporting; can be NULL. */
+ int port, /* Port number to open. */
+ const char *host, /* Name of host on which to open port. */
+ int server, /* 1 if socket should be a server socket, else
+ * 0 for a client socket. */
+ const char *myaddr, /* Optional client-side address */
+ int myport, /* Optional client-side port */
+ int async) /* If nonzero, connect client socket
* asynchronously. */
{
u_long flag = 1; /* Indicates nonblocking mode. */
- int asyncConnect = 0; /* Will be 1 if async connect is
- * in progress. */
+ int asyncConnect = 0; /* Will be 1 if async connect is in
+ * progress. */
SOCKADDR_IN sockaddr; /* Socket address */
SOCKADDR_IN mysockaddr; /* Socket address for client */
SOCKET sock = INVALID_SOCKET;
SocketInfo *infoPtr; /* The returned value. */
- ThreadSpecificData *tsdPtr =
- (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ TclThreadDataKeyGet(&dataKey);
/*
- * Check that WinSock is initialized; do not call it if not, to
- * prevent system crashes. This can happen at exit time if the exit
- * handler for WinSock ran before other exit handlers that want to
- * use sockets.
+ * Check that WinSock is initialized; do not call it if not, to prevent
+ * system crashes. This can happen at exit time if the exit handler for
+ * WinSock ran before other exit handlers that want to use sockets.
*/
if (!SocketsEnabled()) {
- return NULL;
+ return NULL;
}
- if (! CreateSocketAddress(&sockaddr, host, port)) {
+ if (!CreateSocketAddress(&sockaddr, host, port)) {
goto error;
}
if ((myaddr != NULL || myport != 0) &&
- ! CreateSocketAddress(&mysockaddr, myaddr, myport)) {
+ !CreateSocketAddress(&mysockaddr, myaddr, myport)) {
goto error;
}
- sock = winSock.socket(AF_INET, SOCK_STREAM, 0);
+ sock = socket(AF_INET, SOCK_STREAM, 0);
if (sock == INVALID_SOCKET) {
goto error;
}
/*
- * 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
*/
@@ -1160,27 +972,27 @@ CreateSocket(interp, port, host, server, myaddr, myport, async)
if (server) {
/*
- * Bind to the specified port. Note that we must not call setsockopt
+ * 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.
+ *
+ * Bind should not be affected by the socket having already been set
+ * into nonblocking mode. If there is trouble, this is one place to
+ * look for bugs.
*/
-
- if (winSock.bind(sock, (SOCKADDR *) &sockaddr,
- sizeof(SOCKADDR_IN)) == 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).
- */
-
- if (winSock.listen(sock, SOMAXCONN) == SOCKET_ERROR) {
+
+ if (bind(sock, (SOCKADDR *) &sockaddr, sizeof(SOCKADDR_IN))
+ == 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).
+ */
+
+ if (listen(sock, SOMAXCONN) == SOCKET_ERROR) {
goto error;
}
@@ -1198,25 +1010,24 @@ CreateSocket(interp, port, host, server, myaddr, myport, async)
infoPtr->watchEvents |= FD_ACCEPT;
} else {
+ /*
+ * Try to bind to a local port, if specified.
+ */
- /*
- * Try to bind to a local port, if specified.
- */
-
- if (myaddr != NULL || myport != 0) {
- if (winSock.bind(sock, (SOCKADDR *) &mysockaddr,
- sizeof(SOCKADDR_IN)) == SOCKET_ERROR) {
+ if (myaddr != NULL || myport != 0) {
+ if (bind(sock, (SOCKADDR *) &mysockaddr, sizeof(SOCKADDR_IN))
+ == SOCKET_ERROR) {
goto error;
}
- }
-
+ }
+
/*
- * Set the socket into nonblocking mode if the connect should be
- * done in the background.
+ * Set the socket into nonblocking mode if the connect should be done
+ * in the background.
*/
-
+
if (async) {
- if (winSock.ioctlsocket(sock, (long) FIONBIO, &flag) == SOCKET_ERROR) {
+ if (ioctlsocket(sock, (long) FIONBIO, &flag) == SOCKET_ERROR) {
goto error;
}
}
@@ -1225,9 +1036,9 @@ CreateSocket(interp, port, host, server, myaddr, myport, async)
* Attempt to connect to the remote socket.
*/
- if (winSock.connect(sock, (SOCKADDR *) &sockaddr,
+ if (connect(sock, (SOCKADDR *) &sockaddr,
sizeof(SOCKADDR_IN)) == SOCKET_ERROR) {
- TclWinConvertWSAError((DWORD) winSock.WSAGetLastError());
+ TclWinConvertWSAError((DWORD) WSAGetLastError());
if (Tcl_GetErrno() != EWOULDBLOCK) {
goto error;
}
@@ -1237,7 +1048,7 @@ CreateSocket(interp, port, host, server, myaddr, myport, async)
*/
asyncConnect = 1;
- }
+ }
/*
* Add this socket to the global list of sockets.
@@ -1246,7 +1057,7 @@ CreateSocket(interp, port, host, server, myaddr, myport, async)
infoPtr = NewSocketInfo(sock);
/*
- * Set up the select mask for read/write events. If the connect
+ * Set up the select mask for read/write events. If the connect
* attempt has not completed, include connect events.
*/
@@ -1258,24 +1069,23 @@ CreateSocket(interp, port, host, server, myaddr, myport, async)
}
/*
- * Register for interest in events in the select mask. Note that this
+ * Register for interest in events in the select mask. Note that this
* automatically places the socket into non-blocking mode.
*/
- winSock.ioctlsocket(sock, (long) FIONBIO, &flag);
- SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
- (WPARAM) SELECT, (LPARAM) infoPtr);
+ ioctlsocket(sock, (long) FIONBIO, &flag);
+ SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT, (LPARAM) infoPtr);
return infoPtr;
-error:
- TclWinConvertWSAError((DWORD) winSock.WSAGetLastError());
+ error:
+ TclWinConvertWSAError((DWORD) WSAGetLastError());
if (interp != NULL) {
Tcl_AppendResult(interp, "couldn't open socket: ",
- Tcl_PosixError(interp), (char *) NULL);
+ Tcl_PosixError(interp), NULL);
}
if (sock != INVALID_SOCKET) {
- winSock.closesocket(sock);
+ closesocket(sock);
}
return NULL;
}
@@ -1288,8 +1098,8 @@ error:
* This function initializes a sockaddr structure for a host and port.
*
* Results:
- * 1 if the host was valid, 0 if the host could not be converted to
- * an IP address.
+ * 1 if the host was valid, 0 if the host could not be converted to an IP
+ * address.
*
* Side effects:
* Fills in the *sockaddrPtr structure.
@@ -1298,43 +1108,42 @@ error:
*/
static int
-CreateSocketAddress(sockaddrPtr, host, port)
- LPSOCKADDR_IN sockaddrPtr; /* Socket address */
- CONST char *host; /* Host. NULL implies INADDR_ANY */
- int port; /* Port number */
+CreateSocketAddress(
+ LPSOCKADDR_IN sockaddrPtr, /* Socket address */
+ const char *host, /* Host. NULL implies INADDR_ANY */
+ int port) /* Port number */
{
- struct hostent *hostent; /* Host database entry */
- struct in_addr addr; /* For 64/32 bit madness */
+ struct hostent *hostent; /* Host database entry */
+ struct in_addr addr; /* For 64/32 bit madness */
/*
- * Check that WinSock is initialized; do not call it if not, to
- * prevent system crashes. This can happen at exit time if the exit
- * handler for WinSock ran before other exit handlers that want to
- * use sockets.
+ * Check that WinSock is initialized; do not call it if not, to prevent
+ * system crashes. This can happen at exit time if the exit handler for
+ * WinSock ran before other exit handlers that want to use sockets.
*/
if (!SocketsEnabled()) {
- Tcl_SetErrno(EFAULT);
- return 0;
+ Tcl_SetErrno(EFAULT);
+ return 0;
}
ZeroMemory(sockaddrPtr, sizeof(SOCKADDR_IN));
sockaddrPtr->sin_family = AF_INET;
- sockaddrPtr->sin_port = winSock.htons((u_short) (port & 0xFFFF));
+ sockaddrPtr->sin_port = htons((u_short) (port & 0xFFFF));
if (host == NULL) {
addr.s_addr = INADDR_ANY;
} else {
- addr.s_addr = winSock.inet_addr(host);
- if (addr.s_addr == INADDR_NONE) {
- hostent = winSock.gethostbyname(host);
- if (hostent != NULL) {
- memcpy(&addr, hostent->h_addr, (size_t) hostent->h_length);
- } else {
+ addr.s_addr = inet_addr(host);
+ if (addr.s_addr == INADDR_NONE) {
+ hostent = gethostbyname(host);
+ if (hostent != NULL) {
+ memcpy(&addr, hostent->h_addr, (size_t) hostent->h_length);
+ } else {
#ifdef EHOSTUNREACH
- Tcl_SetErrno(EHOSTUNREACH);
+ Tcl_SetErrno(EHOSTUNREACH);
#else
#ifdef ENXIO
- Tcl_SetErrno(ENXIO);
+ Tcl_SetErrno(ENXIO);
#endif
#endif
return 0; /* Error. */
@@ -1343,14 +1152,14 @@ CreateSocketAddress(sockaddrPtr, host, port)
}
/*
- * NOTE: On 64 bit machines the assignment below is rumored to not
- * do the right thing. Please report errors related to this if you
- * observe incorrect behavior on 64 bit machines such as DEC Alphas.
- * Should we modify this code to do an explicit memcpy?
+ * NOTE: On 64 bit machines the assignment below is rumored to not do the
+ * right thing. Please report errors related to this if you observe
+ * incorrect behavior on 64 bit machines such as DEC Alphas. Should we
+ * modify this code to do an explicit memcpy?
*/
sockaddrPtr->sin_addr.s_addr = addr.s_addr;
- return 1; /* Success. */
+ return 1; /* Success. */
}
/*
@@ -1371,34 +1180,33 @@ CreateSocketAddress(sockaddrPtr, host, port)
*/
static int
-WaitForSocketEvent(infoPtr, events, errorCodePtr)
- SocketInfo *infoPtr; /* Information about this socket. */
- int events; /* Events to look for. */
- int *errorCodePtr; /* Where to store errors? */
+WaitForSocketEvent(
+ SocketInfo *infoPtr, /* Information about this socket. */
+ int events, /* Events to look for. */
+ int *errorCodePtr) /* Where to store errors? */
{
int result = 1;
int oldMode;
- ThreadSpecificData *tsdPtr =
- (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ TclThreadDataKeyGet(&dataKey);
/*
* Be sure to disable event servicing so we are truly modal.
*/
oldMode = Tcl_SetServiceMode(TCL_SERVICE_NONE);
-
+
/*
* Reset WSAAsyncSelect so we have a fresh set of events pending.
*/
- SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
- (WPARAM) UNSELECT, (LPARAM) infoPtr);
+ SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) UNSELECT,
+ (LPARAM) infoPtr);
- SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
- (WPARAM) SELECT, (LPARAM) infoPtr);
+ SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
+ (LPARAM) infoPtr);
while (1) {
-
if (infoPtr->lastError) {
*errorCodePtr = infoPtr->lastError;
result = 0;
@@ -1414,9 +1222,10 @@ WaitForSocketEvent(infoPtr, events, errorCodePtr)
/*
* Wait until something happens.
*/
+
WaitForSingleObject(tsdPtr->readyEvent, INFINITE);
}
-
+
(void) Tcl_SetServiceMode(oldMode);
return result;
}
@@ -1429,8 +1238,8 @@ WaitForSocketEvent(infoPtr, events, errorCodePtr)
* Opens a TCP client socket and creates a channel around it.
*
* Results:
- * The channel or NULL if failed. An error message is returned
- * in the interpreter on failure.
+ * The channel or NULL if failed. An error message is returned in the
+ * interpreter on failure.
*
* Side effects:
* Opens a client socket and creates a new channel.
@@ -1439,14 +1248,14 @@ WaitForSocketEvent(infoPtr, events, errorCodePtr)
*/
Tcl_Channel
-Tcl_OpenTcpClient(interp, port, host, myaddr, myport, async)
- Tcl_Interp *interp; /* For error reporting; can be NULL. */
- int port; /* Port number to open. */
- CONST char *host; /* Host on which to open port. */
- CONST char *myaddr; /* Client-side address */
- int myport; /* Client-side port */
- int async; /* If nonzero, should connect
- * client socket asynchronously. */
+Tcl_OpenTcpClient(
+ Tcl_Interp *interp, /* For error reporting; can be NULL. */
+ int port, /* Port number to open. */
+ const char *host, /* Host on which to open port. */
+ const char *myaddr, /* Client-side address */
+ int myport, /* Client-side port */
+ int async) /* If nonzero, should connect client socket
+ * asynchronously. */
{
SocketInfo *infoPtr;
char channelName[16 + TCL_INTEGER_SPACE];
@@ -1470,13 +1279,13 @@ Tcl_OpenTcpClient(interp, port, host, myaddr, myport, async)
(ClientData) infoPtr, (TCL_READABLE | TCL_WRITABLE));
if (Tcl_SetChannelOption(interp, infoPtr->channel, "-translation",
"auto crlf") == TCL_ERROR) {
- Tcl_Close((Tcl_Interp *) NULL, infoPtr->channel);
- return (Tcl_Channel) NULL;
+ Tcl_Close((Tcl_Interp *) NULL, infoPtr->channel);
+ return (Tcl_Channel) NULL;
}
if (Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "")
== TCL_ERROR) {
- Tcl_Close((Tcl_Interp *) NULL, infoPtr->channel);
- return (Tcl_Channel) NULL;
+ Tcl_Close((Tcl_Interp *) NULL, infoPtr->channel);
+ return (Tcl_Channel) NULL;
}
return infoPtr->channel;
}
@@ -1500,8 +1309,8 @@ Tcl_OpenTcpClient(interp, port, host, myaddr, myport, async)
*/
Tcl_Channel
-Tcl_MakeTcpClientChannel(sock)
- ClientData sock; /* The socket to wrap up into a channel. */
+Tcl_MakeTcpClientChannel(
+ ClientData sock) /* The socket to wrap up into a channel. */
{
SocketInfo *infoPtr;
char channelName[16 + TCL_INTEGER_SPACE];
@@ -1544,8 +1353,8 @@ Tcl_MakeTcpClientChannel(sock)
* Opens a TCP server socket and creates a channel around it.
*
* Results:
- * The channel or NULL if failed. An error message is returned
- * in the interpreter on failure.
+ * The channel or NULL if failed. An error message is returned in the
+ * interpreter on failure.
*
* Side effects:
* Opens a server socket and creates a new channel.
@@ -1554,14 +1363,14 @@ Tcl_MakeTcpClientChannel(sock)
*/
Tcl_Channel
-Tcl_OpenTcpServer(interp, port, host, acceptProc, acceptProcData)
- Tcl_Interp *interp; /* For error reporting - may be
- * NULL. */
- int port; /* Port number to open. */
- CONST char *host; /* Name of local host. */
- Tcl_TcpAcceptProc *acceptProc; /* Callback for accepting connections
- * from new clients. */
- ClientData acceptProcData; /* Data for the callback. */
+Tcl_OpenTcpServer(
+ Tcl_Interp *interp, /* For error reporting - may be NULL. */
+ int port, /* Port number to open. */
+ const char *host, /* Name of local host. */
+ Tcl_TcpAcceptProc *acceptProc,
+ /* Callback for accepting connections from new
+ * clients. */
+ ClientData acceptProcData) /* Data for the callback. */
{
SocketInfo *infoPtr;
char channelName[16 + TCL_INTEGER_SPACE];
@@ -1588,8 +1397,8 @@ Tcl_OpenTcpServer(interp, port, host, acceptProc, acceptProcData)
(ClientData) infoPtr, 0);
if (Tcl_SetChannelOption(interp, infoPtr->channel, "-eofchar", "")
== TCL_ERROR) {
- Tcl_Close((Tcl_Interp *) NULL, infoPtr->channel);
- return (Tcl_Channel) NULL;
+ Tcl_Close((Tcl_Interp *) NULL, infoPtr->channel);
+ return (Tcl_Channel) NULL;
}
return infoPtr->channel;
@@ -1599,9 +1408,9 @@ Tcl_OpenTcpServer(interp, port, host, acceptProc, acceptProcData)
*----------------------------------------------------------------------
*
* TcpAccept --
- * Accept a TCP socket connection. This is called by
- * SocketEventProc and it in turns calls the registered accept
- * procedure.
+ *
+ * Accept a TCP socket connection. This is called by SocketEventProc and
+ * it in turns calls the registered accept function.
*
* Results:
* None.
@@ -1613,16 +1422,16 @@ Tcl_OpenTcpServer(interp, port, host, acceptProc, acceptProcData)
*/
static void
-TcpAccept(infoPtr)
- SocketInfo *infoPtr; /* Socket to accept. */
+TcpAccept(
+ SocketInfo *infoPtr) /* Socket to accept. */
{
SOCKET newSocket;
SocketInfo *newInfoPtr;
SOCKADDR_IN addr;
int len;
char channelName[16 + TCL_INTEGER_SPACE];
- ThreadSpecificData *tsdPtr =
- (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ TclThreadDataKeyGet(&dataKey);
/*
* Accept the incoming connection request.
@@ -1630,7 +1439,7 @@ TcpAccept(infoPtr)
len = sizeof(SOCKADDR_IN);
- newSocket = winSock.accept(infoPtr->socket, (SOCKADDR *)&addr,
+ newSocket = accept(infoPtr->socket, (SOCKADDR *)&addr,
&len);
/*
@@ -1640,9 +1449,9 @@ TcpAccept(infoPtr)
WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
/*
- * Clear the ready mask so we can detect the next connection request.
- * Note that connection requests are level triggered, so if there is
- * a request already pending, a new event will be generated.
+ * Clear the ready mask so we can detect the next connection request. Note
+ * that connection requests are level triggered, so if there is a request
+ * already pending, a new event will be generated.
*/
if (newSocket == INVALID_SOCKET) {
@@ -1655,7 +1464,7 @@ TcpAccept(infoPtr)
/*
* It is possible that more than one FD_ACCEPT has been sent, so an extra
- * count must be kept. Decrement the count, and reset the readyEvent bit
+ * count must be kept. Decrement the count, and reset the readyEvent bit
* if the count is no longer > 0.
*/
@@ -1668,11 +1477,11 @@ TcpAccept(infoPtr)
SetEvent(tsdPtr->socketListLock);
/*
- * 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) newSocket, HANDLE_FLAG_INHERIT, 0 );
+ SetHandleInformation((HANDLE) newSocket, HANDLE_FLAG_INHERIT, 0);
/*
* Add this socket to the global list of sockets.
@@ -1703,14 +1512,12 @@ TcpAccept(infoPtr)
}
/*
- * Invoke the accept callback procedure.
+ * Invoke the accept callback function.
*/
if (infoPtr->acceptProc != NULL) {
- (infoPtr->acceptProc) (infoPtr->acceptProcData,
- newInfoPtr->channel,
- winSock.inet_ntoa(addr.sin_addr),
- winSock.ntohs(addr.sin_port));
+ (infoPtr->acceptProc) (infoPtr->acceptProcData, newInfoPtr->channel,
+ inet_ntoa(addr.sin_addr), ntohs(addr.sin_port));
}
}
@@ -1719,8 +1526,8 @@ TcpAccept(infoPtr)
*
* TcpInputProc --
*
- * This procedure is called by the generic IO level to read data from
- * a socket based channel.
+ * This function is called by the generic IO level to read data from a
+ * socket based channel.
*
* Results:
* The number of bytes read or -1 on error.
@@ -1732,35 +1539,34 @@ TcpAccept(infoPtr)
*/
static int
-TcpInputProc(instanceData, buf, toRead, errorCodePtr)
- ClientData instanceData; /* The socket state. */
- char *buf; /* Where to store data. */
- int toRead; /* Maximum number of bytes to read. */
- int *errorCodePtr; /* Where to store error codes. */
+TcpInputProc(
+ ClientData instanceData, /* The socket state. */
+ char *buf, /* Where to store data. */
+ int toRead, /* Maximum number of bytes to read. */
+ int *errorCodePtr) /* Where to store error codes. */
{
SocketInfo *infoPtr = (SocketInfo *) instanceData;
int bytesRead;
DWORD error;
- ThreadSpecificData *tsdPtr =
- (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
-
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ TclThreadDataKeyGet(&dataKey);
+
*errorCodePtr = 0;
/*
- * Check that WinSock is initialized; do not call it if not, to
- * prevent system crashes. This can happen at exit time if the exit
- * handler for WinSock ran before other exit handlers that want to
- * use sockets.
+ * Check that WinSock is initialized; do not call it if not, to prevent
+ * system crashes. This can happen at exit time if the exit handler for
+ * WinSock ran before other exit handlers that want to use sockets.
*/
if (!SocketsEnabled()) {
- *errorCodePtr = EFAULT;
- return -1;
+ *errorCodePtr = EFAULT;
+ return -1;
}
/*
- * First check to see if EOF was already detected, to prevent
- * calling the socket stack after the first time EOF is detected.
+ * First check to see if EOF was already detected, to prevent calling the
+ * socket stack after the first time EOF is detected.
*/
if (infoPtr->flags & SOCKET_EOF) {
@@ -1772,63 +1578,63 @@ TcpInputProc(instanceData, buf, toRead, errorCodePtr)
*/
if ((infoPtr->flags & SOCKET_ASYNC_CONNECT)
- && ! WaitForSocketEvent(infoPtr, FD_CONNECT, errorCodePtr)) {
+ && !WaitForSocketEvent(infoPtr, FD_CONNECT, errorCodePtr)) {
return -1;
}
-
+
/*
- * No EOF, and it is connected, so try to read more from the socket.
- * Note that we clear the FD_READ bit because read events are level
- * triggered so a new event will be generated if there is still data
- * available to be read. We have to simulate blocking behavior here
- * since we are always using non-blocking sockets.
+ * No EOF, and it is connected, so try to read more from the socket. Note
+ * that we clear the FD_READ bit because read events are level triggered
+ * so a new event will be generated if there is still data available to be
+ * read. We have to simulate blocking behavior here since we are always
+ * using non-blocking sockets.
*/
while (1) {
SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
(WPARAM) UNSELECT, (LPARAM) infoPtr);
- bytesRead = winSock.recv(infoPtr->socket, buf, toRead, 0);
+ bytesRead = recv(infoPtr->socket, buf, toRead, 0);
infoPtr->readyEvents &= ~(FD_READ);
-
+
/*
* Check for end-of-file condition or successful read.
*/
-
+
if (bytesRead == 0) {
infoPtr->flags |= SOCKET_EOF;
}
if (bytesRead != SOCKET_ERROR) {
break;
}
-
+
/*
- * If an error occurs after the FD_CLOSE has arrived,
- * then ignore the error and report an EOF.
+ * If an error occurs after the FD_CLOSE has arrived, then ignore the
+ * error and report an EOF.
*/
-
+
if (infoPtr->readyEvents & FD_CLOSE) {
infoPtr->flags |= SOCKET_EOF;
bytesRead = 0;
break;
}
-
- error = winSock.WSAGetLastError();
-
- /*
- * If an RST comes, then ignore the error and report an EOF just like
- * on unix.
- */
-
- if (error == WSAECONNRESET) {
- infoPtr->flags |= SOCKET_EOF;
- bytesRead = 0;
- break;
- }
-
+
+ error = WSAGetLastError();
+
+ /*
+ * If an RST comes, then ignore the error and report an EOF just like
+ * on unix.
+ */
+
+ if (error == WSAECONNRESET) {
+ infoPtr->flags |= SOCKET_EOF;
+ bytesRead = 0;
+ break;
+ }
+
/*
* Check for error condition or underflow in non-blocking case.
*/
-
+
if ((infoPtr->flags & SOCKET_ASYNC) || (error != WSAEWOULDBLOCK)) {
TclWinConvertWSAError(error);
*errorCodePtr = Tcl_GetErrno();
@@ -1837,19 +1643,19 @@ TcpInputProc(instanceData, buf, toRead, errorCodePtr)
}
/*
- * In the blocking case, wait until the file becomes readable
- * or closed and try again.
+ * In the blocking case, wait until the file becomes readable or
+ * closed and try again.
*/
if (!WaitForSocketEvent(infoPtr, FD_READ|FD_CLOSE, errorCodePtr)) {
bytesRead = -1;
break;
- }
+ }
}
-
+
SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
(WPARAM) SELECT, (LPARAM) infoPtr);
-
+
return bytesRead;
}
@@ -1858,8 +1664,8 @@ TcpInputProc(instanceData, buf, toRead, errorCodePtr)
*
* TcpOutputProc --
*
- * This procedure is called by the generic IO level to write data
- * to a socket based channel.
+ * This function is called by the generic IO level to write data to a
+ * socket based channel.
*
* Results:
* The number of bytes written or -1 on failure.
@@ -1871,38 +1677,37 @@ TcpInputProc(instanceData, buf, toRead, errorCodePtr)
*/
static int
-TcpOutputProc(instanceData, buf, toWrite, errorCodePtr)
- ClientData instanceData; /* The socket state. */
- CONST char *buf; /* Where to get data. */
- int toWrite; /* Maximum number of bytes to write. */
- int *errorCodePtr; /* Where to store error codes. */
+TcpOutputProc(
+ ClientData instanceData, /* The socket state. */
+ const char *buf, /* Where to get data. */
+ int toWrite, /* Maximum number of bytes to write. */
+ int *errorCodePtr) /* Where to store error codes. */
{
SocketInfo *infoPtr = (SocketInfo *) instanceData;
int bytesWritten;
DWORD error;
- ThreadSpecificData *tsdPtr =
- (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ TclThreadDataKeyGet(&dataKey);
*errorCodePtr = 0;
/*
- * Check that WinSock is initialized; do not call it if not, to
- * prevent system crashes. This can happen at exit time if the exit
- * handler for WinSock ran before other exit handlers that want to
- * use sockets.
+ * Check that WinSock is initialized; do not call it if not, to prevent
+ * system crashes. This can happen at exit time if the exit handler for
+ * WinSock ran before other exit handlers that want to use sockets.
*/
if (!SocketsEnabled()) {
- *errorCodePtr = EFAULT;
- return -1;
+ *errorCodePtr = EFAULT;
+ return -1;
}
/*
* Check to see if the socket is connected before trying to write.
*/
-
+
if ((infoPtr->flags & SOCKET_ASYNC_CONNECT)
- && ! WaitForSocketEvent(infoPtr, FD_CONNECT, errorCodePtr)) {
+ && !WaitForSocketEvent(infoPtr, FD_CONNECT, errorCodePtr)) {
return -1;
}
@@ -1910,36 +1715,36 @@ TcpOutputProc(instanceData, buf, toWrite, errorCodePtr)
SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
(WPARAM) UNSELECT, (LPARAM) infoPtr);
- bytesWritten = winSock.send(infoPtr->socket, buf, toWrite, 0);
+ bytesWritten = send(infoPtr->socket, buf, toWrite, 0);
if (bytesWritten != SOCKET_ERROR) {
/*
- * Since Windows won't generate a new write event until we hit
- * an overflow condition, we need to force the event loop to
- * poll until the condition changes.
+ * Since Windows won't generate a new write event until we hit an
+ * overflow condition, we need to force the event loop to poll
+ * until the condition changes.
*/
if (infoPtr->watchEvents & FD_WRITE) {
Tcl_Time blockTime = { 0, 0 };
Tcl_SetMaxBlockTime(&blockTime);
- }
+ }
break;
}
-
+
/*
- * Check for error condition or overflow. In the event of overflow, we
+ * Check for error condition or overflow. In the event of overflow, we
* need to clear the FD_WRITE flag so we can detect the next writable
- * event. Note that Windows only sends a new writable event after a
+ * event. Note that Windows only sends a new writable event after a
* send fails with WSAEWOULDBLOCK.
*/
- error = winSock.WSAGetLastError();
+ error = WSAGetLastError();
if (error == WSAEWOULDBLOCK) {
infoPtr->readyEvents &= ~(FD_WRITE);
if (infoPtr->flags & SOCKET_ASYNC) {
*errorCodePtr = EWOULDBLOCK;
bytesWritten = -1;
break;
- }
+ }
} else {
TclWinConvertWSAError(error);
*errorCodePtr = Tcl_GetErrno();
@@ -1948,8 +1753,8 @@ TcpOutputProc(instanceData, buf, toWrite, errorCodePtr)
}
/*
- * In the blocking case, wait until the file becomes writable
- * or closed and try again.
+ * In the blocking case, wait until the file becomes writable or
+ * closed and try again.
*/
if (!WaitForSocketEvent(infoPtr, FD_WRITE|FD_CLOSE, errorCodePtr)) {
@@ -1960,7 +1765,7 @@ TcpOutputProc(instanceData, buf, toWrite, errorCodePtr)
SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
(WPARAM) SELECT, (LPARAM) infoPtr);
-
+
return bytesWritten;
}
@@ -1981,45 +1786,48 @@ TcpOutputProc(instanceData, buf, toWrite, errorCodePtr)
*/
static int
-TcpSetOptionProc (
+TcpSetOptionProc(
ClientData instanceData, /* Socket state. */
Tcl_Interp *interp, /* For error reporting - can be NULL. */
- CONST char *optionName, /* Name of the option to set. */
- CONST char *value) /* New value for option. */
+ const char *optionName, /* Name of the option to set. */
+ const char *value) /* New value for option. */
{
-/*
+#ifdef TCL_FEATURE_KEEPALIVE_NAGLE
SocketInfo *infoPtr;
SOCKET sock;
- BOOL val = FALSE;
- int boolVar, rtn;
-*/
+#endif
+
/*
- * Check that WinSock is initialized; do not call it if not, to
- * prevent system crashes. This can happen at exit time if the exit
- * handler for WinSock ran before other exit handlers that want to
- * use sockets.
+ * Check that WinSock is initialized; do not call it if not, to prevent
+ * system crashes. This can happen at exit time if the exit handler for
+ * WinSock ran before other exit handlers that want to use sockets.
*/
if (!SocketsEnabled()) {
if (interp) {
Tcl_AppendResult(interp, "winsock is not initialized", NULL);
}
- return TCL_ERROR;
+ return TCL_ERROR;
}
-/*
+#ifdef TCL_FEATURE_KEEPALIVE_NAGLE
infoPtr = (SocketInfo *) instanceData;
sock = infoPtr->socket;
- if (!stricmp(optionName, "-keepalive")) {
+ if (!strcasecmp(optionName, "-keepalive")) {
+ BOOL val = FALSE;
+ int boolVar, rtn;
+
if (Tcl_GetBoolean(interp, value, &boolVar) != TCL_OK) {
return TCL_ERROR;
}
- if (boolVar) val = TRUE;
- rtn = winSock.setsockopt(sock, SOL_SOCKET, SO_KEEPALIVE,
+ if (boolVar) {
+ val = TRUE;
+ }
+ rtn = setsockopt(sock, SOL_SOCKET, SO_KEEPALIVE,
(const char *) &val, sizeof(BOOL));
if (rtn != 0) {
- TclWinConvertWSAError(winSock.WSAGetLastError());
+ TclWinConvertWSAError(WSAGetLastError());
if (interp) {
Tcl_AppendResult(interp, "couldn't set socket option: ",
Tcl_PosixError(interp), NULL);
@@ -2027,16 +1835,20 @@ TcpSetOptionProc (
return TCL_ERROR;
}
return TCL_OK;
+ } else if (!strcasecmp(optionName, "-nagle")) {
+ BOOL val = FALSE;
+ int boolVar, rtn;
- } else if (!stricmp(optionName, "-nagle")) {
if (Tcl_GetBoolean(interp, value, &boolVar) != TCL_OK) {
return TCL_ERROR;
}
- if (!boolVar) val = TRUE;
- rtn = winSock.setsockopt(sock, IPPROTO_TCP, TCP_NODELAY,
+ if (!boolVar) {
+ val = TRUE;
+ }
+ rtn = setsockopt(sock, IPPROTO_TCP, TCP_NODELAY,
(const char *) &val, sizeof(BOOL));
if (rtn != 0) {
- TclWinConvertWSAError(winSock.WSAGetLastError());
+ TclWinConvertWSAError(WSAGetLastError());
if (interp) {
Tcl_AppendResult(interp, "couldn't set socket option: ",
Tcl_PosixError(interp), NULL);
@@ -2047,8 +1859,9 @@ TcpSetOptionProc (
}
return Tcl_BadChannelOption(interp, optionName, "keepalive nagle");
-*/
+#else
return Tcl_BadChannelOption(interp, optionName, "");
+#endif /*TCL_FEATURE_KEEPALIVE_NAGLE*/
}
/*
@@ -2056,15 +1869,14 @@ TcpSetOptionProc (
*
* TcpGetOptionProc --
*
- * Computes an option value for a TCP socket based channel, or a
- * list of all options and their values.
+ * Computes an option value for a TCP socket based channel, or a list of
+ * all options and their values.
*
* Note: This code is based on code contributed by John Haxby.
*
* Results:
- * A standard Tcl result. The value of the specified option or a
- * list of all options and their values is returned in the
- * supplied DString.
+ * A standard Tcl result. The value of the specified option or a list of
+ * all options and their values is returned in the supplied DString.
*
* Side effects:
* None.
@@ -2073,15 +1885,14 @@ TcpSetOptionProc (
*/
static int
-TcpGetOptionProc(instanceData, interp, optionName, dsPtr)
- ClientData instanceData; /* Socket state. */
- Tcl_Interp *interp; /* For error reporting - can be NULL */
- CONST char *optionName; /* Name of the option to
- * retrieve the value for, or
- * NULL to get all options and
- * their values. */
- Tcl_DString *dsPtr; /* Where to store the computed
- * value; initialized by caller. */
+TcpGetOptionProc(
+ ClientData instanceData, /* Socket state. */
+ Tcl_Interp *interp, /* For error reporting - can be NULL */
+ const char *optionName, /* Name of the option to retrieve the value
+ * for, or NULL to get all options and their
+ * values. */
+ Tcl_DString *dsPtr) /* Where to store the computed value;
+ * initialized by caller. */
{
SocketInfo *infoPtr;
SOCKADDR_IN sockname;
@@ -2093,23 +1904,22 @@ TcpGetOptionProc(instanceData, interp, optionName, dsPtr)
char buf[TCL_INTEGER_SPACE];
/*
- * Check that WinSock is initialized; do not call it if not, to
- * prevent system crashes. This can happen at exit time if the exit
- * handler for WinSock ran before other exit handlers that want to
- * use sockets.
+ * Check that WinSock is initialized; do not call it if not, to prevent
+ * system crashes. This can happen at exit time if the exit handler for
+ * WinSock ran before other exit handlers that want to use sockets.
*/
if (!SocketsEnabled()) {
if (interp) {
Tcl_AppendResult(interp, "winsock is not initialized", NULL);
}
- return TCL_ERROR;
+ return TCL_ERROR;
}
-
+
infoPtr = (SocketInfo *) instanceData;
sock = (int) infoPtr->socket;
- if (optionName != (char *) NULL) {
- len = strlen(optionName);
+ if (optionName != NULL) {
+ len = strlen(optionName);
}
if ((len > 1) && (optionName[1] == 'e') &&
@@ -2117,12 +1927,12 @@ TcpGetOptionProc(instanceData, interp, optionName, dsPtr)
int optlen;
DWORD err;
int ret;
-
+
optlen = sizeof(int);
- ret = TclWinGetSockOpt(sock, SOL_SOCKET, SO_ERROR,
+ ret = TclWinGetSockOpt((int)sock, SOL_SOCKET, SO_ERROR,
(char *)&err, &optlen);
if (ret == SOCKET_ERROR) {
- err = winSock.WSAGetLastError();
+ err = WSAGetLastError();
}
if (err) {
TclWinConvertWSAError(err);
@@ -2131,140 +1941,136 @@ TcpGetOptionProc(instanceData, interp, optionName, dsPtr)
return TCL_OK;
}
- if ((len == 0) ||
- ((len > 1) && (optionName[1] == 'p') &&
- (strncmp(optionName, "-peername", len) == 0))) {
- if (winSock.getpeername(sock, (LPSOCKADDR) &peername, &size)
- == 0) {
- if (len == 0) {
- Tcl_DStringAppendElement(dsPtr, "-peername");
- Tcl_DStringStartSublist(dsPtr);
- }
- Tcl_DStringAppendElement(dsPtr,
- winSock.inet_ntoa(peername.sin_addr));
+ if ((len == 0) || ((len > 1) && (optionName[1] == 'p') &&
+ (strncmp(optionName, "-peername", len) == 0))) {
+ if (getpeername(sock, (LPSOCKADDR) &peername, &size) == 0) {
+ if (len == 0) {
+ Tcl_DStringAppendElement(dsPtr, "-peername");
+ Tcl_DStringStartSublist(dsPtr);
+ }
+ Tcl_DStringAppendElement(dsPtr, inet_ntoa(peername.sin_addr));
if (peername.sin_addr.s_addr == 0) {
- hostEntPtr = (struct hostent *) NULL;
+ hostEntPtr = NULL;
} else {
- hostEntPtr = winSock.gethostbyaddr(
- (char *) &(peername.sin_addr), sizeof(peername.sin_addr),
- AF_INET);
+ hostEntPtr = gethostbyaddr((char *) &(peername.sin_addr),
+ sizeof(peername.sin_addr), AF_INET);
+ }
+ if (hostEntPtr != NULL) {
+ Tcl_DStringAppendElement(dsPtr, hostEntPtr->h_name);
+ } else {
+ Tcl_DStringAppendElement(dsPtr, inet_ntoa(peername.sin_addr));
+ }
+ TclFormatInt(buf, ntohs(peername.sin_port));
+ Tcl_DStringAppendElement(dsPtr, buf);
+ if (len == 0) {
+ Tcl_DStringEndSublist(dsPtr);
+ } else {
+ return TCL_OK;
+ }
+ } else {
+ /*
+ * getpeername failed - but if we were asked for all the options
+ * (len==0), don't flag an error at that point because it could be
+ * an fconfigure request on a server socket (such sockets have no
+ * peer). {Copied from unix/tclUnixChan.c}
+ */
+
+ if (len) {
+ TclWinConvertWSAError((DWORD) WSAGetLastError());
+ if (interp) {
+ Tcl_AppendResult(interp, "can't get peername: ",
+ Tcl_PosixError(interp), NULL);
+ }
+ return TCL_ERROR;
+ }
+ }
+ }
+
+ 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);
}
- if (hostEntPtr != (struct hostent *) NULL) {
- Tcl_DStringAppendElement(dsPtr, hostEntPtr->h_name);
- } else {
- Tcl_DStringAppendElement(dsPtr,
- winSock.inet_ntoa(peername.sin_addr));
- }
- TclFormatInt(buf, winSock.ntohs(peername.sin_port));
- Tcl_DStringAppendElement(dsPtr, buf);
- if (len == 0) {
- Tcl_DStringEndSublist(dsPtr);
- } else {
- return TCL_OK;
- }
- } else {
- /*
- * getpeername failed - but if we were asked for all the options
- * (len==0), don't flag an error at that point because it could
- * be an fconfigure request on a server socket. (which have
- * no peer). {copied from unix/tclUnixChan.c}
- */
- if (len) {
- TclWinConvertWSAError((DWORD) winSock.WSAGetLastError());
- if (interp) {
- Tcl_AppendResult(interp, "can't get peername: ",
- Tcl_PosixError(interp),
- (char *) NULL);
- }
- return TCL_ERROR;
- }
- }
- }
-
- if ((len == 0) ||
- ((len > 1) && (optionName[1] == 's') &&
- (strncmp(optionName, "-sockname", len) == 0))) {
- if (winSock.getsockname(sock, (LPSOCKADDR) &sockname, &size)
- == 0) {
- if (len == 0) {
- Tcl_DStringAppendElement(dsPtr, "-sockname");
- Tcl_DStringStartSublist(dsPtr);
- }
- Tcl_DStringAppendElement(dsPtr,
- winSock.inet_ntoa(sockname.sin_addr));
+ Tcl_DStringAppendElement(dsPtr, inet_ntoa(sockname.sin_addr));
if (sockname.sin_addr.s_addr == 0) {
- hostEntPtr = (struct hostent *) NULL;
+ hostEntPtr = NULL;
} else {
- hostEntPtr = winSock.gethostbyaddr(
- (char *) &(sockname.sin_addr), sizeof(peername.sin_addr),
- AF_INET);
+ hostEntPtr = gethostbyaddr((char *) &(sockname.sin_addr),
+ sizeof(peername.sin_addr), AF_INET);
}
- if (hostEntPtr != (struct hostent *) NULL) {
- Tcl_DStringAppendElement(dsPtr, hostEntPtr->h_name);
- } else {
- Tcl_DStringAppendElement(dsPtr,
- winSock.inet_ntoa(sockname.sin_addr));
- }
- TclFormatInt(buf, winSock.ntohs(sockname.sin_port));
- Tcl_DStringAppendElement(dsPtr, buf);
- if (len == 0) {
- Tcl_DStringEndSublist(dsPtr);
- } else {
- return TCL_OK;
- }
- } else {
+ if (hostEntPtr != NULL) {
+ Tcl_DStringAppendElement(dsPtr, hostEntPtr->h_name);
+ } else {
+ Tcl_DStringAppendElement(dsPtr, inet_ntoa(sockname.sin_addr));
+ }
+ TclFormatInt(buf, ntohs(sockname.sin_port));
+ Tcl_DStringAppendElement(dsPtr, buf);
+ if (len == 0) {
+ Tcl_DStringEndSublist(dsPtr);
+ } else {
+ return TCL_OK;
+ }
+ } else {
if (interp) {
- TclWinConvertWSAError((DWORD) winSock.WSAGetLastError());
+ TclWinConvertWSAError((DWORD) WSAGetLastError());
Tcl_AppendResult(interp, "can't get sockname: ",
- Tcl_PosixError(interp),
- (char *) NULL);
+ Tcl_PosixError(interp), NULL);
}
return TCL_ERROR;
}
}
-/*
+#ifdef TCL_FEATURE_KEEPALIVE_NAGLE
if (len == 0 || !strncmp(optionName, "-keepalive", len)) {
int optlen;
BOOL opt = FALSE;
-
- if (len == 0) {
- Tcl_DStringAppendElement(dsPtr, "-keepalive");
- }
+
+ if (len == 0) {
+ Tcl_DStringAppendElement(dsPtr, "-keepalive");
+ }
optlen = sizeof(BOOL);
- winSock.getsockopt(sock, SOL_SOCKET, SO_KEEPALIVE, (char *)&opt,
- &optlen);
+ getsockopt(sock, SOL_SOCKET, SO_KEEPALIVE, (char *)&opt, &optlen);
if (opt) {
Tcl_DStringAppendElement(dsPtr, "1");
} else {
Tcl_DStringAppendElement(dsPtr, "0");
}
- if (len > 0) return TCL_OK;
+ if (len > 0) {
+ return TCL_OK;
+ }
}
if (len == 0 || !strncmp(optionName, "-nagle", len)) {
int optlen;
BOOL opt = FALSE;
-
- if (len == 0) {
- Tcl_DStringAppendElement(dsPtr, "-nagle");
- }
+
+ if (len == 0) {
+ Tcl_DStringAppendElement(dsPtr, "-nagle");
+ }
optlen = sizeof(BOOL);
- winSock.getsockopt(sock, IPPROTO_TCP, TCP_NODELAY, (char *)&opt,
+ getsockopt(sock, IPPROTO_TCP, TCP_NODELAY, (char *)&opt,
&optlen);
if (opt) {
Tcl_DStringAppendElement(dsPtr, "0");
} else {
Tcl_DStringAppendElement(dsPtr, "1");
}
- if (len > 0) return TCL_OK;
+ if (len > 0) {
+ return TCL_OK;
+ }
}
-*/
+#endif /*TCL_FEATURE_KEEPALIVE_NAGLE*/
if (len > 0) {
- /*return Tcl_BadChannelOption(interp, optionName, "peername sockname keepalive nagle");*/
- return Tcl_BadChannelOption(interp, optionName, "peername sockname");
+#ifdef TCL_FEATURE_KEEPALIVE_NAGLE
+ return Tcl_BadChannelOption(interp, optionName,
+ "peername sockname keepalive nagle");
+#else
+ return Tcl_BadChannelOption(interp, optionName, "peername sockname");
+#endif /*TCL_FEATURE_KEEPALIVE_NAGLE*/
}
return TCL_OK;
@@ -2275,45 +2081,45 @@ TcpGetOptionProc(instanceData, interp, optionName, dsPtr)
*
* TcpWatchProc --
*
- * Informs the channel driver of the events that the generic
- * channel code wishes to receive on this socket.
+ * Informs the channel driver of the events that the generic channel code
+ * wishes to receive on this socket.
*
* Results:
* None.
*
* Side effects:
- * May cause the notifier to poll if any of the specified
- * conditions are already true.
+ * May cause the notifier to poll if any of the specified conditions are
+ * already true.
*
*----------------------------------------------------------------------
*/
static void
-TcpWatchProc(instanceData, mask)
- ClientData instanceData; /* The socket state. */
- int mask; /* Events of interest; an OR-ed
- * combination of TCL_READABLE,
- * TCL_WRITABLE and TCL_EXCEPTION. */
+TcpWatchProc(
+ ClientData instanceData, /* The socket state. */
+ int mask) /* Events of interest; an OR-ed combination of
+ * TCL_READABLE, TCL_WRITABLE and
+ * TCL_EXCEPTION. */
{
SocketInfo *infoPtr = (SocketInfo *) instanceData;
-
+
/*
- * Update the watch events mask. Only if the socket is not a
- * server socket. Fix for SF Tcl Bug #557878.
+ * Update the watch events mask. Only if the socket is not a server
+ * socket. Fix for SF Tcl Bug #557878.
*/
- if (!infoPtr->acceptProc) {
- infoPtr->watchEvents = 0;
+ if (!infoPtr->acceptProc) {
+ infoPtr->watchEvents = 0;
if (mask & TCL_READABLE) {
infoPtr->watchEvents |= (FD_READ|FD_CLOSE|FD_ACCEPT);
}
if (mask & TCL_WRITABLE) {
infoPtr->watchEvents |= (FD_WRITE|FD_CLOSE|FD_CONNECT);
}
-
+
/*
- * If there are any conditions already set, then tell the notifier to poll
- * rather than block.
+ * If there are any conditions already set, then tell the notifier to
+ * poll rather than block.
*/
if (infoPtr->readyEvents & infoPtr->watchEvents) {
@@ -2341,10 +2147,10 @@ TcpWatchProc(instanceData, mask)
*/
static int
-TcpGetHandleProc(instanceData, direction, handlePtr)
- ClientData instanceData; /* The socket state. */
- int direction; /* Not used. */
- ClientData *handlePtr; /* Where to store the handle. */
+TcpGetHandleProc(
+ ClientData instanceData, /* The socket state. */
+ int direction, /* Not used. */
+ ClientData *handlePtr) /* Where to store the handle. */
{
SocketInfo *statePtr = (SocketInfo *) instanceData;
@@ -2369,7 +2175,8 @@ TcpGetHandleProc(instanceData, direction, handlePtr)
*/
static DWORD WINAPI
-SocketThread(LPVOID arg)
+SocketThread(
+ LPVOID arg)
{
MSG msg;
ThreadSpecificData *tsdPtr = (ThreadSpecificData *)(arg);
@@ -2378,7 +2185,7 @@ SocketThread(LPVOID arg)
* Create a dummy window receiving socket events.
*/
- tsdPtr->hwnd = CreateWindow("TclSocket", "TclSocket",
+ tsdPtr->hwnd = CreateWindow("TclSocket", "TclSocket",
WS_TILED, 0, 0, 0, 0, NULL, NULL, windowClass.hInstance, arg);
/*
@@ -2396,9 +2203,9 @@ SocketThread(LPVOID arg)
}
/*
- * Process all messages on the socket window until WM_QUIT.
- * This threads exits only when instructed to do so by the
- * call to PostMessage(SOCKET_TERMINATE) in TclpFinalizeSockets().
+ * Process all messages on the socket window until WM_QUIT. This threads
+ * exits only when instructed to do so by the call to
+ * PostMessage(SOCKET_TERMINATE) in TclpFinalizeSockets().
*/
while (GetMessage(&msg, NULL, 0, 0) > 0) {
@@ -2411,7 +2218,7 @@ SocketThread(LPVOID arg)
SetEvent(tsdPtr->readyEvent);
- return (DWORD)msg.wParam;
+ return msg.wParam;
}
@@ -2420,152 +2227,147 @@ SocketThread(LPVOID arg)
*
* SocketProc --
*
- * This function is called when WSAAsyncSelect has been used
- * to register interest in a socket event, and the event has
- * occurred.
+ * This function is called when WSAAsyncSelect has been used to register
+ * interest in a socket event, and the event has occurred.
*
* Results:
* 0 on success.
*
* Side effects:
- * The flags for the given socket are updated to reflect the
- * event that occured.
+ * The flags for the given socket are updated to reflect the event that
+ * occured.
*
*----------------------------------------------------------------------
*/
static LRESULT CALLBACK
-SocketProc(hwnd, message, wParam, lParam)
- HWND hwnd;
- UINT message;
- WPARAM wParam;
- LPARAM lParam;
+SocketProc(
+ HWND hwnd,
+ UINT message,
+ WPARAM wParam,
+ LPARAM lParam)
{
int event, error;
SOCKET socket;
SocketInfo *infoPtr;
- ThreadSpecificData *tsdPtr =
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
#ifdef _WIN64
- (ThreadSpecificData *) GetWindowLongPtr(hwnd, GWLP_USERDATA);
+ GetWindowLongPtr(hwnd, GWLP_USERDATA);
#else
- (ThreadSpecificData *) GetWindowLong(hwnd, GWL_USERDATA);
+ GetWindowLong(hwnd, GWL_USERDATA);
#endif
switch (message) {
+ default:
+ return DefWindowProc(hwnd, message, wParam, lParam);
+ break;
- default:
- return DefWindowProc(hwnd, message, wParam, lParam);
- break;
-
- case WM_CREATE:
- /*
- * store the initial tsdPtr, it's from a different thread, so it's
- * not directly accessible, but needed.
- */
+ case WM_CREATE:
+ /*
+ * Store the initial tsdPtr, it's from a different thread, so it's not
+ * directly accessible, but needed.
+ */
#ifdef _WIN64
- SetWindowLongPtr(hwnd, GWLP_USERDATA,
- (LONG_PTR) ((LPCREATESTRUCT)lParam)->lpCreateParams);
+ SetWindowLongPtr(hwnd, GWLP_USERDATA,
+ (LONG_PTR) ((LPCREATESTRUCT)lParam)->lpCreateParams);
#else
- SetWindowLong(hwnd, GWL_USERDATA,
- (LONG) ((LPCREATESTRUCT)lParam)->lpCreateParams);
+ SetWindowLong(hwnd, GWL_USERDATA,
+ (LONG) ((LPCREATESTRUCT)lParam)->lpCreateParams);
#endif
- break;
+ break;
- case WM_DESTROY:
- PostQuitMessage(0);
- break;
+ case WM_DESTROY:
+ PostQuitMessage(0);
+ break;
- case SOCKET_MESSAGE:
- event = WSAGETSELECTEVENT(lParam);
- error = WSAGETSELECTERROR(lParam);
- socket = (SOCKET) wParam;
+ case SOCKET_MESSAGE:
+ event = WSAGETSELECTEVENT(lParam);
+ error = WSAGETSELECTERROR(lParam);
+ socket = (SOCKET) wParam;
- /*
- * Find the specified socket on the socket list and update its
- * eventState flag.
- */
+ /*
+ * Find the specified socket on the socket list and update its
+ * eventState flag.
+ */
+
+ WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
+ for (infoPtr = tsdPtr->socketList; infoPtr != NULL;
+ infoPtr = infoPtr->nextPtr) {
+ if (infoPtr->socket == socket) {
+ /*
+ * Update the socket state.
+ *
+ * A count of FD_ACCEPTS is stored, so if an FD_CLOSE event
+ * happens, then clear the FD_ACCEPT count. Otherwise,
+ * increment the count if the current event is an FD_ACCEPT.
+ */
- WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
- for (infoPtr = tsdPtr->socketList; infoPtr != NULL;
- infoPtr = infoPtr->nextPtr) {
- if (infoPtr->socket == socket) {
+ if (event & FD_CLOSE) {
+ infoPtr->acceptEventCount = 0;
+ infoPtr->readyEvents &= ~(FD_WRITE|FD_ACCEPT);
+ } else if (event & FD_ACCEPT) {
+ infoPtr->acceptEventCount++;
+ }
+
+ if (event & FD_CONNECT) {
/*
- * Update the socket state.
+ * The socket is now connected, clear the async connect
+ * flag.
*/
+ infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT);
+
/*
- * A count of FD_ACCEPTS is stored, so if an FD_CLOSE
- * event happens, then clear the FD_ACCEPT count.
- * Otherwise, increment the count if the current
- * event is an FD_ACCEPT.
+ * Remember any error that occurred so we can report
+ * connection failures.
*/
- if (event & FD_CLOSE) {
- infoPtr->acceptEventCount = 0;
- infoPtr->readyEvents &= ~(FD_WRITE|FD_ACCEPT);
- } else if (event & FD_ACCEPT) {
- infoPtr->acceptEventCount++;
+ if (error != ERROR_SUCCESS) {
+ TclWinConvertWSAError((DWORD) error);
+ infoPtr->lastError = Tcl_GetErrno();
}
+ }
- if (event & FD_CONNECT) {
- /*
- * The socket is now connected,
- * clear the async connect flag.
- */
-
- infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT);
-
- /*
- * Remember any error that occurred so we can report
- * connection failures.
- */
-
- if (error != ERROR_SUCCESS) {
- TclWinConvertWSAError((DWORD) error);
- infoPtr->lastError = Tcl_GetErrno();
- }
-
- }
- if(infoPtr->flags & SOCKET_ASYNC_CONNECT) {
- infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT);
- if (error != ERROR_SUCCESS) {
- TclWinConvertWSAError((DWORD) error);
- infoPtr->lastError = Tcl_GetErrno();
- }
- infoPtr->readyEvents |= FD_WRITE;
+ if (infoPtr->flags & SOCKET_ASYNC_CONNECT) {
+ infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT);
+ if (error != ERROR_SUCCESS) {
+ TclWinConvertWSAError((DWORD) error);
+ infoPtr->lastError = Tcl_GetErrno();
}
- infoPtr->readyEvents |= event;
-
- /*
- * Wake up the Main Thread.
- */
- SetEvent(tsdPtr->readyEvent);
- Tcl_ThreadAlert(tsdPtr->threadId);
- break;
+ infoPtr->readyEvents |= FD_WRITE;
}
- }
- SetEvent(tsdPtr->socketListLock);
- break;
-
- case SOCKET_SELECT:
- infoPtr = (SocketInfo *) lParam;
- if (wParam == SELECT) {
+ infoPtr->readyEvents |= event;
- winSock.WSAAsyncSelect(infoPtr->socket, hwnd,
- SOCKET_MESSAGE, infoPtr->selectEvents);
- } else {
/*
- * Clear the selection mask
+ * Wake up the Main Thread.
*/
- winSock.WSAAsyncSelect(infoPtr->socket, hwnd, 0, 0);
+ SetEvent(tsdPtr->readyEvent);
+ Tcl_ThreadAlert(tsdPtr->threadId);
+ break;
}
- break;
+ }
+ SetEvent(tsdPtr->socketListLock);
+ break;
- case SOCKET_TERMINATE:
- DestroyWindow(hwnd);
- break;
+ case SOCKET_SELECT:
+ infoPtr = (SocketInfo *) lParam;
+ if (wParam == SELECT) {
+ WSAAsyncSelect(infoPtr->socket, hwnd,
+ SOCKET_MESSAGE, infoPtr->selectEvents);
+ } else {
+ /*
+ * Clear the selection mask
+ */
+
+ WSAAsyncSelect(infoPtr->socket, hwnd, 0, 0);
+ }
+ break;
+
+ case SOCKET_TERMINATE:
+ DestroyWindow(hwnd);
+ break;
}
return 0;
@@ -2579,49 +2381,82 @@ SocketProc(hwnd, message, wParam, lParam)
* Returns the name of the local host.
*
* Results:
- * A string containing the network name for this machine, or
- * an empty string if we can't figure out the name. The caller
- * must not modify or free this string.
+ * A string containing the network name for this machine. The caller must
+ * not modify or free this string.
*
* Side effects:
+ * Caches the name to return for future calls.
+ *
+ *----------------------------------------------------------------------
+ */
+
+const char *
+Tcl_GetHostName(void)
+{
+ return Tcl_GetString(TclGetProcessGlobalValue(&hostName));
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InitializeHostName --
+ *
+ * This routine sets the process global value of the name of the local
+ * host on which the process is running.
+ *
+ * Results:
* None.
*
*----------------------------------------------------------------------
*/
-CONST char *
-Tcl_GetHostName()
+void
+InitializeHostName(
+ char **valuePtr,
+ int *lengthPtr,
+ Tcl_Encoding *encodingPtr)
{
- DWORD length;
WCHAR wbuf[MAX_COMPUTERNAME_LENGTH + 1];
+ DWORD length = sizeof(wbuf) / sizeof(WCHAR);
+ Tcl_DString ds;
- Tcl_MutexLock(&socketMutex);
- InitSockets();
-
- if (!hostnameInitialized) {
+ if ((*tclWinProcs->getComputerNameProc)(wbuf, &length) != 0) {
/*
- * Convert hostname from native to UTF then change to lowercase.
+ * Convert string from native to UTF then change to lowercase.
*/
- Tcl_DString ds;
-
- length = sizeof(hostname);
- /* same as SocketsEnabled without the socketMutex lock */
- if ((winSock.hModule != NULL)
- && (winSock.gethostname(hostname, length) == 0)) {
- Tcl_ExternalToUtfDString(NULL, hostname, -1, &ds);
- } else if ((*tclWinProcs->getComputerNameProc)(wbuf, &length) != 0) {
- Tcl_WinTCharToUtf((TCHAR *) wbuf, -1, &ds);
- } else {
- Tcl_DStringInit(&ds);
- Tcl_DStringSetLength(&ds, 0);
+
+ Tcl_UtfToLower(Tcl_WinTCharToUtf((TCHAR *) wbuf, -1, &ds));
+
+ } else {
+ Tcl_DStringInit(&ds);
+ if (TclpHasSockets(NULL) == TCL_OK) {
+ /*
+ * Buffer length of 255 copied slavishly from previous version of
+ * this routine. Presumably there's a more "correct" macro value
+ * for a properly sized buffer for a gethostname() call.
+ * Maintainers are welcome to supply it.
+ */
+
+ Tcl_DString inDs;
+
+ Tcl_DStringInit(&inDs);
+ Tcl_DStringSetLength(&inDs, 255);
+ if (gethostname(Tcl_DStringValue(&inDs),
+ Tcl_DStringLength(&inDs)) == 0) {
+ Tcl_DStringSetLength(&ds, 0);
+ } else {
+ Tcl_ExternalToUtfDString(NULL,
+ Tcl_DStringValue(&inDs), -1, &ds);
+ }
+ Tcl_DStringFree(&inDs);
}
- lstrcpynA(hostname, Tcl_DStringValue(&ds), sizeof(hostname));
- Tcl_DStringFree(&ds);
- Tcl_UtfToLower(hostname);
- hostnameInitialized = 1;
}
- Tcl_MutexUnlock(&socketMutex);
- return hostname;
+
+ *encodingPtr = Tcl_GetEncoding(NULL, "utf-8");
+ *lengthPtr = Tcl_DStringLength(&ds);
+ *valuePtr = ckalloc((unsigned int) (*lengthPtr)+1);
+ memcpy(*valuePtr, Tcl_DStringValue(&ds), (size_t)(*lengthPtr)+1);
+ Tcl_DStringFree(&ds);
}
/*
@@ -2629,10 +2464,10 @@ Tcl_GetHostName()
*
* TclWinGetSockOpt, et al. --
*
- * These functions are wrappers that let us bind the WinSock
- * API dynamically so we can run on systems that don't have
- * the wsock32.dll. We need wrappers for these interfaces
- * because they are called from the generic Tcl code.
+ * These functions are wrappers that let us bind the WinSock API
+ * dynamically so we can run on systems that don't have the wsock32.dll.
+ * We need wrappers for these interfaces because they are called from the
+ * generic Tcl code.
*
* Results:
* As defined for each function.
@@ -2644,71 +2479,72 @@ Tcl_GetHostName()
*/
int
-TclWinGetSockOpt(SOCKET s, int level, int optname, char * optval,
+TclWinGetSockOpt(SOCKET s, int level, int optname, char *optval,
int *optlen)
{
/*
- * Check that WinSock is initialized; do not call it if not, to
- * prevent system crashes. This can happen at exit time if the exit
- * handler for WinSock ran before other exit handlers that want to
- * use sockets.
+ * Check that WinSock is initialized; do not call it if not, to prevent
+ * system crashes. This can happen at exit time if the exit handler for
+ * WinSock ran before other exit handlers that want to use sockets.
*/
if (!SocketsEnabled()) {
- return SOCKET_ERROR;
+ return SOCKET_ERROR;
}
-
- return winSock.getsockopt(s, level, optname, optval, optlen);
+
+ return getsockopt(s, level, optname, optval, optlen);
}
int
-TclWinSetSockOpt(SOCKET s, int level, int optname, const char * optval,
- int optlen)
+TclWinSetSockOpt(SOCKET s, int level, int optname, const char *optval,
+ int optlen)
{
/*
- * Check that WinSock is initialized; do not call it if not, to
- * prevent system crashes. This can happen at exit time if the exit
- * handler for WinSock ran before other exit handlers that want to
- * use sockets.
+ * Check that WinSock is initialized; do not call it if not, to prevent
+ * system crashes. This can happen at exit time if the exit handler for
+ * WinSock ran before other exit handlers that want to use sockets.
*/
+
if (!SocketsEnabled()) {
- return SOCKET_ERROR;
+ return SOCKET_ERROR;
}
- return winSock.setsockopt(s, level, optname, optval, optlen);
+ return setsockopt(s, level, optname, optval, optlen);
}
u_short
-TclWinNToHS(u_short netshort)
+TclWinNToHS(
+ u_short netshort)
{
/*
- * Check that WinSock is initialized; do not call it if not, to
- * prevent system crashes. This can happen at exit time if the exit
- * handler for WinSock ran before other exit handlers that want to
- * use sockets.
+ * Check that WinSock is initialized; do not call it if not, to prevent
+ * system crashes. This can happen at exit time if the exit handler for
+ * WinSock ran before other exit handlers that want to use sockets.
*/
if (!SocketsEnabled()) {
- return (u_short) -1;
+ return (u_short) -1;
}
- return winSock.ntohs(netshort);
+ return ntohs(netshort);
}
struct servent *
-TclWinGetServByName(const char * name, const char * proto)
+TclWinGetServByName(
+ const char *name,
+ const char *proto)
{
/*
- * Check that WinSock is initialized; do not call it if not, to
- * prevent system crashes. This can happen at exit time if the exit
- * handler for WinSock ran before other exit handlers that want to
- * use sockets.
+ * Check that WinSock is initialized; do not call it if not, to prevent
+ * system crashes. This can happen at exit time if the exit handler for
+ * WinSock ran before other exit handlers that want to use sockets.
*/
+
if (!SocketsEnabled()) {
- return (struct servent *) NULL;
+ return NULL;
}
- return winSock.getservbyname(name, proto);
+ return getservbyname(name, proto);
}
/*
@@ -2728,21 +2564,21 @@ TclWinGetServByName(const char * name, const char * proto)
*/
static void
-TcpThreadActionProc (instanceData, action)
- ClientData instanceData;
- int action;
+TcpThreadActionProc(
+ ClientData instanceData,
+ int action)
{
ThreadSpecificData *tsdPtr;
SocketInfo *infoPtr = (SocketInfo *) instanceData;
- int notifyCmd;
+ int notifyCmd;
if (action == TCL_CHANNEL_THREAD_INSERT) {
- /*
- * Ensure that socket subsystem is initialized in this thread, or
- * else sockets will not work.
+ /*
+ * Ensure that socket subsystem is initialized in this thread, or else
+ * sockets will not work.
*/
- Tcl_MutexLock(&socketMutex);
+ Tcl_MutexLock(&socketMutex);
InitSockets();
Tcl_MutexUnlock(&socketMutex);
@@ -2758,14 +2594,18 @@ TcpThreadActionProc (instanceData, action)
SocketInfo **nextPtrPtr;
int removed = 0;
- tsdPtr = TCL_TSD_INIT(&dataKey);
+ tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ /*
+ * TIP #218, Bugfix: All access to socketList has to be protected by
+ * the lock.
+ */
- /* TIP #218, Bugfix: All access to socketList has to be protected by the lock */
WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
for (nextPtrPtr = &(tsdPtr->socketList); (*nextPtrPtr) != NULL;
- nextPtrPtr = &((*nextPtrPtr)->nextPtr)) {
+ nextPtrPtr = &((*nextPtrPtr)->nextPtr)) {
if ((*nextPtrPtr) == infoPtr) {
- (*nextPtrPtr) = infoPtr->nextPtr;
+ (*nextPtrPtr) = infoPtr->nextPtr;
removed = 1;
break;
}
@@ -2773,9 +2613,9 @@ TcpThreadActionProc (instanceData, action)
SetEvent(tsdPtr->socketListLock);
/*
- * This could happen if the channel was created in one thread
- * and then moved to another without updating the thread
- * local data in each thread.
+ * This could happen if the channel was created in one thread and then
+ * moved to another without updating the thread local data in each
+ * thread.
*/
if (!removed) {
@@ -2786,9 +2626,18 @@ TcpThreadActionProc (instanceData, action)
}
/*
- * Ensure that, or stop, notifications for the socket occur in this thread.
+ * Ensure that, or stop, notifications for the socket occur in this
+ * thread.
*/
SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
- (WPARAM) notifyCmd, (LPARAM) infoPtr);
+ (WPARAM) notifyCmd, (LPARAM) infoPtr);
}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/win/tclWinTest.c b/win/tclWinTest.c
index c59730d..e493fbf 100644
--- a/win/tclWinTest.c
+++ b/win/tclWinTest.c
@@ -1,16 +1,15 @@
-/*
+/*
* tclWinTest.c --
*
* Contains commands for platform specific tests on Windows.
*
* Copyright (c) 1996 Sun Microsystems, Inc.
*
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
-#define USE_COMPAT_CONST
-#include "tclWinInt.h"
+#include "tclInt.h"
/*
* For TestplatformChmod on Windows
@@ -27,36 +26,31 @@
#endif
/*
- * Forward declarations of procedures defined later in this file:
+ * Forward declarations of functions defined later in this file:
*/
-int TclplatformtestInit _ANSI_ARGS_((Tcl_Interp *interp));
-static int TesteventloopCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, CONST84 char **argv));
-static int TestvolumetypeCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]));
-static int TestwinclockCmd _ANSI_ARGS_(( ClientData dummy,
- Tcl_Interp* interp,
- int objc,
- Tcl_Obj *CONST objv[] ));
-static int TestwinsleepCmd _ANSI_ARGS_(( ClientData dummy,
- Tcl_Interp* interp,
- int objc,
- Tcl_Obj *CONST objv[] ));
-static Tcl_ObjCmdProc TestExceptionCmd;
-static int TestplatformChmod _ANSI_ARGS_((CONST char *nativePath,
- int pmode));
-static int TestchmodCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, CONST84 char **argv));
+int TclplatformtestInit(Tcl_Interp *interp);
+static int TesteventloopCmd(ClientData dummy, Tcl_Interp *interp,
+ int argc, const char **argv);
+static int TestvolumetypeCmd(ClientData dummy,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+static int TestwinclockCmd(ClientData dummy, Tcl_Interp* interp,
+ int objc, Tcl_Obj *const objv[]);
+static int TestwinsleepCmd(ClientData dummy, Tcl_Interp* interp,
+ int objc, Tcl_Obj *const objv[]);
+static Tcl_ObjCmdProc TestExceptionCmd;
+static int TestplatformChmod(const char *nativePath, int pmode);
+static int TestchmodCmd(ClientData dummy,
+ Tcl_Interp *interp, int argc, const char **argv);
/*
*----------------------------------------------------------------------
*
* TclplatformtestInit --
*
- * Defines commands that test platform specific functionality for
- * Windows platforms.
+ * Defines commands that test platform specific functionality for Windows
+ * platforms.
*
* Results:
* A standard Tcl result.
@@ -68,25 +62,20 @@ static int TestchmodCmd _ANSI_ARGS_((ClientData dummy,
*/
int
-TclplatformtestInit(interp)
- Tcl_Interp *interp; /* Interpreter to add commands to. */
+TclplatformtestInit(
+ Tcl_Interp *interp) /* Interpreter to add commands to. */
{
/*
* Add commands for platform specific tests for Windows here.
*/
- Tcl_CreateCommand(interp, "testchmod", TestchmodCmd,
- (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
- Tcl_CreateCommand(interp, "testeventloop", TesteventloopCmd,
- (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateCommand(interp, "testchmod", TestchmodCmd, NULL, NULL);
+ Tcl_CreateCommand(interp, "testeventloop", TesteventloopCmd, NULL, NULL);
Tcl_CreateObjCommand(interp, "testvolumetype", TestvolumetypeCmd,
- (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
- Tcl_CreateObjCommand(interp, "testwinclock", TestwinclockCmd,
- (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
- Tcl_CreateObjCommand(interp, "testwinsleep", TestwinsleepCmd,
- (ClientData) 0, (Tcl_CmdDeleteProc *) NULL );
- Tcl_CreateObjCommand(interp, "testexcept", TestExceptionCmd,
- (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ NULL, NULL);
+ Tcl_CreateObjCommand(interp, "testwinclock", TestwinclockCmd, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "testwinsleep", TestwinsleepCmd, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "testexcept", TestExceptionCmd, NULL, NULL);
return TCL_OK;
}
@@ -95,9 +84,9 @@ TclplatformtestInit(interp)
*
* TesteventloopCmd --
*
- * This procedure implements the "testeventloop" command. It is
- * used to test the Tcl notifier from an "external" event loop
- * (i.e. not Tcl_DoOneEvent()).
+ * This function implements the "testeventloop" command. It is used to
+ * test the Tcl notifier from an "external" event loop (i.e. not
+ * Tcl_DoOneEvent()).
*
* Results:
* A standard Tcl result.
@@ -109,27 +98,25 @@ TclplatformtestInit(interp)
*/
static int
-TesteventloopCmd(clientData, interp, argc, argv)
- ClientData clientData; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- CONST84 char **argv; /* Argument strings. */
+TesteventloopCmd(
+ ClientData clientData, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int argc, /* Number of arguments. */
+ const char **argv) /* Argument strings. */
{
- static int *framePtr = NULL; /* Pointer to integer on stack frame of
- * innermost invocation of the "wait"
- * subcommand. */
+ static int *framePtr = NULL;/* Pointer to integer on stack frame of
+ * innermost invocation of the "wait"
+ * subcommand. */
- if (argc < 2) {
+ if (argc < 2) {
Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
- " option ... \"", (char *) NULL);
- return TCL_ERROR;
+ " option ... \"", NULL);
+ return TCL_ERROR;
}
if (strcmp(argv[1], "done") == 0) {
*framePtr = 1;
} else if (strcmp(argv[1], "wait") == 0) {
- int *oldFramePtr;
- int done;
- MSG msg;
+ int *oldFramePtr, done;
int oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
/*
@@ -140,19 +127,21 @@ TesteventloopCmd(clientData, interp, argc, argv)
framePtr = &done;
/*
- * Enter a standard Windows event loop until the flag changes.
- * Note that we do not explicitly call Tcl_ServiceEvent().
+ * Enter a standard Windows event loop until the flag changes. Note
+ * that we do not explicitly call Tcl_ServiceEvent().
*/
done = 0;
while (!done) {
+ MSG msg;
+
if (!GetMessage(&msg, NULL, 0, 0)) {
/*
- * The application is exiting, so repost the quit message
- * and start unwinding.
+ * The application is exiting, so repost the quit message and
+ * start unwinding.
*/
- PostQuitMessage((int)msg.wParam);
+ PostQuitMessage((int) msg.wParam);
break;
}
TranslateMessage(&msg);
@@ -162,7 +151,7 @@ TesteventloopCmd(clientData, interp, argc, argv)
framePtr = oldFramePtr;
} else {
Tcl_AppendResult(interp, "bad option \"", argv[1],
- "\": must be done or wait", (char *) NULL);
+ "\": must be done or wait", NULL);
return TCL_ERROR;
}
return TCL_OK;
@@ -173,8 +162,8 @@ TesteventloopCmd(clientData, interp, argc, argv)
*
* Testvolumetype --
*
- * This procedure implements the "testvolumetype" command. It is
- * used to check the volume type (FAT, NTFS) of a volume.
+ * This function implements the "testvolumetype" command. It is used to
+ * check the volume type (FAT, NTFS) of a volume.
*
* Results:
* A standard Tcl result.
@@ -186,11 +175,11 @@ TesteventloopCmd(clientData, interp, argc, argv)
*/
static int
-TestvolumetypeCmd(clientData, interp, objc, objv)
- ClientData clientData; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+TestvolumetypeCmd(
+ ClientData clientData, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
#define VOL_BUF_SIZE 32
int found;
@@ -199,23 +188,24 @@ TestvolumetypeCmd(clientData, interp, objc, objv)
if (objc > 2) {
Tcl_WrongNumArgs(interp, 1, objv, "?name?");
- return TCL_ERROR;
+ return TCL_ERROR;
}
if (objc == 2) {
/*
- * path has to be really a proper volume, but we don't
- * get query APIs for that until NT5
+ * path has to be really a proper volume, but we don't get query APIs
+ * for that until NT5
*/
+
path = Tcl_GetString(objv[1]);
} else {
path = NULL;
}
- found = GetVolumeInformationA(path, NULL, 0, NULL, NULL,
- NULL, volType, VOL_BUF_SIZE);
+ found = GetVolumeInformationA(path, NULL, 0, NULL, NULL, NULL, volType,
+ VOL_BUF_SIZE);
if (found == 0) {
Tcl_AppendResult(interp, "could not get volume type for \"",
- (path?path:""), "\"", (char *) NULL);
+ (path?path:""), "\"", NULL);
TclWinConvertError(GetLastError());
return TCL_ERROR;
}
@@ -229,9 +219,9 @@ TestvolumetypeCmd(clientData, interp, objc, objv)
*
* TestwinclockCmd --
*
- * Command that returns the seconds and microseconds portions of
- * the system clock and of the Tcl clock so that they can be
- * compared to validate that the Tcl clock is staying in sync.
+ * Command that returns the seconds and microseconds portions of the
+ * system clock and of the Tcl clock so that they can be compared to
+ * validate that the Tcl clock is staying in sync.
*
* Usage:
* testclock
@@ -240,9 +230,9 @@ TestvolumetypeCmd(clientData, interp, objc, objv)
* None.
*
* Results:
- * Returns a standard Tcl result comprising a four-element list:
- * the seconds and microseconds portions of the system clock,
- * and the seconds and microseconds portions of the Tcl clock.
+ * Returns a standard Tcl result comprising a four-element list: the
+ * seconds and microseconds portions of the system clock, and the seconds
+ * and microseconds portions of the Tcl clock.
*
* Side effects:
* None.
@@ -251,100 +241,71 @@ TestvolumetypeCmd(clientData, interp, objc, objv)
*/
static int
-TestwinclockCmd( ClientData dummy,
- /* Unused */
- Tcl_Interp* interp,
- /* Tcl interpreter */
- int objc,
- /* Argument count */
- Tcl_Obj *CONST objv[] )
- /* Argument vector */
+TestwinclockCmd(
+ ClientData dummy, /* Unused */
+ Tcl_Interp* interp, /* Tcl interpreter */
+ int objc, /* Argument count */
+ Tcl_Obj *const objv[]) /* Argument vector */
{
- static CONST FILETIME posixEpoch = { 0xD53E8000, 0x019DB1DE };
- /* The Posix epoch, expressed as a
- * Windows FILETIME */
+ static const FILETIME posixEpoch = { 0xD53E8000, 0x019DB1DE };
+ /* The Posix epoch, expressed as a Windows
+ * FILETIME */
Tcl_Time tclTime; /* Tcl clock */
FILETIME sysTime; /* System clock */
- Tcl_Obj* result; /* Result of the command */
+ Tcl_Obj *result; /* Result of the command */
LARGE_INTEGER t1, t2;
LARGE_INTEGER p1, p2;
- if ( objc != 1 ) {
- Tcl_WrongNumArgs( interp, 1, objv, "" );
+ if (objc != 1) {
+ Tcl_WrongNumArgs(interp, 1, objv, "");
return TCL_ERROR;
}
- QueryPerformanceCounter( &p1 );
+ QueryPerformanceCounter(&p1);
- Tcl_GetTime( &tclTime );
- GetSystemTimeAsFileTime( &sysTime );
+ Tcl_GetTime(&tclTime);
+ GetSystemTimeAsFileTime(&sysTime);
t1.LowPart = posixEpoch.dwLowDateTime;
t1.HighPart = posixEpoch.dwHighDateTime;
t2.LowPart = sysTime.dwLowDateTime;
t2.HighPart = sysTime.dwHighDateTime;
t2.QuadPart -= t1.QuadPart;
- QueryPerformanceCounter( &p2 );
+ QueryPerformanceCounter(&p2);
result = Tcl_NewObj();
- Tcl_ListObjAppendElement
- ( interp, result, Tcl_NewIntObj( (int) (t2.QuadPart / 10000000 ) ) );
- Tcl_ListObjAppendElement
- ( interp, result,
- Tcl_NewIntObj( (int) ( (t2.QuadPart / 10 ) % 1000000 ) ) );
- Tcl_ListObjAppendElement( interp, result, Tcl_NewIntObj( tclTime.sec ) );
- Tcl_ListObjAppendElement( interp, result, Tcl_NewIntObj( tclTime.usec ) );
+ Tcl_ListObjAppendElement(interp, result,
+ Tcl_NewIntObj((int) (t2.QuadPart / 10000000)));
+ Tcl_ListObjAppendElement(interp, result,
+ Tcl_NewIntObj((int) ((t2.QuadPart / 10) % 1000000)));
+ Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj(tclTime.sec));
+ Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj(tclTime.usec));
- Tcl_ListObjAppendElement( interp, result, Tcl_NewWideIntObj( p1.QuadPart ) );
- Tcl_ListObjAppendElement( interp, result, Tcl_NewWideIntObj( p2.QuadPart ) );
+ Tcl_ListObjAppendElement(interp, result, Tcl_NewWideIntObj(p1.QuadPart));
+ Tcl_ListObjAppendElement(interp, result, Tcl_NewWideIntObj(p2.QuadPart));
- Tcl_SetObjResult( interp, result );
+ Tcl_SetObjResult(interp, result);
return TCL_OK;
}
-/*
- *----------------------------------------------------------------------
- *
- * TestwinsleepCmd --
- *
- * Causes this process to wait for the given number of milliseconds
- * by means of a direct call to Sleep.
- *
- * Usage:
- * testwinsleep <n>
- *
- * Parameters:
- * n - the number of milliseconds to sleep
- *
- * Results:
- * None.
- *
- * Side effects:
- * Sleeps for the requisite number of milliseconds.
- *
- *----------------------------------------------------------------------
- */
-
static int
-TestwinsleepCmd( ClientData clientData,
- /* Unused */
- Tcl_Interp* interp,
- /* Tcl interpreter */
- int objc,
- /* Parameter count */
- Tcl_Obj * CONST * objv )
- /* Parameter vector */
+TestwinsleepCmd(
+ ClientData clientData, /* Unused */
+ Tcl_Interp* interp, /* Tcl interpreter */
+ int objc, /* Parameter count */
+ Tcl_Obj *const * objv) /* Parameter vector */
{
int ms;
- if ( objc != 2 ) {
- Tcl_WrongNumArgs( interp, 1, objv, "ms" );
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "ms");
return TCL_ERROR;
}
- if ( Tcl_GetIntFromObj( interp, objv[1], &ms ) != TCL_OK ) {
+ if (Tcl_GetIntFromObj(interp, objv[1], &ms) != TCL_OK) {
return TCL_ERROR;
}
- Sleep( (DWORD) ms );
+ Sleep((DWORD) ms);
return TCL_OK;
}
@@ -353,8 +314,8 @@ TestwinsleepCmd( ClientData clientData,
*
* TestExceptionCmd --
*
- * Causes this process to end with the named exception. Used for
- * testing Tcl_WaitPid().
+ * Causes this process to end with the named exception. Used for testing
+ * Tcl_WaitPid().
*
* Usage:
* testexcept <type>
@@ -376,58 +337,32 @@ TestExceptionCmd(
ClientData dummy, /* Unused */
Tcl_Interp* interp, /* Tcl interpreter */
int objc, /* Argument count */
- Tcl_Obj *CONST objv[]) /* Argument vector */
+ Tcl_Obj *const objv[]) /* Argument vector */
{
- static CONST84 char *cmds[] = {
- "access_violation",
- "datatype_misalignment",
- "array_bounds",
- "float_denormal",
- "float_divbyzero",
- "float_inexact",
- "float_invalidop",
- "float_overflow",
- "float_stack",
- "float_underflow",
- "int_divbyzero",
- "int_overflow",
- "private_instruction",
- "inpageerror",
- "illegal_instruction",
- "noncontinue",
- "stack_overflow",
- "invalid_disp",
- "guard_page",
- "invalid_handle",
- "ctrl+c",
- NULL
+ static const char *cmds[] = {
+ "access_violation", "datatype_misalignment", "array_bounds",
+ "float_denormal", "float_divbyzero", "float_inexact",
+ "float_invalidop", "float_overflow", "float_stack", "float_underflow",
+ "int_divbyzero", "int_overflow", "private_instruction", "inpageerror",
+ "illegal_instruction", "noncontinue", "stack_overflow",
+ "invalid_disp", "guard_page", "invalid_handle", "ctrl+c",
+ NULL
};
static const DWORD exceptions[] = {
- EXCEPTION_ACCESS_VIOLATION,
- EXCEPTION_DATATYPE_MISALIGNMENT,
- EXCEPTION_ARRAY_BOUNDS_EXCEEDED,
- EXCEPTION_FLT_DENORMAL_OPERAND,
- EXCEPTION_FLT_DIVIDE_BY_ZERO,
- EXCEPTION_FLT_INEXACT_RESULT,
- EXCEPTION_FLT_INVALID_OPERATION,
- EXCEPTION_FLT_OVERFLOW,
- EXCEPTION_FLT_STACK_CHECK,
- EXCEPTION_FLT_UNDERFLOW,
- EXCEPTION_INT_DIVIDE_BY_ZERO,
- EXCEPTION_INT_OVERFLOW,
- EXCEPTION_PRIV_INSTRUCTION,
- EXCEPTION_IN_PAGE_ERROR,
- EXCEPTION_ILLEGAL_INSTRUCTION,
- EXCEPTION_NONCONTINUABLE_EXCEPTION,
- EXCEPTION_STACK_OVERFLOW,
- EXCEPTION_INVALID_DISPOSITION,
- EXCEPTION_GUARD_PAGE,
- EXCEPTION_INVALID_HANDLE,
- CONTROL_C_EXIT
+ EXCEPTION_ACCESS_VIOLATION, EXCEPTION_DATATYPE_MISALIGNMENT,
+ EXCEPTION_ARRAY_BOUNDS_EXCEEDED, EXCEPTION_FLT_DENORMAL_OPERAND,
+ EXCEPTION_FLT_DIVIDE_BY_ZERO, EXCEPTION_FLT_INEXACT_RESULT,
+ EXCEPTION_FLT_INVALID_OPERATION, EXCEPTION_FLT_OVERFLOW,
+ EXCEPTION_FLT_STACK_CHECK, EXCEPTION_FLT_UNDERFLOW,
+ EXCEPTION_INT_DIVIDE_BY_ZERO, EXCEPTION_INT_OVERFLOW,
+ EXCEPTION_PRIV_INSTRUCTION, EXCEPTION_IN_PAGE_ERROR,
+ EXCEPTION_ILLEGAL_INSTRUCTION, EXCEPTION_NONCONTINUABLE_EXCEPTION,
+ EXCEPTION_STACK_OVERFLOW, EXCEPTION_INVALID_DISPOSITION,
+ EXCEPTION_GUARD_PAGE, EXCEPTION_INVALID_HANDLE, CONTROL_C_EXIT
};
int cmd;
- if ( objc != 2 ) {
+ if (objc != 2) {
Tcl_WrongNumArgs(interp, 0, objv, "<type-of-exception>");
return TCL_ERROR;
}
@@ -456,68 +391,46 @@ TestExceptionCmd(
return TCL_OK;
}
-static int
-TestplatformChmod(CONST char *nativePath, int pmode)
+static int
+TestplatformChmod(
+ const char *nativePath,
+ int pmode)
{
- SID_IDENTIFIER_AUTHORITY userSidAuthority =
- { SECURITY_WORLD_SID_AUTHORITY };
+ 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
+ | FILE_ADD_SUBDIRECTORY | FILE_WRITE_EA | FILE_APPEND_DATA
+ | FILE_WRITE_DATA | DELETE;
- typedef DWORD (WINAPI *getSidLengthRequiredDef) ( UCHAR );
- typedef BOOL (WINAPI *initializeSidDef) ( PSID,
- PSID_IDENTIFIER_AUTHORITY, BYTE );
- typedef PDWORD (WINAPI *getSidSubAuthorityDef) ( PSID, DWORD );
+ /*
+ * References to security functions (only available on NT and later).
+ */
static getSidLengthRequiredDef getSidLengthRequiredProc;
static initializeSidDef initializeSidProc;
static getSidSubAuthorityDef getSidSubAuthorityProc;
- static const SECURITY_INFORMATION infoBits = OWNER_SECURITY_INFORMATION
- | GROUP_SECURITY_INFORMATION | DACL_SECURITY_INFORMATION;
- static const DWORD readOnlyMask = FILE_DELETE_CHILD | FILE_ADD_FILE
- | FILE_ADD_SUBDIRECTORY | FILE_WRITE_EA | FILE_APPEND_DATA
- | FILE_WRITE_DATA | DELETE;
-
- PSECURITY_DESCRIPTOR secDesc = 0;
- DWORD secDescLen;
-
- const BOOL set_readOnly = !(pmode & 0222);
- BOOL acl_readOnly_found = FALSE;
-
- ACL_SIZE_INFORMATION ACLSize;
- BOOL curAclPresent, curAclDefaulted;
- PACL curAcl;
- PACL newAcl = 0;
- DWORD newAclSize;
-
- WORD j;
-
- SID *userSid = 0;
- TCHAR *userDomain = NULL;
-
- DWORD attr;
-
- int res = 0;
-
- /*
- * One time initialization, dynamically load Windows NT features
- */
- 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 setNamedSecurityInfoADef setNamedSecurityInfoProc;
static getAceDef getAceProc;
static addAceDef addAceProc;
@@ -527,183 +440,258 @@ TestplatformChmod(CONST char *nativePath, int pmode)
static getLengthSidDef getLengthSidProc;
static getAclInformationDef getAclInformationProc;
static getSecurityDescriptorDaclDef getSecurityDescriptorDaclProc;
- static lookupAccountNameADef lookupAccountNameProc;
+ 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 = {
+ SECURITY_WORLD_SID_AUTHORITY
+ };
+ BYTE *secDesc = 0;
+ DWORD secDescLen, attr, newAclSize;
+ ACL_SIZE_INFORMATION ACLSize;
+ PACL curAcl, newAcl = 0;
+ WORD j;
+ SID *userSid = 0;
+ TCHAR *userDomain = 0;
+ int res = 0;
+
+ /*
+ * One time initialization, dynamically load Windows NT features
+ */
+
if (!initialized) {
TCL_DECLARE_MUTEX(initializeMutex)
Tcl_MutexLock(&initializeMutex);
if (!initialized) {
HINSTANCE hInstance = LoadLibrary("Advapi32");
+
if (hInstance != NULL) {
setNamedSecurityInfoProc = (setNamedSecurityInfoADef)
- GetProcAddress(hInstance, "SetNamedSecurityInfoA");
+ GetProcAddress(hInstance, "SetNamedSecurityInfoA");
getFileSecurityProc = (getFileSecurityADef)
- GetProcAddress(hInstance, "GetFileSecurityA");
+ GetProcAddress(hInstance, "GetFileSecurityA");
getAceProc = (getAceDef)
- GetProcAddress(hInstance, "GetAce");
+ GetProcAddress(hInstance, "GetAce");
addAceProc = (addAceDef)
- GetProcAddress(hInstance, "AddAce");
+ GetProcAddress(hInstance, "AddAce");
equalSidProc = (equalSidDef)
- GetProcAddress(hInstance, "EqualSid");
+ GetProcAddress(hInstance, "EqualSid");
addAccessDeniedAceProc = (addAccessDeniedAceDef)
- GetProcAddress(hInstance, "AddAccessDeniedAce");
+ GetProcAddress(hInstance, "AddAccessDeniedAce");
initializeAclProc = (initializeAclDef)
- GetProcAddress(hInstance, "InitializeAcl");
+ GetProcAddress(hInstance, "InitializeAcl");
getLengthSidProc = (getLengthSidDef)
- GetProcAddress(hInstance, "GetLengthSid");
+ GetProcAddress(hInstance, "GetLengthSid");
getAclInformationProc = (getAclInformationDef)
- GetProcAddress(hInstance, "GetAclInformation");
+ GetProcAddress(hInstance, "GetAclInformation");
getSecurityDescriptorDaclProc = (getSecurityDescriptorDaclDef)
- GetProcAddress(hInstance, "GetSecurityDescriptorDacl");
+ GetProcAddress(hInstance, "GetSecurityDescriptorDacl");
lookupAccountNameProc = (lookupAccountNameADef)
- GetProcAddress(hInstance, "LookupAccountNameA");
+ GetProcAddress(hInstance, "LookupAccountNameA");
getSidLengthRequiredProc = (getSidLengthRequiredDef)
- GetProcAddress(hInstance, "GetSidLengthRequired");
+ GetProcAddress(hInstance, "GetSidLengthRequired");
initializeSidProc = (initializeSidDef)
- GetProcAddress(hInstance, "InitializeSid");
+ GetProcAddress(hInstance, "InitializeSid");
getSidSubAuthorityProc = (getSidSubAuthorityDef)
- GetProcAddress(hInstance, "GetSidSubAuthority");
- if (setNamedSecurityInfoProc && getAceProc
- && addAceProc && equalSidProc && addAccessDeniedAceProc
- && initializeAclProc && getLengthSidProc
- && getAclInformationProc && getSecurityDescriptorDaclProc
- && lookupAccountNameProc && getFileSecurityProc
- && getSidLengthRequiredProc && initializeSidProc
- && getSidSubAuthorityProc)
+ GetProcAddress(hInstance, "GetSidSubAuthority");
+
+ if (setNamedSecurityInfoProc && getAceProc && addAceProc
+ && equalSidProc && addAccessDeniedAceProc
+ && initializeAclProc && getLengthSidProc
+ && getAclInformationProc
+ && getSecurityDescriptorDaclProc
+ && lookupAccountNameProc && getFileSecurityProc
+ && getSidLengthRequiredProc && initializeSidProc
+ && getSidSubAuthorityProc) {
initialized = 1;
+ }
}
- if (!initialized)
+ if (!initialized) {
initialized = -1;
+ }
}
Tcl_MutexUnlock(&initializeMutex);
}
- /* Process the chmod request */
+ /*
+ * Process the chmod request.
+ */
+
attr = GetFileAttributes(nativePath);
- /* nativePath not found */
+ /*
+ * nativePath not found
+ */
+
if (attr == 0xffffffff) {
res = -1;
goto done;
}
- /* If no ACL API is present or nativePath is not a directory,
- * there is no special handling
+ /*
+ * If no ACL API is present or nativePath is not a directory, there is no
+ * special handling.
*/
+
if (initialized < 0 || !(attr & FILE_ATTRIBUTE_DIRECTORY)) {
goto done;
}
-
- /* Set the result to error, if the ACL change is successful it will
- * be reset to 0
+
+ /*
+ * Set the result to error, if the ACL change is successful it will be
+ * reset to 0.
*/
+
res = -1;
/*
- * Read the security descriptor for the directory. Note the
- * first call obtains the size of the security descriptor.
+ * Read the security descriptor for the directory. Note the first call
+ * obtains the size of the security descriptor.
*/
+
if (!getFileSecurityProc(nativePath, infoBits, NULL, 0, &secDescLen)) {
- if (GetLastError() == ERROR_INSUFFICIENT_BUFFER) {
- DWORD secDescLen2 = 0;
- secDesc = (PSECURITY_DESCRIPTOR) ckalloc(secDescLen);
- if (!getFileSecurityProc(nativePath, infoBits, secDesc,
- secDescLen, &secDescLen2)
+ DWORD secDescLen2 = 0;
+
+ if (GetLastError() != ERROR_INSUFFICIENT_BUFFER) {
+ goto done;
+ }
+
+ secDesc = (BYTE *) ckalloc(secDescLen);
+ if (!getFileSecurityProc(nativePath, infoBits,
+ (PSECURITY_DESCRIPTOR) secDesc, secDescLen, &secDescLen2)
|| (secDescLen < secDescLen2)) {
- goto done;
- }
- } else {
goto done;
}
}
- /* Get the World SID */
- userSid = (SID*) ckalloc(getSidLengthRequiredProc((UCHAR)1));
- initializeSidProc( userSid, &userSidAuthority, (BYTE)1);
- *(getSidSubAuthorityProc( userSid, 0)) = SECURITY_WORLD_RID;
+ /*
+ * Get the World SID.
+ */
- /* If curAclPresent == false then curAcl and curAclDefaulted not valid */
- if (!getSecurityDescriptorDaclProc(secDesc, &curAclPresent,
- &curAcl, &curAclDefaulted))
- goto done;
+ userSid = (SID *) ckalloc(getSidLengthRequiredProc((UCHAR) 1));
+ initializeSidProc(userSid, &userSidAuthority, (BYTE) 1);
+ *(getSidSubAuthorityProc(userSid, 0)) = SECURITY_WORLD_RID;
+ /*
+ * If curAclPresent == false then curAcl and curAclDefaulted not valid.
+ */
+
+ if (!getSecurityDescriptorDaclProc((PSECURITY_DESCRIPTOR) secDesc,
+ &curAclPresent, &curAcl, &curAclDefaulted)) {
+ goto done;
+ }
if (!curAclPresent || !curAcl) {
ACLSize.AclBytesInUse = 0;
ACLSize.AceCount = 0;
- } else if (!getAclInformationProc(curAcl, &ACLSize, sizeof(ACLSize),
- AclSizeInformation))
+ } else if (!getAclInformationProc(curAcl, &ACLSize, sizeof(ACLSize),
+ AclSizeInformation)) {
goto done;
+ }
- /* Allocate memory for the new ACL */
- newAclSize = ACLSize.AclBytesInUse + sizeof (ACCESS_DENIED_ACE)
- + getLengthSidProc(userSid) - sizeof (DWORD);
- newAcl = (ACL *) ckalloc (newAclSize);
-
- /* Initialize the new ACL */
- if(!initializeAclProc(newAcl, newAclSize, ACL_REVISION)) {
+ /*
+ * Allocate memory for the new ACL.
+ */
+
+ newAclSize = ACLSize.AclBytesInUse + sizeof(ACCESS_DENIED_ACE)
+ + getLengthSidProc(userSid) - sizeof(DWORD);
+ newAcl = (ACL *) ckalloc(newAclSize);
+
+ /*
+ * Initialize the new ACL.
+ */
+
+ if (!initializeAclProc(newAcl, newAclSize, ACL_REVISION)) {
goto done;
}
-
- /* Add denied to make readonly, this will be known as a "read-only tag" */
- if (set_readOnly && !addAccessDeniedAceProc(newAcl, ACL_REVISION,
- readOnlyMask, userSid)) {
+
+ /*
+ * Add denied to make readonly, this will be known as a "read-only tag".
+ */
+
+ if (set_readOnly && !addAccessDeniedAceProc(newAcl, ACL_REVISION,
+ readOnlyMask, userSid)) {
goto done;
}
-
+
acl_readOnly_found = FALSE;
for (j = 0; j < ACLSize.AceCount; j++) {
- PACL *pACE2;
+ LPVOID pACE2;
ACE_HEADER *phACE2;
- if (! getAceProc (curAcl, j, (LPVOID*) &pACE2)) {
+
+ if (!getAceProc(curAcl, j, &pACE2)) {
goto done;
}
-
- phACE2 = ((ACE_HEADER *) pACE2);
- /* Do NOT propagate inherited ACEs */
+ phACE2 = (ACE_HEADER *) pACE2;
+
+ /*
+ * Do NOT propagate inherited ACEs.
+ */
+
if (phACE2->AceFlags & INHERITED_ACE) {
continue;
}
-
- /* Skip the "read-only tag" restriction (either added above, or it
- * is being removed)
+
+ /*
+ * Skip the "read-only tag" restriction (either added above, or it is
+ * being removed).
*/
+
if (phACE2->AceType == ACCESS_DENIED_ACE_TYPE) {
- ACCESS_DENIED_ACE *pACEd = (ACCESS_DENIED_ACE *)phACE2;
- if (pACEd->Mask == readOnlyMask && equalSidProc(userSid,
- (PSID)&(pACEd->SidStart))) {
+ ACCESS_DENIED_ACE *pACEd = (ACCESS_DENIED_ACE *) phACE2;
+
+ if (pACEd->Mask == readOnlyMask
+ && equalSidProc(userSid, (PSID) &pACEd->SidStart)) {
acl_readOnly_found = TRUE;
continue;
}
}
- /* Copy the current ACE from the old to the new ACL */
- if(! addAceProc (newAcl, ACL_REVISION, MAXDWORD, pACE2,
- ((PACE_HEADER) pACE2)->AceSize)) {
+ /*
+ * Copy the current ACE from the old to the new ACL.
+ */
+
+ if (!addAceProc(newAcl, ACL_REVISION, MAXDWORD, (PACL *)pACE2,
+ ((PACE_HEADER) pACE2)->AceSize)) {
goto done;
}
}
- /* Apply the new ACL */
- if (set_readOnly == acl_readOnly_found
- || setNamedSecurityInfoProc((LPSTR)nativePath, SE_FILE_OBJECT,
- DACL_SECURITY_INFORMATION, NULL, NULL, newAcl, NULL)
- == ERROR_SUCCESS ) {
+ /*
+ * Apply the new ACL.
+ */
+
+ if (set_readOnly == acl_readOnly_found || setNamedSecurityInfoProc(
+ (LPSTR) nativePath, SE_FILE_OBJECT, DACL_SECURITY_INFORMATION,
+ NULL, NULL, newAcl, NULL) == ERROR_SUCCESS) {
res = 0;
}
- done:
- if (secDesc) ckfree((char *)secDesc);
- if (newAcl) ckfree((char *)newAcl);
- if (userSid) ckfree((char *)userSid);
- if (userDomain) ckfree(userDomain);
+ done:
+ if (secDesc) {
+ ckfree((char *) secDesc);
+ }
+ if (newAcl) {
+ ckfree((char *) newAcl);
+ }
+ if (userSid) {
+ ckfree((char *) userSid);
+ }
+ if (userDomain) {
+ ckfree(userDomain);
+ }
- if (res != 0)
+ if (res != 0) {
return res;
-
- /* Run normal chmod command */
+ }
+
+ /*
+ * Run normal chmod command.
+ */
+
return chmod(nativePath, pmode);
}
@@ -712,10 +700,10 @@ TestplatformChmod(CONST char *nativePath, int pmode)
*
* TestchmodCmd --
*
- * Implements the "testchmod" cmd. Used when testing "file" command.
- * The only attribute used by the Windows platform is the user write
- * flag; if this is not set, the file is made read-only. Otehrwise, the
- * file is made read-write.
+ * Implements the "testchmod" cmd. Used when testing "file" command. The
+ * only attribute used by the Windows platform is the user write flag; if
+ * this is not set, the file is made read-only. Otherwise, the file is
+ * made read-write.
*
* Results:
* A standard Tcl result.
@@ -727,17 +715,17 @@ TestplatformChmod(CONST char *nativePath, int pmode)
*/
static int
-TestchmodCmd(dummy, interp, argc, argv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- CONST84 char **argv; /* Argument strings. */
+TestchmodCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int argc, /* Number of arguments. */
+ const char **argv) /* Argument strings. */
{
int i, mode;
char *rest;
if (argc < 2) {
- usage:
+ usage:
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
" mode file ?file ...?", NULL);
return TCL_ERROR;
@@ -750,7 +738,7 @@ TestchmodCmd(dummy, interp, argc, argv)
for (i = 2; i < argc; i++) {
Tcl_DString buffer;
- CONST char *translated;
+ const char *translated;
translated = Tcl_TranslateFileName(interp, argv[i], &buffer);
if (translated == NULL) {
@@ -765,3 +753,11 @@ TestchmodCmd(dummy, interp, argc, argv)
}
return TCL_OK;
}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/win/tclWinThrd.c b/win/tclWinThrd.c
index 13fd411..8544e71 100644
--- a/win/tclWinThrd.c
+++ b/win/tclWinThrd.c
@@ -1,4 +1,4 @@
-/*
+/*
* tclWinThread.c --
*
* This file implements the Windows-specific thread operations.
@@ -6,25 +6,23 @@
* Copyright (c) 1998 by Sun Microsystems, Inc.
* Copyright (c) 1999 by Scriptics Corporation
*
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#include "tclWinInt.h"
-#include <fcntl.h>
-#include <io.h>
#include <sys/stat.h>
/*
- * This is the master lock used to serialize access to other
- * serialization data structures.
+ * This is the master lock used to serialize access to other serialization
+ * data structures.
*/
static CRITICAL_SECTION masterLock;
static int init = 0;
-#define MASTER_LOCK TclpMasterLock()
-#define MASTER_UNLOCK TclpMasterUnlock()
+#define MASTER_LOCK TclpMasterLock()
+#define MASTER_UNLOCK TclpMasterUnlock()
/*
@@ -35,38 +33,39 @@ static int init = 0;
static CRITICAL_SECTION initLock;
/*
- * allocLock is used by Tcl's version of malloc for synchronization.
- * For obvious reasons, cannot use any dyamically allocated storage.
+ * allocLock is used by Tcl's version of malloc for synchronization. For
+ * obvious reasons, cannot use any dyamically allocated storage.
*/
#ifdef TCL_THREADS
-static CRITICAL_SECTION allocLock;
-static Tcl_Mutex allocLockPtr = (Tcl_Mutex) &allocLock;
+static struct Tcl_Mutex_ {
+ CRITICAL_SECTION crit;
+} allocLock;
+static Tcl_Mutex allocLockPtr = &allocLock;
static int allocOnce = 0;
#endif /* TCL_THREADS */
/*
* The joinLock serializes Create- and ExitThread. This is necessary to
- * prevent a race where a new joinable thread exits before the creating
- * thread had the time to create the necessary data structures in the
- * emulation layer.
+ * prevent a race where a new joinable thread exits before the creating thread
+ * had the time to create the necessary data structures in the emulation
+ * layer.
*/
static CRITICAL_SECTION joinLock;
/*
- * Condition variables are implemented with a combination of a
- * per-thread Windows Event and a per-condition waiting queue.
- * The idea is that each thread has its own Event that it waits
- * on when it is doing a ConditionWait; it uses the same event for
- * all condition variables because it only waits on one at a time.
- * Each condition variable has a queue of waiting threads, and a
- * mutex used to serialize access to this queue.
- *
- * Special thanks to David Nichols and
- * Jim Davidson for advice on the Condition Variable implementation.
+ * Condition variables are implemented with a combination of a per-thread
+ * Windows Event and a per-condition waiting queue. The idea is that each
+ * thread has its own Event that it waits on when it is doing a ConditionWait;
+ * it uses the same event for all condition variables because it only waits on
+ * one at a time. Each condition variable has a queue of waiting threads, and
+ * a mutex used to serialize access to this queue.
+ *
+ * Special thanks to David Nichols and Jim Davidson for advice on the
+ * Condition Variable implementation.
*/
/*
@@ -86,42 +85,42 @@ static Tcl_ThreadDataKey dataKey;
#endif /* TCL_THREADS */
/*
- * Additions by AOL for specialized thread memory allocator.
- */
-
-#if defined(USE_THREAD_ALLOC) && !defined(TCL_MEM_DEBUG)
-static int once;
-static DWORD tlsKey;
-
-typedef struct allocMutex {
- Tcl_Mutex tlock;
- CRITICAL_SECTION wlock;
-} allocMutex;
-#endif
-
-/*
* State bits for the thread.
- * WIN_THREAD_UNINIT Uninitialized. Must be zero because
- * of the way ThreadSpecificData is created.
+ * WIN_THREAD_UNINIT Uninitialized. Must be zero because of the way
+ * ThreadSpecificData is created.
* WIN_THREAD_RUNNING Running, not waiting.
* WIN_THREAD_BLOCKED Waiting, or trying to wait.
- */
+ */
#define WIN_THREAD_UNINIT 0x0
#define WIN_THREAD_RUNNING 0x1
#define WIN_THREAD_BLOCKED 0x2
/*
- * The per condition queue pointers and the
- * Mutex used to serialize access to the queue.
+ * The per condition queue pointers and the Mutex used to serialize access to
+ * the queue.
*/
typedef struct WinCondition {
- CRITICAL_SECTION condLock; /* Lock to serialize queuing on the condition */
+ CRITICAL_SECTION condLock; /* Lock to serialize queuing on the
+ * condition. */
struct ThreadSpecificData *firstPtr; /* Queue pointers */
struct ThreadSpecificData *lastPtr;
} WinCondition;
+/*
+ * Additions by AOL for specialized thread memory allocator.
+ */
+
+#ifdef USE_THREAD_ALLOC
+static int once;
+static DWORD tlsKey;
+
+typedef struct allocMutex {
+ Tcl_Mutex tlock;
+ CRITICAL_SECTION wlock;
+} allocMutex;
+#endif /* USE_THREAD_ALLOC */
/*
*----------------------------------------------------------------------
@@ -131,8 +130,8 @@ typedef struct WinCondition {
* This procedure creates a new thread.
*
* Results:
- * TCL_OK if the thread could be created. The thread ID is
- * returned in a parameter.
+ * TCL_OK if the thread could be created. The thread ID is returned in a
+ * parameter.
*
* Side effects:
* A new thread is created.
@@ -141,21 +140,25 @@ typedef struct WinCondition {
*/
int
-TclpThreadCreate(idPtr, proc, clientData, stackSize, flags)
- Tcl_ThreadId *idPtr; /* Return, the ID 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 thread */
+TclpThreadCreate(
+ Tcl_ThreadId *idPtr, /* Return, the ID 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
+ * thread. */
{
HANDLE tHandle;
EnterCriticalSection(&joinLock);
+ *idPtr = 0; /* must initialize as Tcl_Thread is a pointer and
+ * on WIN64 sizeof void* != sizeof unsigned
+ */
+
#if defined(_MSC_VER) || defined(__MSVCRT__) || defined(__BORLANDC__)
tHandle = (HANDLE) _beginthreadex(NULL, (unsigned) stackSize, proc,
- clientData, 0, (unsigned *)idPtr);
+ clientData, 0, (unsigned *)idPtr);
#else
tHandle = CreateThread(NULL, (DWORD) stackSize,
(LPTHREAD_START_ROUTINE) proc, (LPVOID) clientData,
@@ -163,11 +166,11 @@ TclpThreadCreate(idPtr, proc, clientData, stackSize, flags)
#endif
if (tHandle == NULL) {
- LeaveCriticalSection(&joinLock);
+ LeaveCriticalSection(&joinLock);
return TCL_ERROR;
} else {
- if (flags & TCL_THREAD_JOINABLE) {
- TclRememberJoinableThread (*idPtr);
+ if (flags & TCL_THREAD_JOINABLE) {
+ TclRememberJoinableThread(*idPtr);
}
/*
@@ -199,13 +202,12 @@ TclpThreadCreate(idPtr, proc, clientData, stackSize, flags)
*/
int
-Tcl_JoinThread(threadId, result)
- Tcl_ThreadId threadId; /* Id of the thread to wait upon */
- int* result; /* Reference to the storage the result
- * of the thread we wait upon will be
- * written into. */
+Tcl_JoinThread(
+ Tcl_ThreadId threadId, /* Id of the thread to wait upon */
+ int *result) /* Reference to the storage the result of the
+ * thread we wait upon will be written into. */
{
- return TclJoinThread (threadId, result);
+ return TclJoinThread(threadId, result);
}
/*
@@ -225,11 +227,11 @@ Tcl_JoinThread(threadId, result)
*/
void
-TclpThreadExit(status)
- int status;
+TclpThreadExit(
+ int status)
{
EnterCriticalSection(&joinLock);
- TclSignalExitThread (Tcl_GetCurrentThread (), status);
+ TclSignalExitThread(Tcl_GetCurrentThread(), status);
LeaveCriticalSection(&joinLock);
#if defined(_MSC_VER) || defined(__MSVCRT__) || defined(__BORLANDC__)
@@ -256,9 +258,9 @@ TclpThreadExit(status)
*/
Tcl_ThreadId
-Tcl_GetCurrentThread()
+Tcl_GetCurrentThread(void)
{
- return (Tcl_ThreadId)GetCurrentThreadId();
+ return (Tcl_ThreadId) INT2PTR(GetCurrentThreadId());
}
/*
@@ -267,9 +269,9 @@ Tcl_GetCurrentThread()
* TclpInitLock
*
* This procedure is used to grab a lock that serializes initialization
- * and finalization of Tcl. On some platforms this may also initialize
- * the mutex used to serialize creation of more mutexes and thread
- * local storage keys.
+ * and finalization of Tcl. On some platforms this may also initialize
+ * the mutex used to serialize creation of more mutexes and thread local
+ * storage keys.
*
* Results:
* None.
@@ -281,15 +283,16 @@ Tcl_GetCurrentThread()
*/
void
-TclpInitLock()
+TclpInitLock(void)
{
if (!init) {
/*
- * There is a fundamental race here that is solved by creating
- * the first Tcl interpreter in a single threaded environment.
- * Once the interpreter has been created, it is safe to create
- * more threads that create interpreters in parallel.
+ * There is a fundamental race here that is solved by creating the
+ * first Tcl interpreter in a single threaded environment. Once the
+ * interpreter has been created, it is safe to create more threads
+ * that create interpreters in parallel.
*/
+
init = 1;
InitializeCriticalSection(&joinLock);
InitializeCriticalSection(&initLock);
@@ -303,8 +306,8 @@ TclpInitLock()
*
* TclpInitUnlock
*
- * This procedure is used to release a lock that serializes initialization
- * and finalization of Tcl.
+ * This procedure is used to release a lock that serializes
+ * initialization and finalization of Tcl.
*
* Results:
* None.
@@ -316,7 +319,7 @@ TclpInitLock()
*/
void
-TclpInitUnlock()
+TclpInitUnlock(void)
{
LeaveCriticalSection(&initLock);
}
@@ -326,11 +329,11 @@ TclpInitUnlock()
*
* TclpMasterLock
*
- * This procedure is used to grab a lock that serializes creation
- * of mutexes, condition variables, and thread local storage keys.
+ * This procedure is used to grab a lock that serializes creation of
+ * mutexes, condition variables, and thread local storage keys.
*
- * This lock must be different than the initLock because the
- * initLock is held during creation of syncronization objects.
+ * This lock must be different than the initLock because the initLock is
+ * held during creation of syncronization objects.
*
* Results:
* None.
@@ -342,15 +345,16 @@ TclpInitUnlock()
*/
void
-TclpMasterLock()
+TclpMasterLock(void)
{
if (!init) {
/*
- * There is a fundamental race here that is solved by creating
- * the first Tcl interpreter in a single threaded environment.
- * Once the interpreter has been created, it is safe to create
- * more threads that create interpreters in parallel.
+ * There is a fundamental race here that is solved by creating the
+ * first Tcl interpreter in a single threaded environment. Once the
+ * interpreter has been created, it is safe to create more threads
+ * that create interpreters in parallel.
*/
+
init = 1;
InitializeCriticalSection(&joinLock);
InitializeCriticalSection(&initLock);
@@ -364,8 +368,8 @@ TclpMasterLock()
*
* TclpMasterUnlock
*
- * This procedure is used to release a lock that serializes creation
- * and deletion of synchronization objects.
+ * This procedure is used to release a lock that serializes creation and
+ * deletion of synchronization objects.
*
* Results:
* None.
@@ -377,7 +381,7 @@ TclpMasterLock()
*/
void
-TclpMasterUnlock()
+TclpMasterUnlock(void)
{
LeaveCriticalSection(&masterLock);
}
@@ -387,13 +391,13 @@ TclpMasterUnlock()
*
* Tcl_GetAllocMutex
*
- * This procedure returns a pointer to a statically initialized
- * mutex for use by the memory allocator. The alloctor must
- * use this lock, because all other locks are allocated...
+ * This procedure returns a pointer to a statically initialized mutex for
+ * use by the memory allocator. The alloctor must use this lock, because
+ * all other locks are allocated...
*
* Results:
- * A pointer to a mutex that is suitable for passing to
- * Tcl_MutexLock and Tcl_MutexUnlock.
+ * A pointer to a mutex that is suitable for passing to Tcl_MutexLock and
+ * Tcl_MutexUnlock.
*
* Side effects:
* None.
@@ -402,11 +406,11 @@ TclpMasterUnlock()
*/
Tcl_Mutex *
-Tcl_GetAllocMutex()
+Tcl_GetAllocMutex(void)
{
#ifdef TCL_THREADS
if (!allocOnce) {
- InitializeCriticalSection(&allocLock);
+ InitializeCriticalSection(&allocLock.crit);
allocOnce = 1;
}
return &allocLockPtr;
@@ -420,74 +424,85 @@ Tcl_GetAllocMutex()
*
* TclpFinalizeLock
*
- * This procedure is used to destroy all private resources used in
- * this file.
+ * This procedure is used to destroy all private resources used in this
+ * file.
*
* Results:
* None.
*
* Side effects:
- * Destroys everything private. TclpInitLock must be held
- * entering this function.
+ * Destroys everything private. TclpInitLock must be held entering this
+ * function.
*
*----------------------------------------------------------------------
*/
void
-TclFinalizeLock ()
+TclFinalizeLock(void)
{
MASTER_LOCK;
DeleteCriticalSection(&joinLock);
- /* Destroy the critical section that we are holding! */
+
+ /*
+ * Destroy the critical section that we are holding!
+ */
+
DeleteCriticalSection(&masterLock);
init = 0;
+
#ifdef TCL_THREADS
- DeleteCriticalSection(&allocLock);
- allocOnce = 0;
+ if (allocOnce) {
+ DeleteCriticalSection(&allocLock.crit);
+ allocOnce = 0;
+ }
#endif
- /* Destroy the critical section that we are holding! */
+
+ LeaveCriticalSection(&initLock);
+
+ /*
+ * Destroy the critical section that we were holding.
+ */
+
DeleteCriticalSection(&initLock);
}
#ifdef TCL_THREADS
/* locally used prototype */
-static void FinalizeConditionEvent(ClientData data);
-
+static void FinalizeConditionEvent(ClientData data);
/*
*----------------------------------------------------------------------
*
* Tcl_MutexLock --
*
- * This procedure is invoked to lock a mutex. This is a self
- * initializing mutex that is automatically finalized during
- * Tcl_Finalize.
+ * This procedure is invoked to lock a mutex. This is a self initializing
+ * mutex that is automatically finalized during Tcl_Finalize.
*
* Results:
* None.
*
* Side effects:
- * May block the current thread. The mutex is aquired when
- * this returns.
+ * May block the current thread. The mutex is aquired when this returns.
*
*----------------------------------------------------------------------
*/
void
-Tcl_MutexLock(mutexPtr)
- Tcl_Mutex *mutexPtr; /* The lock */
+Tcl_MutexLock(
+ Tcl_Mutex *mutexPtr) /* The lock */
{
CRITICAL_SECTION *csPtr;
+
if (*mutexPtr == NULL) {
MASTER_LOCK;
- /*
+ /*
* Double inside master lock check to avoid a race.
*/
if (*mutexPtr == NULL) {
- csPtr = (CRITICAL_SECTION *)ckalloc(sizeof(CRITICAL_SECTION));
+ csPtr = (CRITICAL_SECTION *) ckalloc(sizeof(CRITICAL_SECTION));
InitializeCriticalSection(csPtr);
*mutexPtr = (Tcl_Mutex)csPtr;
TclRememberMutex(mutexPtr);
@@ -515,10 +530,11 @@ Tcl_MutexLock(mutexPtr)
*/
void
-Tcl_MutexUnlock(mutexPtr)
- Tcl_Mutex *mutexPtr; /* The lock */
+Tcl_MutexUnlock(
+ Tcl_Mutex *mutexPtr) /* The lock */
{
CRITICAL_SECTION *csPtr = *((CRITICAL_SECTION **)mutexPtr);
+
LeaveCriticalSection(csPtr);
}
@@ -527,8 +543,8 @@ Tcl_MutexUnlock(mutexPtr)
*
* TclpFinalizeMutex --
*
- * This procedure is invoked to clean up one mutex. This is only
- * safe to call at the end of time.
+ * This procedure is invoked to clean up one mutex. This is only safe to
+ * call at the end of time.
*
* Results:
* None.
@@ -540,13 +556,14 @@ Tcl_MutexUnlock(mutexPtr)
*/
void
-TclpFinalizeMutex(mutexPtr)
- Tcl_Mutex *mutexPtr;
+TclpFinalizeMutex(
+ Tcl_Mutex *mutexPtr)
{
CRITICAL_SECTION *csPtr = *(CRITICAL_SECTION **)mutexPtr;
+
if (csPtr != NULL) {
DeleteCriticalSection(csPtr);
- ckfree((char *)csPtr);
+ ckfree((char *) csPtr);
*mutexPtr = NULL;
}
}
@@ -554,210 +571,11 @@ TclpFinalizeMutex(mutexPtr)
/*
*----------------------------------------------------------------------
*
- * TclpThreadDataKeyInit --
- *
- * This procedure initializes a thread specific data block key.
- * Each thread has table of pointers to thread specific data.
- * all threads agree on which table entry is used by each module.
- * this is remembered in a "data key", that is just an index into
- * this table. To allow self initialization, the interface
- * passes a pointer to this key and the first thread to use
- * the key fills in the pointer to the key. The key should be
- * a process-wide static.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Will allocate memory the first time this process calls for
- * this key. In this case it modifies its argument
- * to hold the pointer to information about the key.
- *
- *----------------------------------------------------------------------
- */
-
-void
-TclpThreadDataKeyInit(keyPtr)
- Tcl_ThreadDataKey *keyPtr; /* Identifier for the data chunk,
- * really (DWORD **) */
-{
- DWORD *indexPtr;
- DWORD newKey;
-
- MASTER_LOCK;
- if (*keyPtr == NULL) {
- indexPtr = (DWORD *)ckalloc(sizeof(DWORD));
- newKey = TlsAlloc();
- if (newKey != TLS_OUT_OF_INDEXES) {
- *indexPtr = newKey;
- } else {
- panic("TlsAlloc failed from TclpThreadDataKeyInit!"); /* this should be a fatal error */
- }
- *keyPtr = (Tcl_ThreadDataKey)indexPtr;
- TclRememberDataKey(keyPtr);
- }
- MASTER_UNLOCK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclpThreadDataKeyGet --
- *
- * This procedure returns a pointer to a block of thread local storage.
- *
- * Results:
- * A thread-specific pointer to the data structure, or NULL
- * if the memory has not been assigned to this key for this thread.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-VOID *
-TclpThreadDataKeyGet(keyPtr)
- Tcl_ThreadDataKey *keyPtr; /* Identifier for the data chunk,
- * really (DWORD **) */
-{
- DWORD *indexPtr = *(DWORD **)keyPtr;
- LPVOID result;
- if (indexPtr == NULL) {
- return NULL;
- } else {
- result = TlsGetValue(*indexPtr);
- if ((result == NULL) && (GetLastError() != NO_ERROR)) {
- panic("TlsGetValue failed from TclpThreadDataKeyGet!");
- }
- return result;
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclpThreadDataKeySet --
- *
- * This procedure sets the pointer to a block of thread local storage.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Sets up the thread so future calls to TclpThreadDataKeyGet with
- * this key will return the data pointer.
- *
- *----------------------------------------------------------------------
- */
-
-void
-TclpThreadDataKeySet(keyPtr, data)
- Tcl_ThreadDataKey *keyPtr; /* Identifier for the data chunk,
- * really (pthread_key_t **) */
- VOID *data; /* Thread local storage */
-{
- DWORD *indexPtr = *(DWORD **)keyPtr;
- BOOL success;
- success = TlsSetValue(*indexPtr, (void *)data);
- if (!success) {
- panic("TlsSetValue failed from TclpThreadDataKeySet!");
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclpFinalizeThreadData --
- *
- * This procedure cleans up the thread-local storage. This is
- * called once for each thread.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Frees up the memory.
- *
- *----------------------------------------------------------------------
- */
-
-void
-TclpFinalizeThreadData(keyPtr)
- Tcl_ThreadDataKey *keyPtr;
-{
- VOID *result;
- DWORD *indexPtr;
- BOOL success;
-
- if (*keyPtr != NULL) {
- indexPtr = *(DWORD **)keyPtr;
- result = (VOID *)TlsGetValue(*indexPtr);
- if (result != NULL) {
-#if defined(USE_THREAD_ALLOC) && !defined(TCL_MEM_DEBUG)
- if (indexPtr == &tlsKey) {
- TclpFreeAllocCache(result);
- return;
- }
-#endif
- ckfree((char *)result);
- success = TlsSetValue(*indexPtr, (void *)NULL);
- if (!success) {
- panic("TlsSetValue failed from TclpFinalizeThreadData!");
- }
- } else {
- if (GetLastError() != NO_ERROR) {
- panic("TlsGetValue failed from TclpFinalizeThreadData!");
- }
- }
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclpFinalizeThreadDataKey --
- *
- * This procedure is invoked to clean up one key. This is a
- * process-wide storage identifier. The thread finalization code
- * cleans up the thread local storage itself.
- *
- * This assumes the master lock is held.
- *
- * Results:
- * None.
- *
- * Side effects:
- * The key is deallocated.
- *
- *----------------------------------------------------------------------
- */
-
-void
-TclpFinalizeThreadDataKey(keyPtr)
- Tcl_ThreadDataKey *keyPtr;
-{
- DWORD *indexPtr;
- BOOL success;
- if (*keyPtr != NULL) {
- indexPtr = *(DWORD **)keyPtr;
- success = TlsFree(*indexPtr);
- if (!success) {
- panic("TlsFree failed from TclpFinalizeThreadDataKey!");
- }
- ckfree((char *)indexPtr);
- *keyPtr = NULL;
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
* Tcl_ConditionWait --
*
- * This procedure is invoked to wait on a condition variable.
- * The mutex is atomically released as part of the wait, and
- * automatically grabbed when the condition is signaled.
+ * This procedure is invoked to wait on a condition variable. The mutex
+ * is atomically released as part of the wait, and automatically grabbed
+ * when the condition is signaled.
*
* The mutex must be held when this procedure is called.
*
@@ -765,18 +583,18 @@ TclpFinalizeThreadDataKey(keyPtr)
* None.
*
* Side effects:
- * May block the current thread. The mutex is aquired when
- * this returns. Will allocate memory for a HANDLE
- * and initialize this the first time this Tcl_Condition is used.
+ * May block the current thread. The mutex is aquired when this returns.
+ * Will allocate memory for a HANDLE and initialize this the first time
+ * this Tcl_Condition is used.
*
*----------------------------------------------------------------------
*/
void
-Tcl_ConditionWait(condPtr, mutexPtr, timePtr)
- Tcl_Condition *condPtr; /* Really (WinCondition **) */
- Tcl_Mutex *mutexPtr; /* Really (CRITICAL_SECTION **) */
- Tcl_Time *timePtr; /* Timeout on waiting period */
+Tcl_ConditionWait(
+ Tcl_Condition *condPtr, /* Really (WinCondition **) */
+ Tcl_Mutex *mutexPtr, /* Really (CRITICAL_SECTION **) */
+ Tcl_Time *timePtr) /* Timeout on waiting period */
{
WinCondition *winCondPtr; /* Per-condition queue head */
CRITICAL_SECTION *csPtr; /* Caller's Mutex, after casting */
@@ -786,21 +604,20 @@ Tcl_ConditionWait(condPtr, mutexPtr, timePtr)
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
/*
- * Self initialize the two parts of the condition.
- * The per-condition and per-thread parts need to be
- * handled independently.
+ * Self initialize the two parts of the condition. The per-condition and
+ * per-thread parts need to be handled independently.
*/
if (tsdPtr->flags == WIN_THREAD_UNINIT) {
MASTER_LOCK;
- /*
+ /*
* Create the per-thread event and queue pointers.
*/
if (tsdPtr->flags == WIN_THREAD_UNINIT) {
tsdPtr->condEvent = CreateEvent(NULL, TRUE /* manual reset */,
- FALSE /* non signaled */, NULL);
+ FALSE /* non signaled */, NULL);
tsdPtr->nextPtr = NULL;
tsdPtr->prevPtr = NULL;
tsdPtr->flags = WIN_THREAD_RUNNING;
@@ -810,13 +627,12 @@ Tcl_ConditionWait(condPtr, mutexPtr, timePtr)
if (doExit) {
/*
- * Create a per-thread exit handler to clean up the condEvent.
- * We must be careful to do this outside the Master Lock
- * because Tcl_CreateThreadExitHandler uses its own
- * ThreadSpecificData, and initializing that may drop
- * back into the Master Lock.
+ * Create a per-thread exit handler to clean up the condEvent. We
+ * must be careful to do this outside the Master Lock because
+ * Tcl_CreateThreadExitHandler uses its own ThreadSpecificData,
+ * and initializing that may drop back into the Master Lock.
*/
-
+
Tcl_CreateThreadExitHandler(FinalizeConditionEvent,
(ClientData) tsdPtr);
}
@@ -830,11 +646,11 @@ Tcl_ConditionWait(condPtr, mutexPtr, timePtr)
*/
if (*condPtr == NULL) {
- winCondPtr = (WinCondition *)ckalloc(sizeof(WinCondition));
+ winCondPtr = (WinCondition *) ckalloc(sizeof(WinCondition));
InitializeCriticalSection(&winCondPtr->condLock);
winCondPtr->firstPtr = NULL;
winCondPtr->lastPtr = NULL;
- *condPtr = (Tcl_Condition)winCondPtr;
+ *condPtr = (Tcl_Condition) winCondPtr;
TclRememberCondition(condPtr);
}
MASTER_UNLOCK;
@@ -848,8 +664,8 @@ Tcl_ConditionWait(condPtr, mutexPtr, timePtr)
}
/*
- * Queue the thread on the condition, using
- * the per-condition lock for serialization.
+ * Queue the thread on the condition, using the per-condition lock for
+ * serialization.
*/
tsdPtr->flags = WIN_THREAD_BLOCKED;
@@ -858,22 +674,22 @@ Tcl_ConditionWait(condPtr, mutexPtr, timePtr)
tsdPtr->prevPtr = winCondPtr->lastPtr; /* A: */
winCondPtr->lastPtr = tsdPtr;
if (tsdPtr->prevPtr != NULL) {
- tsdPtr->prevPtr->nextPtr = tsdPtr;
+ tsdPtr->prevPtr->nextPtr = tsdPtr;
}
if (winCondPtr->firstPtr == NULL) {
- winCondPtr->firstPtr = tsdPtr;
+ winCondPtr->firstPtr = tsdPtr;
}
/*
* Unlock the caller's mutex and wait for the condition, or a timeout.
- * There is a minor issue here in that we don't count down the
- * timeout if we get notified, but another thread grabs the condition
- * before we do. In that race condition we'll wait again for the
- * full timeout. Timed waits are dubious anyway. Either you have
- * the locking protocol wrong and are masking a deadlock,
- * or you are using conditions to pause your thread.
+ * There is a minor issue here in that we don't count down the timeout if
+ * we get notified, but another thread grabs the condition before we do.
+ * In that race condition we'll wait again for the full timeout. Timed
+ * waits are dubious anyway. Either you have the locking protocol wrong
+ * and are masking a deadlock, or you are using conditions to pause your
+ * thread.
*/
-
+
LeaveCriticalSection(csPtr);
timeout = 0;
while (!timeout && (tsdPtr->flags & WIN_THREAD_BLOCKED)) {
@@ -886,32 +702,32 @@ Tcl_ConditionWait(condPtr, mutexPtr, timePtr)
}
/*
- * Be careful on timeouts because the signal might arrive right around
- * the time limit and someone else could have taken us off the queue.
+ * Be careful on timeouts because the signal might arrive right around the
+ * time limit and someone else could have taken us off the queue.
*/
-
+
if (timeout) {
if (tsdPtr->flags & WIN_THREAD_RUNNING) {
timeout = 0;
} else {
/*
- * When dequeuing, we can leave the tsdPtr->nextPtr
- * and tsdPtr->prevPtr with dangling pointers because
- * they are reinitialilzed w/out reading them when the
- * thread is enqueued later.
+ * When dequeuing, we can leave the tsdPtr->nextPtr and
+ * tsdPtr->prevPtr with dangling pointers because they are
+ * reinitialilzed w/out reading them when the thread is enqueued
+ * later.
*/
- if (winCondPtr->firstPtr == tsdPtr) {
- winCondPtr->firstPtr = tsdPtr->nextPtr;
- } else {
- tsdPtr->prevPtr->nextPtr = tsdPtr->nextPtr;
- }
- if (winCondPtr->lastPtr == tsdPtr) {
- winCondPtr->lastPtr = tsdPtr->prevPtr;
- } else {
- tsdPtr->nextPtr->prevPtr = tsdPtr->prevPtr;
- }
- tsdPtr->flags = WIN_THREAD_RUNNING;
+ if (winCondPtr->firstPtr == tsdPtr) {
+ winCondPtr->firstPtr = tsdPtr->nextPtr;
+ } else {
+ tsdPtr->prevPtr->nextPtr = tsdPtr->nextPtr;
+ }
+ if (winCondPtr->lastPtr == tsdPtr) {
+ winCondPtr->lastPtr = tsdPtr->prevPtr;
+ } else {
+ tsdPtr->nextPtr->prevPtr = tsdPtr->prevPtr;
+ }
+ tsdPtr->flags = WIN_THREAD_RUNNING;
}
}
@@ -926,8 +742,8 @@ Tcl_ConditionWait(condPtr, mutexPtr, timePtr)
*
* This procedure is invoked to signal a condition variable.
*
- * The mutex must be held during this call to avoid races,
- * but this interface does not enforce that.
+ * The mutex must be held during this call to avoid races, but this
+ * interface does not enforce that.
*
* Results:
* None.
@@ -939,13 +755,13 @@ Tcl_ConditionWait(condPtr, mutexPtr, timePtr)
*/
void
-Tcl_ConditionNotify(condPtr)
- Tcl_Condition *condPtr;
+Tcl_ConditionNotify(
+ Tcl_Condition *condPtr)
{
WinCondition *winCondPtr;
ThreadSpecificData *tsdPtr;
- if (condPtr != NULL) {
+ if (*condPtr != NULL) {
winCondPtr = *((WinCondition **)condPtr);
if (winCondPtr == NULL) {
@@ -953,9 +769,9 @@ Tcl_ConditionNotify(condPtr)
}
/*
- * Loop through all the threads waiting on the condition
- * and notify them (i.e., broadcast semantics). The queue
- * manipulation is guarded by the per-condition coordinating mutex.
+ * Loop through all the threads waiting on the condition and notify
+ * them (i.e., broadcast semantics). The queue manipulation is guarded
+ * by the per-condition coordinating mutex.
*/
EnterCriticalSection(&winCondPtr->condLock);
@@ -973,7 +789,7 @@ Tcl_ConditionNotify(condPtr)
LeaveCriticalSection(&winCondPtr->condLock);
} else {
/*
- * Noone has used the condition variable, so there are no waiters.
+ * No-one has used the condition variable, so there are no waiters.
*/
}
}
@@ -983,9 +799,9 @@ Tcl_ConditionNotify(condPtr)
*
* FinalizeConditionEvent --
*
- * This procedure is invoked to clean up the per-thread
- * event used to implement condition waiting.
- * This is only safe to call at the end of time.
+ * This procedure is invoked to clean up the per-thread event used to
+ * implement condition waiting. This is only safe to call at the end of
+ * time.
*
* Results:
* None.
@@ -997,10 +813,11 @@ Tcl_ConditionNotify(condPtr)
*/
static void
-FinalizeConditionEvent(data)
- ClientData data;
+FinalizeConditionEvent(
+ ClientData data)
{
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)data;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *) data;
+
tsdPtr->flags = WIN_THREAD_UNINIT;
CloseHandle(tsdPtr->condEvent);
}
@@ -1010,8 +827,8 @@ FinalizeConditionEvent(data)
*
* TclpFinalizeCondition --
*
- * This procedure is invoked to clean up a condition variable.
- * This is only safe to call at the end of time.
+ * This procedure is invoked to clean up a condition variable. This is
+ * only safe to call at the end of time.
*
* This assumes the Master Lock is held.
*
@@ -1025,30 +842,33 @@ FinalizeConditionEvent(data)
*/
void
-TclpFinalizeCondition(condPtr)
- Tcl_Condition *condPtr;
+TclpFinalizeCondition(
+ Tcl_Condition *condPtr)
{
WinCondition *winCondPtr = *(WinCondition **)condPtr;
/*
- * Note - this is called long after the thread-local storage is
- * reclaimed. The per-thread condition waiting event is
- * reclaimed earlier in a per-thread exit handler, which is
- * called before thread local storage is reclaimed.
+ * Note - this is called long after the thread-local storage is reclaimed.
+ * The per-thread condition waiting event is reclaimed earlier in a
+ * per-thread exit handler, which is called before thread local storage is
+ * reclaimed.
*/
if (winCondPtr != NULL) {
DeleteCriticalSection(&winCondPtr->condLock);
- ckfree((char *)winCondPtr);
+ ckfree((char *) winCondPtr);
*condPtr = NULL;
}
}
+
+
+
/*
* Additions by AOL for specialized thread memory allocator.
*/
+#ifdef USE_THREAD_ALLOC
-#if defined(USE_THREAD_ALLOC) && !defined(TCL_MEM_DEBUG)
Tcl_Mutex *
TclpNewAllocMutex(void)
{
@@ -1056,7 +876,7 @@ TclpNewAllocMutex(void)
lockPtr = malloc(sizeof(struct allocMutex));
if (lockPtr == NULL) {
- panic("could not allocate lock");
+ Tcl_Panic("could not allocate lock");
}
lockPtr->tlock = (Tcl_Mutex) &lockPtr->wlock;
InitializeCriticalSection(&lockPtr->wlock);
@@ -1064,11 +884,14 @@ TclpNewAllocMutex(void)
}
void
-TclpFreeAllocMutex(mutex)
- Tcl_Mutex *mutex; /* The alloc mutex to free. */
+TclpFreeAllocMutex(
+ Tcl_Mutex *mutex) /* The alloc mutex to free. */
{
- allocMutex* lockPtr = (allocMutex*) mutex;
- if (!lockPtr) return;
+ allocMutex *lockPtr = (allocMutex *) mutex;
+
+ if (!lockPtr) {
+ return;
+ }
DeleteCriticalSection(&lockPtr->wlock);
free(lockPtr);
}
@@ -1080,60 +903,73 @@ TclpGetAllocCache(void)
if (!once) {
/*
- * We need to make sure that TclpFreeAllocCache is called
- * on each thread that calls this, but only on threads that
- * call this.
+ * We need to make sure that TclpFreeAllocCache is called on each
+ * thread that calls this, but only on threads that call this.
*/
- tlsKey = TlsAlloc();
+
+ tlsKey = TlsAlloc();
once = 1;
if (tlsKey == TLS_OUT_OF_INDEXES) {
- panic("could not allocate thread local storage");
+ Tcl_Panic("could not allocate thread local storage");
}
}
result = TlsGetValue(tlsKey);
if ((result == NULL) && (GetLastError() != NO_ERROR)) {
- panic("TlsGetValue failed from TclpGetAllocCache!");
+ Tcl_Panic("TlsGetValue failed from TclpGetAllocCache");
}
return result;
}
void
-TclpSetAllocCache(void *ptr)
+TclpSetAllocCache(
+ void *ptr)
{
BOOL success;
success = TlsSetValue(tlsKey, ptr);
if (!success) {
- panic("TlsSetValue failed from TclpSetAllocCache!");
+ Tcl_Panic("TlsSetValue failed from TclpSetAllocCache");
}
}
void
-TclpFreeAllocCache(void *ptr)
+TclpFreeAllocCache(
+ void *ptr)
{
BOOL success;
if (ptr != NULL) {
- /*
- * Called by the pthread lib when a thread exits
- */
- TclFreeAllocCache(ptr);
- success = TlsSetValue(tlsKey, NULL);
- if (!success) {
- panic("TlsSetValue failed from TclpFreeAllocCache!");
- }
- } else if (once) {
- /*
- * Called by us in TclFinalizeThreadAlloc() during
- * the library finalization initiated from Tcl_Finalize()
- */
- success = TlsFree(tlsKey);
- if (!success) {
- Tcl_Panic("TlsFree failed from TclpFreeAllocCache!");
- }
- once = 0; /* reset for next time. */
+ /*
+ * Called by us in TclpFinalizeThreadData when a thread exits and
+ * destroys the tsd key which stores allocator caches.
+ */
+
+ TclFreeAllocCache(ptr);
+ success = TlsSetValue(tlsKey, NULL);
+ if (!success) {
+ Tcl_Panic("TlsSetValue failed from TclpFreeAllocCache");
+ }
+ } else if (once) {
+ /*
+ * Called by us in TclFinalizeThreadAlloc() during the library
+ * finalization initiated from Tcl_Finalize()
+ */
+
+ success = TlsFree(tlsKey);
+ if (!success) {
+ Tcl_Panic("TlsFree failed from TclpFreeAllocCache");
+ }
+ once = 0; /* reset for next time. */
}
-}
+}
#endif /* USE_THREAD_ALLOC */
#endif /* TCL_THREADS */
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/win/tclWinTime.c b/win/tclWinTime.c
index 8bbd8fd..f34884a 100644
--- a/win/tclWinTime.c
+++ b/win/tclWinTime.c
@@ -1,29 +1,30 @@
-/*
+/*
* tclWinTime.c --
*
- * Contains Windows specific versions of Tcl functions that
- * obtain time values from the operating system.
+ * Contains Windows specific versions of Tcl functions that obtain time
+ * values from the operating system.
*
* Copyright 1995-1998 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.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
-#include "tclWinInt.h"
+#include "tclInt.h"
-#define SECSPERDAY (60L * 60L * 24L)
-#define SECSPERYEAR (SECSPERDAY * 365L)
-#define SECSPER4YEAR (SECSPERYEAR * 4L + SECSPERDAY)
+#define SECSPERDAY (60L * 60L * 24L)
+#define SECSPERYEAR (SECSPERDAY * 365L)
+#define SECSPER4YEAR (SECSPERYEAR * 4L + SECSPERDAY)
/*
- * Number of samples over which to estimate the performance counter
+ * Number of samples over which to estimate the performance counter.
*/
-#define SAMPLES 64
+
+#define SAMPLES 64
/*
- * The following arrays contain the day of year for the last day of
- * each month, where index 1 is January.
+ * The following arrays contain the day of year for the last day of each
+ * month, where index 1 is January.
*/
static const int normalDays[] = {
@@ -45,38 +46,29 @@ static Tcl_ThreadDataKey dataKey;
*/
typedef struct TimeInfo {
-
- CRITICAL_SECTION cs; /* Mutex guarding this structure */
-
+ CRITICAL_SECTION cs; /* Mutex guarding this structure. */
int initialized; /* Flag == 1 if this structure is
* initialized. */
-
- int perfCounterAvailable; /* Flag == 1 if the hardware has a
- * performance counter */
-
- HANDLE calibrationThread; /* Handle to the thread that keeps the
- * virtual clock calibrated. */
-
- HANDLE readyEvent; /* System event used to
- * trigger the requesting thread
- * when the clock calibration procedure
- * is initialized for the first time */
-
- HANDLE exitEvent; /* Event to signal out of an exit handler
- * to tell the calibration loop to
- * terminate */
-
- LARGE_INTEGER nominalFreq; /* Nominal frequency of the system
- * performance counter, that is, the value
- * returned from QueryPerformanceFrequency. */
+ int perfCounterAvailable; /* Flag == 1 if the hardware has a performance
+ * counter. */
+ HANDLE calibrationThread; /* Handle to the thread that keeps the virtual
+ * clock calibrated. */
+ HANDLE readyEvent; /* System event used to trigger the requesting
+ * thread when the clock calibration procedure
+ * is initialized for the first time. */
+ HANDLE exitEvent; /* Event to signal out of an exit handler to
+ * tell the calibration loop to terminate. */
+ LARGE_INTEGER nominalFreq; /* Nominal frequency of the system performance
+ * counter, that is, the value returned from
+ * QueryPerformanceFrequency. */
/*
- * The following values are used for calculating virtual time.
- * Virtual time is always equal to:
- * lastFileTime + (current perf counter - lastCounter)
+ * The following values are used for calculating virtual time. Virtual
+ * time is always equal to:
+ * lastFileTime + (current perf counter - lastCounter)
* * 10000000 / curCounterFreq
- * and lastFileTime and lastCounter are updated any time that
- * virtual time is returned to a caller.
+ * and lastFileTime and lastCounter are updated any time that virtual time
+ * is returned to a caller.
*/
ULARGE_INTEGER fileTimeLastCall;
@@ -84,16 +76,14 @@ typedef struct TimeInfo {
LARGE_INTEGER curCounterFreq;
/*
- * Data used in developing the estimate of performance counter
- * frequency
+ * Data used in developing the estimate of performance counter frequency
*/
+
Tcl_WideUInt fileTimeSample[SAMPLES];
- /* Last 64 samples of system time */
+ /* Last 64 samples of system time. */
Tcl_WideInt perfCounterSample[SAMPLES];
- /* Last 64 samples of performance counter */
- int sampleNo; /* Current sample number */
-
-
+ /* Last 64 samples of performance counter. */
+ int sampleNo; /* Current sample number. */
} TimeInfo;
static TimeInfo timeInfo = {
@@ -119,33 +109,38 @@ static TimeInfo timeInfo = {
0
};
-static CONST FILETIME posixEpoch = { 0xD53E8000, 0x019DB1DE };
-
/*
* Declarations for functions defined later in this file.
*/
-static struct tm * ComputeGMT _ANSI_ARGS_((const time_t *tp));
-static void StopCalibration _ANSI_ARGS_(( ClientData ));
-static DWORD WINAPI CalibrationThread _ANSI_ARGS_(( LPVOID arg ));
-static void UpdateTimeEachSecond _ANSI_ARGS_(( void ));
-static void ResetCounterSamples _ANSI_ARGS_((
- Tcl_WideUInt fileTime,
- Tcl_WideInt perfCounter,
- Tcl_WideInt perfFreq
- ));
-static Tcl_WideInt AccumulateSample _ANSI_ARGS_((
- Tcl_WideInt perfCounter,
- Tcl_WideUInt fileTime
- ));
+static struct tm * ComputeGMT(const time_t *tp);
+static void StopCalibration(ClientData clientData);
+static DWORD WINAPI CalibrationThread(LPVOID arg);
+static void UpdateTimeEachSecond(void);
+static void ResetCounterSamples(Tcl_WideUInt fileTime,
+ Tcl_WideInt perfCounter, Tcl_WideInt perfFreq);
+static Tcl_WideInt AccumulateSample(Tcl_WideInt perfCounter,
+ Tcl_WideUInt fileTime);
+static void NativeScaleTime(Tcl_Time* timebuf,
+ ClientData clientData);
+static void NativeGetTime(Tcl_Time* timebuf,
+ ClientData clientData);
+
+/*
+ * TIP #233 (Virtualized Time): Data for the time hooks, if any.
+ */
+
+Tcl_GetTimeProc *tclGetTimeProcPtr = NativeGetTime;
+Tcl_ScaleTimeProc *tclScaleTimeProcPtr = NativeScaleTime;
+ClientData tclTimeClientData = NULL;
/*
*----------------------------------------------------------------------
*
* TclpGetSeconds --
*
- * This procedure returns the number of seconds from the epoch.
- * On most Unix systems the epoch is Midnight Jan 1, 1970 GMT.
+ * This procedure returns the number of seconds from the epoch. On most
+ * Unix systems the epoch is Midnight Jan 1, 1970 GMT.
*
* Results:
* Number of seconds from the epoch.
@@ -157,10 +152,11 @@ static Tcl_WideInt AccumulateSample _ANSI_ARGS_((
*/
unsigned long
-TclpGetSeconds()
+TclpGetSeconds(void)
{
Tcl_Time t;
- Tcl_GetTime( &t );
+
+ (*tclGetTimeProcPtr) (&t, tclTimeClientData); /* Tcl_GetTime inlined. */
return t.sec;
}
@@ -169,11 +165,10 @@ TclpGetSeconds()
*
* TclpGetClicks --
*
- * This procedure returns a value that represents the highest
- * resolution clock available on the system. There are no
- * guarantees on what the resolution will be. In Tcl we will
- * call this value a "click". The start time is also system
- * dependant.
+ * This procedure returns a value that represents the highest resolution
+ * clock available on the system. There are no guarantees on what the
+ * resolution will be. In Tcl we will call this value a "click". The
+ * start time is also system dependant.
*
* Results:
* Number of clicks from some start time.
@@ -185,18 +180,19 @@ TclpGetSeconds()
*/
unsigned long
-TclpGetClicks()
+TclpGetClicks(void)
{
/*
- * Use the Tcl_GetTime abstraction to get the time in microseconds,
- * as nearly as we can, and return it.
+ * Use the Tcl_GetTime abstraction to get the time in microseconds, as
+ * nearly as we can, and return it.
*/
Tcl_Time now; /* Current Tcl time */
unsigned long retval; /* Value to return */
- Tcl_GetTime( &now );
- retval = ( now.sec * 1000000 ) + now.usec;
+ (*tclGetTimeProcPtr) (&now, tclTimeClientData); /* Tcl_GetTime inlined */
+
+ retval = (now.sec * 1000000) + now.usec;
return retval;
}
@@ -206,9 +202,8 @@ TclpGetClicks()
*
* TclpGetTimeZone --
*
- * Determines the current timezone. The method varies wildly
- * between different Platform implementations, so its hidden in
- * this function.
+ * Determines the current timezone. The method varies wildly between
+ * different Platform implementations, so its hidden in this function.
*
* Results:
* Minutes west of GMT.
@@ -220,13 +215,13 @@ TclpGetClicks()
*/
int
-TclpGetTimeZone (currentTime)
- Tcl_WideInt currentTime;
+TclpGetTimeZone(
+ unsigned long currentTime)
{
int timeZone;
tzset();
- timeZone = _timezone / 60;
+ timeZone = timezone / 60;
return timeZone;
}
@@ -236,79 +231,137 @@ TclpGetTimeZone (currentTime)
*
* Tcl_GetTime --
*
- * Gets the current system time in seconds and microseconds
- * since the beginning of the epoch: 00:00 UCT, January 1, 1970.
+ * Gets the current system time in seconds and microseconds since the
+ * beginning of the epoch: 00:00 UCT, January 1, 1970.
*
* Results:
* Returns the current time in timePtr.
*
* Side effects:
- * On the first call, initializes a set of static variables to
- * keep track of the base value of the performance counter, the
- * corresponding wall clock (obtained through ftime) and the
- * frequency of the performance counter. Also spins a thread
- * whose function is to wake up periodically and monitor these
- * values, adjusting them as necessary to correct for drift
- * in the performance counter's oscillator.
+ * On the first call, initializes a set of static variables to keep track
+ * of the base value of the performance counter, the corresponding wall
+ * clock (obtained through ftime) and the frequency of the performance
+ * counter. Also spins a thread whose function is to wake up periodically
+ * and monitor these values, adjusting them as necessary to correct for
+ * drift in the performance counter's oscillator.
*
*----------------------------------------------------------------------
*/
void
-Tcl_GetTime(timePtr)
- Tcl_Time *timePtr; /* Location to store time information. */
+Tcl_GetTime(
+ Tcl_Time *timePtr) /* Location to store time information. */
{
- struct timeb t;
+ (*tclGetTimeProcPtr) (timePtr, tclTimeClientData);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NativeScaleTime --
+ *
+ * TIP #233: Scale from virtual time to the real-time. For native scaling
+ * the relationship is 1:1 and nothing has to be done.
+ *
+ * Results:
+ * Scales the time in timePtr.
+ *
+ * Side effects:
+ * See above.
+ *
+ *----------------------------------------------------------------------
+ */
- int useFtime = 1; /* Flag == TRUE if we need to fall back
- * on ftime rather than using the perf
- * counter */
+static void
+NativeScaleTime(
+ Tcl_Time *timePtr,
+ ClientData clientData)
+{
+ /*
+ * Native scale is 1:1. Nothing is done.
+ */
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NativeGetTime --
+ *
+ * TIP #233: Gets the current system time in seconds and microseconds
+ * since the beginning of the epoch: 00:00 UCT, January 1, 1970.
+ *
+ * Results:
+ * Returns the current time in timePtr.
+ *
+ * Side effects:
+ * On the first call, initializes a set of static variables to keep track
+ * of the base value of the performance counter, the corresponding wall
+ * clock (obtained through ftime) and the frequency of the performance
+ * counter. Also spins a thread whose function is to wake up periodically
+ * and monitor these values, adjusting them as necessary to correct for
+ * drift in the performance counter's oscillator.
+ *
+ *----------------------------------------------------------------------
+ */
- /* Initialize static storage on the first trip through. */
+static void
+NativeGetTime(
+ Tcl_Time *timePtr,
+ ClientData clientData)
+{
+ struct timeb t;
+ int useFtime = 1; /* Flag == TRUE if we need to fall back on
+ * ftime rather than using the perf counter. */
/*
- * Note: Outer check for 'initialized' is a performance win
- * since it avoids an extra mutex lock in the common case.
+ * Initialize static storage on the first trip through.
+ *
+ * Note: Outer check for 'initialized' is a performance win since it
+ * avoids an extra mutex lock in the common case.
*/
- if ( !timeInfo.initialized ) {
+ if (!timeInfo.initialized) {
TclpInitLock();
- if ( !timeInfo.initialized ) {
- timeInfo.perfCounterAvailable
- = QueryPerformanceFrequency( &timeInfo.nominalFreq );
+ if (!timeInfo.initialized) {
+ timeInfo.perfCounterAvailable =
+ QueryPerformanceFrequency(&timeInfo.nominalFreq);
/*
- * Some hardware abstraction layers use the CPU clock
- * in place of the real-time clock as a performance counter
- * reference. This results in:
+ * Some hardware abstraction layers use the CPU clock in place of
+ * the real-time clock as a performance counter reference. This
+ * results in:
* - inconsistent results among the processors on
* multi-processor systems.
- * - unpredictable changes in performance counter frequency
- * on "gearshift" processors such as Transmeta and
- * SpeedStep.
+ * - unpredictable changes in performance counter frequency on
+ * "gearshift" processors such as Transmeta and SpeedStep.
*
* There seems to be no way to test whether the performance
- * counter is reliable, but a useful heuristic is that
- * if its frequency is 1.193182 MHz or 3.579545 MHz, it's
- * derived from a colorburst crystal and is therefore
- * the RTC rather than the TSC.
+ * counter is reliable, but a useful heuristic is that if its
+ * frequency is 1.193182 MHz or 3.579545 MHz, it's derived from a
+ * colorburst crystal and is therefore the RTC rather than the
+ * TSC.
+ *
+ * A sloppier but serviceable heuristic is that the RTC crystal is
+ * normally less than 15 MHz while the TSC crystal is virtually
+ * assured to be greater than 100 MHz. Since Win98SE appears to
+ * fiddle with the definition of the perf counter frequency
+ * (perhaps in an attempt to calibrate the clock?), we use the
+ * latter rule rather than an exact match.
*
- * A sloppier but serviceable heuristic is that the RTC crystal
- * is normally less than 15 MHz while the TSC crystal is
- * virtually assured to be greater than 100 MHz. Since Win98SE
- * appears to fiddle with the definition of the perf counter
- * frequency (perhaps in an attempt to calibrate the clock?)
- * we use the latter rule rather than an exact match.
+ * We also assume (perhaps questionably) that the vendors have
+ * gotten their act together on Win64, so bypass all this rubbish
+ * on that platform.
*/
- if ( timeInfo.perfCounterAvailable
- /* The following lines would do an exact match on
- * crystal frequency:
- * && timeInfo.nominalFreq.QuadPart != (Tcl_WideInt) 1193182
- * && timeInfo.nominalFreq.QuadPart != (Tcl_WideInt) 3579545
- */
- && timeInfo.nominalFreq.QuadPart > (Tcl_WideInt) 15000000 ) {
-
+#if !defined(_WIN64)
+ if (timeInfo.perfCounterAvailable
+ /*
+ * The following lines would do an exact match on crystal
+ * frequency:
+ * && timeInfo.nominalFreq.QuadPart != (Tcl_WideInt)1193182
+ * && timeInfo.nominalFreq.QuadPart != (Tcl_WideInt)3579545
+ */
+ && timeInfo.nominalFreq.QuadPart > (Tcl_WideInt) 15000000){
/*
* As an exception, if every logical processor on the system
* is on the same chip, we use the performance counter anyway,
@@ -318,118 +371,109 @@ Tcl_GetTime(timePtr)
SYSTEM_INFO systemInfo;
unsigned int regs[4];
- GetSystemInfo( &systemInfo );
- if ( TclWinCPUID( 0, regs ) == TCL_OK
-
- && regs[1] == 0x756e6547 /* "Genu" */
- && regs[3] == 0x49656e69 /* "ineI" */
- && regs[2] == 0x6c65746e /* "ntel" */
-
- && TclWinCPUID( 1, regs ) == TCL_OK
-
- && ( (regs[0] & 0x00000F00) == 0x00000F00 /* Pentium 4 */
- || ( (regs[0] & 0x00F00000) /* Extended family */
- && (regs[3] & 0x10000000) ) ) /* Hyperthread */
- && ( ( ( regs[1] & 0x00FF0000 ) >> 16 ) /* CPU count */
- == systemInfo.dwNumberOfProcessors )
- ) {
+ GetSystemInfo(&systemInfo);
+ if (TclWinCPUID(0, regs) == TCL_OK
+ && regs[1] == 0x756e6547 /* "Genu" */
+ && regs[3] == 0x49656e69 /* "ineI" */
+ && regs[2] == 0x6c65746e /* "ntel" */
+ && TclWinCPUID(1, regs) == TCL_OK
+ && ((regs[0]&0x00000F00) == 0x00000F00 /* Pentium 4 */
+ || ((regs[0] & 0x00F00000) /* Extended family */
+ && (regs[3] & 0x10000000))) /* Hyperthread */
+ && (((regs[1]&0x00FF0000) >> 16)/* CPU count */
+ == systemInfo.dwNumberOfProcessors)) {
timeInfo.perfCounterAvailable = TRUE;
} else {
- timeInfo.perfCounterAvailable = FALSE;
- }
-
+ timeInfo.perfCounterAvailable = FALSE;
+ }
}
+#endif /* above code is Win32 only */
/*
* If the performance counter is available, start a thread to
* calibrate it.
*/
- if ( timeInfo.perfCounterAvailable ) {
+ if (timeInfo.perfCounterAvailable) {
DWORD id;
- InitializeCriticalSection( &timeInfo.cs );
- timeInfo.readyEvent = CreateEvent( NULL, FALSE, FALSE, NULL );
- timeInfo.exitEvent = CreateEvent( NULL, FALSE, FALSE, NULL );
- timeInfo.calibrationThread = CreateThread( NULL,
- 256,
- CalibrationThread,
- (LPVOID) NULL,
- 0,
- &id );
- SetThreadPriority( timeInfo.calibrationThread,
- THREAD_PRIORITY_HIGHEST );
+
+ InitializeCriticalSection(&timeInfo.cs);
+ timeInfo.readyEvent = CreateEvent(NULL, FALSE, FALSE, NULL);
+ timeInfo.exitEvent = CreateEvent(NULL, FALSE, FALSE, NULL);
+ timeInfo.calibrationThread = CreateThread(NULL, 256,
+ CalibrationThread, (LPVOID) NULL, 0, &id);
+ SetThreadPriority(timeInfo.calibrationThread,
+ THREAD_PRIORITY_HIGHEST);
/*
- * Wait for the thread just launched to start running,
- * and create an exit handler that kills it so that it
- * doesn't outlive unloading tclXX.dll
+ * Wait for the thread just launched to start running, and
+ * create an exit handler that kills it so that it doesn't
+ * outlive unloading tclXX.dll
*/
- WaitForSingleObject( timeInfo.readyEvent, INFINITE );
- CloseHandle( timeInfo.readyEvent );
- Tcl_CreateExitHandler( StopCalibration, (ClientData) NULL );
+ WaitForSingleObject(timeInfo.readyEvent, INFINITE);
+ CloseHandle(timeInfo.readyEvent);
+ Tcl_CreateExitHandler(StopCalibration, (ClientData) NULL);
}
timeInfo.initialized = TRUE;
}
TclpInitUnlock();
}
- if ( timeInfo.perfCounterAvailable ) {
+ if (timeInfo.perfCounterAvailable && timeInfo.curCounterFreq.QuadPart!=0) {
/*
- * Query the performance counter and use it to calculate the
- * current time.
+ * Query the performance counter and use it to calculate the current
+ * time.
*/
LARGE_INTEGER curCounter;
- /* Current performance counter */
-
- Tcl_WideInt curFileTime;
- /* Current estimated time, expressed
- * as 100-ns ticks since the Windows epoch */
-
+ /* Current performance counter. */
+ Tcl_WideInt curFileTime;/* Current estimated time, expressed as 100-ns
+ * ticks since the Windows epoch. */
static LARGE_INTEGER posixEpoch;
- /* Posix epoch expressed as 100-ns ticks
- * since the windows epoch */
-
+ /* Posix epoch expressed as 100-ns ticks since
+ * the windows epoch. */
Tcl_WideInt usecSincePosixEpoch;
- /* Current microseconds since Posix epoch */
+ /* Current microseconds since Posix epoch. */
posixEpoch.LowPart = 0xD53E8000;
posixEpoch.HighPart = 0x019DB1DE;
- EnterCriticalSection( &timeInfo.cs );
+ EnterCriticalSection(&timeInfo.cs);
- QueryPerformanceCounter( &curCounter );
+ QueryPerformanceCounter(&curCounter);
- /*
+ /*
* If it appears to be more than 1.1 seconds since the last trip
- * through the calibration loop, the performance counter may
- * have jumped forward. (See MSDN Knowledge Base article
- * Q274323 for a description of the hardware problem that makes
- * this test necessary.) If the counter jumps, we don't want
- * to use it directly. Instead, we must return system time.
- * Eventually, the calibration loop should recover.
+ * through the calibration loop, the performance counter may have
+ * jumped forward. (See MSDN Knowledge Base article Q274323 for a
+ * description of the hardware problem that makes this test
+ * necessary.) If the counter jumps, we don't want to use it directly.
+ * Instead, we must return system time. Eventually, the calibration
+ * loop should recover.
*/
- if ( curCounter.QuadPart - timeInfo.perfCounterLastCall.QuadPart
- < 11 * timeInfo.curCounterFreq.QuadPart / 10 ) {
- curFileTime = timeInfo.fileTimeLastCall.QuadPart
- + ( ( curCounter.QuadPart - timeInfo.perfCounterLastCall.QuadPart )
- * 10000000 / timeInfo.curCounterFreq.QuadPart );
+ if (curCounter.QuadPart - timeInfo.perfCounterLastCall.QuadPart <
+ 11 * timeInfo.curCounterFreq.QuadPart / 10) {
+ curFileTime = timeInfo.fileTimeLastCall.QuadPart +
+ ((curCounter.QuadPart - timeInfo.perfCounterLastCall.QuadPart)
+ * 10000000 / timeInfo.curCounterFreq.QuadPart);
timeInfo.fileTimeLastCall.QuadPart = curFileTime;
timeInfo.perfCounterLastCall.QuadPart = curCounter.QuadPart;
- usecSincePosixEpoch = ( curFileTime - posixEpoch.QuadPart ) / 10;
- timePtr->sec = (long) ( usecSincePosixEpoch / 1000000 );
- timePtr->usec = (unsigned long ) ( usecSincePosixEpoch % 1000000 );
+ usecSincePosixEpoch = (curFileTime - posixEpoch.QuadPart) / 10;
+ timePtr->sec = (long) (usecSincePosixEpoch / 1000000);
+ timePtr->usec = (unsigned long) (usecSincePosixEpoch % 1000000);
useFtime = 0;
}
- LeaveCriticalSection( &timeInfo.cs );
+ LeaveCriticalSection(&timeInfo.cs);
}
- if ( useFtime ) {
- /* High resolution timer is not available. Just use ftime */
+ if (useFtime) {
+ /*
+ * High resolution timer is not available. Just use ftime.
+ */
ftime(&t);
timePtr->sec = (long)t.time;
@@ -449,20 +493,26 @@ Tcl_GetTime(timePtr)
* None.
*
* Side effects:
- * Sets the 'exitEvent' event in the 'timeInfo' structure to ask
- * the thread in question to exit, and waits for it to do so.
+ * Sets the 'exitEvent' event in the 'timeInfo' structure to ask the
+ * thread in question to exit, and waits for it to do so.
*
*----------------------------------------------------------------------
*/
static void
-StopCalibration( ClientData unused )
- /* Client data is unused */
+StopCalibration(
+ ClientData unused) /* Client data is unused */
{
- SetEvent( timeInfo.exitEvent );
- WaitForSingleObject( timeInfo.calibrationThread, INFINITE );
- CloseHandle( timeInfo.exitEvent );
- CloseHandle( timeInfo.calibrationThread );
+ SetEvent(timeInfo.exitEvent);
+
+ /*
+ * If Tcl_Finalize was called from DllMain, the calibration thread is in a
+ * paused state so we need to timeout and continue.
+ */
+
+ WaitForSingleObject(timeInfo.calibrationThread, 100);
+ CloseHandle(timeInfo.exitEvent);
+ CloseHandle(timeInfo.calibrationThread);
}
/*
@@ -482,9 +532,10 @@ StopCalibration( ClientData unused )
*/
char *
-TclpGetTZName(int dst)
+TclpGetTZName(
+ int dst)
{
- size_t len;
+ int len;
char *zone, *p;
TIME_ZONE_INFORMATION tz;
Tcl_Encoding encoding;
@@ -495,9 +546,9 @@ TclpGetTZName(int dst)
* tzset() under Borland doesn't seem to set up tzname[] at all.
* tzset() under MSVC has the following weird observed behavior:
* First time we call "clock format [clock seconds] -format %Z -gmt 1"
- * we get "GMT", but on all subsequent calls we get the current time
- * zone string, even though env(TZ) is GMT and the variable _timezone
- * is 0.
+ * we get "GMT", but on all subsequent calls we get the current time
+ * ezone string, even though env(TZ) is GMT and the variable _timezone
+ * is 0.
*/
name[0] = '\0';
@@ -505,11 +556,10 @@ TclpGetTZName(int dst)
zone = getenv("TZ");
if (zone != NULL) {
/*
- * TZ is of form "NST-4:30NDT", where "NST" would be the
- * name of the standard time zone for this area, "-4:30" is
- * the offset from GMT in hours, and "NDT is the name of
- * the daylight savings time zone in this area. The offset
- * and DST strings are optional.
+ * TZ is of form "NST-4:30NDT", where "NST" would be the name of the
+ * standard time zone for this area, "-4:30" is the offset from GMT in
+ * hours, and "NDT is the name of the daylight savings time zone in
+ * this area. The offset and DST strings are optional.
*/
len = strlen(zone);
@@ -531,23 +581,24 @@ TclpGetTZName(int dst)
}
}
}
- Tcl_ExternalToUtf(NULL, NULL, zone, (int)len, 0, NULL, name,
+ Tcl_ExternalToUtf(NULL, NULL, zone, len, 0, NULL, name,
sizeof(tsdPtr->tzName), NULL, NULL, NULL);
}
if (name[0] == '\0') {
if (GetTimeZoneInformation(&tz) == TIME_ZONE_ID_UNKNOWN) {
/*
- * MSDN: On NT this is returned if DST is not used in
- * the current TZ
+ * MSDN: On NT this is returned if DST is not used in the current
+ * TZ
*/
+
dst = 0;
}
encoding = Tcl_GetEncoding(NULL, "unicode");
- Tcl_ExternalToUtf(NULL, encoding,
- (char *) ((dst) ? tz.DaylightName : tz.StandardName), -1,
+ Tcl_ExternalToUtf(NULL, encoding,
+ (char *) ((dst) ? tz.DaylightName : tz.StandardName), -1,
0, NULL, name, sizeof(tsdPtr->tzName), NULL, NULL, NULL);
Tcl_FreeEncoding(encoding);
- }
+ }
return name;
}
@@ -556,9 +607,9 @@ TclpGetTZName(int dst)
*
* TclpGetDate --
*
- * This function converts between seconds and struct tm. If
- * useGMT is true, then the returned date will be in Greenwich
- * Mean Time (GMT). Otherwise, it will be in the local time zone.
+ * This function converts between seconds and struct tm. If useGMT is
+ * true, then the returned date will be in Greenwich Mean Time (GMT).
+ * Otherwise, it will be in the local time zone.
*
* Results:
* Returns a static tm structure.
@@ -570,11 +621,10 @@ TclpGetTZName(int dst)
*/
struct tm *
-TclpGetDate(t, useGMT)
- TclpTime_t t;
- int useGMT;
+TclpGetDate(
+ CONST time_t *t,
+ int useGMT)
{
- const time_t *tp = (const time_t *) t;
struct tm *tmPtr;
time_t time;
@@ -582,28 +632,44 @@ TclpGetDate(t, useGMT)
tzset();
/*
- * If we are in the valid range, let the C run-time library
- * handle it. Otherwise we need to fake it. Note that this
- * algorithm ignores daylight savings time before the epoch.
+ * If we are in the valid range, let the C run-time library handle it.
+ * Otherwise we need to fake it. Note that this algorithm ignores
+ * daylight savings time before the epoch.
*/
- if (*tp >= 0) {
- return localtime(tp);
+ /*
+ * Hm, Borland's localtime manages to return NULL under certain
+ * circumstances (e.g. wintime.test, test 1.2). Nobody tests for this,
+ * since 'localtime' isn't supposed to do this, possibly leading to
+ * crashes.
+ *
+ * Patch: We only call this function if we are at least one day into
+ * the epoch, else we handle it ourselves (like we do for times < 0).
+ * H. Giese, June 2003
+ */
+
+#ifdef __BORLANDC__
+#define LOCALTIME_VALIDITY_BOUNDARY SECSPERDAY
+#else
+#define LOCALTIME_VALIDITY_BOUNDARY 0
+#endif
+
+ if (*t >= LOCALTIME_VALIDITY_BOUNDARY) {
+ return TclpLocaltime(t);
}
- time = *tp - _timezone;
+ time = *t - timezone;
/*
* If we aren't near to overflowing the long, just add the bias and
- * use the normal calculation. Otherwise we will need to adjust
- * the result at the end.
+ * use the normal calculation. Otherwise we will need to adjust the
+ * result at the end.
*/
- if (*tp < (LONG_MAX - 2 * SECSPERDAY)
- && *tp > (LONG_MIN + 2 * SECSPERDAY)) {
+ if (*t < (LONG_MAX - 2*SECSPERDAY) && *t > (LONG_MIN + 2*SECSPERDAY)) {
tmPtr = ComputeGMT(&time);
} else {
- tmPtr = ComputeGMT(tp);
+ tmPtr = ComputeGMT(t);
tzset();
@@ -612,7 +678,7 @@ TclpGetDate(t, useGMT)
* Propagate seconds overflow into minutes, hours and days.
*/
- time = tmPtr->tm_sec - _timezone;
+ time = tmPtr->tm_sec - timezone;
tmPtr->tm_sec = (int)(time % 60);
if (tmPtr->tm_sec < 0) {
tmPtr->tm_sec += 60;
@@ -639,7 +705,7 @@ TclpGetDate(t, useGMT)
tmPtr->tm_wday = (tmPtr->tm_wday + (int)time) % 7;
}
} else {
- tmPtr = ComputeGMT(tp);
+ tmPtr = ComputeGMT(t);
}
return tmPtr;
}
@@ -649,8 +715,8 @@ TclpGetDate(t, useGMT)
*
* ComputeGMT --
*
- * This function computes GMT given the number of seconds since
- * the epoch (midnight Jan 1 1970).
+ * This function computes GMT given the number of seconds since the epoch
+ * (midnight Jan 1 1970).
*
* Results:
* Returns a (per thread) statically allocated struct tm.
@@ -662,8 +728,8 @@ TclpGetDate(t, useGMT)
*/
static struct tm *
-ComputeGMT(tp)
- const time_t *tp;
+ComputeGMT(
+ const time_t *tp)
{
struct tm *tmPtr;
long tmp, rem;
@@ -678,7 +744,7 @@ ComputeGMT(tp)
*/
tmp = (long)(*tp / SECSPER4YEAR);
- rem = (LONG)(*tp % SECSPER4YEAR);
+ rem = (long)(*tp % SECSPER4YEAR);
/*
* Correct for weird mod semantics so the remainder is always positive.
@@ -690,9 +756,9 @@ ComputeGMT(tp)
}
/*
- * Compute the year after 1900 by taking the 4 year span and adjusting
- * for the remainder. This works because 2000 is a leap year, and
- * 1900/2100 are out of the range.
+ * Compute the year after 1900 by taking the 4 year span and adjusting for
+ * the remainder. This works because 2000 is a leap year, and 1900/2100
+ * are out of the range.
*/
tmp = (tmp * 4) + 70;
@@ -714,13 +780,13 @@ ComputeGMT(tp)
tmPtr->tm_year = tmp;
/*
- * Compute the day of year and leave the seconds in the current day in
- * the remainder.
+ * Compute the day of year and leave the seconds in the current day in the
+ * remainder.
*/
tmPtr->tm_yday = rem / SECSPERDAY;
rem %= SECSPERDAY;
-
+
/*
* Compute the time of day.
*/
@@ -736,6 +802,7 @@ ComputeGMT(tp)
days = (isLeap) ? leapDays : normalDays;
for (tmp = 1; days[tmp] < tmPtr->tm_yday; tmp++) {
+ /* empty body */
}
tmPtr->tm_mon = --tmp;
tmPtr->tm_mday = tmPtr->tm_yday - days[tmp];
@@ -761,60 +828,66 @@ ComputeGMT(tp)
*
* CalibrationThread --
*
- * Thread that manages calibration of the hi-resolution time
- * derived from the performance counter, to keep it synchronized
- * with the system clock.
+ * Thread that manages calibration of the hi-resolution time derived from
+ * the performance counter, to keep it synchronized with the system
+ * clock.
*
* Parameters:
- * arg -- Client data from the CreateThread call. This parameter
- * points to the static TimeInfo structure.
+ * arg - Client data from the CreateThread call. This parameter points to
+ * the static TimeInfo structure.
*
* Return value:
- * None. This thread embeds an infinite loop.
+ * None. This thread embeds an infinite loop.
*
* Side effects:
- * At an interval of 1 s, this thread performs virtual time discipline.
+ * At an interval of 1s, this thread performs virtual time discipline.
*
- * Note: When this thread is entered, TclpInitLock has been called
- * to safeguard the static storage. There is therefore no synchronization
- * in the body of this procedure.
+ * Note: When this thread is entered, TclpInitLock has been called to
+ * safeguard the static storage. There is therefore no synchronization in the
+ * body of this procedure.
*
*----------------------------------------------------------------------
*/
static DWORD WINAPI
-CalibrationThread( LPVOID arg )
+CalibrationThread(
+ LPVOID arg)
{
FILETIME curFileTime;
DWORD waitResult;
- /* Get initial system time and performance counter */
+ /*
+ * Get initial system time and performance counter.
+ */
- GetSystemTimeAsFileTime( &curFileTime );
- QueryPerformanceCounter( &timeInfo.perfCounterLastCall );
- QueryPerformanceFrequency( &timeInfo.curCounterFreq );
+ GetSystemTimeAsFileTime(&curFileTime);
+ QueryPerformanceCounter(&timeInfo.perfCounterLastCall);
+ QueryPerformanceFrequency(&timeInfo.curCounterFreq);
timeInfo.fileTimeLastCall.LowPart = curFileTime.dwLowDateTime;
timeInfo.fileTimeLastCall.HighPart = curFileTime.dwHighDateTime;
- ResetCounterSamples( timeInfo.fileTimeLastCall.QuadPart,
- timeInfo.perfCounterLastCall.QuadPart,
- timeInfo.curCounterFreq.QuadPart );
+ ResetCounterSamples(timeInfo.fileTimeLastCall.QuadPart,
+ timeInfo.perfCounterLastCall.QuadPart,
+ timeInfo.curCounterFreq.QuadPart);
/*
- * Wake up the calling thread. When it wakes up, it will release the
+ * Wake up the calling thread. When it wakes up, it will release the
* initialization lock.
*/
- SetEvent( timeInfo.readyEvent );
+ SetEvent(timeInfo.readyEvent);
- /* Run the calibration once a second */
-
- for ( ; ; ) {
+ /*
+ * Run the calibration once a second.
+ */
- /* If the exitEvent is set, break out of the loop. */
+ while (timeInfo.perfCounterAvailable) {
+ /*
+ * If the exitEvent is set, break out of the loop.
+ */
waitResult = WaitForSingleObjectEx(timeInfo.exitEvent, 1000, FALSE);
- if ( waitResult == WAIT_OBJECT_0 ) {
+ if (waitResult == WAIT_OBJECT_0) {
break;
}
UpdateTimeEachSecond();
@@ -829,11 +902,11 @@ CalibrationThread( LPVOID arg )
*
* UpdateTimeEachSecond --
*
- * Callback from the waitable timer in the clock calibration thread
- * that updates system time.
+ * Callback from the waitable timer in the clock calibration thread that
+ * updates system time.
*
* Parameters:
- * info -- Pointer to the static TimeInfo structure
+ * info - Pointer to the static TimeInfo structure
*
* Results:
* None.
@@ -845,113 +918,116 @@ CalibrationThread( LPVOID arg )
*/
static void
-UpdateTimeEachSecond()
+UpdateTimeEachSecond(void)
{
-
LARGE_INTEGER curPerfCounter;
/* Current value returned from
- * QueryPerformanceCounter */
-
- FILETIME curSysTime; /* Current system time */
-
- LARGE_INTEGER curFileTime; /* File time at the time this callback
- * was scheduled. */
-
- Tcl_WideInt estFreq; /* Estimated perf counter frequency */
-
- Tcl_WideInt vt0; /* Tcl time right now */
- Tcl_WideInt vt1; /* Tcl time one second from now */
-
- Tcl_WideInt tdiff; /* Difference between system clock and
- * Tcl time. */
-
- Tcl_WideInt driftFreq; /* Frequency needed to drift virtual time
- * into step over 1 second */
+ * QueryPerformanceCounter. */
+ FILETIME curSysTime; /* Current system time. */
+ LARGE_INTEGER curFileTime; /* File time at the time this callback was
+ * scheduled. */
+ Tcl_WideInt estFreq; /* Estimated perf counter frequency. */
+ Tcl_WideInt vt0; /* Tcl time right now. */
+ Tcl_WideInt vt1; /* Tcl time one second from now. */
+ Tcl_WideInt tdiff; /* Difference between system clock and Tcl
+ * time. */
+ Tcl_WideInt driftFreq; /* Frequency needed to drift virtual time into
+ * step over 1 second. */
/*
* Sample performance counter and system time.
*/
- QueryPerformanceCounter( &curPerfCounter );
- GetSystemTimeAsFileTime( &curSysTime );
+ QueryPerformanceCounter(&curPerfCounter);
+ GetSystemTimeAsFileTime(&curSysTime);
curFileTime.LowPart = curSysTime.dwLowDateTime;
curFileTime.HighPart = curSysTime.dwHighDateTime;
- EnterCriticalSection( &timeInfo.cs );
+ EnterCriticalSection(&timeInfo.cs);
/*
- * Several things may have gone wrong here that have to
- * be checked for.
- * (1) The performance counter may have jumped.
- * (2) The system clock may have been reset.
- *
- * In either case, we'll need to reinitialize the circular buffer
- * with samples relative to the current system time and the NOMINAL
- * performance frequency (not the actual, because the actual has
- * probably run slow in the first case). Our estimated frequency
- * will be the nominal frequency.
+ * We devide by timeInfo.curCounterFreq.QuadPart in several places. That
+ * value should always be positive on a correctly functioning system. But
+ * it is good to be defensive about such matters. So if something goes
+ * wrong and the value does goes to zero, we clear the
+ * timeInfo.perfCounterAvailable in order to cause the calibration thread
+ * to shut itself down, then return without additional processing.
*/
+ if (timeInfo.curCounterFreq.QuadPart == 0){
+ LeaveCriticalSection(&timeInfo.cs);
+ timeInfo.perfCounterAvailable = 0;
+ return;
+ }
+
/*
- * Store the current sample into the circular buffer of samples,
- * and estimate the performance counter frequency.
+ * Several things may have gone wrong here that have to be checked for.
+ * (1) The performance counter may have jumped.
+ * (2) The system clock may have been reset.
+ *
+ * In either case, we'll need to reinitialize the circular buffer with
+ * samples relative to the current system time and the NOMINAL performance
+ * frequency (not the actual, because the actual has probably run slow in
+ * the first case). Our estimated frequency will be the nominal frequency.
+ *
+ * Store the current sample into the circular buffer of samples, and
+ * estimate the performance counter frequency.
*/
- estFreq = AccumulateSample( curPerfCounter.QuadPart,
- (Tcl_WideUInt) curFileTime.QuadPart );
+ estFreq = AccumulateSample(curPerfCounter.QuadPart,
+ (Tcl_WideUInt) curFileTime.QuadPart);
/*
* We want to adjust things so that time appears to be continuous.
- * Virtual file time, right now, is
+ * Virtual file time, right now, is
*
- * vt0 = 10000000 * ( curPerfCounter - perfCounterLastCall )
- * / curCounterFreq
- * + fileTimeLastCall
+ * vt0 = 10000000 * (curPerfCounter - perfCounterLastCall)
+ * / curCounterFreq
+ * + fileTimeLastCall
*
- * Ideally, we would like to drift the clock into place over a
- * period of 2 sec, so that virtual time 2 sec from now will be
+ * Ideally, we would like to drift the clock into place over a period of 2
+ * sec, so that virtual time 2 sec from now will be
*
* vt1 = 20000000 + curFileTime
- *
- * The frequency that we need to use to drift the counter back into
- * place is estFreq * 20000000 / ( vt1 - vt0 )
+ *
+ * The frequency that we need to use to drift the counter back into place
+ * is estFreq * 20000000 / (vt1 - vt0)
*/
-
- vt0 = 10000000 * ( curPerfCounter.QuadPart
- - timeInfo.perfCounterLastCall.QuadPart )
- / timeInfo.curCounterFreq.QuadPart
- + timeInfo.fileTimeLastCall.QuadPart;
+
+ vt0 = 10000000 * (curPerfCounter.QuadPart
+ - timeInfo.perfCounterLastCall.QuadPart)
+ / timeInfo.curCounterFreq.QuadPart
+ + timeInfo.fileTimeLastCall.QuadPart;
vt1 = 20000000 + curFileTime.QuadPart;
/*
- * If we've gotten more than a second away from system time,
- * then drifting the clock is going to be pretty hopeless.
- * Just let it jump. Otherwise, compute the drift frequency and
- * fill in everything.
+ * If we've gotten more than a second away from system time, then drifting
+ * the clock is going to be pretty hopeless. Just let it jump. Otherwise,
+ * compute the drift frequency and fill in everything.
*/
tdiff = vt0 - curFileTime.QuadPart;
- if ( tdiff > 10000000 || tdiff < -10000000 ) {
+ if (tdiff > 10000000 || tdiff < -10000000) {
timeInfo.fileTimeLastCall.QuadPart = curFileTime.QuadPart;
timeInfo.curCounterFreq.QuadPart = estFreq;
} else {
- driftFreq = estFreq * 20000000 / ( vt1 - vt0 );
- if ( driftFreq > 1003 * estFreq / 1000 ) {
- driftFreq = 1003 * estFreq / 1000;
- }
- if ( driftFreq < 997 * estFreq / 1000 ) {
- driftFreq = 997 * estFreq / 1000;
+ driftFreq = estFreq * 20000000 / (vt1 - vt0);
+
+ if (driftFreq > 1003*estFreq/1000) {
+ driftFreq = 1003*estFreq/1000;
+ } else if (driftFreq < 997*estFreq/1000) {
+ driftFreq = 997*estFreq/1000;
}
+
timeInfo.fileTimeLastCall.QuadPart = vt0;
timeInfo.curCounterFreq.QuadPart = driftFreq;
}
timeInfo.perfCounterLastCall.QuadPart = curPerfCounter.QuadPart;
- LeaveCriticalSection( &timeInfo.cs );
-
+ LeaveCriticalSection(&timeInfo.cs);
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -964,23 +1040,21 @@ UpdateTimeEachSecond()
* None.
*
* Side effects:
- * The array of samples is filled in so that it appears that there
- * are SAMPLES samples at one-second intervals, separated by precisely
- * the given frequency.
+ * The array of samples is filled in so that it appears that there are
+ * SAMPLES samples at one-second intervals, separated by precisely the
+ * given frequency.
*
*----------------------------------------------------------------------
*/
static void
-ResetCounterSamples( Tcl_WideUInt fileTime,
- /* Current file time */
- Tcl_WideInt perfCounter,
- /* Current performance counter */
- Tcl_WideInt perfFreq )
- /* Target performance frequency */
+ResetCounterSamples(
+ Tcl_WideUInt fileTime, /* Current file time */
+ Tcl_WideInt perfCounter, /* Current performance counter */
+ Tcl_WideInt perfFreq) /* Target performance frequency */
{
int i;
- for ( i = SAMPLES-1; i >= 0; --i ) {
+ for (i=SAMPLES-1 ; i>=0 ; --i) {
timeInfo.perfCounterSample[i] = perfCounter;
timeInfo.fileTimeSample[i] = fileTime;
perfCounter -= perfFreq;
@@ -994,87 +1068,84 @@ ResetCounterSamples( Tcl_WideUInt fileTime,
*
* AccumulateSample --
*
- * Updates the circular buffer of performance counter and system
- * time samples with a new data point.
+ * Updates the circular buffer of performance counter and system time
+ * samples with a new data point.
*
* Results:
* None.
*
* Side effects:
- * The new data point replaces the oldest point in the circular
- * buffer, and the descriptive statistics are updated to accumulate
- * the new point.
- *
- * Several things may have gone wrong here that have to
- * be checked for.
- * (1) The performance counter may have jumped.
- * (2) The system clock may have been reset.
- *
- * In either case, we'll need to reinitialize the circular buffer
- * with samples relative to the current system time and the NOMINAL
- * performance frequency (not the actual, because the actual has
- * probably run slow in the first case).
+ * The new data point replaces the oldest point in the circular buffer,
+ * and the descriptive statistics are updated to accumulate the new
+ * point.
+ *
+ * Several things may have gone wrong here that have to be checked for.
+ * (1) The performance counter may have jumped.
+ * (2) The system clock may have been reset.
+ *
+ * In either case, we'll need to reinitialize the circular buffer with samples
+ * relative to the current system time and the NOMINAL performance frequency
+ * (not the actual, because the actual has probably run slow in the first
+ * case).
*/
static Tcl_WideInt
-AccumulateSample( Tcl_WideInt perfCounter,
- Tcl_WideUInt fileTime )
+AccumulateSample(
+ Tcl_WideInt perfCounter,
+ Tcl_WideUInt fileTime)
{
- Tcl_WideUInt workFTSample; /* File time sample being removed
- * from or added to the circular buffer */
-
- Tcl_WideInt workPCSample; /* Performance counter sample being
- * removed from or added to the circular
- * buffer */
-
+ Tcl_WideUInt workFTSample; /* File time sample being removed from or
+ * added to the circular buffer. */
+ Tcl_WideInt workPCSample; /* Performance counter sample being removed
+ * from or added to the circular buffer. */
Tcl_WideUInt lastFTSample; /* Last file time sample recorded */
-
Tcl_WideInt lastPCSample; /* Last performance counter sample recorded */
-
Tcl_WideInt FTdiff; /* Difference between last FT and current */
-
Tcl_WideInt PCdiff; /* Difference between last PC and current */
-
Tcl_WideInt estFreq; /* Estimated performance counter frequency */
- /* Test for jumps and reset the samples if we have one. */
+ /*
+ * Test for jumps and reset the samples if we have one.
+ */
- if ( timeInfo.sampleNo == 0 ) {
- lastPCSample = timeInfo.perfCounterSample[ timeInfo.sampleNo
- + SAMPLES - 1 ];
- lastFTSample = timeInfo.fileTimeSample[ timeInfo.sampleNo
- + SAMPLES - 1 ];
+ if (timeInfo.sampleNo == 0) {
+ lastPCSample =
+ timeInfo.perfCounterSample[timeInfo.sampleNo + SAMPLES - 1];
+ lastFTSample =
+ timeInfo.fileTimeSample[timeInfo.sampleNo + SAMPLES - 1];
} else {
- lastPCSample = timeInfo.perfCounterSample[ timeInfo.sampleNo - 1 ];
- lastFTSample = timeInfo.fileTimeSample[ timeInfo.sampleNo - 1 ];
+ lastPCSample = timeInfo.perfCounterSample[timeInfo.sampleNo - 1];
+ lastFTSample = timeInfo.fileTimeSample[timeInfo.sampleNo - 1];
}
+
PCdiff = perfCounter - lastPCSample;
FTdiff = fileTime - lastFTSample;
- if ( PCdiff < timeInfo.nominalFreq.QuadPart * 9 / 10
- || PCdiff > timeInfo.nominalFreq.QuadPart * 11 / 10
- || FTdiff < 9000000
- || FTdiff > 11000000 ) {
- ResetCounterSamples( fileTime, perfCounter,
- timeInfo.nominalFreq.QuadPart );
+ if (PCdiff < timeInfo.nominalFreq.QuadPart * 9 / 10
+ || PCdiff > timeInfo.nominalFreq.QuadPart * 11 / 10
+ || FTdiff < 9000000 || FTdiff > 11000000) {
+ ResetCounterSamples(fileTime, perfCounter,
+ timeInfo.nominalFreq.QuadPart);
return timeInfo.nominalFreq.QuadPart;
-
} else {
-
- /* Estimate the frequency */
-
- workPCSample = timeInfo.perfCounterSample[ timeInfo.sampleNo ];
- workFTSample = timeInfo.fileTimeSample[ timeInfo.sampleNo ];
- estFreq = 10000000 * ( perfCounter - workPCSample )
- / ( fileTime - workFTSample );
- timeInfo.perfCounterSample[ timeInfo.sampleNo ] = perfCounter;
- timeInfo.fileTimeSample[ timeInfo.sampleNo ] = (Tcl_WideInt) fileTime;
-
- /* Advance the sample number */
-
- if ( ++timeInfo.sampleNo >= SAMPLES ) {
+ /*
+ * Estimate the frequency.
+ */
+
+ workPCSample = timeInfo.perfCounterSample[timeInfo.sampleNo];
+ workFTSample = timeInfo.fileTimeSample[timeInfo.sampleNo];
+ estFreq = 10000000 * (perfCounter - workPCSample)
+ / (fileTime - workFTSample);
+ timeInfo.perfCounterSample[timeInfo.sampleNo] = perfCounter;
+ timeInfo.fileTimeSample[timeInfo.sampleNo] = (Tcl_WideInt) fileTime;
+
+ /*
+ * Advance the sample number.
+ */
+
+ if (++timeInfo.sampleNo >= SAMPLES) {
timeInfo.sampleNo = 0;
- }
-
+ }
+
return estFreq;
}
}
@@ -1084,8 +1155,7 @@ AccumulateSample( Tcl_WideInt perfCounter,
*
* TclpGmtime --
*
- * Wrapper around the 'gmtime' library function to make it thread
- * safe.
+ * Wrapper around the 'gmtime' library function to make it thread safe.
*
* Results:
* Returns a pointer to a 'struct tm' in thread-specific data.
@@ -1097,18 +1167,17 @@ AccumulateSample( Tcl_WideInt perfCounter,
*/
struct tm *
-TclpGmtime( tt )
- TclpTime_t_CONST tt;
+TclpGmtime(
+ CONST time_t *timePtr) /* Pointer to the number of seconds since the
+ * local system's epoch */
{
- CONST time_t *timePtr = (CONST time_t *) tt;
- /* Pointer to the number of seconds
- * since the local system's epoch */
/*
- * The MS implementation of gmtime is thread safe because
- * it returns the time in a block of thread-local storage,
- * and Windows does not provide a Posix gmtime_r function.
+ * The MS implementation of gmtime is thread safe because it returns the
+ * time in a block of thread-local storage, and Windows does not provide a
+ * Posix gmtime_r function.
*/
- return gmtime( timePtr );
+
+ return gmtime(timePtr);
}
/*
@@ -1129,17 +1198,85 @@ TclpGmtime( tt )
*/
struct tm *
-TclpLocaltime( tt )
- TclpTime_t_CONST tt;
-{
- CONST time_t *timePtr = (CONST time_t *) tt;
- /* Pointer to the number of seconds
- * since the local system's epoch */
+TclpLocaltime(
+ CONST time_t *timePtr) /* Pointer to the number of seconds since the
+ * local system's epoch */
+{
/*
- * The MS implementation of localtime is thread safe because
- * it returns the time in a block of thread-local storage,
- * and Windows does not provide a Posix localtime_r function.
+ * The MS implementation of localtime is thread safe because it returns
+ * the time in a block of thread-local storage, and Windows does not
+ * provide a Posix localtime_r function.
*/
- return localtime( timePtr );
+
+ return localtime(timePtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetTimeProc --
+ *
+ * TIP #233 (Virtualized Time): Registers two handlers for the
+ * virtualization of Tcl's access to time information.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Remembers the handlers, alters core behaviour.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_SetTimeProc(
+ Tcl_GetTimeProc *getProc,
+ Tcl_ScaleTimeProc *scaleProc,
+ ClientData clientData)
+{
+ tclGetTimeProcPtr = getProc;
+ tclScaleTimeProcPtr = scaleProc;
+ tclTimeClientData = clientData;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_QueryTimeProc --
+ *
+ * TIP #233 (Virtualized Time): Query which time handlers are registered.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_QueryTimeProc(
+ Tcl_GetTimeProc **getProc,
+ Tcl_ScaleTimeProc **scaleProc,
+ ClientData *clientData)
+{
+ if (getProc) {
+ *getProc = tclGetTimeProcPtr;
+ }
+ if (scaleProc) {
+ *scaleProc = tclScaleTimeProcPtr;
+ }
+ if (clientData) {
+ *clientData = tclTimeClientData;
+ }
}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/win/tclsh.rc b/win/tclsh.rc
index a1b0b76..16eaf83 100644
--- a/win/tclsh.rc
+++ b/win/tclsh.rc
@@ -7,20 +7,20 @@
//
// build-up the name suffix that defines the type of build this is.
//
-#ifdef TCL_THREADS
+#if TCL_THREADS
#define SUFFIX_THREADS "t"
#else
#define SUFFIX_THREADS ""
#endif
-#ifdef STATIC_BUILD
+#if STATIC_BUILD
#define SUFFIX_STATIC "s"
#else
#define SUFFIX_STATIC ""
#endif
-#ifdef DEBUG
-#define SUFFIX_DEBUG "d"
+#if DEBUG && !UNCHECKED
+#define SUFFIX_DEBUG "g"
#else
#define SUFFIX_DEBUG ""
#endif
@@ -48,7 +48,7 @@ BEGIN
BLOCK "040904b0"
BEGIN
VALUE "FileDescription", "Tclsh Application\0"
- VALUE "OriginalFilename", "tclsh" STRINGIFY(JOIN(TCL_MAJOR_VERSION,TCL_MINOR_VERSION)) SUFFIX ".exe\0"
+ VALUE "OriginalFilename", "tclsh" STRINGIFY(TCL_MAJOR_VERSION) STRINGIFY(TCL_MINOR_VERSION) SUFFIX ".exe\0"
VALUE "CompanyName", "ActiveState Corporation\0"
VALUE "FileVersion", TCL_PATCH_LEVEL
VALUE "LegalCopyright", "Copyright \251 2000 by ActiveState Corporation, et al\0"