summaryrefslogtreecommitdiffstats
path: root/tcl8.6/win
diff options
context:
space:
mode:
authorWilliam Joye <wjoye@cfa.harvard.edu>2018-12-25 19:55:50 (GMT)
committerWilliam Joye <wjoye@cfa.harvard.edu>2018-12-25 19:55:50 (GMT)
commitff51550ee89b473c63df78de6b2a413f21105687 (patch)
treebcdca927ed2a7b05c647b9a6bfdfd4a7ca5c730e /tcl8.6/win
parent01cbf5b15ea760408c24288ccb5cf8e0af9aa299 (diff)
downloadblt-ff51550ee89b473c63df78de6b2a413f21105687.zip
blt-ff51550ee89b473c63df78de6b2a413f21105687.tar.gz
blt-ff51550ee89b473c63df78de6b2a413f21105687.tar.bz2
update tcl/tk
Diffstat (limited to 'tcl8.6/win')
-rw-r--r--tcl8.6/win/Makefile.in882
-rw-r--r--tcl8.6/win/README99
-rw-r--r--tcl8.6/win/aclocal.m41
-rw-r--r--tcl8.6/win/buildall.vc.bat103
-rw-r--r--tcl8.6/win/cat.c41
-rw-r--r--tcl8.6/win/coffbase.txt43
-rwxr-xr-xtcl8.6/win/configure6300
-rw-r--r--tcl8.6/win/configure.in465
-rw-r--r--tcl8.6/win/license.terms40
-rw-r--r--tcl8.6/win/makefile.vc941
-rw-r--r--tcl8.6/win/nmakehlp.c815
-rw-r--r--tcl8.6/win/rules-ext.vc118
-rw-r--r--tcl8.6/win/rules.vc1752
-rw-r--r--tcl8.6/win/targets.vc98
-rw-r--r--tcl8.6/win/tcl.dsp1563
-rw-r--r--tcl8.6/win/tcl.dsw29
-rw-r--r--tcl8.6/win/tcl.hpj.in19
-rw-r--r--tcl8.6/win/tcl.m41299
-rw-r--r--tcl8.6/win/tcl.rc57
-rw-r--r--tcl8.6/win/tclAppInit.c340
-rw-r--r--tcl8.6/win/tclConfig.sh.in181
-rw-r--r--tcl8.6/win/tclWin32Dll.c792
-rw-r--r--tcl8.6/win/tclWinChan.c1588
-rw-r--r--tcl8.6/win/tclWinConsole.c1427
-rw-r--r--tcl8.6/win/tclWinDde.c1942
-rw-r--r--tcl8.6/win/tclWinError.c428
-rw-r--r--tcl8.6/win/tclWinFCmd.c1967
-rwxr-xr-xtcl8.6/win/tclWinFile.c3264
-rw-r--r--tcl8.6/win/tclWinInit.c748
-rw-r--r--tcl8.6/win/tclWinInt.h166
-rw-r--r--tcl8.6/win/tclWinLoad.c430
-rw-r--r--tcl8.6/win/tclWinNotify.c608
-rw-r--r--tcl8.6/win/tclWinPipe.c3588
-rw-r--r--tcl8.6/win/tclWinPort.h574
-rw-r--r--tcl8.6/win/tclWinReg.c1546
-rw-r--r--tcl8.6/win/tclWinSerial.c2236
-rw-r--r--tcl8.6/win/tclWinSock.c3376
-rw-r--r--tcl8.6/win/tclWinTest.c663
-rw-r--r--tcl8.6/win/tclWinThrd.c1104
-rw-r--r--tcl8.6/win/tclWinTime.c1183
-rw-r--r--tcl8.6/win/tclooConfig.sh19
-rw-r--r--tcl8.6/win/tclsh.exe.manifest.in53
-rw-r--r--tcl8.6/win/tclsh.icobin57022 -> 0 bytes
-rw-r--r--tcl8.6/win/tclsh.rc82
44 files changed, 0 insertions, 42970 deletions
diff --git a/tcl8.6/win/Makefile.in b/tcl8.6/win/Makefile.in
deleted file mode 100644
index 9d955cd..0000000
--- a/tcl8.6/win/Makefile.in
+++ /dev/null
@@ -1,882 +0,0 @@
-#
-# 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).
-#--------------------------------------------------------------------------
-
-# 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@
-bindir = @bindir@
-libdir = @libdir@
-includedir = @includedir@
-datarootdir = @datarootdir@
-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.
-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):
-TCL_LIBRARY = $(prefix)/lib/tcl$(VERSION)
-
-# Path to use at runtime to refer to LIB_INSTALL_DIR:
-LIB_RUNTIME_DIR = $(libdir)
-
-# Directory in which to install the program tclsh:
-BIN_INSTALL_DIR = $(INSTALL_ROOT)$(bindir)
-
-# Directory in which to install the .a or .so binary for the Tcl library:
-LIB_INSTALL_DIR = $(INSTALL_ROOT)$(libdir)
-
-# Path name to use when installing library scripts.
-SCRIPT_INSTALL_DIR = $(INSTALL_ROOT)$(TCL_LIBRARY)
-
-# Directory in which to install the include file tcl.h:
-INCLUDE_INSTALL_DIR = $(INSTALL_ROOT)$(includedir)
-
-# Directory in which to (optionally) install the private tcl headers:
-PRIVATE_INCLUDE_INSTALL_DIR = $(INSTALL_ROOT)$(includedir)
-
-# Top-level directory in which to install manual entries:
-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:
-MAN3_INSTALL_DIR = $(MAN_INSTALL_DIR)/man3
-
-# 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
-TCL_DBGX = @TCL_DBGX@
-
-# warning flags
-CFLAGS_WARNING = @CFLAGS_WARNING@
-
-# The default switches for optimization or debugging
-CFLAGS_DEBUG = @CFLAGS_DEBUG@
-CFLAGS_OPTIMIZE = @CFLAGS_OPTIMIZE@
-
-# To change the compiler switches, for example to change from optimization to
-# debugging symbols, change the following line:
-#CFLAGS = $(CFLAGS_DEBUG)
-#CFLAGS = $(CFLAGS_OPTIMIZE)
-#CFLAGS = $(CFLAGS_DEBUG) $(CFLAGS_OPTIMIZE)
-CFLAGS = @CFLAGS@ @CFLAGS_DEFAULT@ -DUNICODE -D_UNICODE -D_ATL_XP_TARGETING
-
-# To compile without backward compatibility and deprecated code uncomment the
-# following
-NO_DEPRECATED_FLAGS =
-#NO_DEPRECATED_FLAGS = -DTCL_NO_DEPRECATED
-
-# 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
-
-SRC_DIR = @srcdir@
-ROOT_DIR = @srcdir@/..
-TOP_DIR = $(shell cd @srcdir@/..; pwd -P)
-GENERIC_DIR = $(TOP_DIR)/generic
-TOMMATH_DIR = $(TOP_DIR)/libtommath
-WIN_DIR = $(TOP_DIR)/win
-COMPAT_DIR = $(TOP_DIR)/compat
-PKGS_DIR = $(TOP_DIR)/pkgs
-ZLIB_DIR = $(COMPAT_DIR)/zlib
-
-# Converts a POSIX path to a Windows native path.
-CYGPATH = @CYGPATH@
-
-libdir_native = $(shell $(CYGPATH) '$(libdir)')
-bindir_native = $(shell $(CYGPATH) '$(bindir)')
-includedir_native = $(shell $(CYGPATH) '$(includedir)')
-mandir_native = $(shell $(CYGPATH) '$(mandir)')
-TCL_LIBRARY_NATIVE = $(shell $(CYGPATH) '$(TCL_LIBRARY)')
-GENERIC_DIR_NATIVE = $(shell $(CYGPATH) '$(GENERIC_DIR)')
-TOMMATH_DIR_NATIVE = $(shell $(CYGPATH) '$(TOMMATH_DIR)')
-WIN_DIR_NATIVE = $(shell $(CYGPATH) '$(WIN_DIR)')
-ROOT_DIR_NATIVE = $(shell $(CYGPATH) '$(ROOT_DIR)')
-ZLIB_DIR_NATIVE = $(shell $(CYGPATH) '$(ZLIB_DIR)')
-#GENERIC_DIR_NATIVE = $(GENERIC_DIR)
-#TOMMATH_DIR_NATIVE = $(TOMMATH_DIR)
-#WIN_DIR_NATIVE = $(WIN_DIR)
-#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 -P)
-LIBRARY_DIR = $(shell $(CYGPATH) '$(LIBRARY_DIR1)')
-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@
-DDE_DLL_FILE = tcldde$(DDEVER)${DLLSUFFIX}
-DDE_LIB_FILE = @LIBPREFIX@tcldde$(DDEVER)${LIBSUFFIX}
-REG_DLL_FILE = tclreg$(REGVER)${DLLSUFFIX}
-REG_LIB_FILE = @LIBPREFIX@tclreg$(REGVER)${LIBSUFFIX}
-TEST_DLL_FILE = tcltest$(VER)${DLLSUFFIX}
-TEST_LIB_FILE = @LIBPREFIX@tcltest$(VER)${LIBSUFFIX}
-ZLIB_DLL_FILE = zlib1.dll
-
-SHARED_LIBRARIES = $(TCL_DLL_FILE) @ZLIB_DLL_FILE@
-STATIC_LIBRARIES = $(TCL_LIB_FILE)
-
-TCLSH = tclsh$(VER)${EXESUFFIX}
-CAT32 = cat32$(EXEEXT)
-MAN2TCL = man2tcl$(EXEEXT)
-
-# For cross-compiled builds, TCL_EXE is the name of a tclsh executable that is
-# available *BEFORE* running make for the first time. Certain build targets
-# (make genstubs, make install) need it to be available on the PATH. This
-# executable should *NOT* be required just to do a normal build although
-# it can be required to run make dist.
-TCL_EXE = @TCL_EXE@
-
-@SET_MAKE@
-
-# Setting the VPATH variable to a list of paths will cause the Makefile to
-# look into these paths when resolving .c to .obj dependencies.
-
-VPATH = $(GENERIC_DIR):$(TOMMATH_DIR):$(WIN_DIR):$(COMPAT_DIR):$(ZLIB_DIR)
-
-AR = @AR@
-RANLIB = @RANLIB@
-CC = @CC@
-RC = @RC@
-RES = @RES@
-AC_FLAGS = @EXTRA_CFLAGS@ @DEFS@
-CPPFLAGS = @CPPFLAGS@
-LDFLAGS_DEBUG = @LDFLAGS_DEBUG@
-LDFLAGS_OPTIMIZE = @LDFLAGS_OPTIMIZE@
-LDFLAGS = @LDFLAGS@ @LDFLAGS_DEFAULT@
-LDFLAGS_CONSOLE = @LDFLAGS_CONSOLE@
-LDFLAGS_WINDOW = @LDFLAGS_WINDOW@
-EXEEXT = @EXEEXT@
-OBJEXT = @OBJEXT@
-STLIB_LD = @STLIB_LD@
-SHLIB_LD = @SHLIB_LD@
-SHLIB_LD_LIBS = @SHLIB_LD_LIBS@
-SHLIB_CFLAGS = @SHLIB_CFLAGS@
-SHLIB_SUFFIX = @SHLIB_SUFFIX@
-LIBS = @LIBS@ $(shell $(CYGPATH) '@ZLIB_LIBS@')
-
-RMDIR = rm -rf
-MKDIR = mkdir -p
-SHELL = @SHELL@
-RM = rm -f
-COPY = cp
-
-CC_SWITCHES = ${CFLAGS} ${CFLAGS_WARNING} ${TCL_SHLIB_CFLAGS} \
--I"${ZLIB_DIR_NATIVE}" -I"${GENERIC_DIR_NATIVE}" -DTCL_TOMMATH \
--DMP_PREC=4 -I"${TOMMATH_DIR_NATIVE}" -I"${WIN_DIR_NATIVE}" \
-${AC_FLAGS} ${COMPILE_DEBUG_FLAGS} ${NO_DEPRECATED_FLAGS}
-
-CC_OBJNAME = @CC_OBJNAME@
-CC_EXENAME = @CC_EXENAME@
-
-STUB_CC_SWITCHES = ${CFLAGS} ${CFLAGS_WARNING} ${SHLIB_CFLAGS} \
--I"${GENERIC_DIR_NATIVE}" -DTCL_TOMMATH -DMP_PREC=4 -I"${TOMMATH_DIR_NATIVE}" \
--I"${WIN_DIR_NATIVE}" ${AC_FLAGS} \
-${COMPILE_DEBUG_FLAGS}
-
-TCLTEST_OBJS = \
- tclTest.$(OBJEXT) \
- tclTestObj.$(OBJEXT) \
- tclTestProcBodyObj.$(OBJEXT) \
- tclThreadTest.$(OBJEXT) \
- tclWinTest.$(OBJEXT)
-
-GENERIC_OBJS = \
- regcomp.$(OBJEXT) \
- regexec.$(OBJEXT) \
- regfree.$(OBJEXT) \
- regerror.$(OBJEXT) \
- tclAlloc.$(OBJEXT) \
- tclAssembly.$(OBJEXT) \
- tclAsync.$(OBJEXT) \
- tclBasic.$(OBJEXT) \
- tclBinary.$(OBJEXT) \
- tclCkalloc.$(OBJEXT) \
- tclClock.$(OBJEXT) \
- tclCmdAH.$(OBJEXT) \
- tclCmdIL.$(OBJEXT) \
- tclCmdMZ.$(OBJEXT) \
- tclCompCmds.$(OBJEXT) \
- tclCompCmdsGR.$(OBJEXT) \
- tclCompCmdsSZ.$(OBJEXT) \
- tclCompExpr.$(OBJEXT) \
- tclCompile.$(OBJEXT) \
- tclConfig.$(OBJEXT) \
- tclDate.$(OBJEXT) \
- tclDictObj.$(OBJEXT) \
- tclDisassemble.$(OBJEXT) \
- tclEncoding.$(OBJEXT) \
- tclEnsemble.$(OBJEXT) \
- tclEnv.$(OBJEXT) \
- tclEvent.$(OBJEXT) \
- tclExecute.$(OBJEXT) \
- tclFCmd.$(OBJEXT) \
- tclFileName.$(OBJEXT) \
- tclGet.$(OBJEXT) \
- tclHash.$(OBJEXT) \
- tclHistory.$(OBJEXT) \
- tclIndexObj.$(OBJEXT) \
- tclInterp.$(OBJEXT) \
- tclIO.$(OBJEXT) \
- tclIOCmd.$(OBJEXT) \
- tclIOGT.$(OBJEXT) \
- tclIORChan.$(OBJEXT) \
- tclIORTrans.$(OBJEXT) \
- tclIOSock.$(OBJEXT) \
- tclIOUtil.$(OBJEXT) \
- tclLink.$(OBJEXT) \
- tclLiteral.$(OBJEXT) \
- tclListObj.$(OBJEXT) \
- tclLoad.$(OBJEXT) \
- tclMain.$(OBJEXT) \
- tclMain2.$(OBJEXT) \
- tclNamesp.$(OBJEXT) \
- tclNotify.$(OBJEXT) \
- tclOO.$(OBJEXT) \
- tclOOBasic.$(OBJEXT) \
- tclOOCall.$(OBJEXT) \
- tclOODefineCmds.$(OBJEXT) \
- tclOOInfo.$(OBJEXT) \
- tclOOMethod.$(OBJEXT) \
- tclOOStubInit.$(OBJEXT) \
- tclObj.$(OBJEXT) \
- tclOptimize.$(OBJEXT) \
- tclPanic.$(OBJEXT) \
- tclParse.$(OBJEXT) \
- tclPathObj.$(OBJEXT) \
- tclPipe.$(OBJEXT) \
- tclPkg.$(OBJEXT) \
- tclPkgConfig.$(OBJEXT) \
- tclPosixStr.$(OBJEXT) \
- tclPreserve.$(OBJEXT) \
- tclProc.$(OBJEXT) \
- tclRegexp.$(OBJEXT) \
- tclResolve.$(OBJEXT) \
- tclResult.$(OBJEXT) \
- tclScan.$(OBJEXT) \
- tclStringObj.$(OBJEXT) \
- tclStrToD.$(OBJEXT) \
- tclStubInit.$(OBJEXT) \
- tclThread.$(OBJEXT) \
- tclThreadAlloc.$(OBJEXT) \
- tclThreadJoin.$(OBJEXT) \
- tclThreadStorage.$(OBJEXT) \
- tclTimer.$(OBJEXT) \
- tclTomMathInterface.$(OBJEXT) \
- tclTrace.$(OBJEXT) \
- tclUtf.$(OBJEXT) \
- tclUtil.$(OBJEXT) \
- tclVar.$(OBJEXT) \
- tclZlib.$(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) \
- tclWinConsole.$(OBJEXT) \
- tclWinSerial.$(OBJEXT) \
- tclWinError.$(OBJEXT) \
- tclWinFCmd.$(OBJEXT) \
- tclWinFile.$(OBJEXT) \
- tclWinInit.$(OBJEXT) \
- tclWinLoad.$(OBJEXT) \
- tclWinNotify.$(OBJEXT) \
- tclWinPipe.$(OBJEXT) \
- tclWinSock.$(OBJEXT) \
- tclWinThrd.$(OBJEXT) \
- tclWinTime.$(OBJEXT)
-
-DDE_OBJS = tclWinDde.$(OBJEXT)
-
-REG_OBJS = tclWinReg.$(OBJEXT)
-
-STUB_OBJS = \
- tclStubLib.$(OBJEXT) \
- tclTomMathStubLib.$(OBJEXT) \
- tclOOStubLib.$(OBJEXT)
-
-TCLSH_OBJS = tclAppInit.$(OBJEXT)
-
-ZLIB_OBJS = \
- adler32.$(OBJEXT) \
- compress.$(OBJEXT) \
- crc32.$(OBJEXT) \
- deflate.$(OBJEXT) \
- infback.$(OBJEXT) \
- inffast.$(OBJEXT) \
- inflate.$(OBJEXT) \
- inftrees.$(OBJEXT) \
- trees.$(OBJEXT) \
- uncompr.$(OBJEXT) \
- zutil.$(OBJEXT)
-
-TCL_OBJS = ${GENERIC_OBJS} $(TOMMATH_OBJS) ${WIN_OBJS} @ZLIB_OBJS@
-
-TCL_DOCS = "$(ROOT_DIR_NATIVE)"/doc/*.[13n]
-
-all: binaries libraries doc packages
-
-tcltest: $(TCLSH) $(TEST_DLL_FILE)
-
-binaries: $(TCL_STUB_LIB_FILE) @LIBRARIES@ winextensions $(TCLSH)
-
-winextensions: ${DDE_DLL_FILE} ${REG_DLL_FILE}
-
-libraries:
-
-doc:
-
-$(TCLSH): $(TCLSH_OBJS) @LIBRARIES@ $(TCL_STUB_LIB_FILE) tclsh.$(RES)
- $(CC) $(CFLAGS) $(TCLSH_OBJS) $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE) $(LIBS) \
- tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE)
- @VC_MANIFEST_EMBED_EXE@
-
-cat32.$(OBJEXT): cat.c
- $(CC) -c $(CC_SWITCHES) @DEPARG@ $(CC_OBJNAME)
-
-$(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
-
-${TCL_STUB_LIB_FILE}: ${STUB_OBJS}
- @$(RM) ${TCL_STUB_LIB_FILE}
- @MAKE_STUB_LIB@ ${STUB_OBJS}
- @POST_MAKE_LIB@
-
-${TCL_DLL_FILE}: ${TCL_OBJS} tcl.$(RES) @ZLIB_DLL_FILE@
- @$(RM) ${TCL_DLL_FILE} $(TCL_LIB_FILE)
- @MAKE_DLL@ ${TCL_OBJS} tcl.$(RES) $(SHLIB_LD_LIBS)
- @VC_MANIFEST_EMBED_DLL@
-
-${TCL_LIB_FILE}: ${TCL_OBJS} ${DDE_OBJS} ${REG_OBJS}
- @$(RM) ${TCL_LIB_FILE}
- @MAKE_LIB@ ${TCL_OBJS} ${DDE_OBJS} ${REG_OBJS}
- @POST_MAKE_LIB@
-
-${DDE_DLL_FILE}: ${TCL_STUB_LIB_FILE} ${DDE_OBJS}
- @MAKE_DLL@ ${DDE_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS)
-
-${REG_DLL_FILE}: ${TCL_STUB_LIB_FILE} ${REG_OBJS}
- @MAKE_DLL@ ${REG_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS)
-
-${TEST_DLL_FILE}: ${TCL_STUB_LIB_FILE} ${TCLTEST_OBJS}
- @$(RM) ${TEST_DLL_FILE} ${TEST_LIB_FILE}
- @MAKE_DLL@ ${TCLTEST_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS)
-
-# use pre-built zlib1.dll
-${ZLIB_DLL_FILE}: ${TCL_STUB_LIB_FILE}
- @if test "@ZLIB_LIBS@set" != "${ZLIB_DIR_NATIVE}/win32/zdll.libset" ; then \
- $(COPY) $(ZLIB_DIR)/win64/${ZLIB_DLL_FILE} ${ZLIB_DLL_FILE}; \
- else \
- $(COPY) $(ZLIB_DIR)/win32/${ZLIB_DLL_FILE} ${ZLIB_DLL_FILE}; \
- fi;
-
-# Add the object extension to the implicit rules. By default .obj is not
-# automatically added.
-
-.SUFFIXES: .${OBJEXT}
-.SUFFIXES: .$(RES)
-.SUFFIXES: .rc
-
-# Special case object targets
-
-tclWinInit.${OBJEXT}: tclWinInit.c
- $(CC) -c $(CC_SWITCHES) -DBUILD_tcl $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME)
-
-tclWinPipe.${OBJEXT}: tclWinPipe.c
- $(CC) -c $(CC_SWITCHES) -DBUILD_tcl $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME)
-
-testMain.${OBJEXT}: tclAppInit.c
- $(CC) -c $(CC_SWITCHES) -DTCL_TEST @DEPARG@ $(CC_OBJNAME)
-
-tclMain2.${OBJEXT}: tclMain.c
- $(CC) -c $(CC_SWITCHES) -DBUILD_tcl -DTCL_ASCII_MAIN @DEPARG@ $(CC_OBJNAME)
-
-# 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_NATIVE)\" \
- -DCFG_INSTALL_BINDIR=\"$(BIN_INSTALL_DIR_NATIVE)\" \
- -DCFG_INSTALL_SCRDIR=\"$(SCRIPT_INSTALL_DIR_NATIVE)\" \
- -DCFG_INSTALL_INCDIR=\"$(INCLUDE_INSTALL_DIR_NATIVE)\" \
- -DCFG_INSTALL_DOCDIR=\"$(MAN_INSTALL_DIR)\" \
- \
- -DCFG_RUNTIME_LIBDIR=\"$(libdir_native)\" \
- -DCFG_RUNTIME_BINDIR=\"$(bindir_native)\" \
- -DCFG_RUNTIME_SCRDIR=\"$(TCL_LIBRARY_NATIVE)\" \
- -DCFG_RUNTIME_INCDIR=\"$(includedir_native)\" \
- -DCFG_RUNTIME_DOCDIR=\"$(mandir_native)\" \
- -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)
-
-tclTomMathStubLib.${OBJEXT}: tclTomMathStubLib.c
- $(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD @DEPARG@ $(CC_OBJNAME)
-
-tclOOStubLib.${OBJEXT}: tclOOStubLib.c
- $(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD @DEPARG@ $(CC_OBJNAME)
-
-# Implicit rule for all object files that will end up in the Tcl library
-
-%.${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-packages
-
-install-binaries: binaries
- @for i in "$(LIB_INSTALL_DIR)" "$(BIN_INSTALL_DIR)" ; \
- do \
- if [ ! -d $$i ] ; then \
- echo "Making directory $$i"; \
- $(MKDIR) $$i; \
- chmod 755 $$i; \
- else true; \
- fi; \
- done;
- @for i in dde${DDEDOTVER} reg${REGDOTVER}; \
- do \
- if [ ! -d $(LIB_INSTALL_DIR)/$$i ] ; then \
- echo "Making directory $(LIB_INSTALL_DIR)/$$i"; \
- $(MKDIR) $(LIB_INSTALL_DIR)/$$i; \
- else true; \
- fi; \
- done;
- @for i in $(TCL_DLL_FILE) $(ZLIB_DLL_FILE) $(TCLSH); \
- do \
- if [ -f $$i ]; then \
- echo "Installing $$i to $(BIN_INSTALL_DIR)/"; \
- $(COPY) $$i "$(BIN_INSTALL_DIR)"; \
- fi; \
- done
- @for i in tclConfig.sh tclooConfig.sh $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE); \
- do \
- if [ -f $$i ]; then \
- echo "Installing $$i to $(LIB_INSTALL_DIR)/"; \
- $(COPY) $$i "$(LIB_INSTALL_DIR)"; \
- fi; \
- done
- @if [ -f $(DDE_DLL_FILE) ]; then \
- echo Installing $(DDE_DLL_FILE); \
- $(COPY) $(DDE_DLL_FILE) $(LIB_INSTALL_DIR)/dde${DDEDOTVER}; \
- $(COPY) $(ROOT_DIR)/library/dde/pkgIndex.tcl \
- $(LIB_INSTALL_DIR)/dde${DDEDOTVER}; \
- fi
- @if [ -f $(DDE_LIB_FILE) ]; then \
- echo Installing $(DDE_LIB_FILE); \
- $(COPY) $(DDE_LIB_FILE) $(LIB_INSTALL_DIR)/dde${DDEDOTVER}; \
- fi
- @if [ -f $(REG_DLL_FILE) ]; then \
- echo Installing $(REG_DLL_FILE); \
- $(COPY) $(REG_DLL_FILE) $(LIB_INSTALL_DIR)/reg${REGDOTVER}; \
- $(COPY) $(ROOT_DIR)/library/reg/pkgIndex.tcl \
- $(LIB_INSTALL_DIR)/reg${REGDOTVER}; \
- fi
- @if [ -f $(REG_LIB_FILE) ]; then \
- echo Installing $(REG_LIB_FILE); \
- $(COPY) $(REG_LIB_FILE) $(LIB_INSTALL_DIR)/reg${REGDOTVER}; \
- fi
-
-install-libraries: libraries install-tzdata install-msgs
- @for i in "$$($(CYGPATH) $(prefix)/lib)" "$(INCLUDE_INSTALL_DIR)" \
- $(SCRIPT_INSTALL_DIR); \
- do \
- if [ ! -d $$i ] ; then \
- echo "Making directory $$i"; \
- $(MKDIR) $$i; \
- else true; \
- fi; \
- done;
- @for i in http1.0 opt0.4 encoding ../tcl8 ../tcl8/8.4 ../tcl8/8.4/platform ../tcl8/8.5 ../tcl8/8.6; \
- do \
- if [ ! -d $(SCRIPT_INSTALL_DIR)/$$i ] ; then \
- echo "Making directory $(SCRIPT_INSTALL_DIR)/$$i"; \
- $(MKDIR) $(SCRIPT_INSTALL_DIR)/$$i; \
- else true; \
- fi; \
- done;
- @echo "Installing header files";
- @for i in "$(GENERIC_DIR)/tcl.h" "$(GENERIC_DIR)/tclDecls.h" \
- "$(GENERIC_DIR)/tclOO.h" "$(GENERIC_DIR)/tclOODecls.h" \
- "$(GENERIC_DIR)/tclPlatDecls.h" \
- "$(GENERIC_DIR)/tclTomMath.h" \
- "$(GENERIC_DIR)/tclTomMathDecls.h"; \
- do \
- $(COPY) "$$i" "$(INCLUDE_INSTALL_DIR)"; \
- done;
- @echo "Installing library files to $(SCRIPT_INSTALL_DIR)";
- @for i in $(ROOT_DIR)/library/*.tcl $(ROOT_DIR)/library/tclIndex; \
- do \
- $(COPY) "$$i" "$(SCRIPT_INSTALL_DIR)"; \
- 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 package http 2.9.0 as a Tcl Module";
- @$(COPY) $(ROOT_DIR)/library/http/http.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.6/http-2.9.0.tm;
- @echo "Installing library opt0.4 directory";
- @for j in $(ROOT_DIR)/library/opt/*.tcl; \
- do \
- $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/opt0.4"; \
- done;
- @echo "Installing package msgcat 1.6.1 as a Tcl Module";
- @$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/msgcat-1.6.1.tm;
- @echo "Installing package tcltest 2.5.0 as a Tcl Module";
- @$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/tcltest-2.5.0.tm;
- @echo "Installing package platform 1.0.14 as a Tcl Module";
- @$(COPY) $(ROOT_DIR)/library/platform/platform.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/platform-1.0.14.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_EXE) "$(ROOT_DIR)/tools/installData.tcl" \
- "$(ROOT_DIR)/library/tzdata" "$(SCRIPT_INSTALL_DIR)/tzdata"
-
-install-msgs:
- @echo "Installing message catalogs"
- @$(TCL_EXE) "$(ROOT_DIR)/tools/installData.tcl" \
- "$(ROOT_DIR)/library/msgs" "$(SCRIPT_INSTALL_DIR)/msgs"
-
-install-doc: doc
-
-# Optional target to install private headers
-install-private-headers: libraries
- @for i in $(PRIVATE_INCLUDE_INSTALL_DIR); \
- do \
- if [ ! -d $$i ] ; then \
- echo "Making directory $$i"; \
- $(MKDIR) $$i; \
- else true; \
- fi; \
- done;
- @echo "Installing private header files";
- @for i in "$(GENERIC_DIR)/tclInt.h" "$(GENERIC_DIR)/tclIntDecls.h" \
- "$(GENERIC_DIR)/tclIntPlatDecls.h" "$(GENERIC_DIR)/tclPort.h" \
- "$(GENERIC_DIR)/tclOOInt.h" "$(GENERIC_DIR)/tclOOIntDecls.h" \
- "$(WIN_DIR)/tclWinPort.h" ; \
- do \
- $(COPY) "$$i" "$(PRIVATE_INCLUDE_INSTALL_DIR)"; \
- done;
-
-# 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: test-tcl test-packages
-
-test-tcl: binaries $(TCLSH) $(CAT32) $(TEST_DLL_FILE)
- TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \
- ./$(TCLSH) "$(ROOT_DIR_NATIVE)/tests/all.tcl" $(TESTFLAGS) \
- -load "package ifneeded Tcltest ${VERSION}@TCL_PATCH_LEVEL@ [list load [file normalize ${TEST_DLL_FILE}] Tcltest]; \
- package ifneeded dde 1.4.1 [list load [file normalize ${DDE_DLL_FILE}] dde]; \
- package ifneeded registry 1.3.3 [list load [file normalize ${REG_DLL_FILE}] registry]" | ./$(CAT32)
-
-# Useful target to launch a built tclsh with the proper path,...
-runtest: binaries $(TCLSH) $(TEST_DLL_FILE)
- @TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \
- ./$(TCLSH) $(TESTFLAGS) -load "package ifneeded Tcltest ${VERSION}@TCL_PATCH_LEVEL@ [list load [file normalize ${TEST_DLL_FILE}] Tcltest]; \
- package ifneeded dde 1.4.1 [list load [file normalize ${DDE_DLL_FILE}] dde]; \
- package ifneeded registry 1.3.3 [list load [file normalize ${REG_DLL_FILE}] registry]" $(SCRIPT)
-
-# This target can be used to run tclsh from the build directory via
-# `make shell SCRIPT=foo.tcl`
-shell: binaries
- @TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \
- ./$(TCLSH) $(SCRIPT)
-
-# 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
- rm gdb.run
-
-depend:
-
-Makefile: $(SRC_DIR)/Makefile.in
- ./config.status
-
-cleanhelp:
- $(RM) *.hlp *.cnt *.GID *.rtf man2tcl.exe
-
-clean: cleanhelp clean-packages
- $(RM) *.lib *.a *.exp *.dll *.$(RES) *.${OBJEXT} *~ \#* TAGS a.out
- $(RM) $(TCLSH) $(CAT32)
- $(RM) *.pch *.ilk *.pdb
-
-distclean: distclean-packages clean
- $(RM) Makefile config.status config.cache config.log tclConfig.sh \
- tcl.hpj config.status.lineno
-
-#
-# Bundled package targets
-#
-
-PKG_CFG_ARGS = @PKG_CFG_ARGS@
-PKG_DIR = ./pkgs
-
-packages:
- @builddir=`$(CYGPATH) $$(pwd -P)`; \
- for i in $(PKGS_DIR)/*; do \
- if [ -d $$i ] ; then \
- if [ -x $$i/configure ] ; then \
- pkg=`basename $$i`; \
- mkdir -p $(PKG_DIR)/$$pkg; \
- if [ ! -f $(PKG_DIR)/$$pkg/Makefile ]; then \
- ( cd $(PKG_DIR)/$$pkg; \
- echo "Configuring package '$$i' wd = `$(CYGPATH) $$(pwd -P)`"; \
- $$i/configure --with-tcl=$$builddir --with-tclinclude=$(GENERIC_DIR_NATIVE) $(PKG_CFG_ARGS) --enable-shared --enable-threads; ) \
- fi ; \
- echo "Building package '$$pkg'"; \
- ( cd $(PKG_DIR)/$$pkg; $(MAKE); ) \
- fi; \
- fi; \
- done; \
- cd $$builddir
-
-install-packages: packages
- @builddir=`pwd -P`; \
- for i in $(PKGS_DIR)/*; do \
- if [ -d $$i ]; then \
- pkg=`basename $$i`; \
- if [ -f $(PKG_DIR)/$$pkg/Makefile ]; then \
- echo "Installing package '$$pkg'"; \
- ( cd $(PKG_DIR)/$$pkg; $(MAKE) install "DESTDIR=$(INSTALL_ROOT)"; ) \
- fi; \
- fi; \
- done; \
- cd $$builddir
-
-test-packages: tcltest packages
- @builddir=`pwd -P`; \
- for i in $(PKGS_DIR)/*; do \
- if [ -d $$i ]; then \
- pkg=`basename $$i`; \
- if [ -f $(PKG_DIR)/$$pkg/Makefile ]; then \
- echo "Testing package '$$pkg'"; \
- ( cd $(PKG_DIR)/$$pkg; $(MAKE) "LD_LIBRARY_PATH=$$builddir:${LD_LIBRARY_PATH}" "TCL_LIBRARY=${TCL_BUILDTIME_LIBRARY}" "TCLLIBPATH=$$builddir/pkgs" test "TCLSH_PROG=$$builddir/${TCLSH}"; ) \
- fi; \
- fi; \
- done; \
- cd $$builddir
-
-clean-packages:
- @builddir=`pwd -P`; \
- for i in $(PKGS_DIR)/*; do \
- if [ -d $$i ]; then \
- pkg=`basename $$i`; \
- if [ -f $(PKG_DIR)/$$pkg/Makefile ]; then \
- ( cd $(PKG_DIR)/$$pkg; $(MAKE) clean; ) \
- fi; \
- fi; \
- done; \
- cd $$builddir
-
-distclean-packages:
- @builddir=`pwd -P`; \
- for i in $(PKGS_DIR)/*; do \
- if [ -d $$i ]; then \
- pkg=`basename $$i`; \
- if [ -f $(PKG_DIR)/$$pkg/Makefile ]; then \
- ( cd $(PKG_DIR)/$$pkg; $(MAKE) distclean; ) \
- fi; \
- cd $$builddir; \
- rm -rf $(PKG_DIR)/$$pkg; \
- fi; \
- done; \
- rm -rf $(PKG_DIR)
-
-#
-# Regenerate the stubs files.
-#
-
-$(GENERIC_DIR)/tclStubInit.c: $(GENERIC_DIR)/tcl.decls \
- $(GENERIC_DIR)/tclInt.decls
- @echo "Warning: tclStubInit.c may be out of date."
- @echo "Developers may want to run \"make genstubs\" to regenerate."
- @echo "This warning can be safely ignored, do not report as a bug!"
-
-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)/tclTomMath.decls"
- $(TCL_EXE) "$(ROOT_DIR_NATIVE)/tools/genStubs.tcl" \
- "$(GENERIC_DIR_NATIVE)" \
- "$(GENERIC_DIR_NATIVE)/tclOO.decls"
-
-#
-# This target creates the HTML folder for Tcl & Tk and places it in
-# DISTDIR/html. It uses the tcltk-man2html.tcl tool from the Tcl group's tool
-# workspace. It depends on the Tcl & Tk being in directories called tcl8.* &
-# tk8.* up two directories from the TOOL_DIR.
-#
-
-TOOL_DIR=$(ROOT_DIR)/tools
-HTML_INSTALL_DIR=$(ROOT_DIR)/html
-html:
- $(MAKE) shell SCRIPT="$(TOOL_DIR)/tcltk-man2html.tcl --htmldir=$(HTML_INSTALL_DIR) --srcdir=$(ROOT_DIR)/.. $(BUILD_HTML_FLAGS)"
-
-html-tcl: $(TCLSH)
- $(MAKE) shell SCRIPT="$(TOOL_DIR)/tcltk-man2html.tcl --htmldir=$(HTML_INSTALL_DIR) --srcdir=$(ROOT_DIR)/.. $(BUILD_HTML_FLAGS) --tcl"
-
-html-tk: $(TCLSH)
- $(MAKE) shell SCRIPT="$(TOOL_DIR)/tcltk-man2html.tcl --htmldir=$(HTML_INSTALL_DIR) --srcdir=$(ROOT_DIR)/.. $(BUILD_HTML_FLAGS) --tk"
-
-#
-# The list of all the targets that do not correspond to real files. This stops
-# 'make' from getting confused when someone makes an error in a rule.
-#
-
-.PHONY: all tcltest binaries libraries doc gendate gentommath_h install
-.PHONY: install-binaries install-libraries install-tzdata install-msgs
-.PHONY: install-doc install-private-headers test test-tcl runtest shell
-.PHONY: gdb depend cleanhelp clean distclean packages install-packages
-.PHONY: test-packages clean-packages distclean-packages genstubs html
-.PHONY: html-tcl html-tk
-
-# DO NOT DELETE THIS LINE -- make depend depends on it.
diff --git a/tcl8.6/win/README b/tcl8.6/win/README
deleted file mode 100644
index 5e060ef..0000000
--- a/tcl8.6/win/README
+++ /dev/null
@@ -1,99 +0,0 @@
-Tcl 8.6 for Windows
-
-1. Introduction
----------------
-
-This is the directory where you configure and compile the Windows
-version of Tcl. This directory also contains source files for Tcl
-that are specific to Microsoft Windows.
-
-The information in this file is maintained on the web at:
-
- http://www.tcl.tk/doc/howto/compile.html#win
-
-2. Compiling Tcl
-----------------
-
-In order to compile Tcl for Windows, you need the following:
-
- Tcl 8.6 Source Distribution (plus any patches)
-
- and
-
- Visual C++ 6 or newer
-
- or
-
- Linux + MinGW-w64 [http://mingw-w64.sourceforge.net/]
- (win32 or win64)
-
- or
-
- Cygwin + MinGW-w64 [http://cygwin.com/install.html]
- (win32 or win64)
-
- or
-
- Darwin + MinGW-w64 [http://mingw-w64.sourceforge.net/]
- (win32 or win64)
-
- or
-
- Msys + MinGW-w64 [http://mingw-w64.sourceforge.net/]
- (win32 or win64)
-
- or
-
- Msys + MinGW [http://www.mingw.org/download.shtml]
- (win32 only)
-
-
-In practice, this release is built with Visual C++ 6.0 and the TEA
-Makefile.
-
-If you are building with Visual C++, in the "win" subdirectory of the
-source release, you will find "makefile.vc". This is the makefile for the
-Visual C++ compiler and uses the stock NMAKE tool. Detailed directions for
-using it, are in the comments of "makefile.vc". A quick example would be:
-
- C:\tcl_source\win\>nmake -f makefile.vc
-
-There is also a Developer Studio workspace and project file, too, if you
-would like to use them.
-
-If you are building with Linux, Cygwin or Msys, you can use the configure
-script that lives in the win subdirectory. The Linux/Cygwin/Msys based
-configure/build process works just like the UNIX one, so you will want
-to refer to ../unix/README for available configure options.
-
-If you want 64-bit executables (x86_64), you need to configure using
-the --enable-64bit option. Make sure that the x86_64-w64-mingw32
-compiler is present. For Cygwin this compiler can be found in the
-"mingw64-x86_64-gcc-core" package, which can be installed through
-the normal Cygwin install process. If you only want 32-bit executables,
-the "mingw64-i686-gcc-core" package is what you need. For Linux, Darwin
-and Msys, you can download a suitable win32 or win64 compiler from
-[https://sourceforge.net/projects/mingw-w64/files/]
-
-Use the Makefile "install" target to install Tcl. It will install it
-according to the prefix options you provided in the correct directory
-structure.
-
-Note that in order to run tclsh86.exe, you must ensure that tcl86.dll is
-on your path, in the system directory, or in the directory containing
-tclsh86.exe.
-
-Note: Tcl no longer provides support for Win32s.
-
-3. Test suite
--------------
-
-This distribution contains an extensive test suite for Tcl. Some of the
-tests are timing dependent and will fail from time to time. If a test is
-failing consistently, please send us a bug report with as much detail as
-you can manage to our tracker:
-
- http://core.tcl.tk/tcl/reportlist
-
-In order to run the test suite, you build the "test" target using the
-appropriate makefile for your compiler.
diff --git a/tcl8.6/win/aclocal.m4 b/tcl8.6/win/aclocal.m4
deleted file mode 100644
index bc7540d..0000000
--- a/tcl8.6/win/aclocal.m4
+++ /dev/null
@@ -1 +0,0 @@
-builtin(include,tcl.m4)
diff --git a/tcl8.6/win/buildall.vc.bat b/tcl8.6/win/buildall.vc.bat
deleted file mode 100644
index deb9e39..0000000
--- a/tcl8.6/win/buildall.vc.bat
+++ /dev/null
@@ -1,103 +0,0 @@
-@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
-
-:: You might have installed your developer studio to add itself to the
-:: path or have already run vcvars32.bat. Testing these envars proves
-:: cl.exe and friends are in your path.
-::
-if defined VCINSTALLDIR (goto :startBuilding)
-if defined MSDEVDIR (goto :startBuilding)
-if defined MSVCDIR (goto :startBuilding)
-if defined MSSDK (goto :startBuilding)
-if defined WINDOWSSDKDIR (goto :startBuilding)
-
-:: We need to run the development environment batch script that comes
-:: with developer studio (v4,5,6,7,etc...) All have it. This path
-:: might not be correct. You should call it yourself prior to running
-:: this batchfile.
-::
-call "C:\Program Files\Microsoft Developer Studio\vc98\bin\vcvars32.bat"
-if errorlevel 1 (goto no_vcvars)
-
-:startBuilding
-
-echo.
-echo Sit back and have a cup of coffee while this grinds through ;)
-echo You asked for *everything*, remember?
-echo.
-title Building Tcl, please wait...
-
-
-:: 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.
-::
-set OPTS=none
-if not %SYMBOLS%.==. set OPTS=symbols
-nmake -nologo -f makefile.vc release htmlhelp OPTS=%OPTS% %1
-if errorlevel 1 goto error
-
-:: Build the static core and shell.
-::
-set OPTS=static,msvcrt
-if not %SYMBOLS%.==. set OPTS=symbols,static,msvcrt
-nmake -nologo -f makefile.vc shell OPTS=%OPTS% %1
-if errorlevel 1 goto error
-
-set OPTS=
-set SYMBOLS=
-goto end
-
-:error
-echo *** BOOM! ***
-goto end
-
-:no_vcvars
-echo vcvars32.bat was not run prior to this batchfile, nor are the MS tools in your path.
-goto out
-
-:help
-title buildall.vc.bat help message
-echo usage:
-echo %0 : builds Tcl for all build types (do this first)
-echo %0 install : installs all the release builds (do this second)
-echo %0 symbols : builds Tcl for all debugging build types
-echo %0 symbols install : install all the debug builds.
-echo.
-goto out
-
-:end
-title Building Tcl, please wait... DONE!
-echo DONE!
-goto out
-
-:out
-pause
-title Command Prompt
diff --git a/tcl8.6/win/cat.c b/tcl8.6/win/cat.c
deleted file mode 100644
index d49e37c..0000000
--- a/tcl8.6/win/cat.c
+++ /dev/null
@@ -1,41 +0,0 @@
-/*
- * cat.c --
- *
- * Program used when testing tclWinPipe.c
- *
- * 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.
- */
-
-#ifdef TCL_BROKEN_MAINARGS
-/* On mingw32 and cygwin this doesn't work */
-# undef UNICODE
-# undef _UNICODE
-#endif
-
-#include <stdio.h>
-#include <io.h>
-#include <string.h>
-#include <tchar.h>
-
-int
-_tmain(void)
-{
- char buf[1024];
- int n;
- const char *err;
-
- while (1) {
- n = read(0, buf, sizeof(buf));
- if (n <= 0) {
- break;
- }
- write(1, buf, n);
- }
- err = (sizeof(int) == 2) ? "stderr16" : "stderr32";
- write(2, err, strlen(err));
-
- return 0;
-}
diff --git a/tcl8.6/win/coffbase.txt b/tcl8.6/win/coffbase.txt
deleted file mode 100644
index 3314f26..0000000
--- a/tcl8.6/win/coffbase.txt
+++ /dev/null
@@ -1,43 +0,0 @@
-;
-; This file defines the virtual base addresses for the Dynamic Link Libraries
-; that are part of the Tcl system. The first token on a line is the key (or name
-; of the DLL) and the second token is the virtual base address, in hexidecimal.
-; The third token is the maximum size of the DLL image file, including symbols.
-;
-; Using a specified "prefered load address" should speed loading time by avoiding
-; relocations (NT supported only). It is assumed extension authors will contribute
-; their modules to this grand-master list. You can use the dumpbin utility with
-; the /headers option to get the "size of image" data (already in hex). If the
-; maximum size is too small a linker warning will occur. Modules can overlap when
-; they're mutually exclusive. This info is placed in the DLL's PE header by the
-; linker with the `-base:@$(TCLDIR)\win\coffbase.txt,<key>` option.
-
-tcl 0x10000000 0x00200000
-tcldde 0x10200000 0x00010000
-tclreg 0x10210000 0x00010000
-tk 0x10220000 0x00200000
-expect 0x10480000 0x00080000
-itcl 0x10500000 0x00080000
-itk 0x10580000 0x00080000
-bltlite 0x10600000 0x00080000
-blt 0x10680000 0x00080000
-iocpsock 0x10700000 0x00080000
-tls 0x10780000 0x00100000
-winico 0x10880000 0x00010000
-sample 0x108B0000 0x00010000
-tile 0x10900000 0x00080000
-memchan 0x109D0000 0x00010000
-tdom 0x109E0000 0x00080000
-tclvfs 0x10A70000 0x00010000
-tkvideo 0x10B00000 0x00010000
-tclsdl 0x10B20000 0x00080000
-vqtcl 0x10C00000 0x00010000
-tdbc 0x10C40000 0x00010000
-thread 0x10C80000 0x00020000
-nsf 0x10ca0000 0x00080000
-;
-; insert new packages here
-;
-snack 0x1E000000 0x00400000
-sound 0x1E400000 0x00400000
-snackogg 0x1E800000 0x00200000
diff --git a/tcl8.6/win/configure b/tcl8.6/win/configure
deleted file mode 100755
index 2f8959d..0000000
--- a/tcl8.6/win/configure
+++ /dev/null
@@ -1,6300 +0,0 @@
-#! /bin/sh
-# Guess values for system-dependent variables and create Makefiles.
-# 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
-
-
-# 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
-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 ZLIB_DLL_FILE ZLIB_LIBS ZLIB_OBJS CFLAGS_DEFAULT LDFLAGS_DEFAULT VC_MANIFEST_EMBED_DLL VC_MANIFEST_EMBED_EXE TCL_WIN_VERSION MACHINE TCL_VERSION TCL_MAJOR_VERSION TCL_MINOR_VERSION TCL_PATCH_LEVEL PKG_CFG_ARGS TCL_EXE TCL_LIB_FILE TCL_LIB_FLAG TCL_STATIC_LIB_FILE TCL_STATIC_LIB_FLAG TCL_IMPORT_LIB_FILE TCL_IMPORT_LIB_FLAG TCL_LIB_SPEC TCL_STUB_LIB_FILE TCL_STUB_LIB_FLAG TCL_STUB_LIB_SPEC TCL_STUB_LIB_PATH TCL_INCLUDE_SPEC TCL_BUILD_STUB_LIB_SPEC TCL_BUILD_STUB_LIB_PATH TCL_DLL_FILE TCL_SRC_DIR TCL_BIN_DIR TCL_DBGX CFG_TCL_SHARED_LIB_SUFFIX CFG_TCL_UNSHARED_LIB_SUFFIX CFG_TCL_EXPORT_FILE_SUFFIX EXTRA_CFLAGS DEPARG CC_OBJNAME CC_EXENAME LDFLAGS_DEBUG LDFLAGS_OPTIMIZE LDFLAGS_CONSOLE LDFLAGS_WINDOW STLIB_LD SHLIB_LD SHLIB_LD_LIBS SHLIB_CFLAGS SHLIB_SUFFIX TCL_SHARED_BUILD LIBS_GUI DLLSUFFIX LIBPREFIX LIBSUFFIX EXESUFFIX LIBRARIES MAKE_LIB MAKE_STUB_LIB POST_MAKE_LIB MAKE_DLL MAKE_EXE TCL_BUILD_LIB_SPEC TCL_CC_SEARCH_FLAGS TCL_LD_SEARCH_FLAGS TCL_NEEDS_EXP_FILE TCL_BUILD_EXP_FILE TCL_EXP_FILE TCL_LIB_VERSIONS_OK TCL_PACKAGE_PATH TCL_DDE_VERSION TCL_DDE_MAJOR_VERSION TCL_DDE_MINOR_VERSION TCL_REG_VERSION TCL_REG_MAJOR_VERSION TCL_REG_MINOR_VERSION RC_OUT RC_TYPE RC_INCLUDE RC_DEFINE RC_DEFINES RES LIBOBJS LTLIBOBJS'
-ac_subst_files=''
-
-# Initialize some variables set by options.
-ac_init_help=
-ac_init_version=false
-# The variables have the same names as the options, with
-# dashes changed to underlines.
-cache_file=/dev/null
-exec_prefix=NONE
-no_create=
-no_recursion=
-prefix=NONE
-program_prefix=NONE
-program_suffix=NONE
-program_transform_name=s,x,x,
-silent=
-site=
-srcdir=
-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'
-datadir='${prefix}/share'
-sysconfdir='${prefix}/etc'
-sharedstatedir='${prefix}/com'
-localstatedir='${prefix}/var'
-libdir='${exec_prefix}/lib'
-includedir='${prefix}/include'
-oldincludedir='/usr/include'
-infodir='${prefix}/info'
-mandir='${prefix}/man'
-
-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"
- ac_prev=
- continue
- fi
-
- ac_optarg=`expr "x$ac_option" : 'x[^=]*=\(.*\)'`
-
- # Accept the important Cygnus configure options, so we can diagnose typos.
-
- case $ac_option in
-
- -bindir | --bindir | --bindi | --bind | --bin | --bi)
- ac_prev=bindir ;;
- -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*)
- bindir=$ac_optarg ;;
-
- -build | --build | --buil | --bui | --bu)
- ac_prev=build_alias ;;
- -build=* | --build=* | --buil=* | --bui=* | --bu=*)
- 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 ;;
-
- --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 ;;
-
- -disable-* | --disable-*)
- ac_feature=`expr "x$ac_option" : 'x-*disable-\(.*\)'`
- # Reject names that are not valid shell variable names.
- 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=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'`
- # Reject names that are not valid shell variable names.
- 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'" ;;
-
- -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \
- | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \
- | --exec | --exe | --ex)
- ac_prev=exec_prefix ;;
- -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \
- | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \
- | --exec=* | --exe=* | --ex=*)
- exec_prefix=$ac_optarg ;;
-
- -gas | --gas | --ga | --g)
- # Obsolete; use --with-gas.
- with_gas=yes ;;
-
- -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_alias ;;
- -host=* | --host=* | --hos=* | --ho=*)
- 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 ;;
-
- -infodir | --infodir | --infodi | --infod | --info | --inf)
- ac_prev=infodir ;;
- -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*)
- infodir=$ac_optarg ;;
-
- -libdir | --libdir | --libdi | --libd)
- ac_prev=libdir ;;
- -libdir=* | --libdir=* | --libdi=* | --libd=*)
- 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 ;;
-
- -localstatedir | --localstatedir | --localstatedi | --localstated \
- | --localstate | --localstat | --localsta | --localst \
- | --locals | --local | --loca | --loc | --lo)
- ac_prev=localstatedir ;;
- -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \
- | --localstate=* | --localstat=* | --localsta=* | --localst=* \
- | --locals=* | --local=* | --loca=* | --loc=* | --lo=*)
- localstatedir=$ac_optarg ;;
-
- -mandir | --mandir | --mandi | --mand | --man | --ma | --m)
- ac_prev=mandir ;;
- -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*)
- 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 | -n)
- no_create=yes ;;
-
- -no-recursion | --no-recursion | --no-recursio | --no-recursi \
- | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r)
- no_recursion=yes ;;
-
- -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \
- | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \
- | --oldin | --oldi | --old | --ol | --o)
- ac_prev=oldincludedir ;;
- -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \
- | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \
- | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*)
- oldincludedir=$ac_optarg ;;
-
- -prefix | --prefix | --prefi | --pref | --pre | --pr | --p)
- ac_prev=prefix ;;
- -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*)
- 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-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-transform-name | --program-transform-name \
- | --program-transform-nam | --program-transform-na \
- | --program-transform-n | --program-transform- \
- | --program-transform | --program-transfor \
- | --program-transfo | --program-transf \
- | --program-trans | --program-tran \
- | --progr-tra | --program-tr | --program-t)
- ac_prev=program_transform_name ;;
- -program-transform-name=* | --program-transform-name=* \
- | --program-transform-nam=* | --program-transform-na=* \
- | --program-transform-n=* | --program-transform-=* \
- | --program-transform=* | --program-transfor=* \
- | --program-transfo=* | --program-transf=* \
- | --program-trans=* | --program-tran=* \
- | --progr-tra=* | --program-tr=* | --program-t=*)
- program_transform_name=$ac_optarg ;;
-
- -q | -quiet | --quiet | --quie | --qui | --qu | --q \
- | -silent | --silent | --silen | --sile | --sil)
- silent=yes ;;
-
- -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb)
- ac_prev=sbindir ;;
- -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \
- | --sbi=* | --sb=*)
- sbindir=$ac_optarg ;;
-
- -sharedstatedir | --sharedstatedir | --sharedstatedi \
- | --sharedstated | --sharedstate | --sharedstat | --sharedsta \
- | --sharedst | --shareds | --shared | --share | --shar \
- | --sha | --sh)
- ac_prev=sharedstatedir ;;
- -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \
- | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \
- | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \
- | --sha=* | --sh=*)
- sharedstatedir=$ac_optarg ;;
-
- -site | --site | --sit)
- ac_prev=site ;;
- -site=* | --site=* | --sit=*)
- site=$ac_optarg ;;
-
- -srcdir | --srcdir | --srcdi | --srcd | --src | --sr)
- ac_prev=srcdir ;;
- -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*)
- 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 ;;
-
- -target | --target | --targe | --targ | --tar | --ta | --t)
- ac_prev=target_alias ;;
- -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*)
- target_alias=$ac_optarg ;;
-
- -v | -verbose | --verbose | --verbos | --verbo | --verb)
- verbose=yes ;;
-
- -version | --version | --versio | --versi | --vers | -V)
- ac_init_version=: ;;
-
- -with-* | --with-*)
- ac_package=`expr "x$ac_option" : 'x-*with-\([^=]*\)'`
- # Reject names that are not valid shell variable names.
- 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
- *=*) ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`;;
- *) ac_optarg=yes ;;
- esac
- eval "with_$ac_package='$ac_optarg'" ;;
-
- -without-* | --without-*)
- ac_package=`expr "x$ac_option" : 'x-*without-\(.*\)'`
- # Reject names that are not valid shell variable names.
- 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.
- with_x=yes ;;
-
- -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \
- | --x-incl | --x-inc | --x-in | --x-i)
- 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-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 ;;
-
- -*) { 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 ;;
-
- *)
- # 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
- ac_option=--`echo $ac_prev | sed 's/_/-/g'`
- { echo "$as_me: error: missing argument to $ac_option" >&2
- { (exit 1); exit 1; }; }
-fi
-
-# 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
-
-# Be sure to have absolute paths.
-for ac_var in bindir sbindir libexecdir datadir sysconfdir sharedstatedir \
- localstatedir libdir includedir oldincludedir infodir mandir
-do
- 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
-
-# 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
-
-ac_tool_prefix=
-test -n "$host_alias" && ac_tool_prefix=$host_alias-
-
-test "$silent" = yes && exec 6>/dev/null
-
-
-# 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_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=..
- fi
-else
- ac_srcdir_defaulted=no
-fi
-if test ! -r $srcdir/$ac_unique_file; then
- if test "$ac_srcdir_defaulted" = yes; then
- { echo "$as_me: error: cannot find sources ($ac_unique_file) in $ac_confdir or .." >&2
- { (exit 1); exit 1; }; }
- else
- { echo "$as_me: error: cannot find sources ($ac_unique_file) in $srcdir" >&2
- { (exit 1); exit 1; }; }
- fi
-fi
-(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 (default: on)
- --enable-shared build and link with shared libraries (default: on)
- --enable-64bit enable 64bit support (where applicable)
- --enable-wince enable Win/CE support (where applicable)
- --enable-symbols build with debugging symbols (default: off)
- --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
- CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site"
- else
- CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site"
- fi
-fi
-for ac_site_file in $CONFIG_SITE; do
- if test -r "$ac_site_file"; then
- { 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
- # 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 "$as_me:$LINENO: creating cache $cache_file" >&5
-echo "$as_me: creating cache $cache_file" >&6;}
- >$cache_file
-fi
-
-# 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
-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
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-# 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.6
-TCL_MAJOR_VERSION=8
-TCL_MINOR_VERSION=6
-TCL_PATCH_LEVEL=".9"
-VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION
-
-TCL_DDE_VERSION=1.4
-TCL_DDE_MAJOR_VERSION=1
-TCL_DDE_MINOR_VERSION=4
-DDEVER=$TCL_DDE_MAJOR_VERSION$TCL_DDE_MINOR_VERSION
-
-TCL_REG_VERSION=1.3
-TCL_REG_MAJOR_VERSION=1
-TCL_REG_MINOR_VERSION=3
-REGVER=$TCL_REG_MAJOR_VERSION$TCL_REG_MINOR_VERSION
-
-PKG_CFG_ARGS=$@
-
-#------------------------------------------------------------------------
-# Empty slate for bundled packages, to avoid stale configuration
-#------------------------------------------------------------------------
-rm -Rf pkgs
-
-#------------------------------------------------------------------------
-# Handle the --prefix=... option
-#------------------------------------------------------------------------
-
-if test "${prefix}" = "NONE"; then
- prefix=/usr/local
-fi
-if test "${exec_prefix}" = "NONE"; then
- exec_prefix=$prefix
-fi
-# libdir must be a fully qualified path (not ${exec_prefix}/lib)
-eval libdir="$libdir"
-
-#------------------------------------------------------------------------
-# Standard compiler checks
-#------------------------------------------------------------------------
-
-# If the user did not set CFLAGS, set it now to keep
-# the AC_PROG_CC macro from adding "-g -O2".
-if test "${CFLAGS+set}" != "set" ; then
- CFLAGS=""
-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
-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 "$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
-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
-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 "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 "$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
- ac_prog_rejected=no
-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 $# != 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
- ac_cv_prog_CC="$as_dir/$ac_word${1+' '}$@"
- fi
-fi
-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 "$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
-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
-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
-
- 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
-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
-
- test -n "$ac_ct_CC" && break
-done
-
- 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
- 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
-fi
-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
- { { 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
-
-rm -f conftest$ac_cv_exeext
-echo "$as_me:$LINENO: result: $ac_cv_exeext" >&5
-echo "${ECHO_T}$ac_cv_exeext" >&6
-
-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
- 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
-
-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
- 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
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-ac_compiler_gnu=no
-fi
-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
-
-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
-elif test $ac_cv_prog_cc_g = yes; then
- if test "$GCC" = yes; then
- CFLAGS="-g -O2"
- else
- CFLAGS="-g"
- fi
-else
- if test "$GCC" = yes; then
- CFLAGS="-O2"
- 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
-
-fi
-
-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
- 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
- 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
-
-else
- 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
-
-
-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
- 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
- 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
-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
- 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
-
- # 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
-
- done
- ac_cv_prog_CPP=$CPP
-
-fi
- CPP=$ac_cv_prog_CPP
-else
- 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
-
- # 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
-
-
-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 >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
- 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 conftest*
-
-fi
-
-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
- ac_cv_header_stdc=no
-fi
-rm -f conftest*
-
-fi
-
-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
-
-#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 "$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
-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
-
-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
-
-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
- echo "$as_me:$LINENO: result: no" >&5
-echo "${ECHO_T}no" >&6
-fi
-
-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
-
-fi
-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
-
- AR=$ac_ct_AR
-else
- AR="$ac_cv_prog_AR"
-fi
-
-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
- 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
-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
-
-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
-
-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 -n "$RC"; then
- ac_cv_prog_RC="$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_RC="${ac_tool_prefix}windres"
- echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
- break 2
- fi
-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.)
-#--------------------------------------------------------------------
-
-
-
-
-#--------------------------------------------------------------------
-# Check whether --enable-threads or --disable-threads was given.
-#--------------------------------------------------------------------
-
-
- 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=yes
-fi;
-
- if test "$tcl_ok" = "yes"; then
- echo "$as_me:$LINENO: result: yes (default)" >&5
-echo "${ECHO_T}yes (default)" >&6
- TCL_THREADS=1
- cat >>confdefs.h <<\_ACEOF
-#define TCL_THREADS 1
-_ACEOF
-
- # USE_THREAD_ALLOC tells us to try the special thread-based
- # allocator that significantly reduces lock contention
- cat >>confdefs.h <<\_ACEOF
-#define USE_THREAD_ALLOC 1
-_ACEOF
-
- else
- TCL_THREADS=0
- echo "$as_me:$LINENO: result: no" >&5
-echo "${ECHO_T}no" >&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
-
-
-#--------------------------------------------------------------------
-# The statements below define a collection of symbols related to
-# building libtcl as a shared library instead of a static library.
-#--------------------------------------------------------------------
-
-
- 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;
-
- if test "${enable_shared+set}" = set; then
- enableval="$enable_shared"
- tcl_ok=$enableval
- else
- tcl_ok=yes
- fi
-
- if test "$tcl_ok" = "yes" ; then
- echo "$as_me:$LINENO: result: shared" >&5
-echo "${ECHO_T}shared" >&6
- SHARED_BUILD=1
- else
- echo "$as_me:$LINENO: result: static" >&5
-echo "${ECHO_T}static" >&6
- SHARED_BUILD=0
-
-cat >>confdefs.h <<\_ACEOF
-#define STATIC_BUILD 1
-_ACEOF
-
- fi
-
-
-#--------------------------------------------------------------------
-# The statements below define a collection of compile flags. This
-# macro depends on the value of SHARED_BUILD, and should be called
-# after SC_ENABLE_SHARED checks the configure switches.
-#--------------------------------------------------------------------
-
-# 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 "$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 "$as_me:$LINENO: result: $do64bit" >&5
-echo "${ECHO_T}$do64bit" >&6
-
- # Cross-compiling options for Windows/CE builds
-
- 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;
- echo "$as_me:$LINENO: result: $doWince" >&5
-echo "${ECHO_T}$doWince" >&6
-
- echo "$as_me:$LINENO: checking for Windows/CE celib directory" >&5
-echo $ECHO_N "checking for Windows/CE celib directory... $ECHO_C" >&6
-
-# 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 "$as_me:$LINENO: result: $CELIB_DIR" >&5
-echo "${ECHO_T}$CELIB_DIR" >&6
-
- # Set some defaults (may get changed below)
- EXTRA_CFLAGS=""
-
-cat >>confdefs.h <<\_ACEOF
-#define MODULE_SCOPE extern
-_ACEOF
-
-
- # Extract the first word of "cygpath", so it can be a program name with args.
-set dummy cygpath; ac_word=$2
-echo "$as_me:$LINENO: checking for $ac_word" >&5
-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
-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 -m"
- 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
-if test -n "$CYGPATH"; then
- echo "$as_me:$LINENO: result: $CYGPATH" >&5
-echo "${ECHO_T}$CYGPATH" >&6
-else
- echo "$as_me:$LINENO: result: no" >&5
-echo "${ECHO_T}no" >&6
-fi
-
-
- SHLIB_SUFFIX=".dll"
-
- # MACHINE is IX86 for LINK, but this is used by the manifest,
- # which requires x86|amd64|ia64.
- MACHINE="X86"
-
- if test "$GCC" = "yes"; then
-
- 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 <<_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;
-}
-_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 "$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
-
-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
- amd64|x64|yes)
- CC="x86_64-w64-mingw32-gcc"
- LD="x86_64-w64-mingw32-ld"
- AR="x86_64-w64-mingw32-ar"
- RANLIB="x86_64-w64-mingw32-ranlib"
- RC="x86_64-w64-mingw32-windres"
- ;;
- *)
- CC="i686-w64-mingw32-gcc"
- LD="i686-w64-mingw32-ld"
- AR="i686-w64-mingw32-ar"
- RANLIB="i686-w64-mingw32-ranlib"
- RC="i686-w64-mingw32-windres"
- ;;
- esac
- fi
- fi
-
- # Check for a bug in gcc's windres that causes the
- # compile to fail when a Windows native path is
- # passed into windres. The mingw toolchain requires
- # Windows native paths while Cygwin should work
- # with both. Avoid the bug by passing a POSIX
- # path when using the Cygwin toolchain.
-
- if test "$GCC" = "yes" && test "$CYGPATH" != "echo" ; then
- conftest=/tmp/conftest.rc
- echo "STRINGTABLE BEGIN" > $conftest
- echo "101 \"name\"" >> $conftest
- echo "END" >> $conftest
-
- 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 "$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 "$as_me:$LINENO: result: yes" >&5
-echo "${ECHO_T}yes" >&6
- CYGPATH=echo
- fi
- conftest=
- cyg_conftest=
- fi
-
- if test "$CYGPATH" = "echo"; then
- DEPARG='"$<"'
- else
- DEPARG='"$(shell $(CYGPATH) $<)"'
- fi
-
- # set various compiler flags depending on whether we are using gcc or cl
-
- if test "${GCC}" = "yes" ; then
- extra_cflags="-pipe"
- extra_ldflags="-pipe -static-libgcc"
- 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 <<_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;
-}
-_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 "$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
-
-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 "$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
-
- hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -mwindows -municode -Dmain=xxmain"
- echo "$as_me:$LINENO: checking for working -municode linker flag" >&5
-echo $ECHO_N "checking for working -municode linker flag... $ECHO_C" >&6
-if test "${ac_cv_municode+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-
- #include <windows.h>
- int APIENTRY wWinMain(HINSTANCE a, HINSTANCE b, LPWSTR c, int d) {return 0;}
-
-int
-main ()
-{
-
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_cv_municode=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-ac_cv_municode=no
-fi
-rm -f conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-
-fi
-echo "$as_me:$LINENO: result: $ac_cv_municode" >&5
-echo "${ECHO_T}$ac_cv_municode" >&6
- CFLAGS=$hold_cflags
- if test "$ac_cv_municode" = "yes" ; then
- extra_ldflags="$extra_ldflags -municode"
- else
- extra_cflags="$extra_cflags -DTCL_BROKEN_MAINARGS"
- fi
- fi
-
- echo "$as_me:$LINENO: checking compiler flags" >&5
-echo $ECHO_N "checking compiler flags... $ECHO_C" >&6
- if test "${GCC}" = "yes" ; then
- SHLIB_LD=""
- SHLIB_LD_LIBS='${LIBS}'
- LIBS="-lnetapi32 -lkernel32 -luser32 -ladvapi32 -luserenv -lws2_32"
- # 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=
- RC_INCLUDE=--include
- RC_DEFINE=--define
- RES=res.o
- MAKE_LIB="\${STLIB_LD} \$@"
- MAKE_STUB_LIB="\${STLIB_LD} \$@"
- POST_MAKE_LIB="\${RANLIB} \$@"
- MAKE_EXE="\${CC} -o \$@"
- LIBPREFIX="lib"
-
- if test "${SHARED_BUILD}" = "0" ; then
- # static
- echo "$as_me:$LINENO: result: using static flags" >&5
-echo "${ECHO_T}using static flags" >&6
- runtime=
- LIBRARIES="\${STATIC_LIBRARIES}"
- EXESUFFIX="s\${DBGX}.exe"
- else
- # dynamic
- 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 "$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=
- # Add SHLIB_LD_LIBS to the Make rule, not here.
-
- EXESUFFIX="\${DBGX}.exe"
- LIBRARIES="\${SHARED_LIBRARIES}"
- fi
- # Link with gcc since ld does not link to default libs like
- # -luser32 and -lmsvcrt by default.
- SHLIB_LD='${CC} -shared'
- SHLIB_LD_LIBS='${LIBS}'
- MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -o \$@ ${extra_ldflags} \
- -Wl,--out-implib,\$(patsubst %.dll,lib%.a,\$@)"
- # DLLSUFFIX is separate because it is the building block for
- # users of tclConfig.sh that may build shared or static.
- DLLSUFFIX="\${DBGX}.dll"
- LIBSUFFIX="\${DBGX}.a"
- LIBFLAGSUFFIX="\${DBGX}"
- SHLIB_SUFFIX=.dll
-
- EXTRA_CFLAGS="${extra_cflags}"
-
- CFLAGS_DEBUG=-g
- CFLAGS_OPTIMIZE="-O2 -fomit-frame-pointer"
- CFLAGS_WARNING="-Wall -Wdeclaration-after-statement"
- LDFLAGS_DEBUG=
- LDFLAGS_OPTIMIZE=
-
- # Specify the CC output file names based on the target name
- CC_OBJNAME="-o \$@"
- CC_EXENAME="-o \$@"
-
- # Specify linker flags depending on the type of app being
- # built -- Console vs. Window.
- #
- # ORIGINAL COMMENT:
- # We need to pass -e _WinMain@16 so that ld will use
- # WinMain() instead of main() as the entry point. We can't
- # use autoconf to check for this case since it would need
- # to run an executable and that does not work when
- # cross compiling. Remove this -e workaround once we
- # require a gcc that does not have this bug.
- #
- # MK NOTE: Tk should use a different mechanism. This causes
- # interesting problems, such as wish dying at startup.
- #LDFLAGS_WINDOW="-mwindows -e _WinMain@16 ${extra_ldflags}"
- LDFLAGS_CONSOLE="-mconsole ${extra_ldflags}"
- LDFLAGS_WINDOW="-mwindows ${extra_ldflags}"
-
- case "$do64bit" in
- amd64|x64|yes)
- MACHINE="AMD64" ; # assume AMD64 as default 64-bit build
- echo "$as_me:$LINENO: result: Using 64-bit $MACHINE mode" >&5
-echo "${ECHO_T} Using 64-bit $MACHINE mode" >&6
- ;;
- ia64)
- MACHINE="IA64"
- echo "$as_me:$LINENO: result: Using 64-bit $MACHINE mode" >&5
-echo "${ECHO_T} Using 64-bit $MACHINE mode" >&6
- ;;
- *)
- 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;
-}
-_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 "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-tcl_win_64bit=no
-
-fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
- if test "$tcl_win_64bit" = "yes" ; then
- do64bit=amd64
- MACHINE="AMD64"
- 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 "$as_me:$LINENO: result: using static flags" >&5
-echo "${ECHO_T}using static flags" >&6
- runtime=-MT
- LIBRARIES="\${STATIC_LIBRARIES}"
- EXESUFFIX="s\${DBGX}.exe"
- else
- # dynamic
- echo "$as_me:$LINENO: result: using shared flags" >&5
-echo "${ECHO_T}using shared flags" >&6
- runtime=-MD
- # Add SHLIB_LD_LIBS to the Make rule, not here.
- LIBRARIES="\${SHARED_LIBRARIES}"
- EXESUFFIX="\${DBGX}.exe"
- case "x`echo \${VisualStudioVersion}`" in
- x1[4-9]*)
- lflags="${lflags} -nodefaultlib:libucrt.lib"
- ;;
- *)
- ;;
- esac
- fi
- MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -out:\$@"
- # DLLSUFFIX is separate because it is the building block for
- # users of tclConfig.sh that may build shared or static.
- DLLSUFFIX="\${DBGX}.dll"
- LIBSUFFIX="\${DBGX}.lib"
- LIBFLAGSUFFIX="\${DBGX}"
-
- # This is a 2-stage check to make sure we have the 64-bit SDK
- # We have to know where the SDK is installed.
- # This magic is based on MS Platform SDK for Win2003 SP1 - hobbs
- if test "$do64bit" != "no" ; then
- if test "x${MSSDK}x" = "xx" ; then
- MSSDK="C:/Progra~1/Microsoft Platform SDK"
- fi
- MSSDK=`echo "$MSSDK" | sed -e 's!\\\!/!g'`
- PATH64=""
- case "$do64bit" in
- amd64|x64|yes)
- MACHINE="AMD64" ; # assume AMD64 as default 64-bit build
- PATH64="${MSSDK}/Bin/Win64/x86/AMD64"
- ;;
- ia64)
- MACHINE="IA64"
- PATH64="${MSSDK}/Bin/Win64"
- ;;
- esac
- if test ! -d "${PATH64}" ; then
- { echo "$as_me:$LINENO: WARNING: Could not find 64-bit $MACHINE SDK" >&5
-echo "$as_me: WARNING: Could not find 64-bit $MACHINE SDK" >&2;}
- fi
- echo "$as_me:$LINENO: result: Using 64-bit $MACHINE mode" >&5
-echo "${ECHO_T} Using 64-bit $MACHINE mode" >&6
- fi
-
- LIBS="netapi32.lib kernel32.lib user32.lib advapi32.lib userenv.lib ws2_32.lib"
-
- case "x`echo \${VisualStudioVersion}`" in
- x1[4-9]*)
- LIBS="$LIBS ucrt.lib"
- ;;
- *)
- ;;
- esac
-
- 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.
- # 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.
- CFLAGS_OPTIMIZE="-nologo -O1 ${runtime}"
- lflags="${lflags} -nologo -MACHINE:${MACHINE} -LIBPATH:\"${MSSDK}/Lib/${MACHINE}\""
- LINKBIN="\"${PATH64}/link.exe\""
- # Avoid 'unresolved external symbol __security_cookie' errors.
- # c.f. http://support.microsoft.com/?id=894573
- LIBS="$LIBS bufferoverflowU.lib"
- else
- RC="rc"
- # -Od - no optimization
- # -WX - warnings as errors
- CFLAGS_DEBUG="-nologo -Z7 -Od -WX ${runtime}d"
- # -O2 - create fast code (/Og /Oi /Ot /Oy /Ob2 /Gs /GF /Gy)
- CFLAGS_OPTIMIZE="-nologo -O2 ${runtime}"
- lflags="${lflags} -nologo"
- LINKBIN="link"
- fi
-
- if test "$doWince" != "no" ; then
- # Set defaults for common evc4/PPC2003 setup
- # Currently Tcl requires 300+, possibly 420+ for sockets
- CEVERSION=420; # could be 211 300 301 400 420 ...
- TARGETCPU=ARMV4; # could be ARMV4 ARM MIPS SH3 X86 ...
- ARCH=ARM; # could be ARM MIPS X86EM ...
- PLATFORM="Pocket PC 2003"; # or "Pocket PC 2002"
- if test "$doWince" != "yes"; then
- # If !yes then the user specified something
- # Reset ARCH to allow user to skip specifying it
- ARCH=
- eval `echo $doWince | awk -F "," '{ \
- if (length($1)) { printf "CEVERSION=\"%s\"\n", $1; \
- if ($1 < 400) { printf "PLATFORM=\"Pocket PC 2002\"\n" } }; \
- if (length($2)) { printf "TARGETCPU=\"%s\"\n", toupper($2) }; \
- if (length($3)) { printf "ARCH=\"%s\"\n", toupper($3) }; \
- if (length($4)) { printf "PLATFORM=\"%s\"\n", $4 }; \
- }'`
- if test "x${ARCH}" = "x" ; then
- ARCH=$TARGETCPU;
- fi
- fi
- OSVERSION=WCE$CEVERSION;
- if test "x${WCEROOT}" = "x" ; then
- WCEROOT="C:/Program Files/Microsoft eMbedded C++ 4.0"
- if test ! -d "${WCEROOT}" ; then
- WCEROOT="C:/Program Files/Microsoft eMbedded Tools"
- fi
- fi
- if test "x${SDKROOT}" = "x" ; then
- SDKROOT="C:/Program Files/Windows CE Tools"
- if test ! -d "${SDKROOT}" ; then
- SDKROOT="C:/Windows CE Tools"
- fi
- fi
- # The space-based-path will work for the Makefile, but will
- # not work if AC_TRY_COMPILE is called.
- WCEROOT=`echo "$WCEROOT" | sed -e 's!\\\!/!g'`
- SDKROOT=`echo "$SDKROOT" | sed -e 's!\\\!/!g'`
- CELIB_DIR=`echo "$CELIB_DIR" | sed -e 's!\\\!/!g'`
- if test ! -d "${CELIB_DIR}/inc"; then
- { { 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 "$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
- CEINCLUDE="${CEINCLUDE}/${TARGETCPU}"
- fi
- CELIBPATH="${SDKROOT}/${OSVERSION}/${PLATFORM}/Lib/${TARGETCPU}"
- fi
- fi
-
- if test "$doWince" != "no" ; then
- CEBINROOT="${WCEROOT}/EVC/${OSVERSION}/bin"
- if test "${TARGETCPU}" = "X86"; then
- CC="${CEBINROOT}/cl.exe"
- else
- CC="${CEBINROOT}/cl${ARCH}.exe"
- fi
- CC="\"${CC}\" -I\"${CELIB_DIR}/inc\" -I\"${CEINCLUDE}\""
- RC="\"${WCEROOT}/Common/EVC/bin/rc.exe\""
- arch=`echo ${ARCH} | awk '{print tolower($0)}'`
- defs="${ARCH} _${ARCH}_ ${arch} PALM_SIZE _MT _DLL _WINDOWS"
- for i in $defs ; do
- cat >>confdefs.h <<_ACEOF
-#define $i 1
-_ACEOF
-
- done
-# if test "${ARCH}" = "X86EM"; then
-# AC_DEFINE_UNQUOTED(_WIN32_WCE_EMULATION)
-# fi
- cat >>confdefs.h <<_ACEOF
-#define _WIN32_WCE $CEVERSION
-_ACEOF
-
- cat >>confdefs.h <<_ACEOF
-#define UNDER_CE $CEVERSION
-_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
- LIBS="coredll.lib corelibc.lib ws2.lib"
- fi
- # celib currently stuck at wce300 status
- #LIBS="$LIBS \${CELIB_DIR}/wince-${ARCH}-pocket-${OSVERSION}-release/celib.lib"
- 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 uuid.lib"
- fi
-
- SHLIB_LD="${LINKBIN} -dll -incremental:no ${lflags}"
- SHLIB_LD_LIBS='${LIBS}'
- # link -lib only works when -lib is the first arg
- STLIB_LD="${LINKBIN} -lib ${lflags}"
- RC_OUT=-fo
- RC_TYPE=-r
- RC_INCLUDE=-i
- RC_DEFINE=-d
- RES=res
- MAKE_LIB="\${STLIB_LD} -out:\$@"
- MAKE_STUB_LIB="\${STLIB_LD} -nodefaultlib -out:\$@"
- POST_MAKE_LIB=
- MAKE_EXE="\${CC} -Fe\$@"
- LIBPREFIX=""
-
- CFLAGS_DEBUG="${CFLAGS_DEBUG} -D_CRT_SECURE_NO_DEPRECATE -D_CRT_NONSTDC_NO_DEPRECATE"
- CFLAGS_OPTIMIZE="${CFLAGS_OPTIMIZE} -D_CRT_SECURE_NO_DEPRECATE -D_CRT_NONSTDC_NO_DEPRECATE"
-
- EXTRA_CFLAGS=""
- CFLAGS_WARNING="-W3"
- LDFLAGS_DEBUG="-debug"
- LDFLAGS_OPTIMIZE="-release"
-
- # Specify the CC output file names based on the target name
- CC_OBJNAME="-Fo\$@"
- CC_EXENAME="-Fe\"\$(shell \$(CYGPATH) '\$@')\""
-
- # Specify linker flags depending on the type of app being
- # built -- Console vs. Window.
- if test "$doWince" != "no" -a "${TARGETCPU}" != "X86"; then
- LDFLAGS_CONSOLE="-link ${lflags}"
- LDFLAGS_WINDOW=${LDFLAGS_CONSOLE}
- else
- LDFLAGS_CONSOLE="-link -subsystem:console ${lflags}"
- LDFLAGS_WINDOW="-link -subsystem:windows ${lflags}"
- fi
- fi
-
- if test "$do64bit" != "no" ; then
- cat >>confdefs.h <<\_ACEOF
-#define TCL_CFG_DO64BIT 1
-_ACEOF
-
- fi
-
- if test "${GCC}" = "yes" ; then
- 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 <<_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 argc, char** argv) {
- int a, b = 0;
- __try {
- a = 666 / b;
- }
- __except (EXCEPTION_EXECUTE_HANDLER) {
- return 0;
- }
- return 1;
- }
-
-_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 "$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 -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext
-fi
-
-fi
-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 <<\_ACEOF
-#define HAVE_NO_SEH 1
-_ACEOF
-
- fi
-
- #
- # Check to see if the excpt.h include file provided contains the
- # definition for EXCEPTION_DISPOSITION; if not, which is the case
- # with Cygwin's version as of 2002-04-10, define it to be int,
- # sufficient for getting the current code to work.
- #
- 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 <<_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 ()
-{
-
- EXCEPTION_DISPOSITION x;
-
- ;
- 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 "$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
-
-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 <<\_ACEOF
-#define EXCEPTION_DISPOSITION int
-_ACEOF
-
- fi
-
- # Check to see if winnt.h defines CHAR, SHORT, and LONG
- # even if VOID has already been #defined. The win32api
- # used by mingw and cygwin is known to do this.
-
- 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 <<_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 ()
-{
-
- CHAR c;
- SHORT s;
- LONG l;
-
- ;
- 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 "$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
-
-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 <<\_ACEOF
-#define HAVE_WINNT_IGNORE_VOID 1
-_ACEOF
-
- fi
-
- # See if the compiler supports casting to a union type.
- # This is used to stop gcc from printing a compiler
- # warning when initializing a union member.
-
- 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 <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-
-int
-main ()
-{
-
- union foo { int i; double d; };
- union foo f = (union foo) (int) 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_cv_cast_to_union=yes
-else
- 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
-
-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 <<\_ACEOF
-#define HAVE_CAST_TO_UNION 1
-_ACEOF
-
- fi
- fi
-
- # DL_LIBS is empty, but then we match the Unix version
-
-
-
-
-
-
-# Cross-compiling
-case ${host_alias} in
-*mingw32*)
- TCL_EXE="tclsh"
- ;;
-*)
- TCL_EXE="TCL_LIBRARY=\"\${LIBRARY_DIR}\"; export TCL_LIBRARY; ./\${TCLSH}"
- ;;
-esac
-
-#------------------------------------------------------------------------
-# Add stuff for zlib; note that this is mostly done in the makefile now
-# as we just assume that the platform hasn't got a usable z.lib
-#------------------------------------------------------------------------
-
-if test "${enable_shared+set}" = "set"; then
-
- enableval="$enable_shared"
- tcl_ok=$enableval
-
-else
-
- tcl_ok=yes
-
-fi
-
-if test "$tcl_ok" = "yes"; then
-
- ZLIB_DLL_FILE=\${ZLIB_DLL_FILE}
-
- if test "$do64bit" != "no"; then
-
- if test "$GCC" == "yes"; then
-
- ZLIB_LIBS=\${ZLIB_DIR_NATIVE}/win64/libz.dll.a
-
-
-else
-
- ZLIB_LIBS=\${ZLIB_DIR_NATIVE}/win64/zdll.lib
-
-
-fi
-
-
-else
-
- ZLIB_LIBS=\${ZLIB_DIR_NATIVE}/win32/zdll.lib
-
-
-fi
-
-
-else
-
- ZLIB_OBJS=\${ZLIB_OBJS}
-
-
-fi
-
-
-cat >>confdefs.h <<\_ACEOF
-#define HAVE_ZLIB 1
-_ACEOF
-
-
-echo "$as_me:$LINENO: checking for intptr_t" >&5
-echo $ECHO_N "checking for intptr_t... $ECHO_C" >&6
-if test "${ac_cv_type_intptr_t+set}" = set; then
- 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 ((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
-
-
-cat >>confdefs.h <<\_ACEOF
-#define HAVE_INTPTR_T 1
-_ACEOF
-
-else
-
- 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
-
- 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 "$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_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 "$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
-
- 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
-
- 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
- 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
-
-
-#--------------------------------------------------------------------
-# Perform additinal compiler tests.
-#--------------------------------------------------------------------
-
-# See if declarations like FINDEX_INFO_LEVELS are
-# missing from winbase.h. This is known to be
-# a problem with VC++ 5.2.
-
-echo "$as_me:$LINENO: checking for FINDEX_INFO_LEVELS in winbase.h" >&5
-echo $ECHO_N "checking for FINDEX_INFO_LEVELS in winbase.h... $ECHO_C" >&6
-if test "${tcl_cv_findex_enums+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-
-#define WIN32_LEAN_AND_MEAN
-#include <windows.h>
-#undef WIN32_LEAN_AND_MEAN
-
-int
-main ()
-{
-
- FINDEX_INFO_LEVELS i;
- FINDEX_SEARCH_OPS j;
-
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- tcl_cv_findex_enums=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-tcl_cv_findex_enums=no
-fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
-
-fi
-echo "$as_me:$LINENO: result: $tcl_cv_findex_enums" >&5
-echo "${ECHO_T}$tcl_cv_findex_enums" >&6
-if test "$tcl_cv_findex_enums" = "no"; then
-
-cat >>confdefs.h <<\_ACEOF
-#define HAVE_NO_FINDEX_ENUMS 1
-_ACEOF
-
-fi
-
-# See if the compiler supports intrinsics.
-
-echo "$as_me:$LINENO: checking for intrinsics support in compiler" >&5
-echo $ECHO_N "checking for intrinsics support in compiler... $ECHO_C" >&6
-if test "${tcl_cv_intrinsics+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-
-#define WIN32_LEAN_AND_MEAN
-#include <windows.h>
-#undef WIN32_LEAN_AND_MEAN
-#include <intrin.h>
-
-int
-main ()
-{
-
- __cpuidex(0,0,0);
-
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- tcl_cv_intrinsics=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-tcl_cv_intrinsics=no
-fi
-rm -f conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-
-fi
-echo "$as_me:$LINENO: result: $tcl_cv_intrinsics" >&5
-echo "${ECHO_T}$tcl_cv_intrinsics" >&6
-if test "$tcl_cv_intrinsics" = "yes"; then
-
-cat >>confdefs.h <<\_ACEOF
-#define HAVE_INTRIN_H 1
-_ACEOF
-
-fi
-
-# See if the <wspiapi.h> header file is present
-
-echo "$as_me:$LINENO: checking for wspiapi.h" >&5
-echo $ECHO_N "checking for wspiapi.h... $ECHO_C" >&6
-if test "${tcl_cv_wspiapi_h+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-
-#include <wspiapi.h>
-
-int
-main ()
-{
-
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- tcl_cv_wspiapi_h=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-tcl_cv_wspiapi_h=no
-fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
-
-fi
-echo "$as_me:$LINENO: result: $tcl_cv_wspiapi_h" >&5
-echo "${ECHO_T}$tcl_cv_wspiapi_h" >&6
-if test "$tcl_cv_wspiapi_h" = "yes"; then
-
-cat >>confdefs.h <<\_ACEOF
-#define HAVE_WSPIAPI_H 1
-_ACEOF
-
-fi
-
-# See if declarations like FINDEX_INFO_LEVELS are
-# missing from winbase.h. This is known to be
-# a problem with VC++ 5.2.
-
-echo "$as_me:$LINENO: checking for FINDEX_INFO_LEVELS in winbase.h" >&5
-echo $ECHO_N "checking for FINDEX_INFO_LEVELS in winbase.h... $ECHO_C" >&6
-if test "${tcl_cv_findex_enums+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-
-#define WIN32_LEAN_AND_MEAN
-#include <windows.h>
-#undef WIN32_LEAN_AND_MEAN
-
-int
-main ()
-{
-
- FINDEX_INFO_LEVELS i;
- FINDEX_SEARCH_OPS j;
-
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- tcl_cv_findex_enums=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-tcl_cv_findex_enums=no
-fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
-
-fi
-echo "$as_me:$LINENO: result: $tcl_cv_findex_enums" >&5
-echo "${ECHO_T}$tcl_cv_findex_enums" >&6
-if test "$tcl_cv_findex_enums" = "no"; then
-
-cat >>confdefs.h <<\_ACEOF
-#define HAVE_NO_FINDEX_ENUMS 1
-_ACEOF
-
-fi
-
-#--------------------------------------------------------------------
-# Set the default compiler switches based on the --enable-symbols
-# option. This macro depends on C flags, and should be called
-# after SC_CONFIG_CFLAGS macro is called.
-#--------------------------------------------------------------------
-
-
- 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;
-# 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 <<\_ACEOF
-#define NDEBUG 1
-_ACEOF
-
- echo "$as_me:$LINENO: result: no" >&5
-echo "${ECHO_T}no" >&6
-
- cat >>confdefs.h <<\_ACEOF
-#define TCL_CFG_OPTIMIZED 1
-_ACEOF
-
- else
- CFLAGS_DEFAULT='$(CFLAGS_DEBUG)'
- LDFLAGS_DEFAULT='$(LDFLAGS_DEBUG)'
- DBGX=g
- if test "$tcl_ok" = "yes"; then
- 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 <<\_ACEOF
-#define TCL_MEM_DEBUG 1
-_ACEOF
-
- fi
-
- if test "$tcl_ok" = "compile" -o "$tcl_ok" = "all"; then
-
-cat >>confdefs.h <<\_ACEOF
-#define TCL_COMPILE_DEBUG 1
-_ACEOF
-
-
-cat >>confdefs.h <<\_ACEOF
-#define TCL_COMPILE_STATS 1
-_ACEOF
-
- fi
-
- if test "$tcl_ok" != "yes" -a "$tcl_ok" != "no"; then
- if test "$tcl_ok" = "all"; then
- echo "$as_me:$LINENO: result: enabled symbols mem compile debugging" >&5
-echo "${ECHO_T}enabled symbols mem compile debugging" >&6
- else
- echo "$as_me:$LINENO: result: enabled $tcl_ok debugging" >&5
-echo "${ECHO_T}enabled $tcl_ok debugging" >&6
- fi
- fi
-
-
-TCL_DBGX=${DBGX}
-
-#--------------------------------------------------------------------
-# Embed the manifest if we can determine how
-#--------------------------------------------------------------------
-
-
- 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
- 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
- echo "$as_me:$LINENO: result: $result" >&5
-echo "${ECHO_T}$result" >&6
-
-
-
-
-#------------------------------------------------------------------------
-# tclConfig.sh refers to this by a different name
-#------------------------------------------------------------------------
-
-TCL_SHARED_BUILD=${SHARED_BUILD}
-
-#--------------------------------------------------------------------
-# Perform final evaluations of variables with possible substitutions.
-#--------------------------------------------------------------------
-
-TCL_SHARED_LIB_SUFFIX="\${NODOT_VERSION}${DLLSUFFIX}"
-TCL_UNSHARED_LIB_SUFFIX="\${NODOT_VERSION}${LIBSUFFIX}"
-TCL_EXPORT_FILE_SUFFIX="\${NODOT_VERSION}${LIBSUFFIX}"
-
-eval "TCL_SRC_DIR=\"`cd $srcdir/..; $CYGPATH $(pwd)`\""
-
-eval "TCL_DLL_FILE=tcl${VER}${DLLSUFFIX}"
-
-eval "TCL_STUB_LIB_FILE=\"${LIBPREFIX}tclstub${VER}${LIBSUFFIX}\""
-eval "TCL_STUB_LIB_FLAG=\"-ltclstub${VER}${LIBFLAGSUFFIX}\""
-eval "TCL_BUILD_STUB_LIB_SPEC=\"-L`$CYGPATH $(pwd)` ${TCL_STUB_LIB_FLAG}\""
-eval "TCL_STUB_LIB_SPEC=\"-L${libdir} ${TCL_STUB_LIB_FLAG}\""
-eval "TCL_BUILD_STUB_LIB_PATH=\"`$CYGPATH $(pwd)`/${TCL_STUB_LIB_FILE}\""
-eval "TCL_STUB_LIB_PATH=\"${libdir}/${TCL_STUB_LIB_FILE}\""
-
-eval "TCL_LIB_FILE=\"${LIBPREFIX}tcl${VER}${LIBSUFFIX}\""
-#eval "TCL_BUILD_LIB_SPEC=\"-L`$CYGPATH $(pwd)` -ltcl${VER}${FLAGSUFFIX}\""
-eval "TCL_BUILD_LIB_SPEC=\"-L`$CYGPATH $(pwd)` -ltcl${VER}${LIBFLAGSUFFIX}\""
-#eval "TCL_LIB_SPEC=\"-L${libdir} -ltcl${VER}${FLAGSUFFIX}\""
-eval "TCL_LIB_SPEC=\"-L${libdir} -ltcl${VER}${LIBFLAGSUFFIX}\""
-
-# Install time header dir can be set via --includedir
-eval "TCL_INCLUDE_SPEC=\"-I${includedir}\""
-
-
-eval "DLLSUFFIX=${DLLSUFFIX}"
-eval "LIBPREFIX=${LIBPREFIX}"
-eval "LIBSUFFIX=${LIBSUFFIX}"
-eval "EXESUFFIX=${EXESUFFIX}"
-
-CFG_TCL_SHARED_LIB_SUFFIX=${TCL_SHARED_LIB_SUFFIX}
-CFG_TCL_UNSHARED_LIB_SUFFIX=${TCL_UNSHARED_LIB_SUFFIX}
-CFG_TCL_EXPORT_FILE_SUFFIX=${TCL_EXPORT_FILE_SUFFIX}
-
-#--------------------------------------------------------------------
-# Adjust the defines for how the resources are built depending
-# on symbols and static vs. shared.
-#--------------------------------------------------------------------
-
-if test ${SHARED_BUILD} = 0 ; then
- if test "${DBGX}" = "g"; then
- RC_DEFINES="${RC_DEFINE} STATIC_BUILD ${RC_DEFINE} DEBUG"
- else
- RC_DEFINES="${RC_DEFINE} STATIC_BUILD"
- fi
-else
- if test "${DBGX}" = "g"; then
- RC_DEFINES="${RC_DEFINE} DEBUG"
- else
- RC_DEFINES=""
- fi
-fi
-
-#--------------------------------------------------------------------
-# The statements below define the symbol TCL_PACKAGE_PATH, which
-# gives a list of directories that may contain packages. The list
-# consists of one directory for machine-dependent binaries and
-# another for platform-independent scripts.
-#--------------------------------------------------------------------
-
-if test "$prefix/lib" != "$libdir"; then
- TCL_PACKAGE_PATH="${libdir} ${prefix}/lib"
-else
- TCL_PACKAGE_PATH="${prefix}/lib"
-fi
-
-# The tclsh.exe.manifest requires these
-# TCL_WIN_VERSION is the 4 dotted pair Windows version format which needs
-# the release level, and must account for interim release versioning
-case "$TCL_PATCH_LEVEL" in
- *a*) TCL_RELEASE_LEVEL=0 ;;
- *b*) TCL_RELEASE_LEVEL=1 ;;
- *) TCL_RELEASE_LEVEL=2 ;;
-esac
-TCL_WIN_VERSION="$TCL_VERSION.$TCL_RELEASE_LEVEL.`echo $TCL_PATCH_LEVEL | tr -d ab.`"
-
-# X86|AMD64|IA64 for manifest
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-# empty on win
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-# win/tcl.m4 doesn't set (CFLAGS)
-
-
-
-
-
-
-
-# win/tcl.m4 doesn't set (LDFLAGS)
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-# empty on win, but needs sub'ing
-
-
-
-
-
-
-
-
-
-
-# win only
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
- ac_config_files="$ac_config_files Makefile tclConfig.sh tcl.hpj tclsh.exe.manifest"
-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, 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.
-#
-# config.status only pays attention to the cache file if you give it
-# the --recheck option to rerun configure.
-#
-# `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 \
- "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
- 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
-
-test "x$prefix" = xNONE && prefix=$ac_default_prefix
-# Let make expand exec_prefix.
-test "x$exec_prefix" = xNONE && exec_prefix='${prefix}'
-
-# 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[ ]*=/{
-s/:*\$(srcdir):*/:/;
-s/:*\${srcdir}:*/:/;
-s/:*@srcdir@:*/:/;
-s/^\([^=]*=[ ]*\):*/\1/;
-s/:*$//;
-s/^[^=]*=[ ]*$//;
-}'
-fi
-
-# Transform confdefs.h into DEFS.
-# Protect against shell expansion while executing Makefile rules.
-# Protect against Makefile macro expansion.
-#
-# 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
-
-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.
-# Compiler output produced by configure, useful for debugging
-# 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
-
-# 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:$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
- 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
-
-ac_configure_extra_args=
-
-if $ac_cs_silent; then
- exec 6>/dev/null
- ac_configure_extra_args="$ac_configure_extra_args --silent"
-fi
-
-_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
-
-_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" ;;
- "tclsh.exe.manifest" ) CONFIG_FILES="$CONFIG_FILES tclsh.exe.manifest" ;;
- *) { { 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
-
-# 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
-
-# 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,@ZLIB_DLL_FILE@,$ZLIB_DLL_FILE,;t t
-s,@ZLIB_LIBS@,$ZLIB_LIBS,;t t
-s,@ZLIB_OBJS@,$ZLIB_OBJS,;t t
-s,@CFLAGS_DEFAULT@,$CFLAGS_DEFAULT,;t t
-s,@LDFLAGS_DEFAULT@,$LDFLAGS_DEFAULT,;t t
-s,@VC_MANIFEST_EMBED_DLL@,$VC_MANIFEST_EMBED_DLL,;t t
-s,@VC_MANIFEST_EMBED_EXE@,$VC_MANIFEST_EMBED_EXE,;t t
-s,@TCL_WIN_VERSION@,$TCL_WIN_VERSION,;t t
-s,@MACHINE@,$MACHINE,;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,@PKG_CFG_ARGS@,$PKG_CFG_ARGS,;t t
-s,@TCL_EXE@,$TCL_EXE,;t t
-s,@TCL_LIB_FILE@,$TCL_LIB_FILE,;t t
-s,@TCL_LIB_FLAG@,$TCL_LIB_FLAG,;t t
-s,@TCL_STATIC_LIB_FILE@,$TCL_STATIC_LIB_FILE,;t t
-s,@TCL_STATIC_LIB_FLAG@,$TCL_STATIC_LIB_FLAG,;t t
-s,@TCL_IMPORT_LIB_FILE@,$TCL_IMPORT_LIB_FILE,;t t
-s,@TCL_IMPORT_LIB_FLAG@,$TCL_IMPORT_LIB_FLAG,;t t
-s,@TCL_LIB_SPEC@,$TCL_LIB_SPEC,;t t
-s,@TCL_STUB_LIB_FILE@,$TCL_STUB_LIB_FILE,;t t
-s,@TCL_STUB_LIB_FLAG@,$TCL_STUB_LIB_FLAG,;t t
-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,@MAKE_STUB_LIB@,$MAKE_STUB_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_CC_SEARCH_FLAGS@,$TCL_CC_SEARCH_FLAGS,;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_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,@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"
-
-_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; }; }; }
-
- 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
-
-
-
- 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
-
-done
-_ACEOF
-
-cat >>$CONFIG_STATUS <<\_ACEOF
-
-{ (exit 0); exit 0; }
-_ACEOF
-chmod +x $CONFIG_STATUS
-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/tcl8.6/win/configure.in b/tcl8.6/win/configure.in
deleted file mode 100644
index 511cb39..0000000
--- a/tcl8.6/win/configure.in
+++ /dev/null
@@ -1,465 +0,0 @@
-#! /bin/bash -norc
-# This file is an input file used by the GNU "autoconf" program to
-# generate the file "configure", which is run during Tcl installation
-# to configure the system for the local environment.
-
-AC_INIT(../generic/tcl.h)
-AC_PREREQ(2.59)
-
-# 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.6
-TCL_MAJOR_VERSION=8
-TCL_MINOR_VERSION=6
-TCL_PATCH_LEVEL=".9"
-VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION
-
-TCL_DDE_VERSION=1.4
-TCL_DDE_MAJOR_VERSION=1
-TCL_DDE_MINOR_VERSION=4
-DDEVER=$TCL_DDE_MAJOR_VERSION$TCL_DDE_MINOR_VERSION
-
-TCL_REG_VERSION=1.3
-TCL_REG_MAJOR_VERSION=1
-TCL_REG_MINOR_VERSION=3
-REGVER=$TCL_REG_MAJOR_VERSION$TCL_REG_MINOR_VERSION
-
-PKG_CFG_ARGS=$@
-
-#------------------------------------------------------------------------
-# Empty slate for bundled packages, to avoid stale configuration
-#------------------------------------------------------------------------
-rm -Rf pkgs
-
-#------------------------------------------------------------------------
-# Handle the --prefix=... option
-#------------------------------------------------------------------------
-
-if test "${prefix}" = "NONE"; then
- prefix=/usr/local
-fi
-if test "${exec_prefix}" = "NONE"; then
- exec_prefix=$prefix
-fi
-# libdir must be a fully qualified path (not ${exec_prefix}/lib)
-eval libdir="$libdir"
-
-#------------------------------------------------------------------------
-# Standard compiler checks
-#------------------------------------------------------------------------
-
-# If the user did not set CFLAGS, set it now to keep
-# the AC_PROG_CC macro from adding "-g -O2".
-if test "${CFLAGS+set}" != "set" ; then
- CFLAGS=""
-fi
-
-AC_PROG_CC
-AC_C_INLINE
-AC_HEADER_STDC
-
-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.
-#--------------------------------------------------------------------
-
-AC_PROG_MAKE_SET
-
-#--------------------------------------------------------------------
-# Determines the correct binary file extension (.o, .obj, .exe etc.)
-#--------------------------------------------------------------------
-
-AC_OBJEXT
-AC_EXEEXT
-
-#--------------------------------------------------------------------
-# Check whether --enable-threads or --disable-threads was given.
-#--------------------------------------------------------------------
-
-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.
-#--------------------------------------------------------------------
-
-SC_ENABLE_SHARED
-
-#--------------------------------------------------------------------
-# The statements below define a collection of compile flags. This
-# macro depends on the value of SHARED_BUILD, and should be called
-# after SC_ENABLE_SHARED checks the configure switches.
-#--------------------------------------------------------------------
-
-SC_CONFIG_CFLAGS
-
-# Cross-compiling
-case ${host_alias} in
-*mingw32*)
- TCL_EXE="tclsh"
- ;;
-*)
- TCL_EXE="TCL_LIBRARY=\"\${LIBRARY_DIR}\"; export TCL_LIBRARY; ./\${TCLSH}"
- ;;
-esac
-
-#------------------------------------------------------------------------
-# Add stuff for zlib; note that this is mostly done in the makefile now
-# as we just assume that the platform hasn't got a usable z.lib
-#------------------------------------------------------------------------
-
-AS_IF([test "${enable_shared+set}" = "set"], [
- enableval="$enable_shared"
- tcl_ok=$enableval
-], [
- tcl_ok=yes
-])
-AS_IF([test "$tcl_ok" = "yes"], [
- AC_SUBST(ZLIB_DLL_FILE,[\${ZLIB_DLL_FILE}])
- AS_IF([test "$do64bit" != "no"], [
- AS_IF([test "$GCC" == "yes"],[
- AC_SUBST(ZLIB_LIBS,[\${ZLIB_DIR_NATIVE}/win64/libz.dll.a])
- ], [
- AC_SUBST(ZLIB_LIBS,[\${ZLIB_DIR_NATIVE}/win64/zdll.lib])
- ])
- ], [
- AC_SUBST(ZLIB_LIBS,[\${ZLIB_DIR_NATIVE}/win32/zdll.lib])
- ])
-], [
- AC_SUBST(ZLIB_OBJS,[\${ZLIB_OBJS}])
-])
-AC_DEFINE(HAVE_ZLIB, 1, [Is there an installed zlib?])
-
-AC_CHECK_TYPE([intptr_t], [
- AC_DEFINE([HAVE_INTPTR_T], 1, [Do we have the intptr_t type?])], [
- AC_CACHE_CHECK([for pointer-size signed integer type], tcl_cv_intptr_t, [
- 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.
-#--------------------------------------------------------------------
-
-# See if declarations like FINDEX_INFO_LEVELS are
-# missing from winbase.h. This is known to be
-# a problem with VC++ 5.2.
-
-AC_CACHE_CHECK(for FINDEX_INFO_LEVELS in winbase.h,
- tcl_cv_findex_enums,
-AC_TRY_COMPILE([
-#define WIN32_LEAN_AND_MEAN
-#include <windows.h>
-#undef WIN32_LEAN_AND_MEAN
-],
-[
- FINDEX_INFO_LEVELS i;
- FINDEX_SEARCH_OPS j;
-],
- tcl_cv_findex_enums=yes,
- tcl_cv_findex_enums=no)
-)
-if test "$tcl_cv_findex_enums" = "no"; then
- AC_DEFINE(HAVE_NO_FINDEX_ENUMS, 1,
- [Defined when enums are missing from winbase.h])
-fi
-
-# See if the compiler supports intrinsics.
-
-AC_CACHE_CHECK(for intrinsics support in compiler,
- tcl_cv_intrinsics,
-AC_TRY_LINK([
-#define WIN32_LEAN_AND_MEAN
-#include <windows.h>
-#undef WIN32_LEAN_AND_MEAN
-#include <intrin.h>
-],
-[
- __cpuidex(0,0,0);
-],
- tcl_cv_intrinsics=yes,
- tcl_cv_intrinsics=no)
-)
-if test "$tcl_cv_intrinsics" = "yes"; then
- AC_DEFINE(HAVE_INTRIN_H, 1,
- [Defined when the compilers supports intrinsics])
-fi
-
-# See if the <wspiapi.h> header file is present
-
-AC_CACHE_CHECK(for wspiapi.h,
- tcl_cv_wspiapi_h,
-AC_TRY_COMPILE([
-#include <wspiapi.h>
-], [],
- tcl_cv_wspiapi_h=yes,
- tcl_cv_wspiapi_h=no)
-)
-if test "$tcl_cv_wspiapi_h" = "yes"; then
- AC_DEFINE(HAVE_WSPIAPI_H, 1,
- [Defined when wspiapi.h exists])
-fi
-
-# See if declarations like FINDEX_INFO_LEVELS are
-# missing from winbase.h. This is known to be
-# a problem with VC++ 5.2.
-
-AC_CACHE_CHECK(for FINDEX_INFO_LEVELS in winbase.h,
- tcl_cv_findex_enums,
-AC_TRY_COMPILE([
-#define WIN32_LEAN_AND_MEAN
-#include <windows.h>
-#undef WIN32_LEAN_AND_MEAN
-],
-[
- FINDEX_INFO_LEVELS i;
- FINDEX_SEARCH_OPS j;
-],
- tcl_cv_findex_enums=yes,
- tcl_cv_findex_enums=no)
-)
-if test "$tcl_cv_findex_enums" = "no"; then
- AC_DEFINE(HAVE_NO_FINDEX_ENUMS, 1,
- [Defined when enums are missing from winbase.h])
-fi
-
-#--------------------------------------------------------------------
-# Set the default compiler switches based on the --enable-symbols
-# option. This macro depends on C flags, and should be called
-# after SC_CONFIG_CFLAGS macro is called.
-#--------------------------------------------------------------------
-
-SC_ENABLE_SYMBOLS
-
-TCL_DBGX=${DBGX}
-
-#--------------------------------------------------------------------
-# Embed the manifest if we can determine how
-#--------------------------------------------------------------------
-
-SC_EMBED_MANIFEST
-
-#------------------------------------------------------------------------
-# tclConfig.sh refers to this by a different name
-#------------------------------------------------------------------------
-
-TCL_SHARED_BUILD=${SHARED_BUILD}
-
-#--------------------------------------------------------------------
-# Perform final evaluations of variables with possible substitutions.
-#--------------------------------------------------------------------
-
-TCL_SHARED_LIB_SUFFIX="\${NODOT_VERSION}${DLLSUFFIX}"
-TCL_UNSHARED_LIB_SUFFIX="\${NODOT_VERSION}${LIBSUFFIX}"
-TCL_EXPORT_FILE_SUFFIX="\${NODOT_VERSION}${LIBSUFFIX}"
-
-eval "TCL_SRC_DIR=\"`cd $srcdir/..; $CYGPATH $(pwd)`\""
-
-eval "TCL_DLL_FILE=tcl${VER}${DLLSUFFIX}"
-
-eval "TCL_STUB_LIB_FILE=\"${LIBPREFIX}tclstub${VER}${LIBSUFFIX}\""
-eval "TCL_STUB_LIB_FLAG=\"-ltclstub${VER}${LIBFLAGSUFFIX}\""
-eval "TCL_BUILD_STUB_LIB_SPEC=\"-L`$CYGPATH $(pwd)` ${TCL_STUB_LIB_FLAG}\""
-eval "TCL_STUB_LIB_SPEC=\"-L${libdir} ${TCL_STUB_LIB_FLAG}\""
-eval "TCL_BUILD_STUB_LIB_PATH=\"`$CYGPATH $(pwd)`/${TCL_STUB_LIB_FILE}\""
-eval "TCL_STUB_LIB_PATH=\"${libdir}/${TCL_STUB_LIB_FILE}\""
-
-eval "TCL_LIB_FILE=\"${LIBPREFIX}tcl${VER}${LIBSUFFIX}\""
-eval "TCL_BUILD_LIB_SPEC=\"-L`$CYGPATH $(pwd)` -ltcl${VER}${FLAGSUFFIX}\""
-eval "TCL_LIB_SPEC=\"-L${libdir} -ltcl${VER}${FLAGSUFFIX}\""
-
-# Install time header dir can be set via --includedir
-eval "TCL_INCLUDE_SPEC=\"-I${includedir}\""
-
-
-eval "DLLSUFFIX=${DLLSUFFIX}"
-eval "LIBPREFIX=${LIBPREFIX}"
-eval "LIBSUFFIX=${LIBSUFFIX}"
-eval "EXESUFFIX=${EXESUFFIX}"
-
-CFG_TCL_SHARED_LIB_SUFFIX=${TCL_SHARED_LIB_SUFFIX}
-CFG_TCL_UNSHARED_LIB_SUFFIX=${TCL_UNSHARED_LIB_SUFFIX}
-CFG_TCL_EXPORT_FILE_SUFFIX=${TCL_EXPORT_FILE_SUFFIX}
-
-#--------------------------------------------------------------------
-# Adjust the defines for how the resources are built depending
-# on symbols and static vs. shared.
-#--------------------------------------------------------------------
-
-if test ${SHARED_BUILD} = 0 ; then
- if test "${DBGX}" = "g"; then
- RC_DEFINES="${RC_DEFINE} STATIC_BUILD ${RC_DEFINE} DEBUG"
- else
- RC_DEFINES="${RC_DEFINE} STATIC_BUILD"
- fi
-else
- if test "${DBGX}" = "g"; then
- RC_DEFINES="${RC_DEFINE} DEBUG"
- else
- RC_DEFINES=""
- fi
-fi
-
-#--------------------------------------------------------------------
-# The statements below define the symbol TCL_PACKAGE_PATH, which
-# gives a list of directories that may contain packages. The list
-# consists of one directory for machine-dependent binaries and
-# another for platform-independent scripts.
-#--------------------------------------------------------------------
-
-if test "$prefix/lib" != "$libdir"; then
- TCL_PACKAGE_PATH="${libdir} ${prefix}/lib"
-else
- TCL_PACKAGE_PATH="${prefix}/lib"
-fi
-
-# The tclsh.exe.manifest requires these
-# TCL_WIN_VERSION is the 4 dotted pair Windows version format which needs
-# the release level, and must account for interim release versioning
-case "$TCL_PATCH_LEVEL" in
- *a*) TCL_RELEASE_LEVEL=0 ;;
- *b*) TCL_RELEASE_LEVEL=1 ;;
- *) TCL_RELEASE_LEVEL=2 ;;
-esac
-TCL_WIN_VERSION="$TCL_VERSION.$TCL_RELEASE_LEVEL.`echo $TCL_PATCH_LEVEL | tr -d ab.`"
-AC_SUBST(TCL_WIN_VERSION)
-# X86|AMD64|IA64 for manifest
-AC_SUBST(MACHINE)
-
-AC_SUBST(TCL_VERSION)
-AC_SUBST(TCL_MAJOR_VERSION)
-AC_SUBST(TCL_MINOR_VERSION)
-AC_SUBST(TCL_PATCH_LEVEL)
-AC_SUBST(PKG_CFG_ARGS)
-AC_SUBST(TCL_EXE)
-
-AC_SUBST(TCL_LIB_FILE)
-AC_SUBST(TCL_LIB_FLAG)
-AC_SUBST(TCL_STATIC_LIB_FILE)
-AC_SUBST(TCL_STATIC_LIB_FLAG)
-AC_SUBST(TCL_IMPORT_LIB_FILE)
-AC_SUBST(TCL_IMPORT_LIB_FLAG)
-# empty on win
-AC_SUBST(TCL_LIB_SPEC)
-AC_SUBST(TCL_STUB_LIB_FILE)
-AC_SUBST(TCL_STUB_LIB_FLAG)
-AC_SUBST(TCL_STUB_LIB_SPEC)
-AC_SUBST(TCL_STUB_LIB_PATH)
-AC_SUBST(TCL_INCLUDE_SPEC)
-AC_SUBST(TCL_BUILD_STUB_LIB_SPEC)
-AC_SUBST(TCL_BUILD_STUB_LIB_PATH)
-AC_SUBST(TCL_DLL_FILE)
-
-AC_SUBST(TCL_SRC_DIR)
-AC_SUBST(TCL_BIN_DIR)
-AC_SUBST(TCL_DBGX)
-AC_SUBST(CFG_TCL_SHARED_LIB_SUFFIX)
-AC_SUBST(CFG_TCL_UNSHARED_LIB_SUFFIX)
-AC_SUBST(CFG_TCL_EXPORT_FILE_SUFFIX)
-
-# win/tcl.m4 doesn't set (CFLAGS)
-AC_SUBST(CFLAGS_DEFAULT)
-AC_SUBST(EXTRA_CFLAGS)
-AC_SUBST(CYGPATH)
-AC_SUBST(DEPARG)
-AC_SUBST(CC_OBJNAME)
-AC_SUBST(CC_EXENAME)
-
-# win/tcl.m4 doesn't set (LDFLAGS)
-AC_SUBST(LDFLAGS_DEFAULT)
-AC_SUBST(LDFLAGS_DEBUG)
-AC_SUBST(LDFLAGS_OPTIMIZE)
-AC_SUBST(LDFLAGS_CONSOLE)
-AC_SUBST(LDFLAGS_WINDOW)
-AC_SUBST(AR)
-AC_SUBST(RANLIB)
-
-AC_SUBST(STLIB_LD)
-AC_SUBST(SHLIB_LD)
-AC_SUBST(SHLIB_LD_LIBS)
-AC_SUBST(SHLIB_CFLAGS)
-AC_SUBST(SHLIB_SUFFIX)
-AC_SUBST(TCL_SHARED_BUILD)
-
-AC_SUBST(LIBS)
-AC_SUBST(LIBS_GUI)
-AC_SUBST(DLLSUFFIX)
-AC_SUBST(LIBPREFIX)
-AC_SUBST(LIBSUFFIX)
-AC_SUBST(EXESUFFIX)
-AC_SUBST(LIBRARIES)
-AC_SUBST(MAKE_LIB)
-AC_SUBST(MAKE_STUB_LIB)
-AC_SUBST(POST_MAKE_LIB)
-AC_SUBST(MAKE_DLL)
-AC_SUBST(MAKE_EXE)
-
-# empty on win, but needs sub'ing
-AC_SUBST(TCL_BUILD_LIB_SPEC)
-AC_SUBST(TCL_CC_SEARCH_FLAGS)
-AC_SUBST(TCL_LD_SEARCH_FLAGS)
-AC_SUBST(TCL_NEEDS_EXP_FILE)
-AC_SUBST(TCL_BUILD_EXP_FILE)
-AC_SUBST(TCL_EXP_FILE)
-AC_SUBST(DL_LIBS)
-AC_SUBST(TCL_LIB_VERSIONS_OK)
-AC_SUBST(TCL_PACKAGE_PATH)
-
-# win only
-AC_SUBST(TCL_DDE_VERSION)
-AC_SUBST(TCL_DDE_MAJOR_VERSION)
-AC_SUBST(TCL_DDE_MINOR_VERSION)
-AC_SUBST(TCL_REG_VERSION)
-AC_SUBST(TCL_REG_MAJOR_VERSION)
-AC_SUBST(TCL_REG_MINOR_VERSION)
-
-AC_SUBST(RC)
-AC_SUBST(RC_OUT)
-AC_SUBST(RC_TYPE)
-AC_SUBST(RC_INCLUDE)
-AC_SUBST(RC_DEFINE)
-AC_SUBST(RC_DEFINES)
-AC_SUBST(RES)
-
-AC_OUTPUT(Makefile tclConfig.sh tcl.hpj tclsh.exe.manifest)
-
-dnl Local Variables:
-dnl mode: autoconf;
-dnl End:
diff --git a/tcl8.6/win/license.terms b/tcl8.6/win/license.terms
deleted file mode 100644
index d8049cd..0000000
--- a/tcl8.6/win/license.terms
+++ /dev/null
@@ -1,40 +0,0 @@
-This software is copyrighted by the Regents of the University of
-California, Sun Microsystems, Inc., Scriptics Corporation, ActiveState
-Corporation and other parties. The following terms apply to all files
-associated with the software unless explicitly disclaimed in
-individual files.
-
-The authors hereby grant permission to use, copy, modify, distribute,
-and license this software and its documentation for any purpose, provided
-that existing copyright notices are retained in all copies and that this
-notice is included verbatim in any distributions. No written agreement,
-license, or royalty fee is required for any of the authorized uses.
-Modifications to this software may be copyrighted by their authors
-and need not follow the licensing terms described here, provided that
-the new terms are clearly indicated on the first page of each file where
-they apply.
-
-IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
-FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
-ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
-DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
-POSSIBILITY OF SUCH DAMAGE.
-
-THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
-INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
-FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE
-IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
-NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
-MODIFICATIONS.
-
-GOVERNMENT USE: If you are acquiring this software on behalf of the
-U.S. government, the Government shall have only "Restricted Rights"
-in the software and related documentation as defined in the Federal
-Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2). If you
-are acquiring the software on behalf of the Department of Defense, the
-software shall be classified as "Commercial Computer Software" and the
-Government shall have only "Restricted Rights" as defined in Clause
-252.227-7014 (b) (3) of DFARs. Notwithstanding the foregoing, the
-authors grant the U.S. Government and others acting in its behalf
-permission to use and distribute the software in accordance with the
-terms specified in this license.
diff --git a/tcl8.6/win/makefile.vc b/tcl8.6/win/makefile.vc
deleted file mode 100644
index 0e1e1fd..0000000
--- a/tcl8.6/win/makefile.vc
+++ /dev/null
@@ -1,941 +0,0 @@
-#------------------------------------------------------------- -*- makefile -*-
-#
-# Microsoft Visual C++ makefile for building Tcl with nmake
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# Copyright (c) 1995-1996 Sun Microsystems, Inc.
-# Copyright (c) 1998-2000 Ajuba Solutions.
-# Copyright (c) 2001-2005 ActiveState Corporation.
-# Copyright (c) 2001-2004 David Gravereaux.
-# Copyright (c) 2003-2008 Pat Thoyts.
-# Copyright (c) 2017 Ashok P. Nadkarni
-#------------------------------------------------------------------------------
-
-# General usage:
-# nmake [-nologo] -f makefile.vc [TARGET|MACRODEF [TARGET|MACRODEF] [...]]
-#
-# For MACRODEF, see TIP 477 (https://core.tcl.tk/tips/doc/trunk/tip/477.md)
-# or examine Sections 6-8 in rules.vc.
-#
-# Possible values of TARGET are:
-# release -- Builds the core, the shell and the dlls. (default)
-# dlls -- Just builds the windows extensions
-# shell -- Just builds the shell and the core.
-# core -- Only builds the core [tclXX.(dll|lib)].
-# all -- Builds everything.
-# test -- Builds and runs the test suite.
-# tcltest -- Just builds the test shell.
-# install -- Installs the built binaries and libraries to $(INSTALLDIR)
-# as the root of the install tree.
-# tidy/clean/hose -- varying levels of cleaning.
-# genstubs -- Rebuilds the Stubs table and support files (dev only).
-# depend -- Generates an accurate set of source dependancies for this
-# makefile. Helpful to avoid problems when the sources are
-# refreshed and you rebuild, but can "overbuild" when common
-# headers like tclInt.h just get small changes.
-# htmlhelp -- Builds a Windows .chm help file for Tcl and Tk from the
-# troff manual pages found in $(ROOT)\doc. You need to
-# have installed the HTML Help Compiler package from Microsoft
-# to produce the .chm file.
-#
-# The steps to setup a Visual C++ environment depend on which
-# version of Visual Studio and/or the Windows SDK you are building
-# against and are not described here. The simplest method is generally
-# to start a command shell using one of the short cuts installed by
-# Visual Studio/Windows SDK for the appropriate target architecture.
-#
-# NOTE: For older (Visual C++ 6 or the 2003 SDK), to use the Platform
-# SDK (not expressly needed), run setenv.bat after
-# vcvars32.bat according to the instructions for it. This can also
-# turn on the 64-bit compiler, if your SDK has it.
-#
-# Examples:
-# c:\tcl_src\win\>nmake -f makefile.vc release
-# c:\tcl_src\win\>nmake -f makefile.vc test
-# c:\tcl_src\win\>nmake -f makefile.vc install INSTALLDIR=c:\progra~1\tcl
-# c:\tcl_src\win\>nmake -f makefile.vc release OPTS=pdbs
-# c:\tcl_src\win\>nmake -f makefile.vc release OPTS=symbols
-#
-
-# NOTE:
-# Before modifying this file, check whether the modification is applicable
-# to building extensions as well and if so, modify rules.vc instead.
-
-# The PROJECT macro is used by rules.vc for generating appropriate
-# macros and rules.
-PROJECT = tcl
-
-# Default target to build if no target is specified. If unspecified, the
-# rules.vc file will set up "all" as the target.
-DEFAULT_BUILD_TARGET = release
-
-# We want to use our own resource file, not the standard template one.
-RCFILE = tcl.rc
-
-# The rules.vc file does most of the hard work in terms of defining
-# the build configuration, macros, output directories etc.
-!include "rules.vc"
-
-# Tcl version info based on macros set up by rules.vc
-DOTVERSION = $(TCL_MAJOR_VERSION).$(TCL_MINOR_VERSION)
-VERSION = $(TCL_MAJOR_VERSION)$(TCL_MINOR_VERSION)
-
-# We need versions of various core packages to generate appropriate
-# file names during installation.
-!if [echo REM = This file is generated from makefile.vc > versions.vc]
-!endif
-!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
-
-!include versions.vc
-
-DDEDOTVERSION = 1.4
-DDEVERSION = $(DDEDOTVERSION:.=)
-
-REGDOTVERSION = 1.3
-REGVERSION = $(REGDOTVERSION:.=)
-
-TCLREGLIBNAME = $(PROJECT)reg$(REGVERSION)$(SUFX:t=).$(EXT)
-TCLREGLIB = $(OUT_DIR)\$(TCLREGLIBNAME)
-
-TCLDDELIBNAME = $(PROJECT)dde$(DDEVERSION)$(SUFX:t=).$(EXT)
-TCLDDELIB = $(OUT_DIR)\$(TCLDDELIBNAME)
-
-TCLTEST = $(OUT_DIR)\$(PROJECT)test.exe
-CAT32 = $(OUT_DIR)\cat32.exe
-
-TCLSHOBJS = \
- $(TMP_DIR)\tclAppInit.obj \
-!if !$(STATIC_BUILD)
-!if $(TCL_USE_STATIC_PACKAGES)
- $(TMP_DIR)\tclWinReg.obj \
- $(TMP_DIR)\tclWinDde.obj \
-!endif
-!endif
- $(TMP_DIR)\tclsh.res
-
-TCLTESTOBJS = \
- $(TMP_DIR)\tclTest.obj \
- $(TMP_DIR)\tclTestObj.obj \
- $(TMP_DIR)\tclTestProcBodyObj.obj \
- $(TMP_DIR)\tclThreadTest.obj \
- $(TMP_DIR)\tclWinTest.obj \
-!if !$(STATIC_BUILD)
-!if $(TCL_USE_STATIC_PACKAGES)
- $(TMP_DIR)\tclWinReg.obj \
- $(TMP_DIR)\tclWinDde.obj \
-!endif
-!endif
- $(TMP_DIR)\testMain.obj
-
-COREOBJS = \
- $(TMP_DIR)\regcomp.obj \
- $(TMP_DIR)\regerror.obj \
- $(TMP_DIR)\regexec.obj \
- $(TMP_DIR)\regfree.obj \
- $(TMP_DIR)\tclAlloc.obj \
- $(TMP_DIR)\tclAssembly.obj \
- $(TMP_DIR)\tclAsync.obj \
- $(TMP_DIR)\tclBasic.obj \
- $(TMP_DIR)\tclBinary.obj \
- $(TMP_DIR)\tclCkalloc.obj \
- $(TMP_DIR)\tclClock.obj \
- $(TMP_DIR)\tclCmdAH.obj \
- $(TMP_DIR)\tclCmdIL.obj \
- $(TMP_DIR)\tclCmdMZ.obj \
- $(TMP_DIR)\tclCompCmds.obj \
- $(TMP_DIR)\tclCompCmdsGR.obj \
- $(TMP_DIR)\tclCompCmdsSZ.obj \
- $(TMP_DIR)\tclCompExpr.obj \
- $(TMP_DIR)\tclCompile.obj \
- $(TMP_DIR)\tclConfig.obj \
- $(TMP_DIR)\tclDate.obj \
- $(TMP_DIR)\tclDictObj.obj \
- $(TMP_DIR)\tclDisassemble.obj \
- $(TMP_DIR)\tclEncoding.obj \
- $(TMP_DIR)\tclEnsemble.obj \
- $(TMP_DIR)\tclEnv.obj \
- $(TMP_DIR)\tclEvent.obj \
- $(TMP_DIR)\tclExecute.obj \
- $(TMP_DIR)\tclFCmd.obj \
- $(TMP_DIR)\tclFileName.obj \
- $(TMP_DIR)\tclGet.obj \
- $(TMP_DIR)\tclHash.obj \
- $(TMP_DIR)\tclHistory.obj \
- $(TMP_DIR)\tclIndexObj.obj \
- $(TMP_DIR)\tclInterp.obj \
- $(TMP_DIR)\tclIO.obj \
- $(TMP_DIR)\tclIOCmd.obj \
- $(TMP_DIR)\tclIOGT.obj \
- $(TMP_DIR)\tclIOSock.obj \
- $(TMP_DIR)\tclIOUtil.obj \
- $(TMP_DIR)\tclIORChan.obj \
- $(TMP_DIR)\tclIORTrans.obj \
- $(TMP_DIR)\tclLink.obj \
- $(TMP_DIR)\tclListObj.obj \
- $(TMP_DIR)\tclLiteral.obj \
- $(TMP_DIR)\tclLoad.obj \
- $(TMP_DIR)\tclMain.obj \
- $(TMP_DIR)\tclMain2.obj \
- $(TMP_DIR)\tclNamesp.obj \
- $(TMP_DIR)\tclNotify.obj \
- $(TMP_DIR)\tclOO.obj \
- $(TMP_DIR)\tclOOBasic.obj \
- $(TMP_DIR)\tclOOCall.obj \
- $(TMP_DIR)\tclOODefineCmds.obj \
- $(TMP_DIR)\tclOOInfo.obj \
- $(TMP_DIR)\tclOOMethod.obj \
- $(TMP_DIR)\tclOOStubInit.obj \
- $(TMP_DIR)\tclObj.obj \
- $(TMP_DIR)\tclOptimize.obj \
- $(TMP_DIR)\tclPanic.obj \
- $(TMP_DIR)\tclParse.obj \
- $(TMP_DIR)\tclPathObj.obj \
- $(TMP_DIR)\tclPipe.obj \
- $(TMP_DIR)\tclPkg.obj \
- $(TMP_DIR)\tclPkgConfig.obj \
- $(TMP_DIR)\tclPosixStr.obj \
- $(TMP_DIR)\tclPreserve.obj \
- $(TMP_DIR)\tclProc.obj \
- $(TMP_DIR)\tclRegexp.obj \
- $(TMP_DIR)\tclResolve.obj \
- $(TMP_DIR)\tclResult.obj \
- $(TMP_DIR)\tclScan.obj \
- $(TMP_DIR)\tclStringObj.obj \
- $(TMP_DIR)\tclStrToD.obj \
- $(TMP_DIR)\tclStubInit.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 \
- $(TMP_DIR)\tclZlib.obj
-
-ZLIBOBJS = \
- $(TMP_DIR)\adler32.obj \
- $(TMP_DIR)\compress.obj \
- $(TMP_DIR)\crc32.obj \
- $(TMP_DIR)\deflate.obj \
- $(TMP_DIR)\infback.obj \
- $(TMP_DIR)\inffast.obj \
- $(TMP_DIR)\inflate.obj \
- $(TMP_DIR)\inftrees.obj \
- $(TMP_DIR)\trees.obj \
- $(TMP_DIR)\uncompr.obj \
- $(TMP_DIR)\zutil.obj
-
-TOMMATHOBJS = \
- $(TMP_DIR)\bncore.obj \
- $(TMP_DIR)\bn_reverse.obj \
- $(TMP_DIR)\bn_fast_s_mp_mul_digs.obj \
- $(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
-
-PLATFORMOBJS = \
- $(TMP_DIR)\tclWin32Dll.obj \
- $(TMP_DIR)\tclWinChan.obj \
- $(TMP_DIR)\tclWinConsole.obj \
- $(TMP_DIR)\tclWinError.obj \
- $(TMP_DIR)\tclWinFCmd.obj \
- $(TMP_DIR)\tclWinFile.obj \
- $(TMP_DIR)\tclWinInit.obj \
- $(TMP_DIR)\tclWinLoad.obj \
- $(TMP_DIR)\tclWinNotify.obj \
- $(TMP_DIR)\tclWinPipe.obj \
- $(TMP_DIR)\tclWinSerial.obj \
- $(TMP_DIR)\tclWinSock.obj \
- $(TMP_DIR)\tclWinThrd.obj \
- $(TMP_DIR)\tclWinTime.obj \
-!if $(STATIC_BUILD)
- $(TMP_DIR)\tclWinReg.obj \
- $(TMP_DIR)\tclWinDde.obj \
-!else
- $(TMP_DIR)\tcl.res
-!endif
-
-TCLOBJS = $(COREOBJS) $(ZLIBOBJS) $(TOMMATHOBJS) $(PLATFORMOBJS)
-
-TCLSTUBOBJS = \
- $(TMP_DIR)\tclStubLib.obj \
- $(TMP_DIR)\tclTomMathStubLib.obj \
- $(TMP_DIR)\tclOOStubLib.obj
-
-### The following paths CANNOT have spaces in them as they appear on
-### the left side of implicit rules.
-TOMMATHDIR = $(ROOT)\libtommath
-PKGSDIR = $(ROOT)\pkgs
-
-# Additional include and C macro definitions for the implicit rules
-# defined in rules.vc
-PRJ_INCLUDES = -I"$(TOMMATHDIR)"
-PRJ_DEFINES = -DTCL_TOMMATH -DMP_PREC=4 -Dinline=__inline -DHAVE_ZLIB=1 -D_CRT_SECURE_NO_DEPRECATE -D_CRT_NONSTDC_NO_DEPRECATE
-
-# Additional Link libraries needed beyond those in rules.vc
-PRJ_LIBS = netapi32.lib user32.lib userenv.lib ws2_32.lib
-
-#---------------------------------------------------------------------
-# TclTest flags
-#---------------------------------------------------------------------
-
-!if "$(TESTPAT)" != ""
-TESTFLAGS = $(TESTFLAGS) -file $(TESTPAT)
-!endif
-
-
-#---------------------------------------------------------------------
-# Project specific targets
-#---------------------------------------------------------------------
-
-release: setup $(TCLSH) $(TCLSTUBLIB) dlls pkgs
-core: setup $(TCLLIB) $(TCLSTUBLIB)
-shell: setup $(TCLSH)
-dlls: setup $(TCLREGLIB) $(TCLDDELIB)
-all: setup $(TCLSH) $(TCLSTUBLIB) dlls $(CAT32) pkgs
-tcltest: setup $(TCLTEST) dlls $(CAT32)
-install: install-binaries install-libraries install-docs install-pkgs
-setup: default-setup
-
-test: test-core test-pkgs
-test-core: setup $(TCLTEST) dlls $(CAT32)
- set TCL_LIBRARY=$(ROOT:\=/)/library
- $(DEBUGGER) $(TCLTEST) "$(ROOT:\=/)/tests/all.tcl" $(TESTFLAGS) -loadfile <<
- package ifneeded dde 1.4.1 [list load "$(TCLDDELIB:\=/)" dde]
- package ifneeded registry 1.3.3 [list load "$(TCLREGLIB:\=/)" registry]
-<<
-
-runtest: setup $(TCLTEST) dlls $(CAT32)
- set TCL_LIBRARY=$(ROOT:\=/)/library
- $(DEBUGGER) $(TCLTEST) $(SCRIPT)
-
-runshell: setup $(TCLSH) dlls
- set TCL_LIBRARY=$(ROOT:\=/)/library
- $(DEBUGGER) $(TCLSH) $(SCRIPT)
-
-!if $(STATIC_BUILD)
-
-$(TCLLIB): $(TCLOBJS)
- $(LIBCMD) @<<
-$**
-<<
-
-!else
-
-$(TCLLIB): $(TCLOBJS)
- $(DLLCMD) @<<
-$**
-<<
- $(_VC_MANIFEST_EMBED_DLL)
-$(TCLIMPLIB): $(TCLLIB)
-
-!endif # $(STATIC_BUILD)
-
-
-$(TCLSTUBLIB): $(TCLSTUBOBJS)
- $(LIBCMD) -nodefaultlib $(TCLSTUBOBJS)
-
-$(TCLSH): $(TCLSHOBJS) $(TCLSTUBLIB) $(TCLIMPLIB)
- $(CONEXECMD) -stack:2300000 $**
- $(_VC_MANIFEST_EMBED_EXE)
-
-$(TCLTEST): $(TCLTESTOBJS) $(TCLSTUBLIB) $(TCLIMPLIB)
- $(CONEXECMD) -stack:2300000 $**
- $(_VC_MANIFEST_EMBED_EXE)
-
-!if $(STATIC_BUILD)
-$(TCLDDELIB): $(TMP_DIR)\tclWinDde.obj
- $(LIBCMD) $**
-!else
-$(TCLDDELIB): $(TMP_DIR)\tclWinDde.obj $(TCLSTUBLIB)
- $(DLLCMD) $**
- $(_VC_MANIFEST_EMBED_DLL)
-!endif
-
-!if $(STATIC_BUILD)
-$(TCLREGLIB): $(TMP_DIR)\tclWinReg.obj
- $(LIBCMD) $**
-!else
-$(TCLREGLIB): $(TMP_DIR)\tclWinReg.obj $(TCLSTUBLIB)
- $(DLLCMD) $**
- $(_VC_MANIFEST_EMBED_DLL)
-!endif
-
-pkgs:
- @for /d %d in ($(PKGSDIR)\*) do \
- @if exist "%~fd\win\makefile.vc" ( \
- pushd "%~fd\win" & \
- $(MAKE) -$(MAKEFLAGS) -f makefile.vc TCLDIR=$(ROOT) &\
- popd \
- )
-
-test-pkgs:
- @for /d %d in ($(PKGSDIR)\*) do \
- @if exist "%~fd\win\makefile.vc" ( \
- pushd "%~fd\win" & \
- $(MAKE) -$(MAKEFLAGS) -f makefile.vc TCLDIR=$(ROOT) test &\
- popd \
- )
-
-install-pkgs:
- @for /d %d in ($(PKGSDIR)\*) do \
- @if exist "%~fd\win\makefile.vc" ( \
- pushd "%~fd\win" & \
- $(MAKE) -$(MAKEFLAGS) -f makefile.vc TCLDIR=$(ROOT) install &\
- popd \
- )
-
-clean-pkgs:
- @for /d %d in ($(PKGSDIR)\*) do \
- @if exist "%~fd\win\makefile.vc" ( \
- pushd "%~fd\win" & \
- $(MAKE) -$(MAKEFLAGS) -f makefile.vc TCLDIR=$(ROOT) clean &\
- popd \
- )
-
-$(CAT32): $(WINDIR)\cat.c
- $(cc32) $(cflags) $(crt) -D_CRT_NONSTDC_NO_DEPRECATE -DCONSOLE -Fo$(TMP_DIR)\ $?
- $(CONEXECMD) -stack:16384 $(TMP_DIR)\cat.obj
- $(_VC_MANIFEST_EMBED_EXE)
-
-#---------------------------------------------------------------------
-# Regenerate the stubs files. [Development use only]
-#---------------------------------------------------------------------
-
-genstubs:
-!if !exist($(TCLSH))
- @echo Build tclsh first!
-!else
- $(TCLSH) $(TOOLSDIR:\=/)/genStubs.tcl $(GENERICDIR:\=/) \
- $(GENERICDIR:\=/)/tcl.decls $(GENERICDIR:\=/)/tclInt.decls \
- $(GENERICDIR:\=/)/tclTomMath.decls
- $(TCLSH) $(TOOLSDIR:\=/)/genStubs.tcl $(GENERICDIR:\=/) \
- $(GENERICDIR:\=/)/tclOO.decls
-!endif
-
-
-#----------------------------------------------------------------------
-# 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:
-!if !exist($(TCLSH))
- @echo Build tclsh first!
-!else
- $(TCLSH) "$(TOOLSDIR:\=/)/fix_tommath_h.tcl" \
- "$(TOMMATHDIR:\=/)/tommath.h" \
- > "$(GENERICDIR)\tclTomMath.h"
-!endif
-
-#---------------------------------------------------------------------
-# Build the Windows HTML help file.
-#---------------------------------------------------------------------
-
-# NOTE: you can define HHC on the command-line to override this.
-# nmake does not set macro values if already set on the command line.
-!if defined(PROCESSOR_ARCHITECTURE) && "$(PROCESSOR_ARCHITECTURE)" == "AMD64"
-HHC="%ProgramFiles(x86)%\HTML Help Workshop\hhc.exe"
-!else
-HHC="%ProgramFiles%\HTML Help Workshop\hhc.exe"
-!endif
-HTMLDIR=$(OUT_DIR)\html
-HTMLBASE=TclTk$(VERSION)
-HHPFILE=$(HTMLDIR)\$(HTMLBASE).hhp
-CHMFILE=$(HTMLDIR)\$(HTMLBASE).chm
-
-htmlhelp: chmsetup $(CHMFILE)
-
-$(CHMFILE): $(DOCDIR)\*
- @$(TCLSH) $(TOOLSDIR)\tcltk-man2html.tcl "--htmldir=$(HTMLDIR)"
- @echo Compiling HTML help project
- -"$(HHC)" <<$(HHPFILE) >NUL
-[OPTIONS]
-Compatibility=1.1 or later
-Compiled file=$(HTMLBASE).chm
-Default topic=contents.htm
-Display compile progress=no
-Error log file=$(HTMLBASE).log
-Full-text search=Yes
-Language=0x409 English (United States)
-Title=Tcl/Tk $(DOTVERSION) Help
-[FILES]
-contents.htm
-docs.css
-Keywords\*.htm
-TclCmd\*.htm
-TclLib\*.htm
-TkCmd\*.htm
-TkLib\*.htm
-UserCmd\*.htm
-<<
-
-chmsetup:
- @if not exist $(HTMLDIR)\nul mkdir $(HTMLDIR)
-
-install-docs:
-!if exist("$(CHMFILE)")
- @echo Installing compiled HTML help
- @$(CPY) "$(CHMFILE)" "$(DOC_INSTALL_DIR)\"
-!endif
-
-# "emacs font-lock highlighting fix
-
-#---------------------------------------------------------------------
-# Generate the tcl.nmake file which contains the options used to build
-# Tcl itself. This is used when building extensions.
-#---------------------------------------------------------------------
-tcl-nmake: $(OUT_DIR)\tcl.nmake
-$(OUT_DIR)\tcl.nmake:
- @type << >$@
-CORE_MACHINE = $(MACHINE)
-CORE_DEBUG = $(DEBUG)
-CORE_TCL_THREADS = $(TCL_THREADS)
-CORE_USE_THREAD_ALLOC = $(USE_THREAD_ALLOC)
-CORE_USE_WIDECHAR_API = $(USE_WIDECHAR_API)
-<<
-
-#---------------------------------------------------------------------
-# Build tclConfig.sh for the TEA build system.
-#---------------------------------------------------------------------
-
-tclConfig: $(OUT_DIR)\tclConfig.sh
-
-# TBD - is this tclConfig.sh file ever used? The values are incorrect!
-$(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@ $(pkgcflags)
-@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) $(PRJ_LIBS)
-@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) $(PRJ_LIBS)
-@SHLIB_SUFFIX@ .dll
-@DL_LIBS@
-@LDFLAGS@
-@TCL_CC_SEARCH_FLAGS@
-@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
- $(cc32) $(appcflags) -DTCL_TEST \
- -DTCL_USE_STATIC_PACKAGES=$(TCL_USE_STATIC_PACKAGES) \
- -Fo$@ $?
-
-$(TMP_DIR)\tclMain2.obj: $(GENERICDIR)\tclMain.c
- $(cc32) $(pkgcflags) -DTCL_ASCII_MAIN \
- -Fo$@ $?
-
-$(TMP_DIR)\tclTest.obj: $(GENERICDIR)\tclTest.c
- $(cc32) $(appcflags) -Fo$@ $?
-
-$(TMP_DIR)\tclTestObj.obj: $(GENERICDIR)\tclTestObj.c
- $(cc32) $(appcflags) -Fo$@ $?
-
-$(TMP_DIR)\tclWinTest.obj: $(WINDIR)\tclWinTest.c
- $(CCAPPCMD) $?
-
-$(TMP_DIR)\tclZlib.obj: $(GENERICDIR)\tclZlib.c
- $(cc32) $(pkgcflags) -I$(COMPATDIR)\zlib -Fo$@ $?
-
-$(TMP_DIR)\tclPkgConfig.obj: $(GENERICDIR)\tclPkgConfig.c
- $(cc32) $(pkgcflags) \
- -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
- $(cc32) $(appcflags) \
- -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) $(appcflags) -DSTATIC_BUILD -Fo$@ $?
-!else
- $(cc32) $(appcflags) -DUSE_TCL_STUBS -Fo$@ $?
-!endif
-
-
-$(TMP_DIR)\tclWinDde.obj: $(WINDIR)\tclWinDde.c
-!if $(STATIC_BUILD)
- $(cc32) $(appcflags) -DSTATIC_BUILD -Fo$@ $?
-!else
- $(cc32) $(appcflags) -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 dependency on any
-### specific C run-time.
-
-$(TMP_DIR)\tclStubLib.obj: $(GENERICDIR)\tclStubLib.c
- $(cc32) $(stubscflags) -Fo$@ $?
-
-$(TMP_DIR)\tclTomMathStubLib.obj: $(GENERICDIR)\tclTomMathStubLib.c
- $(cc32) $(stubscflags) -Fo$@ $?
-
-$(TMP_DIR)\tclOOStubLib.obj: $(GENERICDIR)\tclOOStubLib.c
- $(cc32) $(stubscflags) -Fo$@ $?
-
-$(TMP_DIR)\tclsh.exe.manifest: $(WINDIR)\tclsh.exe.manifest.in
- @nmakehlp -s << $** >$@
-@MACHINE@ $(MACHINE:IX86=X86)
-@TCL_WIN_VERSION@ $(DOTVERSION).0.0
-<<
-
-#---------------------------------------------------------------------
-# 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.
-#---------------------------------------------------------------------
-
-depend:
-!if !exist($(TCLSH))
- @echo Build tclsh first!
-!else
- $(TCLSH) $(TOOLSDIR:\=/)/mkdepend.tcl -vc32 -out:"$(OUT_DIR)\depend.mk" \
- -passthru:"-DBUILD_tcl $(TCL_INCLUDES) $(PRJ_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 use.
-!else
-!message *** Dependency rules are not being used.
-!endif
-
-### add a spacer in the output
-!message
-
-
-#---------------------------------------------------------------------
-# Implicit rules that are not covered by the common ones defined in
-# rules.vc. A limitation exists with nmake that requires that
-# source directory can not contain spaces in the path. This an
-# absolute.
-#---------------------------------------------------------------------
-
-{$(TOMMATHDIR)}.c{$(TMP_DIR)}.obj::
- $(cc32) $(pkgcflags) -Fo$(TMP_DIR)\ @<<
-$<
-<<
-
-{$(COMPATDIR)\zlib}.c{$(TMP_DIR)}.obj::
- $(cc32) $(pkgcflags) -Fo$(TMP_DIR)\ @<<
-$<
-<<
-
-$(TMP_DIR)\tclsh.res: $(TMP_DIR)\tclsh.exe.manifest $(WINDIR)\tclsh.rc
-
-
-#---------------------------------------------------------------------
-# Installation.
-#---------------------------------------------------------------------
-
-install-binaries:
- @echo Installing to '$(_INSTALLDIR)'
- @echo Installing $(TCLLIBNAME)
-!if "$(TCLLIB)" != "$(TCLIMPLIB)"
- @$(CPY) "$(TCLLIB)" "$(BIN_INSTALL_DIR)\"
-!endif
- @$(CPY) "$(TCLIMPLIB)" "$(LIB_INSTALL_DIR)\"
-!if exist($(TCLSH))
- @echo Installing $(TCLSHNAME)
- @$(CPY) "$(TCLSH)" "$(BIN_INSTALL_DIR)\"
-!endif
- @echo Installing $(TCLSTUBLIBNAME)
- @$(CPY) "$(TCLSTUBLIB)" "$(LIB_INSTALL_DIR)\"
-
-install-libraries: tclConfig tcl-nmake install-msgs install-tzdata
- @if not exist "$(SCRIPT_INSTALL_DIR)" \
- $(MKDIR) "$(SCRIPT_INSTALL_DIR)"
- @if not exist "$(SCRIPT_INSTALL_DIR)\..\tcl8" \
- $(MKDIR) "$(SCRIPT_INSTALL_DIR)\..\tcl8"
- @if not exist "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.4" \
- $(MKDIR) "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.4"
- @if not exist "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.4\platform" \
- $(MKDIR) "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.4\platform"
- @if not exist "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.5" \
- $(MKDIR) "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.5"
- @if not exist "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.6" \
- $(MKDIR) "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.6"
- @if not exist "$(LIB_INSTALL_DIR)\nmake" \
- $(MKDIR) "$(LIB_INSTALL_DIR)\nmake"
- @echo Installing header files
- @$(CPY) "$(GENERICDIR)\tcl.h" "$(INCLUDE_INSTALL_DIR)\"
- @$(CPY) "$(GENERICDIR)\tclDecls.h" "$(INCLUDE_INSTALL_DIR)\"
- @$(CPY) "$(GENERICDIR)\tclOO.h" "$(INCLUDE_INSTALL_DIR)\"
- @$(CPY) "$(GENERICDIR)\tclOODecls.h" "$(INCLUDE_INSTALL_DIR)\"
- @$(CPY) "$(GENERICDIR)\tclPlatDecls.h" "$(INCLUDE_INSTALL_DIR)\"
- @$(CPY) "$(GENERICDIR)\tclTomMath.h" "$(INCLUDE_INSTALL_DIR)\"
- @$(CPY) "$(GENERICDIR)\tclTomMathDecls.h" "$(INCLUDE_INSTALL_DIR)\"
- @$(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)\"
- @$(CPY) "$(WINDIR)\tclooConfig.sh" "$(LIB_INSTALL_DIR)\"
- @$(CPY) "$(WINDIR)\rules.vc" "$(LIB_INSTALL_DIR)\nmake\"
- @$(CPY) "$(WINDIR)\targets.vc" "$(LIB_INSTALL_DIR)\nmake\"
- @$(CPY) "$(WINDIR)\nmakehlp.c" "$(LIB_INSTALL_DIR)\nmake\"
- @$(CPY) "$(OUT_DIR)\tcl.nmake" "$(LIB_INSTALL_DIR)\nmake\"
- @echo Installing library http1.0 directory
- @$(CPY) "$(ROOT)\library\http1.0\*.tcl" \
- "$(SCRIPT_INSTALL_DIR)\http1.0\"
- @echo Installing library opt0.4 directory
- @$(CPY) "$(ROOT)\library\opt\*.tcl" \
- "$(SCRIPT_INSTALL_DIR)\opt0.4\"
- @echo Installing package http $(PKG_HTTP_VER) as a Tcl Module
- @$(COPY) "$(ROOT)\library\http\http.tcl" \
- "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.6\http-$(PKG_HTTP_VER).tm"
- @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)
-!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 encodings
- @$(CPY) "$(ROOT)\library\encoding\*.enc" \
- "$(SCRIPT_INSTALL_DIR)\encoding\"
-# "emacs font-lock highlighting 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) ...
- @if exist $(TCLTEST) del $(TCLTEST)
- @echo Removing $(TCLDDELIB) ...
- @if exist $(TCLDDELIB) del $(TCLDDELIB)
- @echo Removing $(TCLREGLIB) ...
- @if exist $(TCLREGLIB) del $(TCLREGLIB)
-
-clean: default-clean clean-pkgs
-hose: default-hose
-realclean: hose
-
-# Local Variables:
-# mode: makefile
-# End:
diff --git a/tcl8.6/win/nmakehlp.c b/tcl8.6/win/nmakehlp.c
deleted file mode 100644
index b759020..0000000
--- a/tcl8.6/win/nmakehlp.c
+++ /dev/null
@@ -1,815 +0,0 @@
-/*
- * ----------------------------------------------------------------------------
- * nmakehlp.c --
- *
- * 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.
- * ----------------------------------------------------------------------------
- */
-
-#define _CRT_SECURE_NO_DEPRECATE
-#include <windows.h>
-#pragma comment (lib, "user32.lib")
-#pragma comment (lib, "kernel32.lib")
-#include <stdio.h>
-#include <math.h>
-
-/*
- * This library is required for x64 builds with _some_ versions of MSVC
- */
-#if defined(_M_IA64) || defined(_M_AMD64)
-#if _MSC_VER >= 1400 && _MSC_VER < 1500
-#pragma comment(lib, "bufferoverflowU")
-#endif
-#endif
-
-/* ISO hack for dumb VC++ */
-#ifdef _MSC_VER
-#define snprintf _snprintf
-#endif
-
-
-/* protos */
-
-static int CheckForCompilerFeature(const char *option);
-static int CheckForLinkerFeature(const char **options, int count);
-static int IsIn(const char *string, const char *substring);
-static int SubstituteFile(const char *substs, const char *filename);
-static int QualifyPath(const char *path);
-static int LocateDependency(const char *keyfile);
-static const char *GetVersionFromFile(const char *filename, const char *match, int numdots);
-static DWORD WINAPI ReadFromPipe(LPVOID args);
-
-/* globals */
-
-#define CHUNK 25
-#define STATICBUFFERSIZE 1000
-typedef struct {
- HANDLE pipe;
- char buffer[STATICBUFFERSIZE];
-} pipeinfo;
-
-pipeinfo Out = {INVALID_HANDLE_VALUE, '\0'};
-pipeinfo Err = {INVALID_HANDLE_VALUE, '\0'};
-
-/*
- * exitcodes: 0 == no, 1 == yes, 2 == error
- */
-
-int
-main(
- int argc,
- char *argv[])
-{
- char msg[300];
- DWORD dwWritten;
- int chars;
- const char *s;
-
- /*
- * Make sure children (cl.exe and link.exe) are kept quiet.
- */
-
- SetErrorMode(SEM_FAILCRITICALERRORS | SEM_NOOPENFILEERRORBOX);
-
- /*
- * Make sure the compiler and linker aren't effected by the outside world.
- */
-
- SetEnvironmentVariable("CL", "");
- SetEnvironmentVariable("LINK", "");
-
- if (argc > 1 && *argv[1] == '-') {
- switch (*(argv[1]+1)) {
- case 'c':
- if (argc != 3) {
- chars = snprintf(msg, sizeof(msg) - 1,
- "usage: %s -c <compiler option>\n"
- "Tests for whether cl.exe supports an option\n"
- "exitcodes: 0 == no, 1 == yes, 2 == error\n", argv[0]);
- WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars,
- &dwWritten, NULL);
- return 2;
- }
- return CheckForCompilerFeature(argv[2]);
- case 'l':
- if (argc < 3) {
- chars = snprintf(msg, sizeof(msg) - 1,
- "usage: %s -l <linker option> ?<mandatory option> ...?\n"
- "Tests for whether link.exe supports an option\n"
- "exitcodes: 0 == no, 1 == yes, 2 == error\n", argv[0]);
- WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars,
- &dwWritten, NULL);
- return 2;
- }
- return CheckForLinkerFeature(&argv[2], argc-2);
- case 'f':
- if (argc == 2) {
- chars = snprintf(msg, sizeof(msg) - 1,
- "usage: %s -f <string> <substring>\n"
- "Find a substring within another\n"
- "exitcodes: 0 == no, 1 == yes, 2 == error\n", argv[0]);
- WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars,
- &dwWritten, NULL);
- return 2;
- } else if (argc == 3) {
- /*
- * If the string is blank, there is no match.
- */
-
- return 0;
- } else {
- return IsIn(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;
- }
- s = GetVersionFromFile(argv[2], argv[3], *(argv[1]+2) - '0');
- if (s && *s) {
- printf("%s\n", s);
- return 0;
- } else
- return 1; /* Version not found. Return non-0 exit code */
-
- case 'Q':
- if (argc != 3) {
- chars = snprintf(msg, sizeof(msg) - 1,
- "usage: %s -Q path\n"
- "Emit the fully qualified path\n"
- "exitcodes: 0 == no, 1 == yes, 2 == error\n", argv[0]);
- WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars,
- &dwWritten, NULL);
- return 2;
- }
- return QualifyPath(argv[2]);
-
- case 'L':
- if (argc != 3) {
- chars = snprintf(msg, sizeof(msg) - 1,
- "usage: %s -L keypath\n"
- "Emit the fully qualified path of directory containing keypath\n"
- "exitcodes: 0 == success, 1 == not found, 2 == error\n", argv[0]);
- WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars,
- &dwWritten, NULL);
- return 2;
- }
- return LocateDependency(argv[2]);
- }
- }
- chars = snprintf(msg, sizeof(msg) - 1,
- "usage: %s -c|-f|-l|-Q|-s|-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]);
- WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars, &dwWritten, NULL);
- return 2;
-}
-
-static int
-CheckForCompilerFeature(
- const char *option)
-{
- STARTUPINFO si;
- PROCESS_INFORMATION pi;
- SECURITY_ATTRIBUTES sa;
- DWORD threadID;
- char msg[300];
- BOOL ok;
- HANDLE hProcess, h, pipeThreads[2];
- char cmdline[100];
-
- hProcess = GetCurrentProcess();
-
- ZeroMemory(&pi, sizeof(PROCESS_INFORMATION));
- ZeroMemory(&si, sizeof(STARTUPINFO));
- si.cb = sizeof(STARTUPINFO);
- si.dwFlags = STARTF_USESTDHANDLES;
- si.hStdInput = INVALID_HANDLE_VALUE;
-
- ZeroMemory(&sa, sizeof(SECURITY_ATTRIBUTES));
- sa.nLength = sizeof(SECURITY_ATTRIBUTES);
- sa.lpSecurityDescriptor = NULL;
- sa.bInheritHandle = FALSE;
-
- /*
- * Create a non-inheritible pipe.
- */
-
- CreatePipe(&Out.pipe, &h, &sa, 0);
-
- /*
- * Dupe the write side, make it inheritible, and close the original.
- */
-
- DuplicateHandle(hProcess, h, hProcess, &si.hStdOutput, 0, TRUE,
- DUPLICATE_SAME_ACCESS | DUPLICATE_CLOSE_SOURCE);
-
- /*
- * Same as above, but for the error side.
- */
-
- CreatePipe(&Err.pipe, &h, &sa, 0);
- DuplicateHandle(hProcess, h, hProcess, &si.hStdError, 0, TRUE,
- DUPLICATE_SAME_ACCESS | DUPLICATE_CLOSE_SOURCE);
-
- /*
- * Base command line.
- */
-
- lstrcpy(cmdline, "cl.exe -nologo -c -TC -Zs -X -Fp.\\_junk.pch ");
-
- /*
- * Append our option for testing
- */
-
- lstrcat(cmdline, option);
-
- /*
- * Filename to compile, which exists, but is nothing and empty.
- */
-
- lstrcat(cmdline, " .\\nul");
-
- ok = CreateProcess(
- NULL, /* Module name. */
- cmdline, /* Command line. */
- NULL, /* Process handle not inheritable. */
- NULL, /* Thread handle not inheritable. */
- TRUE, /* yes, inherit handles. */
- DETACHED_PROCESS, /* No console for you. */
- NULL, /* Use parent's environment block. */
- NULL, /* Use parent's starting directory. */
- &si, /* Pointer to STARTUPINFO structure. */
- &pi); /* Pointer to PROCESS_INFORMATION structure. */
-
- if (!ok) {
- DWORD err = GetLastError();
- int chars = snprintf(msg, sizeof(msg) - 1,
- "Tried to launch: \"%s\", but got error [%u]: ", cmdline, err);
-
- 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);
- return 2;
- }
-
- /*
- * Close our references to the write handles that have now been inherited.
- */
-
- CloseHandle(si.hStdOutput);
- CloseHandle(si.hStdError);
-
- WaitForInputIdle(pi.hProcess, 5000);
- CloseHandle(pi.hThread);
-
- /*
- * Start the pipe reader threads.
- */
-
- pipeThreads[0] = CreateThread(NULL, 0, ReadFromPipe, &Out, 0, &threadID);
- pipeThreads[1] = CreateThread(NULL, 0, ReadFromPipe, &Err, 0, &threadID);
-
- /*
- * Block waiting for the process to end.
- */
-
- WaitForSingleObject(pi.hProcess, INFINITE);
- CloseHandle(pi.hProcess);
-
- /*
- * Wait for our pipe to get done reading, should it be a little slow.
- */
-
- WaitForMultipleObjects(2, pipeThreads, TRUE, 500);
- CloseHandle(pipeThreads[0]);
- CloseHandle(pipeThreads[1]);
-
- /*
- * Look for the commandline warning code in both streams.
- * - in MSVC 6 & 7 we get D4002, in MSVC 8 we get D9002.
- */
-
- return !(strstr(Out.buffer, "D4002") != NULL
- || strstr(Err.buffer, "D4002") != NULL
- || strstr(Out.buffer, "D9002") != NULL
- || strstr(Err.buffer, "D9002") != NULL
- || strstr(Out.buffer, "D2021") != NULL
- || strstr(Err.buffer, "D2021") != NULL);
-}
-
-static int
-CheckForLinkerFeature(
- const char **options,
- int count)
-{
- STARTUPINFO si;
- PROCESS_INFORMATION pi;
- SECURITY_ATTRIBUTES sa;
- DWORD threadID;
- char msg[300];
- BOOL ok;
- HANDLE hProcess, h, pipeThreads[2];
- int i;
- char cmdline[255];
-
- hProcess = GetCurrentProcess();
-
- ZeroMemory(&pi, sizeof(PROCESS_INFORMATION));
- ZeroMemory(&si, sizeof(STARTUPINFO));
- si.cb = sizeof(STARTUPINFO);
- si.dwFlags = STARTF_USESTDHANDLES;
- si.hStdInput = INVALID_HANDLE_VALUE;
-
- ZeroMemory(&sa, sizeof(SECURITY_ATTRIBUTES));
- sa.nLength = sizeof(SECURITY_ATTRIBUTES);
- sa.lpSecurityDescriptor = NULL;
- sa.bInheritHandle = TRUE;
-
- /*
- * Create a non-inheritible pipe.
- */
-
- CreatePipe(&Out.pipe, &h, &sa, 0);
-
- /*
- * Dupe the write side, make it inheritible, and close the original.
- */
-
- DuplicateHandle(hProcess, h, hProcess, &si.hStdOutput, 0, TRUE,
- DUPLICATE_SAME_ACCESS | DUPLICATE_CLOSE_SOURCE);
-
- /*
- * Same as above, but for the error side.
- */
-
- CreatePipe(&Err.pipe, &h, &sa, 0);
- DuplicateHandle(hProcess, h, hProcess, &si.hStdError, 0, TRUE,
- DUPLICATE_SAME_ACCESS | DUPLICATE_CLOSE_SOURCE);
-
- /*
- * Base command line.
- */
-
- lstrcpy(cmdline, "link.exe -nologo ");
-
- /*
- * Append our option for testing.
- */
-
- for (i = 0; i < count; i++) {
- lstrcat(cmdline, " \"");
- lstrcat(cmdline, options[i]);
- lstrcat(cmdline, "\"");
- }
-
- ok = CreateProcess(
- NULL, /* Module name. */
- cmdline, /* Command line. */
- NULL, /* Process handle not inheritable. */
- NULL, /* Thread handle not inheritable. */
- TRUE, /* yes, inherit handles. */
- DETACHED_PROCESS, /* No console for you. */
- NULL, /* Use parent's environment block. */
- NULL, /* Use parent's starting directory. */
- &si, /* Pointer to STARTUPINFO structure. */
- &pi); /* Pointer to PROCESS_INFORMATION structure. */
-
- if (!ok) {
- DWORD err = GetLastError();
- int chars = snprintf(msg, sizeof(msg) - 1,
- "Tried to launch: \"%s\", but got error [%u]: ", cmdline, err);
-
- 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);
- return 2;
- }
-
- /*
- * Close our references to the write handles that have now been inherited.
- */
-
- CloseHandle(si.hStdOutput);
- CloseHandle(si.hStdError);
-
- WaitForInputIdle(pi.hProcess, 5000);
- CloseHandle(pi.hThread);
-
- /*
- * Start the pipe reader threads.
- */
-
- pipeThreads[0] = CreateThread(NULL, 0, ReadFromPipe, &Out, 0, &threadID);
- pipeThreads[1] = CreateThread(NULL, 0, ReadFromPipe, &Err, 0, &threadID);
-
- /*
- * Block waiting for the process to end.
- */
-
- WaitForSingleObject(pi.hProcess, INFINITE);
- CloseHandle(pi.hProcess);
-
- /*
- * Wait for our pipe to get done reading, should it be a little slow.
- */
-
- WaitForMultipleObjects(2, pipeThreads, TRUE, 500);
- CloseHandle(pipeThreads[0]);
- CloseHandle(pipeThreads[1]);
-
- /*
- * Look for the commandline warning code in the stderr stream.
- */
-
- return !(strstr(Out.buffer, "LNK1117") != NULL ||
- strstr(Err.buffer, "LNK1117") != NULL ||
- strstr(Out.buffer, "LNK4044") != NULL ||
- strstr(Err.buffer, "LNK4044") != NULL ||
- strstr(Out.buffer, "LNK4224") != NULL ||
- strstr(Err.buffer, "LNK4224") != NULL);
-}
-
-static DWORD WINAPI
-ReadFromPipe(
- LPVOID args)
-{
- pipeinfo *pi = (pipeinfo *) args;
- char *lastBuf = pi->buffer;
- DWORD dwRead;
- BOOL ok;
-
- again:
- if (lastBuf - pi->buffer + CHUNK > STATICBUFFERSIZE) {
- CloseHandle(pi->pipe);
- return (DWORD)-1;
- }
- ok = ReadFile(pi->pipe, lastBuf, CHUNK, &dwRead, 0L);
- if (!ok || dwRead == 0) {
- CloseHandle(pi->pipe);
- return 0;
- }
- lastBuf += dwRead;
- goto again;
-
- return 0; /* makes the compiler happy */
-}
-
-static int
-IsIn(
- const char *string,
- const char *substring)
-{
- return (strstr(string, substring) != NULL);
-}
-
-/*
- * 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.
- */
-
-static const char *
-GetVersionFromFile(
- const char *filename,
- const char *match,
- int numdots)
-{
- 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 after the match.
- */
-
- p += strlen(match);
- while (*p && !isdigit(*p)) {
- ++p;
- }
-
- /*
- * Find ending whitespace.
- */
-
- q = p;
- while (*q && (strchr("0123456789.ab", *q)) && ((!strchr(".ab", *q)
- && (!strchr("ab", q[-1])) || --numdots))) {
- ++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)
- * <<
- */
-
-static 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) {
- unsigned char *ks, *ke, *vs, *ve;
- ks = (unsigned char*)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, (char*)ks, (char*)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;
-}
-
-BOOL FileExists(LPCTSTR szPath)
-{
-#ifndef INVALID_FILE_ATTRIBUTES
- #define INVALID_FILE_ATTRIBUTES ((DWORD)-1)
-#endif
- DWORD pathAttr = GetFileAttributes(szPath);
- return (pathAttr != INVALID_FILE_ATTRIBUTES &&
- !(pathAttr & FILE_ATTRIBUTE_DIRECTORY));
-}
-
-
-/*
- * QualifyPath --
- *
- * This composes the current working directory with a provided path
- * and returns the fully qualified and normalized path.
- * Mostly needed to setup paths for testing.
- */
-
-static int
-QualifyPath(
- const char *szPath)
-{
- char szCwd[MAX_PATH + 1];
-
- GetFullPathName(szPath, sizeof(szCwd)-1, szCwd, NULL);
- printf("%s\n", szCwd);
- return 0;
-}
-
-/*
- * Implements LocateDependency for a single directory. See that command
- * for an explanation.
- * Returns 0 if found after printing the directory.
- * Returns 1 if not found but no errors.
- * Returns 2 on any kind of error
- * Basically, these are used as exit codes for the process.
- */
-static int LocateDependencyHelper(const char *dir, const char *keypath)
-{
- HANDLE hSearch;
- char path[MAX_PATH+1];
- int dirlen, keylen, ret;
- WIN32_FIND_DATA finfo;
-
- if (dir == NULL || keypath == NULL)
- return 2; /* Have no real error reporting mechanism into nmake */
- dirlen = strlen(dir);
- if ((dirlen + 3) > sizeof(path))
- return 2;
- strncpy(path, dir, dirlen);
- strncpy(path+dirlen, "\\*", 3); /* Including terminating \0 */
- keylen = strlen(keypath);
-
-#if 0 /* This function is not available in Visual C++ 6 */
- /*
- * Use numerics 0 -> FindExInfoStandard,
- * 1 -> FindExSearchLimitToDirectories,
- * as these are not defined in Visual C++ 6
- */
- hSearch = FindFirstFileEx(path, 0, &finfo, 1, NULL, 0);
-#else
- hSearch = FindFirstFile(path, &finfo);
-#endif
- if (hSearch == INVALID_HANDLE_VALUE)
- return 1; /* Not found */
-
- /* Loop through all subdirs checking if the keypath is under there */
- ret = 1; /* Assume not found */
- do {
- int sublen;
- /*
- * We need to check it is a directory despite the
- * FindExSearchLimitToDirectories in the above call. See SDK docs
- */
- if ((finfo.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY) == 0)
- continue;
- sublen = strlen(finfo.cFileName);
- if ((dirlen+1+sublen+1+keylen+1) > sizeof(path))
- continue; /* Path does not fit, assume not matched */
- strncpy(path+dirlen+1, finfo.cFileName, sublen);
- path[dirlen+1+sublen] = '\\';
- strncpy(path+dirlen+1+sublen+1, keypath, keylen+1);
- if (FileExists(path)) {
- /* Found a match, print to stdout */
- path[dirlen+1+sublen] = '\0';
- QualifyPath(path);
- ret = 0;
- break;
- }
- } while (FindNextFile(hSearch, &finfo));
- FindClose(hSearch);
- return ret;
-}
-
-/*
- * LocateDependency --
- *
- * Locates a dependency for a package.
- * keypath - a relative path within the package directory
- * that is used to confirm it is the correct directory.
- * The search path for the package directory is currently only
- * the parent and grandparent of the current working directory.
- * If found, the command prints
- * name_DIRPATH=<full path of located directory>
- * and returns 0. If not found, does not print anything and returns 1.
- */
-static int LocateDependency(const char *keypath)
-{
- int i, ret;
- static char *paths[] = {"..", "..\\..", "..\\..\\.."};
-
- for (i = 0; i < (sizeof(paths)/sizeof(paths[0])); ++i) {
- ret = LocateDependencyHelper(paths[i], keypath);
- if (ret == 0)
- return ret;
- }
- return ret;
-}
-
-
-/*
- * Local variables:
- * mode: c
- * c-basic-offset: 4
- * fill-column: 78
- * indent-tabs-mode: t
- * tab-width: 8
- * End:
- */
diff --git a/tcl8.6/win/rules-ext.vc b/tcl8.6/win/rules-ext.vc
deleted file mode 100644
index 531e070..0000000
--- a/tcl8.6/win/rules-ext.vc
+++ /dev/null
@@ -1,118 +0,0 @@
-# This file should only be included in makefiles for Tcl extensions,
-# NOT in the makefile for Tcl itself.
-
-!ifndef _RULES_EXT_VC
-
-# We need to run from the directory the parent makefile is located in.
-# nmake does not tell us what makefile was used to invoke it so parent
-# makefile has to set the MAKEFILEVC macro or we just make a guess and
-# warn if we think that is not the case.
-!if "$(MAKEFILEVC)" == ""
-
-!if exist("$(PROJECT).vc")
-MAKEFILEVC = $(PROJECT).vc
-!elseif exist("makefile.vc")
-MAKEFILEVC = makefile.vc
-!endif
-!endif # "$(MAKEFILEVC)" == ""
-
-!if !exist("$(MAKEFILEVC)")
-MSG = ^
-You must run nmake from the directory containing the project makefile.^
-If you are doing that and getting this message, set the MAKEFILEVC^
-macro to the name of the project makefile.
-!message WARNING: $(MSG)
-!endif
-
-!if "$(PROJECT)" == "tcl"
-!error The rules-ext.vc file is not intended for Tcl itself.
-!endif
-
-# We extract version numbers using the nmakehlp program. For now use
-# the local copy of nmakehlp. Once we locate Tcl, we will use that
-# one if it is newer.
-!if [$(CC) -nologo "nmakehlp.c" -link -subsystem:console > nul]
-!endif
-
-# First locate the Tcl directory that we are working with.
-!if "$(TCLDIR)" != ""
-
-_RULESDIR = $(TCLDIR:/=\)
-
-!else
-
-# If an installation path is specified, that is also the Tcl directory.
-# Also Tk never builds against an installed Tcl, it needs Tcl sources
-!if defined(INSTALLDIR) && "$(PROJECT)" != "tk"
-_RULESDIR=$(INSTALLDIR:/=\)
-!else
-# Locate Tcl sources
-!if [echo _RULESDIR = \> nmakehlp.out] \
- || [nmakehlp -L generic\tcl.h >> nmakehlp.out]
-_RULESDIR = ..\..\tcl
-!else
-!include nmakehlp.out
-!endif
-
-!endif # defined(INSTALLDIR)....
-
-!endif # ifndef TCLDIR
-
-# Now look for the targets.vc file under the Tcl root. Note we check this
-# file and not rules.vc because the latter also exists on older systems.
-!if exist("$(_RULESDIR)\lib\nmake\targets.vc") # Building against installed Tcl
-_RULESDIR = $(_RULESDIR)\lib\nmake
-!elseif exist("$(_RULESDIR)\win\targets.vc") # Building against Tcl sources
-_RULESDIR = $(_RULESDIR)\win
-!else
-# If we have not located Tcl's targets file, most likely we are compiling
-# against an older version of Tcl and so must use our own support files.
-_RULESDIR = .
-!endif
-
-!if "$(_RULESDIR)" != "."
-# Potentially using Tcl's support files. If this extension has its own
-# nmake support files, need to compare the versions and pick newer.
-
-!if exist("rules.vc") # The extension has its own copy
-
-!if [echo TCL_RULES_MAJOR = \> versions.vc] \
- && [nmakehlp -V "$(_RULESDIR)\rules.vc" RULES_VERSION_MAJOR >> versions.vc]
-!endif
-!if [echo TCL_RULES_MINOR = \>> versions.vc] \
- && [nmakehlp -V "$(_RULESDIR)\rules.vc" RULES_VERSION_MINOR >> versions.vc]
-!endif
-
-!if [echo OUR_RULES_MAJOR = \>> versions.vc] \
- && [nmakehlp -V "rules.vc" RULES_VERSION_MAJOR >> versions.vc]
-!endif
-!if [echo OUR_RULES_MINOR = \>> versions.vc] \
- && [nmakehlp -V "rules.vc" RULES_VERSION_MINOR >> versions.vc]
-!endif
-!include versions.vc
-# We have a newer version of the support files, use them
-!if ($(TCL_RULES_MAJOR) != $(OUR_RULES_MAJOR)) || ($(TCL_RULES_MINOR) < $(OUR_RULES_MINOR))
-_RULESDIR = .
-!endif
-
-!endif # if exist("rules.vc")
-
-!endif # if $(_RULESDIR) != "."
-
-# Let rules.vc know what copy of nmakehlp.c to use.
-NMAKEHLPC = $(_RULESDIR)\nmakehlp.c
-
-# Get rid of our internal defines before calling rules.vc
-!undef TCL_RULES_MAJOR
-!undef TCL_RULES_MINOR
-!undef OUR_RULES_MAJOR
-!undef OUR_RULES_MINOR
-
-!if exist("$(_RULESDIR)\rules.vc")
-!message *** Using $(_RULESDIR)\rules.vc
-!include "$(_RULESDIR)\rules.vc"
-!else
-!error *** Could not locate rules.vc in $(_RULESDIR)
-!endif
-
-!endif # _RULES_EXT_VC \ No newline at end of file
diff --git a/tcl8.6/win/rules.vc b/tcl8.6/win/rules.vc
deleted file mode 100644
index 8db4752..0000000
--- a/tcl8.6/win/rules.vc
+++ /dev/null
@@ -1,1752 +0,0 @@
-#------------------------------------------------------------- -*- makefile -*-
-# rules.vc --
-#
-# Part of the nmake based build system for Tcl and its extensions.
-# This file does all the hard work in terms of parsing build options,
-# compiler switches, defining common targets and macros. The Tcl makefile
-# directly includes this. Extensions include it via "rules-ext.vc".
-#
-# See TIP 477 (https://core.tcl.tk/tips/doc/trunk/tip/477.md) for
-# detailed documentation.
-#
-# 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-2008 Patrick Thoyts
-# Copyright (c) 2017 Ashok P. Nadkarni
-#------------------------------------------------------------------------------
-
-!ifndef _RULES_VC
-_RULES_VC = 1
-
-# The following macros define the version of the rules.vc nmake build system
-# For modifications that are not backward-compatible, you *must* change
-# the major version.
-RULES_VERSION_MAJOR = 1
-RULES_VERSION_MINOR = 2
-
-# The PROJECT macro must be defined by parent makefile.
-!if "$(PROJECT)" == ""
-!error *** Error: Macro PROJECT not defined! Please define it before including rules.vc
-!endif
-
-!if "$(PRJ_PACKAGE_TCLNAME)" == ""
-PRJ_PACKAGE_TCLNAME = $(PROJECT)
-!endif
-
-# Also special case Tcl and Tk to save some typing later
-DOING_TCL = 0
-DOING_TK = 0
-!if "$(PROJECT)" == "tcl"
-DOING_TCL = 1
-!elseif "$(PROJECT)" == "tk"
-DOING_TK = 1
-!endif
-
-!ifndef NEED_TK
-# Backwards compatibility
-!ifdef PROJECT_REQUIRES_TK
-NEED_TK = $(PROJECT_REQUIRES_TK)
-!else
-NEED_TK = 0
-!endif
-!endif
-
-!ifndef NEED_TCL_SOURCE
-NEED_TCL_SOURCE = 0
-!endif
-
-!ifdef NEED_TK_SOURCE
-!if $(NEED_TK_SOURCE)
-NEED_TK = 1
-!endif
-!else
-NEED_TK_SOURCE = 0
-!endif
-
-################################################################
-# Nmake is a pretty weak environment in syntax and capabilities
-# so this file is necessarily verbose. It's broken down into
-# the following parts.
-#
-# 0. Sanity check that compiler environment is set up and initialize
-# any built-in settings from the parent makefile
-# 1. First define the external tools used for compiling, copying etc.
-# as this is independent of everything else.
-# 2. Figure out our build structure in terms of the directory, whether
-# we are building Tcl or an extension, etc.
-# 3. Determine the compiler and linker versions
-# 4. Build the nmakehlp helper application
-# 5. Determine the supported compiler options and features
-# 6. Parse the OPTS macro value for user-specified build configuration
-# 7. Parse the STATS macro value for statistics instrumentation
-# 8. Parse the CHECKS macro for additional compilation checks
-# 9. Extract Tcl, and possibly Tk, version numbers from the headers
-# 10. Based on this selected configuration, construct the output
-# directory and file paths
-# 11. Construct the paths where the package is to be installed
-# 12. Set up the actual options passed to compiler and linker based
-# on the information gathered above.
-# 13. Define some standard build targets and implicit rules. These may
-# be optionally disabled by the parent makefile.
-# 14. (For extensions only.) Compare the configuration of the target
-# Tcl and the extensions and warn against discrepancies.
-#
-# One final note about the macro names used. They are as they are
-# for historical reasons. We would like legacy extensions to
-# continue to work with this make include file so be wary of
-# changing them for consistency or clarity.
-
-# 0. Sanity check compiler environment
-
-# Check to see we are configured to build with MSVC (MSDEVDIR, MSVCDIR or
-# VCINSTALLDIR) or with the MS Platform SDK (MSSDK or WindowsSDKDir)
-
-!if !defined(MSDEVDIR) && !defined(MSVCDIR) && !defined(VCINSTALLDIR) && !defined(MSSDK) && !defined(WINDOWSSDKDIR)
-MSG = ^
-Visual C++ compiler environment not initialized.
-!error $(MSG)
-!endif
-
-# We need to run from the directory the parent makefile is located in.
-# nmake does not tell us what makefile was used to invoke it so parent
-# makefile has to set the MAKEFILEVC macro or we just make a guess and
-# warn if we think that is not the case.
-!if "$(MAKEFILEVC)" == ""
-
-!if exist("$(PROJECT).vc")
-MAKEFILEVC = $(PROJECT).vc
-!elseif exist("makefile.vc")
-MAKEFILEVC = makefile.vc
-!endif
-!endif # "$(MAKEFILEVC)" == ""
-
-!if !exist("$(MAKEFILEVC)")
-MSG = ^
-You must run nmake from the directory containing the project makefile.^
-If you are doing that and getting this message, set the MAKEFILEVC^
-macro to the name of the project makefile.
-!message WARNING: $(MSG)
-!endif
-
-
-################################################################
-# 1. Define external programs being used
-
-#----------------------------------------------------------
-# Set the proper copy method to avoid overwrite questions
-# to the user when copying files and selecting the right
-# "delete all" method.
-#----------------------------------------------------------
-
-RMDIR = rmdir /S /Q
-CPY = xcopy /i /y >NUL
-CPYDIR = xcopy /e /i /y >NUL
-COPY = copy /y >NUL
-MKDIR = mkdir
-
-######################################################################
-# 2. Figure out our build environment in terms of what we're building.
-#
-# (a) Tcl itself
-# (b) Tk
-# (c) a Tcl extension using libraries/includes from an *installed* Tcl
-# (d) a Tcl extension using libraries/includes from Tcl source directory
-#
-# This last is needed because some extensions still need
-# some Tcl interfaces that are not publicly exposed.
-#
-# The fragment will set the following macros:
-# ROOT - root of this module sources
-# COMPATDIR - source directory that holds compatibility sources
-# DOCDIR - source directory containing documentation files
-# GENERICDIR - platform-independent source directory
-# WINDIR - Windows-specific source directory
-# TESTDIR - directory containing test files
-# TOOLSDIR - directory containing build tools
-# _TCLDIR - root of the Tcl installation OR the Tcl sources. Not set
-# when building Tcl itself.
-# _INSTALLDIR - native form of the installation path. For Tcl
-# this will be the root of the Tcl installation. For extensions
-# this will be the lib directory under the root.
-# TCLINSTALL - set to 1 if _TCLDIR refers to
-# headers and libraries from an installed Tcl, and 0 if built against
-# Tcl sources. Not set when building Tcl itself. Yes, not very well
-# named.
-# _TCL_H - native path to the tcl.h file
-#
-# If Tk is involved, also sets the following
-# _TKDIR - native form Tk installation OR Tk source. Not set if building
-# Tk itself.
-# TKINSTALL - set 1 if _TKDIR refers to installed Tk and 0 if Tk sources
-# _TK_H - native path to the tk.h file
-
-# Root directory for sources and assumed subdirectories
-ROOT = $(MAKEDIR)\..
-# The following paths CANNOT have spaces in them as they appear on the
-# left side of implicit rules.
-!ifndef COMPATDIR
-COMPATDIR = $(ROOT)\compat
-!endif
-!ifndef DOCDIR
-DOCDIR = $(ROOT)\doc
-!endif
-!ifndef GENERICDIR
-GENERICDIR = $(ROOT)\generic
-!endif
-!ifndef TOOLSDIR
-TOOLSDIR = $(ROOT)\tools
-!endif
-!ifndef TESTDIR
-TESTDIR = $(ROOT)\tests
-!endif
-!ifndef LIBDIR
-!if exist("$(ROOT)\library")
-LIBDIR = $(ROOT)\library
-!else
-LIBDIR = $(ROOT)\lib
-!endif
-!endif
-!ifndef DEMODIR
-!if exist("$(LIBDIR)\demos")
-DEMODIR = $(LIBDIR)\demos
-!else
-DEMODIR = $(ROOT)\demos
-!endif
-!endif # ifndef DEMODIR
-# Do NOT enclose WINDIR in a !ifndef because Windows always defines
-# WINDIR env var to point to c:\windows!
-# TBD - This is a potentially dangerous conflict, rename WINDIR to
-# something else
-WINDIR = $(ROOT)\win
-
-!ifndef RCDIR
-!if exist("$(WINDIR)\rc")
-RCDIR = $(WINDIR)\rc
-!else
-RCDIR = $(WINDIR)
-!endif
-!endif
-RCDIR = $(RCDIR:/=\)
-
-# The target directory where the built packages and binaries will be installed.
-# INSTALLDIR is the (optional) path specified by the user.
-# _INSTALLDIR is INSTALLDIR using the backslash separator syntax
-!ifdef INSTALLDIR
-### Fix the path separators.
-_INSTALLDIR = $(INSTALLDIR:/=\)
-!else
-### Assume the normal default.
-_INSTALLDIR = $(HOMEDRIVE)\Tcl
-!endif
-
-!if $(DOING_TCL)
-
-# BEGIN Case 2(a) - Building Tcl itself
-
-# Only need to define _TCL_H
-_TCL_H = ..\generic\tcl.h
-
-# END Case 2(a) - Building Tcl itself
-
-!elseif $(DOING_TK)
-
-# BEGIN Case 2(b) - Building Tk
-
-TCLINSTALL = 0 # Tk always builds against Tcl source, not an installed Tcl
-!if "$(TCLDIR)" == ""
-!if [echo TCLDIR = \> nmakehlp.out] \
- || [nmakehlp -L generic\tcl.h >> nmakehlp.out]
-!error *** Could not locate Tcl source directory.
-!endif
-!include nmakehlp.out
-!endif # TCLDIR == ""
-
-_TCLDIR = $(TCLDIR:/=\)
-_TCL_H = $(_TCLDIR)\generic\tcl.h
-!if !exist("$(_TCL_H)")
-!error Could not locate tcl.h. Please set the TCLDIR macro to point to the Tcl *source* directory.
-!endif
-
-_TK_H = ..\generic\tk.h
-
-# END Case 2(b) - Building Tk
-
-!else
-
-# BEGIN Case 2(c) or (d) - Building an extension other than Tk
-
-# If command line has specified Tcl location through TCLDIR, use it
-# else default to the INSTALLDIR setting
-!if "$(TCLDIR)" != ""
-
-_TCLDIR = $(TCLDIR:/=\)
-!if exist("$(_TCLDIR)\include\tcl.h") # Case 2(c) with TCLDIR defined
-TCLINSTALL = 1
-_TCL_H = $(_TCLDIR)\include\tcl.h
-!elseif exist("$(_TCLDIR)\generic\tcl.h") # Case 2(d) with TCLDIR defined
-TCLINSTALL = 0
-_TCL_H = $(_TCLDIR)\generic\tcl.h
-!endif
-
-!else # # Case 2(c) for extensions with TCLDIR undefined
-
-# Need to locate Tcl depending on whether it needs Tcl source or not.
-# If we don't, check the INSTALLDIR for an installed Tcl first
-
-!if exist("$(_INSTALLDIR)\include\tcl.h") && !$(NEED_TCL_SOURCE)
-
-TCLINSTALL = 1
-TCLDIR = $(_INSTALLDIR)\..
-# NOTE: we will be resetting _INSTALLDIR to _INSTALLDIR/lib for extensions
-# later so the \.. accounts for the /lib
-_TCLDIR = $(_INSTALLDIR)\..
-_TCL_H = $(_TCLDIR)\include\tcl.h
-
-!else # exist(...) && ! $(NEED_TCL_SOURCE)
-
-!if [echo _TCLDIR = \> nmakehlp.out] \
- || [nmakehlp -L generic\tcl.h >> nmakehlp.out]
-!error *** Could not locate Tcl source directory.
-!endif
-!include nmakehlp.out
-TCLINSTALL = 0
-TCLDIR = $(_TCLDIR)
-_TCL_H = $(_TCLDIR)\generic\tcl.h
-
-!endif # exist(...) && ! $(NEED_TCL_SOURCE)
-
-!endif # TCLDIR
-
-!ifndef _TCL_H
-MSG =^
-Failed to find tcl.h. The TCLDIR macro is set incorrectly or is not set and default path does not contain tcl.h.
-!error $(MSG)
-!endif
-
-# Now do the same to locate Tk headers and libs if project requires Tk
-!if $(NEED_TK)
-
-!if "$(TKDIR)" != ""
-
-_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
-!endif
-
-!else # TKDIR not defined
-
-# Need to locate Tcl depending on whether it needs Tcl source or not.
-# If we don't, check the INSTALLDIR for an installed Tcl first
-
-!if exist("$(_INSTALLDIR)\include\tk.h") && !$(NEED_TK_SOURCE)
-
-TKINSTALL = 1
-# NOTE: we will be resetting _INSTALLDIR to _INSTALLDIR/lib for extensions
-# later so the \.. accounts for the /lib
-_TKDIR = $(_INSTALLDIR)\..
-_TK_H = $(_TKDIR)\include\tk.h
-TKDIR = $(_TKDIR)
-
-!else # exist("$(_INSTALLDIR)\include\tk.h") && !$(NEED_TK_SOURCE)
-
-!if [echo _TKDIR = \> nmakehlp.out] \
- || [nmakehlp -L generic\tk.h >> nmakehlp.out]
-!error *** Could not locate Tk source directory.
-!endif
-!include nmakehlp.out
-TKINSTALL = 0
-TKDIR = $(_TKDIR)
-_TK_H = $(_TKDIR)\generic\tk.h
-
-!endif # exist("$(_INSTALLDIR)\include\tk.h") && !$(NEED_TK_SOURCE)
-
-!endif # TKDIR
-
-!ifndef _TK_H
-MSG =^
-Failed to find tk.h. The TKDIR macro is set incorrectly or is not set and default path does not contain tk.h.
-!error $(MSG)
-!endif
-
-!endif # NEED_TK
-
-!if $(NEED_TCL_SOURCE) && $(TCLINSTALL)
-MSG = ^
-*** Warning: This extension requires the source distribution of Tcl.^
-*** Please set the TCLDIR macro to point to the Tcl sources.
-!error $(MSG)
-!endif
-
-!if $(NEED_TK_SOURCE)
-!if $(TKINSTALL)
-MSG = ^
-*** Warning: This extension requires the source distribution of Tk.^
-*** Please set the TKDIR macro to point to the Tk sources.
-!error $(MSG)
-!endif
-!endif
-
-
-# If INSTALLDIR set to Tcl installation root dir then reset to the
-# lib dir for installing extensions
-!if exist("$(_INSTALLDIR)\include\tcl.h")
-_INSTALLDIR=$(_INSTALLDIR)\lib
-!endif
-
-# END Case 2(c) or (d) - Building an extension
-!endif # if $(DOING_TCL)
-
-################################################################
-# 3. Determine compiler version and architecture
-# In this section, we figure out the compiler version and the
-# architecture for which we are building. This sets the
-# following macros:
-# VCVERSION - the internal compiler version as 1200, 1400, 1910 etc.
-# This is also printed by the compiler in dotted form 19.10 etc.
-# VCVER - the "marketing version", for example Visual C++ 6 for internal
-# compiler version 1200. This is kept only for legacy reasons as it
-# does not make sense for recent Microsoft compilers. Only used for
-# output directory names.
-# ARCH - set to IX86 or AMD64 depending on 32- or 64-bit target
-# NATIVE_ARCH - set to IX86 or AMD64 for the host machine
-# MACHINE - same as $(ARCH) - legacy
-# _VC_MANIFEST_EMBED_{DLL,EXE} - commands for embedding a manifest if needed
-# CFG_ENCODING - set to an character encoding.
-# TBD - this is passed to compiler as TCL_CFGVAL_ENCODING but can't
-# see where it is used
-
-cc32 = $(CC) # built-in default.
-link32 = link
-lib32 = lib
-rc32 = $(RC) # built-in default.
-
-#----------------------------------------------------------------
-# Figure out the compiler architecture and version by writing
-# the C macros to a file, preprocessing them with the C
-# preprocessor and reading back the created file
-
-_HASH=^#
-_VC_MANIFEST_EMBED_EXE=
-_VC_MANIFEST_EMBED_DLL=
-VCVER=0
-!if ![echo VCVERSION=_MSC_VER > vercl.x] \
- && ![echo $(_HASH)if defined(_M_IX86) >> vercl.x] \
- && ![echo ARCH=IX86 >> vercl.x] \
- && ![echo $(_HASH)elif defined(_M_AMD64) >> vercl.x] \
- && ![echo ARCH=AMD64 >> vercl.x] \
- && ![echo $(_HASH)endif >> vercl.x] \
- && ![$(cc32) -nologo -TC -P vercl.x 2>NUL]
-!include vercl.i
-!if $(VCVERSION) < 1900
-!if ![echo VCVER= ^\> vercl.vc] \
- && ![set /a $(VCVERSION) / 100 - 6 >> vercl.vc]
-!include vercl.vc
-!endif
-!else
-# The simple calculation above does not apply to new Visual Studio releases
-# Keep the compiler version in its native form.
-VCVER = $(VCVERSION)
-!endif
-!endif
-
-!if ![del 2>NUL /q/f vercl.x vercl.i vercl.vc]
-!endif
-
-#----------------------------------------------------------------
-# The MACHINE macro is used by legacy makefiles so set it as well
-!ifdef MACHINE
-!if "$(MACHINE)" == "x86"
-!undef MACHINE
-MACHINE = IX86
-!elseif "$(MACHINE)" == "x64"
-!undef MACHINE
-MACHINE = AMD64
-!endif
-!if "$(MACHINE)" != "$(ARCH)"
-!error Specified MACHINE macro $(MACHINE) does not match detected target architecture $(ARCH).
-!endif
-!else
-MACHINE=$(ARCH)
-!endif
-
-#------------------------------------------------------------
-# Figure out the *host* architecture by reading the registry
-
-!if ![reg query HKLM\Hardware\Description\System\CentralProcessor\0 /v Identifier | findstr /i x86]
-NATIVE_ARCH=IX86
-!else
-NATIVE_ARCH=AMD64
-!endif
-
-# Since MSVC8 we must deal with manifest resources.
-!if $(VCVERSION) >= 1400
-_VC_MANIFEST_EMBED_EXE=if exist $@.manifest mt -nologo -manifest $@.manifest -outputresource:$@;1
-_VC_MANIFEST_EMBED_DLL=if exist $@.manifest mt -nologo -manifest $@.manifest -outputresource:$@;2
-!endif
-
-!ifndef CFG_ENCODING
-CFG_ENCODING = \"cp1252\"
-!endif
-
-################################################################
-# 4. Build the nmakehlp program
-# This is a helper app we need to overcome nmake's limiting
-# environment. We will call out to it to get various bits of
-# information about supported compiler options etc.
-#
-# Tcl itself will always use the nmakehlp.c program which is
-# in its own source. This is the "master" copy and kept updated.
-#
-# Extensions built against an installed Tcl will use the installed
-# copy of Tcl's nmakehlp.c if there is one and their own version
-# otherwise. In the latter case, they would also be using their own
-# rules.vc. Note that older versions of Tcl do not install nmakehlp.c
-# or rules.vc.
-#
-# Extensions built against Tcl sources will use the one from the Tcl source.
-#
-# When building an extension using a sufficiently new version of Tcl,
-# rules-ext.vc will define NMAKEHLPC appropriately to point to the
-# copy of nmakehlp.c to be used.
-
-!ifndef NMAKEHLPC
-# Default to the one in the current directory (the extension's own nmakehlp.c)
-NMAKEHLPC = nmakehlp.c
-
-!if !$(DOING_TCL)
-!if $(TCLINSTALL)
-!if exist("$(_TCLDIR)\lib\nmake\nmakehlp.c")
-NMAKEHLPC = $(_TCLDIR)\lib\nmake\nmakehlp.c
-!endif
-!else # ! $(TCLINSTALL)
-!if exist("$(_TCLDIR)\win\nmakehlp.c")
-NMAKEHLPC = $(_TCLDIR)\win\nmakehlp.c
-!endif
-!endif # $(TCLINSTALL)
-!endif # !$(DOING_TCL)
-
-!endif # NMAKEHLPC
-
-# We always build nmakehlp even if it exists since we do not know
-# what source it was built from.
-!if [$(cc32) -nologo "$(NMAKEHLPC)" -link -subsystem:console > nul]
-!endif
-
-################################################################
-# 5. Test for compiler features
-# Visual C++ compiler options have changed over the years. Check
-# which options are supported by the compiler in use.
-#
-# The following macros are set:
-# OPTIMIZATIONS - the compiler flags to be used for optimized builds
-# DEBUGFLAGS - the compiler flags to be used for debug builds
-# LINKERFLAGS - Flags passed to the linker
-#
-# Note that these are the compiler settings *available*, not those
-# that will be *used*. The latter depends on the OPTS macro settings
-# which we have not yet parsed.
-#
-# Also note that some of the flags in OPTIMIZATIONS are not really
-# related to optimization. They are placed there only for legacy reasons
-# as some extensions expect them to be included in that macro.
-
-# -Op improves float consistency. Note only needed for older compilers
-# Newer compilers do not need or support this option.
-!if [nmakehlp -c -Op]
-FPOPTS = -Op
-!endif
-
-# Strict floating point semantics - present in newer compilers in lieu of -Op
-!if [nmakehlp -c -fp:strict]
-FPOPTS = $(FPOPTS) -fp:strict
-!endif
-
-!if "$(MACHINE)" == "IX86"
-### test for pentium errata
-!if [nmakehlp -c -QI0f]
-!message *** Compiler has 'Pentium 0x0f fix'
-FPOPTS = $(FPOPTS) -QI0f
-!else
-!message *** Compiler does not have 'Pentium 0x0f fix'
-!endif
-!endif
-
-### test for optimizations
-# /O2 optimization includes /Og /Oi /Ot /Oy /Ob2 /Gs /GF /Gy as per
-# documentation. Note we do NOT want /Gs as that inserts a _chkstk
-# stack probe at *every* function entry, not just those with more than
-# a page of stack allocation resulting in a performance hit. However,
-# /O2 documentation is misleading as its stack probes are simply the
-# default page size locals allocation probes and not what is implied
-# by an explicit /Gs option.
-
-OPTIMIZATIONS = $(FPOPTS)
-
-!if [nmakehlp -c -O2]
-OPTIMIZING = 1
-OPTIMIZATIONS = $(OPTIMIZATIONS) -O2
-!else
-# Legacy, really. All modern compilers support this
-!message *** Compiler does not have 'Optimizations'
-OPTIMIZING = 0
-!endif
-
-# Checks for buffer overflows in local arrays
-!if [nmakehlp -c -GS]
-OPTIMIZATIONS = $(OPTIMIZATIONS) -GS
-!endif
-
-# Link time optimization. Note that this option (potentially) makes
-# generated libraries only usable by the specific VC++ version that
-# created it. Requires /LTCG linker option
-!if [nmakehlp -c -GL]
-OPTIMIZATIONS = $(OPTIMIZATIONS) -GL
-CC_GL_OPT_ENABLED = 1
-!else
-# In newer compilers -GL and -YX are incompatible.
-!if [nmakehlp -c -YX]
-OPTIMIZATIONS = $(OPTIMIZATIONS) -YX
-!endif
-!endif # [nmakehlp -c -GL]
-
-DEBUGFLAGS = $(FPOPTS)
-
-# Run time error checks. Not available or valid in a release, non-debug build
-# RTC is for modern compilers, -GZ is legacy
-!if [nmakehlp -c -RTC1]
-DEBUGFLAGS = $(DEBUGFLAGS) -RTC1
-!elseif [nmakehlp -c -GZ]
-DEBUGFLAGS = $(DEBUGFLAGS) -GZ
-!endif
-
-#----------------------------------------------------------------
-# Linker flags
-
-# LINKER_TESTFLAGS are for internal use when we call nmakehlp to test
-# if the linker supports a specific option. Without these flags link will
-# return "LNK1561: entry point must be defined" error compiling from VS-IDE:
-# They are not passed through to the actual application / extension
-# link rules.
-!ifndef LINKER_TESTFLAGS
-LINKER_TESTFLAGS = /DLL /NOENTRY /OUT:nmakehlp.out
-!endif
-
-LINKERFLAGS =
-
-# If compiler has enabled link time optimization, linker must too with -ltcg
-!ifdef CC_GL_OPT_ENABLED
-!if [nmakehlp -l -ltcg $(LINKER_TESTFLAGS)]
-LINKERFLAGS = $(LINKERFLAGS) -ltcg
-!endif
-!endif
-
-########################################################################
-# 6. Parse the OPTS macro to work out the requested build configuration.
-# Based on this, we will construct the actual switches to be passed to the
-# compiler and linker using the macros defined in the previous section.
-# The following macros are defined by this section based on OPTS
-# STATIC_BUILD - 0 -> Tcl is to be built as a shared library
-# 1 -> build as a static library and shell
-# TCL_THREADS - legacy but always 1 on Windows since winsock requires it.
-# DEBUG - 1 -> debug build, 0 -> release builds
-# SYMBOLS - 1 -> generate PDB's, 0 -> no PDB's
-# PROFILE - 1 -> generate profiling info, 0 -> no profiling
-# PGO - 1 -> profile based optimization, 0 -> no
-# MSVCRT - 1 -> link to dynamic C runtime even when building static Tcl build
-# 0 -> link to static C runtime for static Tcl build.
-# Does not impact shared Tcl builds (STATIC_BUILD == 0)
-# TCL_USE_STATIC_PACKAGES - 1 -> statically link the registry and dde extensions
-# in the Tcl shell. 0 -> keep them as shared libraries
-# Does not impact shared Tcl builds.
-# USE_THREAD_ALLOC - 1 -> Use a shared global free pool for allocation.
-# 0 -> Use the non-thread allocator.
-# UNCHECKED - 1 -> when doing a debug build with symbols, use the release
-# C runtime, 0 -> use the debug C runtime.
-# USE_STUBS - 1 -> compile to use stubs interfaces, 0 -> direct linking
-# CONFIG_CHECK - 1 -> check current build configuration against Tcl
-# configuration (ignored for Tcl itself)
-# Further, LINKERFLAGS are modified based on above.
-
-# Default values for all the above
-STATIC_BUILD = 0
-TCL_THREADS = 1
-DEBUG = 0
-SYMBOLS = 0
-PROFILE = 0
-PGO = 0
-MSVCRT = 1
-TCL_USE_STATIC_PACKAGES = 0
-USE_THREAD_ALLOC = 1
-UNCHECKED = 0
-CONFIG_CHECK = 1
-!if $(DOING_TCL)
-USE_STUBS = 0
-!else
-USE_STUBS = 1
-!endif
-
-# If OPTS is not empty AND does not contain "none" which turns off all OPTS
-# set the above macros based on OPTS content
-!if "$(OPTS)" != "" && ![nmakehlp -f "$(OPTS)" "none"]
-
-# OPTS are specified, parse them
-
-!if [nmakehlp -f $(OPTS) "static"]
-!message *** Doing static
-STATIC_BUILD = 1
-!endif
-
-!if [nmakehlp -f $(OPTS) "nostubs"]
-!message *** Not using stubs
-USE_STUBS = 0
-!endif
-
-!if [nmakehlp -f $(OPTS) "nomsvcrt"]
-!message *** Doing nomsvcrt
-MSVCRT = 0
-!else
-!if [nmakehlp -f $(OPTS) "msvcrt"]
-!message *** Doing msvcrt
-MSVCRT = 1
-!else
-!if !$(STATIC_BUILD)
-MSVCRT = 1
-!else
-MSVCRT = 0
-!endif
-!endif
-!endif # [nmakehlp -f $(OPTS) "nomsvcrt"]
-
-!if [nmakehlp -f $(OPTS) "staticpkg"] && $(STATIC_BUILD)
-!message *** Doing staticpkg
-TCL_USE_STATIC_PACKAGES = 1
-!else
-TCL_USE_STATIC_PACKAGES = 0
-!endif
-
-!if [nmakehlp -f $(OPTS) "nothreads"]
-!message *** Compile explicitly for non-threaded tcl
-TCL_THREADS = 0
-USE_THREAD_ALLOC= 0
-!else
-TCL_THREADS = 1
-USE_THREAD_ALLOC= 1
-!endif
-
-!if [nmakehlp -f $(OPTS) "symbols"]
-!message *** Doing symbols
-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
-!else
-PROFILE = 0
-!endif
-
-!if [nmakehlp -f $(OPTS) "pgi"]
-!message *** Doing profile guided optimization instrumentation
-PGO = 1
-!elseif [nmakehlp -f $(OPTS) "pgo"]
-!message *** Doing profile guided optimization
-PGO = 2
-!else
-PGO = 0
-!endif
-
-!if [nmakehlp -f $(OPTS) "loimpact"]
-!message *** Warning: ignoring option "loimpact" - deprecated on modern Windows.
-!endif
-
-# TBD - should get rid of this option
-!if [nmakehlp -f $(OPTS) "thrdalloc"]
-!message *** Doing thrdalloc
-USE_THREAD_ALLOC = 1
-!endif
-
-!if [nmakehlp -f $(OPTS) "tclalloc"]
-USE_THREAD_ALLOC = 0
-!endif
-
-!if [nmakehlp -f $(OPTS) "unchecked"]
-!message *** Doing unchecked
-UNCHECKED = 1
-!else
-UNCHECKED = 0
-!endif
-
-!if [nmakehlp -f $(OPTS) "noconfigcheck"]
-CONFIG_CHECK = 1
-!else
-CONFIG_CHECK = 0
-!endif
-
-!endif # "$(OPTS)" != "" && ... parsing of OPTS
-
-# Set linker flags based on above
-
-!if $(PGO) > 1
-!if [nmakehlp -l -ltcg:pgoptimize $(LINKER_TESTFLAGS)]
-LINKERFLAGS = $(LINKERFLAGS:-ltcg=) -ltcg:pgoptimize
-!else
-MSG=^
-This compiler does not support profile guided optimization.
-!error $(MSG)
-!endif
-!elseif $(PGO) > 0
-!if [nmakehlp -l -ltcg:pginstrument $(LINKER_TESTFLAGS)]
-LINKERFLAGS = $(LINKERFLAGS:-ltcg=) -ltcg:pginstrument
-!else
-MSG=^
-This compiler does not support profile guided optimization.
-!error $(MSG)
-!endif
-!endif
-
-################################################################
-# 7. Parse the STATS macro to configure code instrumentation
-# The following macros are set by this section:
-# TCL_MEM_DEBUG - 1 -> enables memory allocation instrumentation
-# 0 -> disables
-# TCL_COMPILE_DEBUG - 1 -> enables byte compiler logging
-# 0 -> disables
-
-# Default both are off
-TCL_MEM_DEBUG = 0
-TCL_COMPILE_DEBUG = 0
-
-!if "$(STATS)" != "" && ![nmakehlp -f "$(STATS)" "none"]
-
-!if [nmakehlp -f $(STATS) "memdbg"]
-!message *** Doing memdbg
-TCL_MEM_DEBUG = 1
-!else
-TCL_MEM_DEBUG = 0
-!endif
-
-!if [nmakehlp -f $(STATS) "compdbg"]
-!message *** Doing compdbg
-TCL_COMPILE_DEBUG = 1
-!else
-TCL_COMPILE_DEBUG = 0
-!endif
-
-!endif
-
-####################################################################
-# 8. Parse the CHECKS macro to configure additional compiler checks
-# The following macros are set by this section:
-# WARNINGS - compiler switches that control the warnings level
-# TCL_NO_DEPRECATED - 1 -> disable support for deprecated functions
-# 0 -> enable deprecated functions
-
-# Defaults - Permit deprecated functions and warning level 3
-TCL_NO_DEPRECATED = 0
-WARNINGS = -W3
-
-!if "$(CHECKS)" != "" && ![nmakehlp -f "$(CHECKS)" "none"]
-
-!if [nmakehlp -f $(CHECKS) "nodep"]
-!message *** Doing nodep check
-TCL_NO_DEPRECATED = 1
-!endif
-
-!if [nmakehlp -f $(CHECKS) "fullwarn"]
-!message *** Doing full warnings check
-WARNINGS = -W4
-!if [nmakehlp -l -warn:3 $(LINKER_TESTFLAGS)]
-LINKERFLAGS = $(LINKERFLAGS) -warn:3
-!endif
-!endif
-
-!if [nmakehlp -f $(CHECKS) "64bit"] && [nmakehlp -c -Wp64]
-!message *** Doing 64bit portability warnings
-WARNINGS = $(WARNINGS) -Wp64
-!endif
-
-!endif
-
-################################################################
-# 9. Extract various version numbers
-# For Tcl and Tk, version numbers are extracted from tcl.h and tk.h
-# respectively. For extensions, versions are extracted from the
-# configure.in or configure.ac from the TEA configuration if it
-# exists, and unset otherwise.
-# Sets the following macros:
-# TCL_MAJOR_VERSION
-# TCL_MINOR_VERSION
-# TCL_PATCH_LEVEL
-# TCL_VERSION
-# TK_MAJOR_VERSION
-# TK_MINOR_VERSION
-# TK_PATCH_LEVEL
-# TK_VERSION
-# DOTVERSION - set as (for example) 2.5
-# VERSION - set as (for example 25)
-#--------------------------------------------------------------
-
-!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 defined(_TK_H)
-!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
-!endif # _TK_H
-
-!include versions.vc
-
-TCL_VERSION = $(TCL_MAJOR_VERSION)$(TCL_MINOR_VERSION)
-TCL_DOTVERSION = $(TCL_MAJOR_VERSION).$(TCL_MINOR_VERSION)
-!if defined(_TK_H)
-TK_VERSION = $(TK_MAJOR_VERSION)$(TK_MINOR_VERSION)
-TK_DOTVERSION = $(TK_MAJOR_VERSION).$(TK_MINOR_VERSION)
-!endif
-
-# Set DOTVERSION and VERSION
-!if $(DOING_TCL)
-
-DOTVERSION = $(TCL_MAJOR_VERSION).$(TCL_MINOR_VERSION)
-VERSION = $(TCL_VERSION)
-
-!elseif $(DOING_TK)
-
-DOTVERSION = $(TK_DOTVERSION)
-VERSION = $(TK_VERSION)
-
-!else # Doing a non-Tk extension
-
-# If parent makefile has not defined DOTVERSION, try to get it from TEA
-# first from a configure.in file, and then from configure.ac
-!ifndef DOTVERSION
-!if [echo DOTVERSION = \> versions.vc] \
- || [nmakehlp -V $(ROOT)\configure.in ^[$(PROJECT)^] >> versions.vc]
-!if [echo DOTVERSION = \> versions.vc] \
- || [nmakehlp -V $(ROOT)\configure.ac ^[$(PROJECT)^] >> versions.vc]
-!error *** Could not figure out extension version. Please define DOTVERSION in parent makefile before including rules.vc.
-!endif
-!endif
-!include versions.vc
-!endif # DOTVERSION
-VERSION = $(DOTVERSION:.=)
-
-!endif # $(DOING_TCL) ... etc.
-
-################################################################
-# 10. Construct output directory and file paths
-# Figure-out how to name our intermediate and output directories.
-# In order to avoid inadvertent mixing of object files built using
-# different compilers, build configurations etc.,
-#
-# Naming convention (suffixes):
-# t = full thread support.
-# s = static library (as opposed to an import library)
-# g = linked to the debug enabled C run-time.
-# x = special static build when it links to the dynamic C run-time.
-#
-# The following macros are set in this section:
-# SUFX - the suffix to use for binaries based on above naming convention
-# BUILDDIRTOP - the toplevel default output directory
-# is of the form {Release,Debug}[_AMD64][_COMPILERVERSION]
-# TMP_DIR - directory where object files are created
-# OUT_DIR - directory where output executables are created
-# Both TMP_DIR and OUT_DIR are defaulted only if not defined by the
-# parent makefile (or command line). The default values are
-# based on BUILDDIRTOP.
-# STUBPREFIX - name of the stubs library for this project
-# PRJIMPLIB - output path of the generated project import library
-# PRJLIBNAME - name of generated project library
-# PRJLIB - output path of generated project library
-# PRJSTUBLIBNAME - name of the generated project stubs library
-# PRJSTUBLIB - output path of the generated project stubs library
-# RESFILE - output resource file (only if not static build)
-
-SUFX = tsgx
-
-!if $(DEBUG)
-BUILDDIRTOP = Debug
-!else
-BUILDDIRTOP = Release
-!endif
-
-!if "$(MACHINE)" != "IX86"
-BUILDDIRTOP =$(BUILDDIRTOP)_$(MACHINE)
-!endif
-!if $(VCVER) > 6
-BUILDDIRTOP =$(BUILDDIRTOP)_VC$(VCVER)
-!endif
-
-!if !$(DEBUG) || $(DEBUG) && $(UNCHECKED)
-SUFX = $(SUFX:g=)
-!endif
-
-TMP_DIRFULL = .\$(BUILDDIRTOP)\$(PROJECT)_ThreadedDynamicStaticX
-
-!if !$(STATIC_BUILD)
-TMP_DIRFULL = $(TMP_DIRFULL:Static=)
-SUFX = $(SUFX:s=)
-EXT = dll
-TMP_DIRFULL = $(TMP_DIRFULL:X=)
-SUFX = $(SUFX:x=)
-!else
-TMP_DIRFULL = $(TMP_DIRFULL:Dynamic=)
-EXT = lib
-!if !$(MSVCRT)
-TMP_DIRFULL = $(TMP_DIRFULL:X=)
-SUFX = $(SUFX:x=)
-!endif
-!endif
-
-!if !$(TCL_THREADS)
-TMP_DIRFULL = $(TMP_DIRFULL:Threaded=)
-SUFX = $(SUFX:t=)
-!endif
-
-!ifndef TMP_DIR
-TMP_DIR = $(TMP_DIRFULL)
-!ifndef OUT_DIR
-OUT_DIR = .\$(BUILDDIRTOP)
-!endif
-!else
-!ifndef OUT_DIR
-OUT_DIR = $(TMP_DIR)
-!endif
-!endif
-
-# Relative paths -> absolute
-!if [echo OUT_DIR = \> nmakehlp.out] \
- || [nmakehlp -Q "$(OUT_DIR)" >> nmakehlp.out]
-!error *** Could not fully qualify path OUT_DIR=$(OUT_DIR)
-!endif
-!if [echo TMP_DIR = \>> nmakehlp.out] \
- || [nmakehlp -Q "$(TMP_DIR)" >> nmakehlp.out]
-!error *** Could not fully qualify path TMP_DIR=$(TMP_DIR)
-!endif
-!include nmakehlp.out
-
-# The name of the stubs library for the project being built
-STUBPREFIX = $(PROJECT)stub
-
-# Set up paths to various Tcl executables and libraries needed by extensions
-!if $(DOING_TCL)
-
-TCLSHNAME = $(PROJECT)sh$(TCL_VERSION)$(SUFX).exe
-TCLSH = $(OUT_DIR)\$(TCLSHNAME)
-TCLIMPLIB = $(OUT_DIR)\$(PROJECT)$(VERSION)$(SUFX).lib
-TCLLIBNAME = $(PROJECT)$(VERSION)$(SUFX).$(EXT)
-TCLLIB = $(OUT_DIR)\$(TCLLIBNAME)
-
-TCLSTUBLIBNAME = $(STUBPREFIX)$(VERSION).lib
-TCLSTUBLIB = $(OUT_DIR)\$(TCLSTUBLIBNAME)
-TCL_INCLUDES = -I"$(WINDIR)" -I"$(GENERICDIR)"
-
-!else # ! $(DOING_TCL)
-
-!if $(TCLINSTALL) # Building against an installed Tcl
-
-# When building extensions, we need to locate tclsh. Depending on version
-# of Tcl we are building against, this may or may not have a "t" suffix.
-# Try various possibilities in turn.
-TCLSH = $(_TCLDIR)\bin\tclsh$(TCL_VERSION)$(SUFX).exe
-!if !exist("$(TCLSH)") && $(TCL_THREADS)
-TCLSH = $(_TCLDIR)\bin\tclsh$(TCL_VERSION)t$(SUFX).exe
-!endif
-!if !exist("$(TCLSH)")
-TCLSH = $(_TCLDIR)\bin\tclsh$(TCL_VERSION)$(SUFX:t=).exe
-!endif
-
-TCLSTUBLIB = $(_TCLDIR)\lib\tclstub$(TCL_VERSION).lib
-TCLIMPLIB = $(_TCLDIR)\lib\tcl$(TCL_VERSION)$(SUFX).lib
-# When building extensions, may be linking against Tcl that does not add
-# "t" suffix (e.g. 8.5 or 8.7). If lib not found check for that possibility.
-!if !exist("$(TCLIMPLIB)")
-TCLIMPLIB = $(_TCLDIR)\lib\tcl$(TCL_VERSION)$(SUFX:t=).lib
-!endif
-TCL_LIBRARY = $(_TCLDIR)\lib
-TCLREGLIB = $(_TCLDIR)\lib\tclreg13$(SUFX:t=).lib
-TCLDDELIB = $(_TCLDIR)\lib\tcldde14$(SUFX:t=).lib
-TCLTOOLSDIR = \must\have\tcl\sources\to\build\this\target
-TCL_INCLUDES = -I"$(_TCLDIR)\include"
-
-!else # Building against Tcl sources
-
-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
-!if !exist($(TCLSH))
-TCLSH = $(_TCLDIR)\win\$(BUILDDIRTOP)\tclsh$(TCL_VERSION)$(SUFX:t=).exe
-!endif
-TCLSTUBLIB = $(_TCLDIR)\win\$(BUILDDIRTOP)\tclstub$(TCL_VERSION).lib
-TCLIMPLIB = $(_TCLDIR)\win\$(BUILDDIRTOP)\tcl$(TCL_VERSION)$(SUFX).lib
-# When building extensions, may be linking against Tcl that does not add
-# "t" suffix (e.g. 8.5 or 8.7). If lib not found check for that possibility.
-!if !exist("$(TCLIMPLIB)")
-TCLIMPLIB = $(_TCLDIR)\win\$(BUILDDIRTOP)\tcl$(TCL_VERSION)$(SUFX:t=).lib
-!endif
-TCL_LIBRARY = $(_TCLDIR)\library
-TCLREGLIB = $(_TCLDIR)\win\$(BUILDDIRTOP)\tclreg13$(SUFX:t=).lib
-TCLDDELIB = $(_TCLDIR)\win\$(BUILDDIRTOP)\tcldde14$(SUFX:t=).lib
-TCLTOOLSDIR = $(_TCLDIR)\tools
-TCL_INCLUDES = -I"$(_TCLDIR)\generic" -I"$(_TCLDIR)\win"
-
-!endif # TCLINSTALL
-
-tcllibs = "$(TCLSTUBLIB)" "$(TCLIMPLIB)"
-
-!endif # $(DOING_TCL)
-
-# We need a tclsh that will run on the host machine as part of the 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
-
-# Do the same for Tk and Tk extensions that require the Tk libraries
-!if $(DOING_TK) || $(NEED_TK)
-WISHNAMEPREFIX = wish
-WISHNAME = $(WISHNAMEPREFIX)$(TK_VERSION)$(SUFX).exe
-TKLIBNAME = $(PROJECT)$(TK_VERSION)$(SUFX).$(EXT)
-TKSTUBLIBNAME = tkstub$(TK_VERSION).lib
-TKIMPLIBNAME = tk$(TK_VERSION)$(SUFX).lib
-
-!if $(DOING_TK)
-WISH = $(OUT_DIR)\$(WISHNAME)
-TKSTUBLIB = $(OUT_DIR)\$(TKSTUBLIBNAME)
-TKIMPLIB = $(OUT_DIR)\$(TKIMPLIBNAME)
-TKLIB = $(OUT_DIR)\$(TKLIBNAME)
-TK_INCLUDES = -I"$(WINDIR)" -I"$(GENERICDIR)"
-
-!else # effectively NEED_TK
-
-!if $(TKINSTALL) # Building against installed Tk
-WISH = $(_TKDIR)\bin\$(WISHNAME)
-TKSTUBLIB = $(_TKDIR)\lib\$(TKSTUBLIBNAME)
-TKIMPLIB = $(_TKDIR)\lib\$(TKIMPLIBNAME)
-# When building extensions, may be linking against Tk that does not add
-# "t" suffix (e.g. 8.5 or 8.7). If lib not found check for that possibility.
-!if !exist("$(TKIMPLIB)")
-TKIMPLIBNAME = tk$(TK_VERSION)$(SUFX:t=).lib
-TKIMPLIB = $(_TKDIR)\lib\$(TKIMPLIBNAME)
-!endif
-TK_INCLUDES = -I"$(_TKDIR)\include"
-!else # Building against Tk sources
-WISH = $(_TKDIR)\win\$(BUILDDIRTOP)\$(WISHNAME)
-TKSTUBLIB = $(_TKDIR)\win\$(BUILDDIRTOP)\$(TKSTUBLIBNAME)
-TKIMPLIB = $(_TKDIR)\win\$(BUILDDIRTOP)\$(TKIMPLIBNAME)
-# When building extensions, may be linking against Tk that does not add
-# "t" suffix (e.g. 8.5 or 8.7). If lib not found check for that possibility.
-!if !exist("$(TKIMPLIB)")
-TKIMPLIBNAME = tk$(TK_VERSION)$(SUFX:t=).lib
-TKIMPLIB = $(_TKDIR)\win\$(BUILDDIRTOP)\$(TKIMPLIBNAME)
-!endif
-TK_INCLUDES = -I"$(_TKDIR)\generic" -I"$(_TKDIR)\win" -I"$(_TKDIR)\xlib"
-!endif # TKINSTALL
-tklibs = "$(TKSTUBLIB)" "$(TKIMPLIB)"
-
-!endif # $(DOING_TK)
-!endif # $(DOING_TK) || $(NEED_TK)
-
-# Various output paths
-PRJIMPLIB = $(OUT_DIR)\$(PROJECT)$(VERSION)$(SUFX).lib
-PRJLIBNAME = $(PROJECT)$(VERSION)$(SUFX).$(EXT)
-PRJLIB = $(OUT_DIR)\$(PRJLIBNAME)
-
-PRJSTUBLIBNAME = $(STUBPREFIX)$(VERSION).lib
-PRJSTUBLIB = $(OUT_DIR)\$(PRJSTUBLIBNAME)
-
-# If extension parent makefile has not defined a resource definition file,
-# we will generate one from standard template.
-!if !$(DOING_TCL) && !$(DOING_TK) && !$(STATIC_BUILD)
-!ifdef RCFILE
-RESFILE = $(TMP_DIR)\$(RCFILE:.rc=.res)
-!else
-RESFILE = $(TMP_DIR)\$(PROJECT).res
-!endif
-!endif
-
-###################################################################
-# 11. Construct the paths for the installation directories
-# The following macros get defined in this section:
-# LIB_INSTALL_DIR - where libraries should be installed
-# BIN_INSTALL_DIR - where the executables should be installed
-# DOC_INSTALL_DIR - where documentation should be installed
-# SCRIPT_INSTALL_DIR - where scripts should be installed
-# INCLUDE_INSTALL_DIR - where C include files should be installed
-# DEMO_INSTALL_DIR - where demos should be installed
-# PRJ_INSTALL_DIR - where package will be installed (not set for Tcl and Tk)
-
-!if $(DOING_TCL) || $(DOING_TK)
-LIB_INSTALL_DIR = $(_INSTALLDIR)\lib
-BIN_INSTALL_DIR = $(_INSTALLDIR)\bin
-DOC_INSTALL_DIR = $(_INSTALLDIR)\doc
-!if $(DOING_TCL)
-SCRIPT_INSTALL_DIR = $(_INSTALLDIR)\lib\$(PROJECT)$(TCL_MAJOR_VERSION).$(TCL_MINOR_VERSION)
-!else # DOING_TK
-SCRIPT_INSTALL_DIR = $(_INSTALLDIR)\lib\$(PROJECT)$(TK_MAJOR_VERSION).$(TK_MINOR_VERSION)
-!endif
-DEMO_INSTALL_DIR = $(SCRIPT_INSTALL_DIR)\demos
-INCLUDE_INSTALL_DIR = $(_INSTALLDIR)\include
-
-!else # extension other than Tk
-
-PRJ_INSTALL_DIR = $(_INSTALLDIR)\$(PROJECT)$(DOTVERSION)
-LIB_INSTALL_DIR = $(PRJ_INSTALL_DIR)
-BIN_INSTALL_DIR = $(PRJ_INSTALL_DIR)
-DOC_INSTALL_DIR = $(PRJ_INSTALL_DIR)
-SCRIPT_INSTALL_DIR = $(PRJ_INSTALL_DIR)
-DEMO_INSTALL_DIR = $(PRJ_INSTALL_DIR)\demos
-INCLUDE_INSTALL_DIR = $(_INSTALLDIR)\..\include
-
-!endif
-
-###################################################################
-# 12. Set up actual options to be passed to the compiler and linker
-# Now we have all the information we need, set up the actual flags and
-# options that we will pass to the compiler and linker. The main
-# makefile should use these in combination with whatever other flags
-# and switches are specific to it.
-# The following macros are defined, names are for historical compatibility:
-# OPTDEFINES - /Dxxx C macro flags based on user-specified OPTS
-# COMPILERFLAGS - /Dxxx C macro flags independent of any configuration opttions
-# crt - Compiler switch that selects the appropriate C runtime
-# cdebug - Compiler switches related to debug AND optimizations
-# cwarn - Compiler switches that set warning levels
-# cflags - complete compiler switches (subsumes cdebug and cwarn)
-# ldebug - Linker switches controlling debug information and optimization
-# lflags - complete linker switches (subsumes ldebug) except subsystem type
-# dlllflags - complete linker switches to build DLLs (subsumes lflags)
-# conlflags - complete linker switches for console program (subsumes lflags)
-# guilflags - complete linker switches for GUI program (subsumes lflags)
-# baselibs - minimum Windows libraries required. Parent makefile can
-# define PRJ_LIBS before including rules.rc if additional libs are needed
-
-OPTDEFINES = -DTCL_CFGVAL_ENCODING=$(CFG_ENCODING) -DSTDC_HEADERS
-
-!if $(TCL_MEM_DEBUG)
-OPTDEFINES = $(OPTDEFINES) -DTCL_MEM_DEBUG
-!endif
-!if $(TCL_COMPILE_DEBUG)
-OPTDEFINES = $(OPTDEFINES) -DTCL_COMPILE_DEBUG -DTCL_COMPILE_STATS
-!endif
-!if $(TCL_THREADS)
-OPTDEFINES = $(OPTDEFINES) -DTCL_THREADS=1
-!if $(USE_THREAD_ALLOC)
-OPTDEFINES = $(OPTDEFINES) -DUSE_THREAD_ALLOC=1
-!endif
-!endif
-!if $(STATIC_BUILD)
-OPTDEFINES = $(OPTDEFINES) -DSTATIC_BUILD
-!endif
-!if $(TCL_NO_DEPRECATED)
-OPTDEFINES = $(OPTDEFINES) -DTCL_NO_DEPRECATED
-!endif
-
-!if $(USE_STUBS)
-# Note we do not define USE_TCL_STUBS even when building tk since some
-# test targets in tk do not use stubs
-!if ! $(DOING_TCL)
-USE_STUBS_DEFS = -DUSE_TCL_STUBS -DUSE_TCLOO_STUBS
-!if $(NEED_TK)
-USE_STUBS_DEFS = $(USE_STUBS_DEFS) -DUSE_TK_STUBS
-!endif
-!endif
-!endif # USE_STUBS
-
-!if !$(DEBUG)
-OPTDEFINES = $(OPTDEFINES) -DNDEBUG
-!if $(OPTIMIZING)
-OPTDEFINES = $(OPTDEFINES) -DTCL_CFG_OPTIMIZED
-!endif
-!endif
-!if $(PROFILE)
-OPTDEFINES = $(OPTDEFINES) -DTCL_CFG_PROFILED
-!endif
-!if "$(MACHINE)" == "AMD64"
-OPTDEFINES = $(OPTDEFINES) -DTCL_CFG_DO64BIT
-!endif
-!if $(VCVERSION) < 1300
-OPTDEFINES = $(OPTDEFINES) -DNO_STRTOI64
-!endif
-
-# _ATL_XP_TARGETING - Newer SDK's need this to build for XP
-COMPILERFLAGS = /D_ATL_XP_TARGETING
-
-# Following is primarily for the benefit of extensions. Tcl 8.5 builds
-# Tcl without /DUNICODE, while 8.6 builds with it defined. When building
-# an extension, it is advisable (but not mandated) to use the same Windows
-# API as the Tcl build. This is accordingly defaulted below. A particular
-# extension can override this by pre-definining USE_WIDECHAR_API.
-!ifndef USE_WIDECHAR_API
-!if $(TCL_VERSION) > 85
-USE_WIDECHAR_API = 1
-!else
-USE_WIDECHAR_API = 0
-!endif
-!endif
-
-!if $(USE_WIDECHAR_API)
-COMPILERFLAGS = $(COMPILERFLAGS) /DUNICODE /D_UNICODE
-!endif
-
-# Like the TEA system only set this non empty for non-Tk extensions
-# Note: some extensions use PACKAGE_NAME and others use PACKAGE_TCLNAME
-# so we pass both
-!if !$(DOING_TCL) && !$(DOING_TK)
-PKGNAMEFLAGS = -DPACKAGE_NAME="\"$(PRJ_PACKAGE_TCLNAME)\"" \
- -DPACKAGE_TCLNAME="\"$(PRJ_PACKAGE_TCLNAME)\"" \
- -DPACKAGE_VERSION="\"$(DOTVERSION)\"" \
- -DMODULE_SCOPE=extern
-!endif
-
-# crt picks the C run time based on selected OPTS
-!if $(MSVCRT)
-!if $(DEBUG) && !$(UNCHECKED)
-crt = -MDd
-!else
-crt = -MD
-!endif
-!else
-!if $(DEBUG) && !$(UNCHECKED)
-crt = -MTd
-!else
-crt = -MT
-!endif
-!endif
-
-# cdebug includes compiler options for debugging as well as optimization.
-!if $(DEBUG)
-
-# In debugging mode, optimizations need to be disabled
-cdebug = -Zi -Od $(DEBUGFLAGS)
-
-!else
-
-cdebug = $(OPTIMIZATIONS)
-!if $(SYMBOLS)
-cdebug = $(cdebug) -Zi
-!endif
-
-!endif # $(DEBUG)
-
-# cwarn includes default warning levels.
-cwarn = $(WARNINGS)
-
-!if "$(MACHINE)" == "AMD64"
-# Disable pointer<->int warnings related to cast between different sizes
-# There are a gadzillion of these due to use of ClientData and
-# clutter up compiler
-# output increasing chance of a real warning getting lost. So disable them.
-# Eventually some day, Tcl will be 64-bit clean.
-cwarn = $(cwarn) -wd4311 -wd4312
-!endif
-
-### Common compiler options that are architecture specific
-!if "$(MACHINE)" == "ARM"
-carch = -D_ARM_WINAPI_PARTITION_DESKTOP_SDK_AVAILABLE
-!else
-carch =
-!endif
-
-!if $(DEBUG)
-# Turn warnings into errors
-cwarn = $(cwarn) -WX
-!endif
-
-INCLUDES = $(TCL_INCLUDES) $(TK_INCLUDES) $(PRJ_INCLUDES)
-!if !$(DOING_TCL) && !$(DOING_TK)
-INCLUDES = $(INCLUDES) -I"$(GENERICDIR)" -I"$(WINDIR)" -I"$(COMPATDIR)"
-!endif
-
-# These flags are defined roughly in the order of the pre-reform
-# rules.vc/makefile.vc to help visually compare that the pre- and
-# post-reform build logs
-
-# cflags contains generic flags used for building practically all object files
-cflags = -nologo -c $(COMPILERFLAGS) $(carch) $(cwarn) -Fp$(TMP_DIR)^\ $(cdebug)
-
-# appcflags contains $(cflags) and flags for building the application
-# object files (e.g. tclsh, or wish) pkgcflags contains $(cflags) plus
-# flags used for building shared object files The two differ in the
-# BUILD_$(PROJECT) macro which should be defined only for the shared
-# library *implementation* and not for its caller interface
-
-appcflags = $(cflags) $(crt) $(INCLUDES) $(TCL_DEFINES) $(PRJ_DEFINES) $(OPTDEFINES) $(USE_STUBS_DEFS)
-appcflags_nostubs = $(cflags) $(crt) $(INCLUDES) $(TCL_DEFINES) $(PRJ_DEFINES) $(OPTDEFINES)
-pkgcflags = $(appcflags) $(PKGNAMEFLAGS) -DBUILD_$(PROJECT)
-pkgcflags_nostubs = $(appcflags_nostubs) $(PKGNAMEFLAGS) -DBUILD_$(PROJECT)
-
-# stubscflags contains $(cflags) plus flags used for building a stubs
-# library for the package. Note: -DSTATIC_BUILD is defined in
-# $(OPTDEFINES) only if the OPTS configuration indicates a static
-# library. However the stubs library is ALWAYS static hence included
-# here irrespective of the OPTS setting.
-#
-# TBD - tclvfs has a comment that stubs libs should not be compiled with -GL
-# without stating why. Tcl itself compiled stubs libs with this flag.
-# so we do not remove it from cflags. -GL may prevent extensions
-# compiled with one VC version to fail to link against stubs library
-# compiled with another VC version. Check for this and fix accordingly.
-stubscflags = $(cflags) $(PKGNAMEFLAGS) $(PRJ_DEFINES) $(OPTDEFINES) -Zl -DSTATIC_BUILD $(INCLUDES)
-
-# Link flags
-
-!if $(DEBUG)
-ldebug = -debug -debugtype:cv
-!else
-ldebug = -release -opt:ref -opt:icf,3
-!if $(SYMBOLS)
-ldebug = $(ldebug) -debug -debugtype:cv
-!endif
-!endif
-
-# Note: Profiling is currently only possible with the Visual Studio Enterprise
-!if $(PROFILE)
-ldebug= $(ldebug) -profile
-!endif
-
-### Declarations common to all linker versions
-lflags = -nologo -machine:$(MACHINE) $(LINKERFLAGS) $(ldebug)
-
-!if $(MSVCRT) && !($(DEBUG) && !$(UNCHECKED)) && $(VCVERSION) >= 1900
-lflags = $(lflags) -nodefaultlib:libucrt.lib
-!endif
-
-# Old linkers (Visual C++ 6 in particular) will link for fast loading
-# on Win98. Since we do not support Win98 any more, we specify nowin98
-# as recommended for NT and later. However, this is only required by
-# IX86 on older compilers and only needed if we are not doing a static build.
-
-!if "$(MACHINE)" == "IX86" && !$(STATIC_BUILD)
-!if [nmakehlp -l -opt:nowin98 $(LINKER_TESTFLAGS)]
-# Align sections for PE size savings.
-lflags = $(lflags) -opt:nowin98
-!endif
-!endif
-
-dlllflags = $(lflags) -dll
-conlflags = $(lflags) -subsystem:console
-guilflags = $(lflags) -subsystem:windows
-
-# Libraries that are required for every image.
-# Extensions should define any additional libraries with $(PRJ_LIBS)
-winlibs = kernel32.lib advapi32.lib
-
-!if $(NEED_TK)
-winlibs = $(winlibs) gdi32.lib user32.lib uxtheme.lib
-!endif
-
-# Avoid 'unresolved external symbol __security_cookie' errors.
-# c.f. http://support.microsoft.com/?id=894573
-!if "$(MACHINE)" == "AMD64"
-!if $(VCVERSION) > 1399 && $(VCVERSION) < 1500
-winlibs = $(winlibs) bufferoverflowU.lib
-!endif
-!endif
-
-baselibs = $(winlibs) $(PRJ_LIBS)
-
-!if $(MSVCRT) && !($(DEBUG) && !$(UNCHECKED)) && $(VCVERSION) >= 1900
-baselibs = $(baselibs) ucrt.lib
-!endif
-
-################################################################
-# 13. Define standard commands, common make targets and implicit rules
-
-CCPKGCMD = $(cc32) $(pkgcflags) -Fo$(TMP_DIR)^\
-CCAPPCMD = $(cc32) $(appcflags) -Fo$(TMP_DIR)^\
-CCSTUBSCMD = $(cc32) $(stubscflags) -Fo$(TMP_DIR)^\
-
-LIBCMD = $(lib32) -nologo $(LINKERFLAGS) -out:$@
-DLLCMD = $(link32) $(dlllflags) -out:$@ $(baselibs) $(tcllibs) $(tklibs)
-
-CONEXECMD = $(link32) $(conlflags) -out:$@ $(baselibs) $(tcllibs) $(tklibs)
-GUIEXECMD = $(link32) $(guilflags) -out:$@ $(baselibs) $(tcllibs) $(tklibs)
-RESCMD = $(rc32) -fo $@ -r -i "$(GENERICDIR)" -i "$(TMP_DIR)" \
- $(TCL_INCLUDES) \
- -DDEBUG=$(DEBUG) -d UNCHECKED=$(UNCHECKED) \
- -DCOMMAVERSION=$(DOTVERSION:.=,),0 \
- -DDOTVERSION=\"$(DOTVERSION)\" \
- -DVERSION=\"$(VERSION)\" \
- -DSUFX=\"$(SUFX)\" \
- -DPROJECT=\"$(PROJECT)\" \
- -DPRJLIBNAME=\"$(PRJLIBNAME)\"
-
-!ifndef DEFAULT_BUILD_TARGET
-DEFAULT_BUILD_TARGET = $(PROJECT)
-!endif
-
-default-target: $(DEFAULT_BUILD_TARGET)
-
-default-pkgindex:
- @echo package ifneeded $(PRJ_PACKAGE_TCLNAME) $(DOTVERSION) \
- [list load [file join $$dir $(PRJLIBNAME)]] > $(OUT_DIR)\pkgIndex.tcl
-
-default-pkgindex-tea:
- @if exist $(ROOT)\pkgIndex.tcl.in nmakehlp -s << $(ROOT)\pkgIndex.tcl.in > $(OUT_DIR)\pkgIndex.tcl
-@PACKAGE_VERSION@ $(DOTVERSION)
-@PACKAGE_NAME@ $(PRJ_PACKAGE_TCLNAME)
-@PACKAGE_TCLNAME@ $(PRJ_PACKAGE_TCLNAME)
-@PKG_LIB_FILE@ $(PRJLIBNAME)
-<<
-
-
-default-install: default-install-binaries default-install-libraries
-
-default-install-binaries: $(PRJLIB)
- @echo Installing binaries to '$(SCRIPT_INSTALL_DIR)'
- @if not exist "$(SCRIPT_INSTALL_DIR)" mkdir "$(SCRIPT_INSTALL_DIR)"
- @$(CPY) $(PRJLIB) "$(SCRIPT_INSTALL_DIR)" >NUL
-
-default-install-libraries: $(OUT_DIR)\pkgIndex.tcl
- @echo Installing libraries to '$(SCRIPT_INSTALL_DIR)'
- @if exist $(LIBDIR) $(CPY) $(LIBDIR)\*.tcl "$(SCRIPT_INSTALL_DIR)"
- @echo Installing package index in '$(SCRIPT_INSTALL_DIR)'
- @$(CPY) $(OUT_DIR)\pkgIndex.tcl $(SCRIPT_INSTALL_DIR)
-
-default-install-stubs:
- @echo Installing stubs library to '$(SCRIPT_INSTALL_DIR)'
- @if not exist "$(SCRIPT_INSTALL_DIR)" mkdir "$(SCRIPT_INSTALL_DIR)"
- @$(CPY) $(PRJSTUBLIB) "$(SCRIPT_INSTALL_DIR)" >NUL
-
-default-install-docs-html:
- @echo Installing documentation files to '$(DOC_INSTALL_DIR)'
- @if not exist "$(DOC_INSTALL_DIR)" mkdir "$(DOC_INSTALL_DIR)"
- @if exist $(DOCDIR) for %f in ("$(DOCDIR)\*.html" "$(DOCDIR)\*.css" "$(DOCDIR)\*.png") do @$(COPY) %f "$(DOC_INSTALL_DIR)"
-
-default-install-docs-n:
- @echo Installing documentation files to '$(DOC_INSTALL_DIR)'
- @if not exist "$(DOC_INSTALL_DIR)" mkdir "$(DOC_INSTALL_DIR)"
- @if exist $(DOCDIR) for %f in ("$(DOCDIR)\*.n") do @$(COPY) %f "$(DOC_INSTALL_DIR)"
-
-default-install-demos:
- @echo Installing demos to '$(DEMO_INSTALL_DIR)'
- @if not exist "$(DEMO_INSTALL_DIR)" mkdir "$(DEMO_INSTALL_DIR)"
- @if exist $(DEMODIR) $(CPYDIR) "$(DEMODIR)" "$(DEMO_INSTALL_DIR)"
-
-default-clean:
- @echo Cleaning $(TMP_DIR)\* ...
- @if exist $(TMP_DIR)\nul $(RMDIR) $(TMP_DIR)
- @echo Cleaning $(WINDIR)\nmakehlp.obj, nmakehlp.exe ...
- @if exist $(WINDIR)\nmakehlp.obj del $(WINDIR)\nmakehlp.obj
- @if exist $(WINDIR)\nmakehlp.exe del $(WINDIR)\nmakehlp.exe
- @if exist $(WINDIR)\nmakehlp.out del $(WINDIR)\nmakehlp.out
- @echo Cleaning $(WINDIR)\nmhlp-out.txt ...
- @if exist $(WINDIR)\nmhlp-out.txt del $(WINDIR)\nmhlp-out.txt
- @echo Cleaning $(WINDIR)\_junk.pch ...
- @if exist $(WINDIR)\_junk.pch del $(WINDIR)\_junk.pch
- @echo Cleaning $(WINDIR)\vercl.x, vercl.i ...
- @if exist $(WINDIR)\vercl.x del $(WINDIR)\vercl.x
- @if exist $(WINDIR)\vercl.i del $(WINDIR)\vercl.i
- @echo Cleaning $(WINDIR)\versions.vc, version.vc ...
- @if exist $(WINDIR)\versions.vc del $(WINDIR)\versions.vc
- @if exist $(WINDIR)\version.vc del $(WINDIR)\version.vc
-
-default-hose: default-clean
- @echo Hosing $(OUT_DIR)\* ...
- @if exist $(OUT_DIR)\nul $(RMDIR) $(OUT_DIR)
-
-# Only for backward compatibility
-default-distclean: default-hose
-
-default-setup:
- @if not exist $(OUT_DIR)\nul mkdir $(OUT_DIR)
- @if not exist $(TMP_DIR)\nul mkdir $(TMP_DIR)
-
-!if "$(TESTPAT)" != ""
-TESTFLAGS = $(TESTFLAGS) -file $(TESTPAT)
-!endif
-
-default-test: default-setup $(PROJECT)
- @set TCLLIBPATH=$(OUT_DIR:\=/)
- @if exist $(LIBDIR) for %f in ("$(LIBDIR)\*.tcl") do @$(COPY) %f "$(OUT_DIR)"
- cd "$(TESTDIR)" && $(DEBUGGER) $(TCLSH) all.tcl $(TESTFLAGS)
-
-default-shell: default-setup $(PROJECT)
- @set TCLLIBPATH=$(OUT_DIR:\=/)
- @if exist $(LIBDIR) for %f in ("$(LIBDIR)\*.tcl") do @$(COPY) %f "$(OUT_DIR)"
- $(DEBUGGER) $(TCLSH)
-
-# Generation of Windows version resource
-!ifdef RCFILE
-
-# Note: don't use $** in below rule because there may be other dependencies
-# and only the "master" rc must be passed to the resource compiler
-$(TMP_DIR)\$(PROJECT).res: $(RCDIR)\$(PROJECT).rc
- $(RESCMD) $(RCDIR)\$(PROJECT).rc
-
-!else
-
-# If parent makefile has not defined a resource definition file,
-# we will generate one from standard template.
-$(TMP_DIR)\$(PROJECT).res: $(TMP_DIR)\$(PROJECT).rc
-
-$(TMP_DIR)\$(PROJECT).rc:
- @$(COPY) << $(TMP_DIR)\$(PROJECT).rc
-#include <winver.h>
-
-VS_VERSION_INFO VERSIONINFO
- FILEVERSION COMMAVERSION
- PRODUCTVERSION COMMAVERSION
- FILEFLAGSMASK 0x3fL
-#ifdef DEBUG
- FILEFLAGS VS_FF_DEBUG
-#else
- FILEFLAGS 0x0L
-#endif
- FILEOS VOS_NT_WINDOWS32
- FILETYPE VFT_DLL
- FILESUBTYPE 0x0L
-BEGIN
- BLOCK "StringFileInfo"
- BEGIN
- BLOCK "040904b0"
- BEGIN
- VALUE "FileDescription", "Tcl extension " PROJECT
- VALUE "OriginalFilename", PRJLIBNAME
- VALUE "FileVersion", DOTVERSION
- VALUE "ProductName", "Package " PROJECT " for Tcl"
- VALUE "ProductVersion", DOTVERSION
- END
- END
- BLOCK "VarFileInfo"
- BEGIN
- VALUE "Translation", 0x409, 1200
- END
-END
-
-<<
-
-!endif # ifdef RCFILE
-
-!ifndef DISABLE_IMPLICIT_RULES
-DISABLE_IMPLICIT_RULES = 0
-!endif
-
-!if !$(DISABLE_IMPLICIT_RULES)
-# Implicit rule definitions - only for building library objects. For stubs and
-# main application, the master makefile should define explicit rules.
-
-{$(ROOT)}.c{$(TMP_DIR)}.obj::
- $(CCPKGCMD) @<<
-$<
-<<
-
-{$(WINDIR)}.c{$(TMP_DIR)}.obj::
- $(CCPKGCMD) @<<
-$<
-<<
-
-{$(GENERICDIR)}.c{$(TMP_DIR)}.obj::
- $(CCPKGCMD) @<<
-$<
-<<
-
-{$(COMPATDIR)}.c{$(TMP_DIR)}.obj::
- $(CCPKGCMD) @<<
-$<
-<<
-
-{$(RCDIR)}.rc{$(TMP_DIR)}.res:
- $(RESCMD) $<
-
-{$(WINDIR)}.rc{$(TMP_DIR)}.res:
- $(RESCMD) $<
-
-{$(TMP_DIR)}.rc{$(TMP_DIR)}.res:
- $(RESCMD) $<
-
-.SUFFIXES:
-.SUFFIXES:.c .rc
-
-!endif
-
-################################################################
-# 14. Sanity check selected options against Tcl build options
-# When building an extension, certain configuration options should
-# match the ones used when Tcl was built. Here we check and
-# warn on a mismatch.
-!if ! $(DOING_TCL)
-
-!if $(TCLINSTALL) # Building against an installed Tcl
-!if exist("$(_TCLDIR)\lib\nmake\tcl.nmake")
-TCLNMAKECONFIG = "$(_TCLDIR)\lib\nmake\tcl.nmake"
-!endif
-!else # ! $(TCLINSTALL) - building against Tcl source
-!if exist("$(OUT_DIR)\tcl.nmake")
-TCLNMAKECONFIG = "$(OUT_DIR)\tcl.nmake"
-!endif
-!endif # TCLINSTALL
-
-!if $(CONFIG_CHECK)
-!ifdef TCLNMAKECONFIG
-!include $(TCLNMAKECONFIG)
-
-!if defined(CORE_MACHINE) && "$(CORE_MACHINE)" != "$(MACHINE)"
-!error ERROR: Build target ($(MACHINE)) does not match the Tcl library architecture ($(CORE_MACHINE)).
-!endif
-!if defined(CORE_USE_THREAD_ALLOC) && $(CORE_USE_THREAD_ALLOC) != $(USE_THREAD_ALLOC)
-!message WARNING: Value of USE_THREAD_ALLOC ($(USE_THREAD_ALLOC)) does not match its Tcl core value ($(CORE_USE_THREAD_ALLOC)).
-!endif
-!if defined(CORE_DEBUG) && $(CORE_DEBUG) != $(DEBUG)
-!message WARNING: Value of DEBUG ($(DEBUG)) does not match its Tcl library configuration ($(DEBUG)).
-!endif
-!endif
-
-!endif # TCLNMAKECONFIG
-
-!endif # ! $(DOING_TCL)
-
-
-#----------------------------------------------------------
-# Display stats being used.
-#----------------------------------------------------------
-
-!if !$(DOING_TCL)
-!message *** Building against Tcl at '$(_TCLDIR)'
-!endif
-!if !$(DOING_TK) && $(NEED_TK)
-!message *** Building against Tk at '$(_TKDIR)'
-!endif
-!message *** Intermediate directory will be '$(TMP_DIR)'
-!message *** Output directory will be '$(OUT_DIR)'
-!message *** Installation, if selected, will be in '$(_INSTALLDIR)'
-!message *** Suffix for binaries will be '$(SUFX)'
-!message *** Compiler version $(VCVER). Target $(MACHINE), host $(NATIVE_ARCH).
-
-!endif # ifdef _RULES_VC
diff --git a/tcl8.6/win/targets.vc b/tcl8.6/win/targets.vc
deleted file mode 100644
index 7f1d388..0000000
--- a/tcl8.6/win/targets.vc
+++ /dev/null
@@ -1,98 +0,0 @@
-#------------------------------------------------------------- -*- makefile -*-
-# targets.vc --
-#
-# Part of the nmake based build system for Tcl and its extensions.
-# This file defines some standard targets for the convenience of extensions
-# and can be optionally included by the extension makefile.
-# See TIP 477 (https://core.tcl.tk/tips/doc/trunk/tip/477.md) for docs.
-
-$(PROJECT): setup pkgindex $(PRJLIB)
-
-!ifdef PRJ_STUBOBJS
-$(PROJECT): $(PRJSTUBLIB)
-$(PRJSTUBLIB): $(PRJ_STUBOBJS)
- $(LIBCMD) $**
-
-$(PRJ_STUBOBJS):
- $(CCSTUBSCMD) %s
-!endif # PRJ_STUBOBJS
-
-!ifdef PRJ_MANIFEST
-$(PROJECT): $(PRJLIB).manifest
-$(PRJLIB).manifest: $(PRJ_MANIFEST)
- @nmakehlp -s << $** >$@
-@MACHINE@ $(MACHINE:IX86=X86)
-<<
-!endif
-
-!if "$(PROJECT)" != "tcl" && "$(PROJECT)" != "tk"
-$(PRJLIB): $(PRJ_OBJS) $(RESFILE)
-!if $(STATIC_BUILD)
- $(LIBCMD) $**
-!else
- $(DLLCMD) $**
- $(_VC_MANIFEST_EMBED_DLL)
-!endif
- -@del $*.exp
-!endif
-
-!if "$(PRJ_HEADERS)" != "" && "$(PRJ_OBJS)" != ""
-$(PRJ_OBJS): $(PRJ_HEADERS)
-!endif
-
-# If parent makefile has defined stub objects, add their installation
-# to the default install
-!if "$(PRJ_STUBOBJS)" != ""
-default-install: default-install-stubs
-!endif
-
-# Unlike the other default targets, these cannot be in rules.vc because
-# the executed command depends on existence of macro PRJ_HEADERS_PUBLIC
-# that the parent makefile will not define until after including rules-ext.vc
-!if "$(PRJ_HEADERS_PUBLIC)" != ""
-default-install: default-install-headers
-default-install-headers:
- @echo Installing headers to '$(INCLUDE_INSTALL_DIR)'
- @for %f in ($(PRJ_HEADERS_PUBLIC)) do @$(COPY) %f "$(INCLUDE_INSTALL_DIR)"
-!endif
-
-!if "$(DISABLE_STANDARD_TARGETS)" == ""
-DISABLE_STANDARD_TARGETS = 0
-!endif
-
-!if "$(DISABLE_TARGET_setup)" == ""
-DISABLE_TARGET_setup = 0
-!endif
-!if "$(DISABLE_TARGET_install)" == ""
-DISABLE_TARGET_install = 0
-!endif
-!if "$(DISABLE_TARGET_clean)" == ""
-DISABLE_TARGET_clean = 0
-!endif
-!if "$(DISABLE_TARGET_test)" == ""
-DISABLE_TARGET_test = 0
-!endif
-!if "$(DISABLE_TARGET_shell)" == ""
-DISABLE_TARGET_shell = 0
-!endif
-
-!if !$(DISABLE_STANDARD_TARGETS)
-!if !$(DISABLE_TARGET_setup)
-setup: default-setup
-!endif
-!if !$(DISABLE_TARGET_install)
-install: default-install
-!endif
-!if !$(DISABLE_TARGET_clean)
-clean: default-clean
-realclean: hose
-hose: default-hose
-distclean: realclean default-distclean
-!endif
-!if !$(DISABLE_TARGET_test)
-test: default-test
-!endif
-!if !$(DISABLE_TARGET_shell)
-shell: default-shell
-!endif
-!endif # DISABLE_STANDARD_TARGETS
diff --git a/tcl8.6/win/tcl.dsp b/tcl8.6/win/tcl.dsp
deleted file mode 100644
index e8b1a33..0000000
--- a/tcl8.6/win/tcl.dsp
+++ /dev/null
@@ -1,1563 +0,0 @@
-# Microsoft Developer Studio Project File - Name="tcl" - Package Owner=<4>
-# Microsoft Developer Studio Generated Build File, Format Version 6.00
-# ** DO NOT EDIT **
-
-# TARGTYPE "Win32 (x86) External Target" 0x0106
-
-CFG=tcl - Win32 Debug Static
-!MESSAGE This is not a valid makefile. To build this project using NMAKE,
-!MESSAGE use the Export Makefile command and run
-!MESSAGE
-!MESSAGE NMAKE /f "tcl.mak".
-!MESSAGE
-!MESSAGE You can specify a configuration when running NMAKE
-!MESSAGE by defining the macro CFG on the command line. For example:
-!MESSAGE
-!MESSAGE NMAKE /f "tcl.mak" CFG="tcl - Win32 Debug Static"
-!MESSAGE
-!MESSAGE Possible choices for configuration are:
-!MESSAGE
-!MESSAGE "tcl - Win32 Release" (based on "Win32 (x86) External Target")
-!MESSAGE "tcl - Win32 Debug" (based on "Win32 (x86) External Target")
-!MESSAGE "tcl - Win32 Debug Static" (based on "Win32 (x86) External Target")
-!MESSAGE "tcl - Win32 Release Static" (based on "Win32 (x86) External Target")
-!MESSAGE
-
-# Begin Project
-# PROP AllowPerConfigDependencies 0
-# PROP Scc_ProjName ""
-# PROP Scc_LocalPath ""
-
-!IF "$(CFG)" == "tcl - Win32 Release"
-
-# PROP BASE Use_MFC 0
-# PROP BASE Use_Debug_Libraries 0
-# PROP BASE Output_Dir "Release"
-# 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\tclsh86.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=threads MSVCDIR=IDE"
-# PROP Rebuild_Opt "clean release"
-# PROP Target_File "Release\tclsh86t.exe"
-# PROP Bsc_Name ""
-# PROP Target_Dir ""
-
-!ELSEIF "$(CFG)" == "tcl - Win32 Debug"
-
-# PROP BASE Use_MFC 0
-# PROP BASE Use_Debug_Libraries 1
-# PROP BASE Output_Dir "Debug"
-# 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\tclsh86g.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=threads,symbols MSVCDIR=IDE"
-# PROP Rebuild_Opt "clean release"
-# PROP Target_File "Debug\tclsh86tg.exe"
-# PROP Bsc_Name ""
-# PROP Target_Dir ""
-
-!ELSEIF "$(CFG)" == "tcl - Win32 Debug Static"
-
-# PROP BASE Use_MFC 0
-# PROP BASE Use_Debug_Libraries 1
-# PROP BASE Output_Dir "Debug"
-# 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\tclsh86sg.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_Static"
-# PROP Cmd_Line "nmake -nologo -f makefile.vc OPTS=symbols,static MSVCDIR=IDE"
-# PROP Rebuild_Opt "-a"
-# PROP Target_File "Debug\tclsh86sg.exe"
-# PROP Bsc_Name ""
-# PROP Target_Dir ""
-
-!ELSEIF "$(CFG)" == "tcl - Win32 Release Static"
-
-# PROP BASE Use_MFC 0
-# PROP BASE Use_Debug_Libraries 0
-# PROP BASE Output_Dir "Release"
-# 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\tclsh86s.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_Static"
-# PROP Cmd_Line "nmake -nologo -f makefile.vc OPTS=static MSVCDIR=IDE"
-# PROP Rebuild_Opt "-a"
-# PROP Target_File "Release\tclsh86s.exe"
-# PROP Bsc_Name ""
-# PROP Target_Dir ""
-
-!ENDIF
-
-# Begin Target
-
-# Name "tcl - Win32 Release"
-# Name "tcl - Win32 Debug"
-# Name "tcl - Win32 Debug Static"
-# Name "tcl - Win32 Release Static"
-
-!IF "$(CFG)" == "tcl - Win32 Release"
-
-!ELSEIF "$(CFG)" == "tcl - Win32 Debug"
-
-!ELSEIF "$(CFG)" == "tcl - Win32 Debug Static"
-
-!ELSEIF "$(CFG)" == "tcl - Win32 Release Static"
-
-!ENDIF
-
-# Begin Group "compat"
-
-# PROP Default_Filter ""
-# Begin Source File
-
-SOURCE=..\compat\dirent.h
-# End Source File
-# Begin Source File
-
-SOURCE=..\compat\dirent2.h
-# End Source File
-# Begin Source File
-
-SOURCE=..\compat\dlfcn.h
-# End Source File
-# Begin Source File
-
-SOURCE=..\compat\fixstrtod.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\compat\float.h
-# End Source File
-# Begin Source File
-
-SOURCE=..\compat\gettod.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\compat\limits.h
-# End Source File
-# Begin Source File
-
-SOURCE=..\compat\memcmp.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\compat\opendir.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\compat\README
-# End Source File
-# Begin Source File
-
-SOURCE=..\compat\stdlib.h
-# End Source File
-# Begin Source File
-
-SOURCE=..\compat\string.h
-# End Source File
-# Begin Source File
-
-SOURCE=..\compat\strncasecmp.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\compat\strstr.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\compat\strtod.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\compat\strtol.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\compat\strtoul.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\compat\tclErrno.h
-# End Source File
-# Begin Source File
-
-SOURCE=..\compat\unistd.h
-# End Source File
-# Begin Source File
-
-SOURCE=..\compat\waitpid.c
-# End Source File
-# End Group
-# Begin Group "doc"
-
-# PROP Default_Filter ""
-# Begin Source File
-
-SOURCE=..\doc\Access.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\AddErrInfo.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\after.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\Alloc.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\AllowExc.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\append.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\AppInit.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\array.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\AssocData.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\Async.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\BackgdErr.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\Backslash.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\bgerror.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\binary.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\BoolObj.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\break.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\ByteArrObj.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\CallDel.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\case.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\catch.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\cd.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\ChnlStack.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\clock.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\close.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\CmdCmplt.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\Concat.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\concat.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\continue.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\CrtChannel.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\CrtChnlHdlr.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\CrtCloseHdlr.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\CrtCommand.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\CrtFileHdlr.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\CrtInterp.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\CrtMathFnc.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\CrtObjCmd.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\CrtSlave.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\CrtTimerHdlr.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\CrtTrace.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\dde.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\DetachPids.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\DoOneEvent.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\DoubleObj.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\DoWhenIdle.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\DString.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\DumpActiveMemory.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\Encoding.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\encoding.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\Environment.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\eof.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\error.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\Eval.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\eval.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\exec.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\Exit.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\exit.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\expr.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\ExprLong.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\ExprLongObj.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\fblocked.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\fconfigure.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\fcopy.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\file.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\fileevent.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\filename.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\FileSystem.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\FindExec.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\flush.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\for.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\foreach.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\format.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\GetCwd.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\GetHostName.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\GetIndex.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\GetInt.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\GetOpnFl.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\gets.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\GetStdChan.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\GetVersion.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\glob.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\global.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\Hash.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\history.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\http.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\if.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\incr.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\info.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\Init.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\InitStubs.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\Interp.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\interp.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\IntObj.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\join.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\lappend.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\library.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\lindex.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\LinkVar.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\linsert.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\list.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\ListObj.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\llength.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\load.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\lrange.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\lreplace.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\lsearch.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\lsort.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\man.macros
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\memory.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\msgcat.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\namespace.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\Notifier.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\Object.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\ObjectType.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\open.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\OpenFileChnl.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\OpenTcp.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\package.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\packagens.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\Panic.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\ParseCmd.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\pid.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\pkgMkIndex.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\PkgRequire.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\Preserve.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\PrintDbl.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\proc.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\puts.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\pwd.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\re_syntax.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\read.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\RecEvalObj.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\RecordEval.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\RegExp.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\regexp.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\registry.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\regsub.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\rename.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\return.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\safe.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\SaveResult.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\scan.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\seek.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\set.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\SetErrno.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\SetRecLmt.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\SetResult.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\SetVar.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\Signal.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\Sleep.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\socket.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\source.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\SourceRCFile.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\split.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\SplitList.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\SplitPath.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\StaticPkg.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\StdChannels.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\string.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\StringObj.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\StrMatch.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\subst.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\SubstObj.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\switch.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\Tcl.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\Tcl_Main.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\TCL_MEM_DEBUG.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\tclsh.1
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\tcltest.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\tclvars.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\tell.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\Thread.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\time.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\ToUpper.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\trace.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\TraceVar.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\Translate.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\UniCharIsAlpha.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\unknown.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\unset.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\update.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\uplevel.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\UpVar.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\upvar.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\Utf.3
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\variable.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\vwait.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\while.n
-# End Source File
-# Begin Source File
-
-SOURCE=..\doc\WrongNumArgs.3
-# End Source File
-# End Group
-# Begin Group "generic"
-
-# PROP Default_Filter ""
-# Begin Source File
-
-SOURCE=..\generic\README
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\regc_color.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\regc_cvec.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\regc_lex.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\regc_locale.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\regc_nfa.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\regcomp.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\regcustom.h
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\rege_dfa.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\regerror.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\regerrs.h
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\regex.h
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\regexec.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\regfree.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\regfronts.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\regguts.h
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\tcl.decls
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\tcl.h
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\tclAlloc.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\tclAsync.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\tclBasic.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\tclBinary.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\tclCkalloc.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\tclClock.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\tclCmdAH.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\tclCmdIL.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\tclCmdMZ.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\tclCompCmds.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\tclCompExpr.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\tclCompile.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\tclCompile.h
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\tclDate.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\tclDecls.h
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\tclEncoding.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\tclEnv.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\tclEvent.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\tclExecute.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\tclFCmd.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\tclFileName.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\tclGet.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\tclGetDate.y
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\tclHash.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\tclHistory.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\tclIndexObj.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\tclInt.decls
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\tclInt.h
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\tclIntDecls.h
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\tclInterp.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\tclIntPlatDecls.h
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\tclIO.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\tclIO.h
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\tclIOCmd.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\tclIOGT.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\tclIOSock.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\tclIOUtil.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\tclLink.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\tclListObj.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\tclLiteral.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\tclLoad.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\tclLoadNone.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\tclMain.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\tclNamesp.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\tclNotify.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\tclObj.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\tclPanic.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\tclParse.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\tclPipe.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\tclPkg.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\tclPlatDecls.h
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\tclPort.h
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\tclPosixStr.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\tclPreserve.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\tclProc.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\tclRegexp.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\tclRegexp.h
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\tclResolve.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\tclResult.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\tclScan.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\tclStringObj.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\tclStubInit.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\tclStubLib.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\tclOOStubLib.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\tclTomMathStubLib.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\tclTest.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\tclTestObj.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\tclTestProcBodyObj.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\tclThread.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\tclThreadJoin.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\tclThreadTest.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\tclTimer.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\tclUniData.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\tclUtf.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\tclUtil.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\tclVar.c
-# End Source File
-# End Group
-# Begin Group "library"
-
-# PROP Default_Filter ""
-# Begin Source File
-
-SOURCE=..\library\auto.tcl
-# End Source File
-# Begin Source File
-
-SOURCE=..\library\history.tcl
-# End Source File
-# Begin Source File
-
-SOURCE=..\library\init.tcl
-# End Source File
-# Begin Source File
-
-SOURCE=..\library\ldAout.tcl
-# End Source File
-# Begin Source File
-
-SOURCE=..\library\package.tcl
-# End Source File
-# Begin Source File
-
-SOURCE=..\library\parray.tcl
-# End Source File
-# Begin Source File
-
-SOURCE=..\library\safe.tcl
-# End Source File
-# Begin Source File
-
-SOURCE=..\library\tclIndex
-# End Source File
-# Begin Source File
-
-SOURCE=..\library\word.tcl
-# End Source File
-# End Group
-# Begin Group "mac"
-
-# PROP Default_Filter ""
-# End Group
-# Begin Group "tests"
-
-# PROP Default_Filter ""
-# End Group
-# Begin Group "tools"
-
-# PROP Default_Filter ""
-# End Group
-# Begin Group "unix"
-
-# PROP Default_Filter ""
-# End Group
-# Begin Group "win"
-
-# PROP Default_Filter ""
-# Begin Source File
-
-SOURCE=.\aclocal.m4
-# End Source File
-# Begin Source File
-
-SOURCE=.\cat.c
-# End Source File
-# Begin Source File
-
-SOURCE=.\configure
-# End Source File
-# Begin Source File
-
-SOURCE=.\configure.in
-# End Source File
-# Begin Source File
-
-SOURCE=.\Makefile.in
-# End Source File
-# Begin Source File
-
-SOURCE=.\makefile.vc
-# End Source File
-# Begin Source File
-
-SOURCE=.\mkd.bat
-# End Source File
-# Begin Source File
-
-SOURCE=.\README
-# End Source File
-# Begin Source File
-
-SOURCE=.\README.binary
-# End Source File
-# Begin Source File
-
-SOURCE=.\rmd.bat
-# End Source File
-# Begin Source File
-
-SOURCE=.\rules.vc
-# End Source File
-# Begin Source File
-
-SOURCE=.\tcl.hpj.in
-# End Source File
-# Begin Source File
-
-SOURCE=.\tcl.m4
-# End Source File
-# Begin Source File
-
-SOURCE=.\tcl.rc
-# End Source File
-# Begin Source File
-
-SOURCE=.\tclAppInit.c
-# End Source File
-# Begin Source File
-
-SOURCE=.\tclConfig.sh.in
-# End Source File
-# Begin Source File
-
-SOURCE=.\tclsh.ico
-# End Source File
-# Begin Source File
-
-SOURCE=.\tclsh.rc
-# End Source File
-# Begin Source File
-
-SOURCE=.\tclWin32Dll.c
-# End Source File
-# Begin Source File
-
-SOURCE=.\tclWinChan.c
-# End Source File
-# Begin Source File
-
-SOURCE=.\tclWinConsole.c
-# End Source File
-# Begin Source File
-
-SOURCE=.\tclWinDde.c
-# End Source File
-# Begin Source File
-
-SOURCE=.\tclWinError.c
-# End Source File
-# Begin Source File
-
-SOURCE=.\tclWinFCmd.c
-# End Source File
-# Begin Source File
-
-SOURCE=.\tclWinFile.c
-# End Source File
-# Begin Source File
-
-SOURCE=.\tclWinInit.c
-# End Source File
-# Begin Source File
-
-SOURCE=.\tclWinInt.h
-# End Source File
-# Begin Source File
-
-SOURCE=.\tclWinLoad.c
-# End Source File
-# Begin Source File
-
-SOURCE=.\tclWinNotify.c
-# End Source File
-# Begin Source File
-
-SOURCE=.\tclWinPipe.c
-# End Source File
-# Begin Source File
-
-SOURCE=.\tclWinPort.h
-# End Source File
-# Begin Source File
-
-SOURCE=.\tclWinReg.c
-# End Source File
-# Begin Source File
-
-SOURCE=.\tclWinSerial.c
-# End Source File
-# Begin Source File
-
-SOURCE=.\tclWinSock.c
-# End Source File
-# Begin Source File
-
-SOURCE=.\tclWinTest.c
-# End Source File
-# Begin Source File
-
-SOURCE=.\tclWinThrd.c
-# End Source File
-# Begin Source File
-
-SOURCE=.\tclWinTime.c
-# End Source File
-# End Group
-# End Target
-# End Project
diff --git a/tcl8.6/win/tcl.dsw b/tcl8.6/win/tcl.dsw
deleted file mode 100644
index 1c16fad..0000000
--- a/tcl8.6/win/tcl.dsw
+++ /dev/null
@@ -1,29 +0,0 @@
-Microsoft Developer Studio Workspace File, Format Version 6.00
-# WARNING: DO NOT EDIT OR DELETE THIS WORKSPACE FILE!
-
-###############################################################################
-
-Project: "tcl"=.\tcl.dsp - Package Owner=<4>
-
-Package=<5>
-{{{
-}}}
-
-Package=<4>
-{{{
-}}}
-
-###############################################################################
-
-Global:
-
-Package=<5>
-{{{
-}}}
-
-Package=<3>
-{{{
-}}}
-
-###############################################################################
-
diff --git a/tcl8.6/win/tcl.hpj.in b/tcl8.6/win/tcl.hpj.in
deleted file mode 100644
index a94cea6..0000000
--- a/tcl8.6/win/tcl.hpj.in
+++ /dev/null
@@ -1,19 +0,0 @@
-; This file is maintained by HCW. Do not modify this file directly.
-
-[OPTIONS]
-HCW=0
-LCID=0x409 0x0 0x0 ;English (United States)
-REPORT=Yes
-TITLE=Tcl/Tk Reference Manual
-CNT=tcl86.cnt
-COPYRIGHT=Copyright © 2000 Ajuba Solutions
-HLP=tcl86.hlp
-
-[FILES]
-tcl.rtf
-
-[WINDOWS]
-main="Tcl/Tk Reference Manual",,0
-
-[CONFIG]
-BrowseButtons()
diff --git a/tcl8.6/win/tcl.m4 b/tcl8.6/win/tcl.m4
deleted file mode 100644
index 84f0dff..0000000
--- a/tcl8.6/win/tcl.m4
+++ /dev/null
@@ -1,1299 +0,0 @@
-#------------------------------------------------------------------------
-# SC_PATH_TCLCONFIG --
-#
-# Locate the tclConfig.sh file and perform a sanity check on
-# the Tcl compile flags
-#
-# Arguments:
-# none
-#
-# Results:
-#
-# Adds the following arguments to configure:
-# --with-tcl=...
-#
-# Defines the following vars:
-# TCL_BIN_DIR Full path to the directory containing
-# the tclConfig.sh file
-#------------------------------------------------------------------------
-
-AC_DEFUN([SC_PATH_TCLCONFIG], [
- #
- # Ok, lets find the tcl configuration
- # First, look for one uninstalled.
- # the alternative search directory is invoked by --with-tcl
- #
-
- if test x"${no_tcl}" = x ; then
- # we reset no_tcl in case something fails here
- no_tcl=true
- AC_ARG_WITH(tcl,
- AC_HELP_STRING([--with-tcl],
- [directory containing tcl configuration (tclConfig.sh)]),
- with_tclconfig="${withval}")
- AC_MSG_CHECKING([for Tcl configuration])
- AC_CACHE_VAL(ac_cv_c_tclconfig,[
-
- # First check to see if --with-tcl was specified.
- if test x"${with_tclconfig}" != x ; then
- case "${with_tclconfig}" in
- */tclConfig.sh )
- if test -f "${with_tclconfig}"; then
- AC_MSG_WARN([--with-tcl argument should refer to directory containing tclConfig.sh, not to tclConfig.sh itself])
- with_tclconfig="`echo "${with_tclconfig}" | sed 's!/tclConfig\.sh$!!'`"
- fi ;;
- esac
- if test -f "${with_tclconfig}/tclConfig.sh" ; then
- ac_cv_c_tclconfig="`(cd "${with_tclconfig}"; pwd)`"
- else
- AC_MSG_ERROR([${with_tclconfig} directory doesn't contain tclConfig.sh])
- fi
- fi
-
- # then check for a private Tcl installation
- if test x"${ac_cv_c_tclconfig}" = x ; then
- for i in \
- ../tcl \
- `ls -dr ../tcl[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \
- `ls -dr ../tcl[[8-9]].[[0-9]] 2>/dev/null` \
- `ls -dr ../tcl[[8-9]].[[0-9]]* 2>/dev/null` \
- ../../tcl \
- `ls -dr ../../tcl[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \
- `ls -dr ../../tcl[[8-9]].[[0-9]] 2>/dev/null` \
- `ls -dr ../../tcl[[8-9]].[[0-9]]* 2>/dev/null` \
- ../../../tcl \
- `ls -dr ../../../tcl[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \
- `ls -dr ../../../tcl[[8-9]].[[0-9]] 2>/dev/null` \
- `ls -dr ../../../tcl[[8-9]].[[0-9]]* 2>/dev/null` ; do
- if test -f "$i/win/tclConfig.sh" ; then
- ac_cv_c_tclconfig="`(cd $i/win; pwd)`"
- break
- fi
- done
- fi
-
- # check in a few common install locations
- if test x"${ac_cv_c_tclconfig}" = x ; then
- for i in `ls -d ${libdir} 2>/dev/null` \
- `ls -d ${exec_prefix}/lib 2>/dev/null` \
- `ls -d ${prefix}/lib 2>/dev/null` \
- `ls -d /cygdrive/c/Tcl/lib 2>/dev/null` \
- `ls -d /cygdrive/c/Progra~1/Tcl/lib 2>/dev/null` \
- `ls -d /c/Tcl/lib 2>/dev/null` \
- `ls -d /c/Progra~1/Tcl/lib 2>/dev/null` \
- `ls -d C:/Tcl/lib 2>/dev/null` \
- `ls -d C:/Progra~1/Tcl/lib 2>/dev/null` \
- ; do
- if test -f "$i/tclConfig.sh" ; then
- ac_cv_c_tclconfig="`(cd $i; pwd)`"
- break
- fi
- done
- fi
-
- # check in a few other private locations
- if test x"${ac_cv_c_tclconfig}" = x ; then
- for i in \
- ${srcdir}/../tcl \
- `ls -dr ${srcdir}/../tcl[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \
- `ls -dr ${srcdir}/../tcl[[8-9]].[[0-9]] 2>/dev/null` \
- `ls -dr ${srcdir}/../tcl[[8-9]].[[0-9]]* 2>/dev/null` ; do
- if test -f "$i/win/tclConfig.sh" ; then
- ac_cv_c_tclconfig="`(cd $i/win; pwd)`"
- break
- fi
- done
- fi
- ])
-
- if test x"${ac_cv_c_tclconfig}" = x ; then
- TCL_BIN_DIR="# no Tcl configs found"
- AC_MSG_ERROR([Can't find Tcl configuration definitions. Use --with-tcl to specify a directory containing tclConfig.sh])
- else
- no_tcl=
- TCL_BIN_DIR="${ac_cv_c_tclconfig}"
- AC_MSG_RESULT([found ${TCL_BIN_DIR}/tclConfig.sh])
- fi
- fi
-])
-
-#------------------------------------------------------------------------
-# SC_PATH_TKCONFIG --
-#
-# Locate the tkConfig.sh file
-#
-# Arguments:
-# none
-#
-# Results:
-#
-# Adds the following arguments to configure:
-# --with-tk=...
-#
-# Defines the following vars:
-# TK_BIN_DIR Full path to the directory containing
-# the tkConfig.sh file
-#------------------------------------------------------------------------
-
-AC_DEFUN([SC_PATH_TKCONFIG], [
- #
- # Ok, lets find the tk configuration
- # First, look for one uninstalled.
- # the alternative search directory is invoked by --with-tk
- #
-
- if test x"${no_tk}" = x ; then
- # we reset no_tk in case something fails here
- no_tk=true
- AC_ARG_WITH(tk,
- AC_HELP_STRING([--with-tk],
- [directory containing tk configuration (tkConfig.sh)]),
- with_tkconfig="${withval}")
- AC_MSG_CHECKING([for Tk configuration])
- AC_CACHE_VAL(ac_cv_c_tkconfig,[
-
- # First check to see if --with-tkconfig was specified.
- if test x"${with_tkconfig}" != x ; then
- case "${with_tkconfig}" in
- */tkConfig.sh )
- if test -f "${with_tkconfig}"; then
- AC_MSG_WARN([--with-tk argument should refer to directory containing tkConfig.sh, not to tkConfig.sh itself])
- with_tkconfig="`echo "${with_tkconfig}" | sed 's!/tkConfig\.sh$!!'`"
- fi ;;
- esac
- if test -f "${with_tkconfig}/tkConfig.sh" ; then
- ac_cv_c_tkconfig="`(cd "${with_tkconfig}"; pwd)`"
- else
- AC_MSG_ERROR([${with_tkconfig} directory doesn't contain tkConfig.sh])
- fi
- fi
-
- # then check for a private Tk library
- if test x"${ac_cv_c_tkconfig}" = x ; then
- for i in \
- ../tk \
- `ls -dr ../tk[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \
- `ls -dr ../tk[[8-9]].[[0-9]] 2>/dev/null` \
- `ls -dr ../tk[[8-9]].[[0-9]]* 2>/dev/null` \
- ../../tk \
- `ls -dr ../../tk[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \
- `ls -dr ../../tk[[8-9]].[[0-9]] 2>/dev/null` \
- `ls -dr ../../tk[[8-9]].[[0-9]]* 2>/dev/null` \
- ../../../tk \
- `ls -dr ../../../tk[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \
- `ls -dr ../../../tk[[8-9]].[[0-9]] 2>/dev/null` \
- `ls -dr ../../../tk[[8-9]].[[0-9]]* 2>/dev/null` ; do
- if test -f "$i/win/tkConfig.sh" ; then
- ac_cv_c_tkconfig="`(cd $i/win; pwd)`"
- break
- fi
- done
- fi
-
- # check in a few common install locations
- if test x"${ac_cv_c_tkconfig}" = x ; then
- for i in `ls -d ${libdir} 2>/dev/null` \
- `ls -d ${exec_prefix}/lib 2>/dev/null` \
- `ls -d ${prefix}/lib 2>/dev/null` \
- `ls -d /cygdrive/c/Tcl/lib 2>/dev/null` \
- `ls -d /cygdrive/c/Progra~1/Tcl/lib 2>/dev/null` \
- `ls -d /c/Tcl/lib 2>/dev/null` \
- `ls -d /c/Progra~1/Tcl/lib 2>/dev/null` \
- `ls -d C:/Tcl/lib 2>/dev/null` \
- `ls -d C:/Progra~1/Tcl/lib 2>/dev/null` \
- ; do
- if test -f "$i/tkConfig.sh" ; then
- ac_cv_c_tkconfig="`(cd $i; pwd)`"
- break
- fi
- done
- fi
-
- # check in a few other private locations
- if test x"${ac_cv_c_tkconfig}" = x ; then
- for i in \
- ${srcdir}/../tk \
- `ls -dr ${srcdir}/../tk[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \
- `ls -dr ${srcdir}/../tk[[8-9]].[[0-9]] 2>/dev/null` \
- `ls -dr ${srcdir}/../tk[[8-9]].[[0-9]]* 2>/dev/null` ; do
- if test -f "$i/win/tkConfig.sh" ; then
- ac_cv_c_tkconfig="`(cd $i/win; pwd)`"
- break
- fi
- done
- fi
- ])
-
- if test x"${ac_cv_c_tkconfig}" = x ; then
- TK_BIN_DIR="# no Tk configs found"
- AC_MSG_ERROR([Can't find Tk configuration definitions. Use --with-tk to specify a directory containing tkConfig.sh])
- else
- no_tk=
- TK_BIN_DIR="${ac_cv_c_tkconfig}"
- AC_MSG_RESULT([found ${TK_BIN_DIR}/tkConfig.sh])
- fi
- fi
-])
-
-#------------------------------------------------------------------------
-# SC_LOAD_TCLCONFIG --
-#
-# Load the tclConfig.sh file.
-#
-# Arguments:
-#
-# Requires the following vars to be set:
-# TCL_BIN_DIR
-#
-# Results:
-#
-# Substitutes the following vars:
-# TCL_BIN_DIR
-# TCL_SRC_DIR
-# TCL_LIB_FILE
-#
-#------------------------------------------------------------------------
-
-AC_DEFUN([SC_LOAD_TCLCONFIG], [
- AC_MSG_CHECKING([for existence of ${TCL_BIN_DIR}/tclConfig.sh])
-
- if test -f "${TCL_BIN_DIR}/tclConfig.sh" ; then
- AC_MSG_RESULT([loading])
- . "${TCL_BIN_DIR}/tclConfig.sh"
- else
- AC_MSG_RESULT([could not find ${TCL_BIN_DIR}/tclConfig.sh])
- fi
-
- #
- # If the TCL_BIN_DIR is the build directory (not the install directory),
- # then set the common variable name to the value of the build variables.
- # For example, the variable TCL_LIB_SPEC will be set to the value
- # of TCL_BUILD_LIB_SPEC. An extension should make use of TCL_LIB_SPEC
- # instead of TCL_BUILD_LIB_SPEC since it will work with both an
- # installed and uninstalled version of Tcl.
- #
-
- if test -f $TCL_BIN_DIR/Makefile ; then
- TCL_LIB_SPEC=${TCL_BUILD_LIB_SPEC}
- TCL_STUB_LIB_SPEC=${TCL_BUILD_STUB_LIB_SPEC}
- TCL_STUB_LIB_PATH=${TCL_BUILD_STUB_LIB_PATH}
- fi
-
- #
- # eval is required to do the TCL_DBGX substitution
- #
-
- eval "TCL_LIB_FILE=\"${TCL_LIB_FILE}\""
- eval "TCL_LIB_FLAG=\"${TCL_LIB_FLAG}\""
- eval "TCL_LIB_SPEC=\"${TCL_LIB_SPEC}\""
-
- eval "TCL_STUB_LIB_FILE=\"${TCL_STUB_LIB_FILE}\""
- eval "TCL_STUB_LIB_FLAG=\"${TCL_STUB_LIB_FLAG}\""
- eval "TCL_STUB_LIB_SPEC=\"${TCL_STUB_LIB_SPEC}\""
-
- AC_SUBST(TCL_VERSION)
- AC_SUBST(TCL_BIN_DIR)
- AC_SUBST(TCL_SRC_DIR)
-
- AC_SUBST(TCL_LIB_FILE)
- AC_SUBST(TCL_LIB_FLAG)
- AC_SUBST(TCL_LIB_SPEC)
-
- AC_SUBST(TCL_STUB_LIB_FILE)
- AC_SUBST(TCL_STUB_LIB_FLAG)
- AC_SUBST(TCL_STUB_LIB_SPEC)
-
- AC_SUBST(TCL_DEFS)
-])
-
-#------------------------------------------------------------------------
-# SC_LOAD_TKCONFIG --
-#
-# Load the tkConfig.sh file
-#
-# Arguments:
-#
-# Requires the following vars to be set:
-# TK_BIN_DIR
-#
-# Results:
-#
-# Sets the following vars that should be in tkConfig.sh:
-# TK_BIN_DIR
-#------------------------------------------------------------------------
-
-AC_DEFUN([SC_LOAD_TKCONFIG], [
- AC_MSG_CHECKING([for existence of ${TK_BIN_DIR}/tkConfig.sh])
-
- if test -f "${TK_BIN_DIR}/tkConfig.sh" ; then
- AC_MSG_RESULT([loading])
- . "${TK_BIN_DIR}/tkConfig.sh"
- else
- AC_MSG_RESULT([could not find ${TK_BIN_DIR}/tkConfig.sh])
- fi
-
-
- AC_SUBST(TK_BIN_DIR)
- AC_SUBST(TK_SRC_DIR)
- AC_SUBST(TK_LIB_FILE)
-])
-
-#------------------------------------------------------------------------
-# SC_ENABLE_SHARED --
-#
-# Allows the building of shared libraries
-#
-# Arguments:
-# none
-#
-# Results:
-#
-# Adds the following arguments to configure:
-# --enable-shared=yes|no
-#
-# Defines the following vars:
-# STATIC_BUILD Used for building import/export libraries
-# on Windows.
-#
-# Sets the following vars:
-# SHARED_BUILD Value of 1 or 0
-#------------------------------------------------------------------------
-
-AC_DEFUN([SC_ENABLE_SHARED], [
- AC_MSG_CHECKING([how to build libraries])
- AC_ARG_ENABLE(shared,
- [ --enable-shared build and link with shared libraries (default: on)],
- [tcl_ok=$enableval], [tcl_ok=yes])
-
- if test "${enable_shared+set}" = set; then
- enableval="$enable_shared"
- tcl_ok=$enableval
- else
- tcl_ok=yes
- fi
-
- if test "$tcl_ok" = "yes" ; then
- AC_MSG_RESULT([shared])
- SHARED_BUILD=1
- else
- AC_MSG_RESULT([static])
- SHARED_BUILD=0
- AC_DEFINE(STATIC_BUILD, 1, [Is this a static build?])
- fi
-])
-
-#------------------------------------------------------------------------
-# SC_ENABLE_THREADS --
-#
-# Specify if thread support should be enabled
-#
-# Arguments:
-# none
-#
-# Results:
-#
-# Adds the following arguments to configure:
-# --enable-threads=yes|no
-#
-# Defines the following vars:
-# TCL_THREADS
-#------------------------------------------------------------------------
-
-AC_DEFUN([SC_ENABLE_THREADS], [
- AC_MSG_CHECKING(for building with threads)
- AC_ARG_ENABLE(threads, [ --enable-threads build with threads (default: on)],
- [tcl_ok=$enableval], [tcl_ok=yes])
-
- if test "$tcl_ok" = "yes"; then
- AC_MSG_RESULT([yes (default)])
- TCL_THREADS=1
- AC_DEFINE(TCL_THREADS)
- # USE_THREAD_ALLOC tells us to try the special thread-based
- # allocator that significantly reduces lock contention
- AC_DEFINE(USE_THREAD_ALLOC)
- else
- TCL_THREADS=0
- AC_MSG_RESULT(no)
- fi
- AC_SUBST(TCL_THREADS)
-])
-
-#------------------------------------------------------------------------
-# SC_ENABLE_SYMBOLS --
-#
-# Specify if debugging symbols should be used.
-# Memory (TCL_MEM_DEBUG) and compile (TCL_COMPILE_DEBUG) debugging
-# can also be enabled.
-#
-# Arguments:
-# none
-#
-# Requires the following vars to be set in the Makefile:
-# CFLAGS_DEBUG
-# CFLAGS_OPTIMIZE
-#
-# Results:
-#
-# Adds the following arguments to configure:
-# --enable-symbols
-#
-# Defines the following vars:
-# CFLAGS_DEFAULT Sets to $(CFLAGS_DEBUG) if true
-# Sets to $(CFLAGS_OPTIMIZE) if false
-# LDFLAGS_DEFAULT Sets to $(LDFLAGS_DEBUG) if true
-# Sets to $(LDFLAGS_OPTIMIZE) if false
-# DBGX Debug library extension
-#
-#------------------------------------------------------------------------
-
-AC_DEFUN([SC_ENABLE_SYMBOLS], [
- AC_MSG_CHECKING([for build with symbols])
- AC_ARG_ENABLE(symbols, [ --enable-symbols build with debugging symbols (default: off)], [tcl_ok=$enableval], [tcl_ok=no])
-# 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=""
- 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)'
- DBGX=g
- if test "$tcl_ok" = "yes"; then
- AC_MSG_RESULT([yes (standard debugging)])
- fi
- fi
- AC_SUBST(CFLAGS_DEFAULT)
- AC_SUBST(LDFLAGS_DEFAULT)
-
- if test "$tcl_ok" = "mem" -o "$tcl_ok" = "all"; then
- AC_DEFINE(TCL_MEM_DEBUG, 1, [Is memory debugging enabled?])
- fi
-
- if test "$tcl_ok" = "compile" -o "$tcl_ok" = "all"; then
- AC_DEFINE(TCL_COMPILE_DEBUG, 1, [Is bytecode debugging enabled?])
- AC_DEFINE(TCL_COMPILE_STATS, 1, [Are bytecode statistics enabled?])
- fi
-
- if test "$tcl_ok" != "yes" -a "$tcl_ok" != "no"; then
- if test "$tcl_ok" = "all"; then
- AC_MSG_RESULT([enabled symbols mem compile debugging])
- else
- AC_MSG_RESULT([enabled $tcl_ok debugging])
- fi
- fi
-])
-
-#--------------------------------------------------------------------
-# SC_CONFIG_CFLAGS
-#
-# Try to determine the proper flags to pass to the compiler
-# for building shared libraries and other such nonsense.
-#
-# NOTE: The backslashes in quotes below are substituted twice
-# due to the fact that they are in a macro and then inlined
-# in the final configure script.
-#
-# Arguments:
-# none
-#
-# Results:
-#
-# Can the following vars:
-# EXTRA_CFLAGS
-# CFLAGS_DEBUG
-# CFLAGS_OPTIMIZE
-# CFLAGS_WARNING
-# LDFLAGS_DEBUG
-# LDFLAGS_OPTIMIZE
-# LDFLAGS_CONSOLE
-# LDFLAGS_WINDOW
-# CC_OBJNAME
-# CC_EXENAME
-# CYGPATH
-# STLIB_LD
-# SHLIB_LD
-# SHLIB_LD_LIBS
-# LIBS
-# AR
-# RC
-# RES
-#
-# MAKE_LIB
-# MAKE_STUB_LIB
-# MAKE_EXE
-# MAKE_DLL
-#
-# LIBSUFFIX
-# LIBFLAGSUFFIX
-# LIBPREFIX
-# LIBRARIES
-# EXESUFFIX
-# DLLSUFFIX
-#
-#--------------------------------------------------------------------
-
-AC_DEFUN([SC_CONFIG_CFLAGS], [
-
- # Step 0: Enable 64 bit support?
-
- AC_MSG_CHECKING([if 64bit support is requested])
- AC_ARG_ENABLE(64bit,[ --enable-64bit enable 64bit support (where applicable)], [do64bit=$enableval], [do64bit=no])
- AC_MSG_RESULT($do64bit)
-
- # Cross-compiling options for Windows/CE builds
-
- AC_MSG_CHECKING([if Windows/CE build is requested])
- AC_ARG_ENABLE(wince,[ --enable-wince enable Win/CE support (where applicable)], [doWince=$enableval], [doWince=no])
- AC_MSG_RESULT($doWince)
-
- AC_MSG_CHECKING([for Windows/CE celib directory])
- AC_ARG_WITH(celib,[ --with-celib=DIR use Windows/CE support library from DIR],
- CELIB_DIR=$withval, CELIB_DIR=NO_CELIB)
- AC_MSG_RESULT([$CELIB_DIR])
-
- # Set some defaults (may get changed below)
- EXTRA_CFLAGS=""
- AC_DEFINE(MODULE_SCOPE, [extern], [No need to mark inidividual symbols as hidden])
-
- AC_CHECK_PROG(CYGPATH, cygpath, cygpath -m, echo)
-
- SHLIB_SUFFIX=".dll"
-
- # MACHINE is IX86 for LINK, but this is used by the manifest,
- # which requires x86|amd64|ia64.
- MACHINE="X86"
-
- if test "$GCC" = "yes"; then
-
- AC_CACHE_CHECK(for cross-compile version of gcc,
- ac_cv_cross,
- AC_TRY_COMPILE([
- #ifndef _WIN32
- #error cross-compiler
- #endif
- ], [],
- ac_cv_cross=no,
- ac_cv_cross=yes)
- )
-
- if test "$ac_cv_cross" = "yes"; then
- case "$do64bit" in
- amd64|x64|yes)
- CC="x86_64-w64-mingw32-gcc"
- LD="x86_64-w64-mingw32-ld"
- AR="x86_64-w64-mingw32-ar"
- RANLIB="x86_64-w64-mingw32-ranlib"
- RC="x86_64-w64-mingw32-windres"
- ;;
- *)
- CC="i686-w64-mingw32-gcc"
- LD="i686-w64-mingw32-ld"
- AR="i686-w64-mingw32-ar"
- RANLIB="i686-w64-mingw32-ranlib"
- RC="i686-w64-mingw32-windres"
- ;;
- esac
- fi
- fi
-
- # Check for a bug in gcc's windres that causes the
- # compile to fail when a Windows native path is
- # passed into windres. The mingw toolchain requires
- # Windows native paths while Cygwin should work
- # with both. Avoid the bug by passing a POSIX
- # path when using the Cygwin toolchain.
-
- if test "$GCC" = "yes" && test "$CYGPATH" != "echo" ; then
- conftest=/tmp/conftest.rc
- echo "STRINGTABLE BEGIN" > $conftest
- echo "101 \"name\"" >> $conftest
- echo "END" >> $conftest
-
- AC_MSG_CHECKING([for Windows native path bug in windres])
- cyg_conftest=`$CYGPATH $conftest`
- if AC_TRY_COMMAND($RC -o conftest.res.o $cyg_conftest) ; then
- AC_MSG_RESULT([no])
- else
- AC_MSG_RESULT([yes])
- CYGPATH=echo
- fi
- conftest=
- cyg_conftest=
- fi
-
- if test "$CYGPATH" = "echo"; then
- DEPARG='"$<"'
- else
- DEPARG='"$(shell $(CYGPATH) $<)"'
- fi
-
- # set various compiler flags depending on whether we are using gcc or cl
-
- if test "${GCC}" = "yes" ; then
- extra_cflags="-pipe"
- extra_ldflags="-pipe -static-libgcc"
- AC_CACHE_CHECK(for mingw32 version of gcc,
- ac_cv_win32,
- AC_TRY_COMPILE([
- #ifdef _WIN32
- #error win32
- #endif
- ], [],
- ac_cv_win32=no,
- ac_cv_win32=yes)
- )
- if test "$ac_cv_win32" != "yes"; then
- AC_MSG_ERROR([${CC} cannot produce win32 executables.])
- fi
-
- hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -mwindows -municode -Dmain=xxmain"
- AC_CACHE_CHECK(for working -municode linker flag,
- ac_cv_municode,
- AC_TRY_LINK([
- #include <windows.h>
- int APIENTRY wWinMain(HINSTANCE a, HINSTANCE b, LPWSTR c, int d) {return 0;}
- ],
- [],
- ac_cv_municode=yes,
- ac_cv_municode=no)
- )
- CFLAGS=$hold_cflags
- if test "$ac_cv_municode" = "yes" ; then
- extra_ldflags="$extra_ldflags -municode"
- else
- extra_cflags="$extra_cflags -DTCL_BROKEN_MAINARGS"
- fi
- fi
-
- AC_MSG_CHECKING([compiler flags])
- if test "${GCC}" = "yes" ; then
- SHLIB_LD=""
- SHLIB_LD_LIBS='${LIBS}'
- LIBS="-lnetapi32 -lkernel32 -luser32 -ladvapi32 -luserenv -lws2_32"
- # 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=
- RC_INCLUDE=--include
- RC_DEFINE=--define
- RES=res.o
- MAKE_LIB="\${STLIB_LD} \[$]@"
- MAKE_STUB_LIB="\${STLIB_LD} \[$]@"
- POST_MAKE_LIB="\${RANLIB} \[$]@"
- MAKE_EXE="\${CC} -o \[$]@"
- LIBPREFIX="lib"
-
- if test "${SHARED_BUILD}" = "0" ; then
- # static
- AC_MSG_RESULT([using static flags])
- runtime=
- LIBRARIES="\${STATIC_LIBRARIES}"
- EXESUFFIX="s\${DBGX}.exe"
- else
- # dynamic
- AC_MSG_RESULT([using shared flags])
-
- # ad-hoc check to see if CC supports -shared.
- if "${CC}" -shared 2>&1 | egrep ': -shared not supported' >/dev/null; then
- AC_MSG_ERROR([${CC} does not support the -shared option.
- You will need to upgrade to a newer version of the toolchain.])
- fi
-
- runtime=
- # Add SHLIB_LD_LIBS to the Make rule, not here.
-
- EXESUFFIX="\${DBGX}.exe"
- LIBRARIES="\${SHARED_LIBRARIES}"
- fi
- # Link with gcc since ld does not link to default libs like
- # -luser32 and -lmsvcrt by default.
- SHLIB_LD='${CC} -shared'
- SHLIB_LD_LIBS='${LIBS}'
- MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -o \[$]@ ${extra_ldflags} \
- -Wl,--out-implib,\$(patsubst %.dll,lib%.a,\[$]@)"
- # DLLSUFFIX is separate because it is the building block for
- # users of tclConfig.sh that may build shared or static.
- DLLSUFFIX="\${DBGX}.dll"
- LIBSUFFIX="\${DBGX}.a"
- LIBFLAGSUFFIX="\${DBGX}"
- SHLIB_SUFFIX=.dll
-
- EXTRA_CFLAGS="${extra_cflags}"
-
- CFLAGS_DEBUG=-g
- CFLAGS_OPTIMIZE="-O2 -fomit-frame-pointer"
- CFLAGS_WARNING="-Wall -Wdeclaration-after-statement"
- LDFLAGS_DEBUG=
- LDFLAGS_OPTIMIZE=
-
- # Specify the CC output file names based on the target name
- CC_OBJNAME="-o \[$]@"
- CC_EXENAME="-o \[$]@"
-
- # Specify linker flags depending on the type of app being
- # built -- Console vs. Window.
- #
- # ORIGINAL COMMENT:
- # We need to pass -e _WinMain@16 so that ld will use
- # WinMain() instead of main() as the entry point. We can't
- # use autoconf to check for this case since it would need
- # to run an executable and that does not work when
- # cross compiling. Remove this -e workaround once we
- # require a gcc that does not have this bug.
- #
- # MK NOTE: Tk should use a different mechanism. This causes
- # interesting problems, such as wish dying at startup.
- #LDFLAGS_WINDOW="-mwindows -e _WinMain@16 ${extra_ldflags}"
- LDFLAGS_CONSOLE="-mconsole ${extra_ldflags}"
- LDFLAGS_WINDOW="-mwindows ${extra_ldflags}"
-
- case "$do64bit" in
- amd64|x64|yes)
- MACHINE="AMD64" ; # assume AMD64 as default 64-bit build
- AC_MSG_RESULT([ Using 64-bit $MACHINE mode])
- ;;
- ia64)
- MACHINE="IA64"
- AC_MSG_RESULT([ Using 64-bit $MACHINE mode])
- ;;
- *)
- AC_TRY_COMPILE([
- #ifndef _WIN64
- #error 32-bit
- #endif
- ], [],
- tcl_win_64bit=yes,
- tcl_win_64bit=no
- )
- if test "$tcl_win_64bit" = "yes" ; then
- do64bit=amd64
- MACHINE="AMD64"
- AC_MSG_RESULT([ Using 64-bit $MACHINE mode])
- fi
- ;;
- esac
- else
- if test "${SHARED_BUILD}" = "0" ; then
- # static
- AC_MSG_RESULT([using static flags])
- runtime=-MT
- LIBRARIES="\${STATIC_LIBRARIES}"
- EXESUFFIX="s\${DBGX}.exe"
- else
- # dynamic
- AC_MSG_RESULT([using shared flags])
- runtime=-MD
- # Add SHLIB_LD_LIBS to the Make rule, not here.
- LIBRARIES="\${SHARED_LIBRARIES}"
- EXESUFFIX="\${DBGX}.exe"
- case "x`echo \${VisualStudioVersion}`" in
- x1[[4-9]]*)
- lflags="${lflags} -nodefaultlib:libucrt.lib"
- ;;
- *)
- ;;
- esac
- fi
- MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -out:\[$]@"
- # DLLSUFFIX is separate because it is the building block for
- # users of tclConfig.sh that may build shared or static.
- DLLSUFFIX="\${DBGX}.dll"
- LIBSUFFIX="\${DBGX}.lib"
- LIBFLAGSUFFIX="\${DBGX}"
-
- # This is a 2-stage check to make sure we have the 64-bit SDK
- # We have to know where the SDK is installed.
- # This magic is based on MS Platform SDK for Win2003 SP1 - hobbs
- if test "$do64bit" != "no" ; then
- if test "x${MSSDK}x" = "xx" ; then
- MSSDK="C:/Progra~1/Microsoft Platform SDK"
- fi
- MSSDK=`echo "$MSSDK" | sed -e 's!\\\!/!g'`
- PATH64=""
- case "$do64bit" in
- amd64|x64|yes)
- MACHINE="AMD64" ; # assume AMD64 as default 64-bit build
- PATH64="${MSSDK}/Bin/Win64/x86/AMD64"
- ;;
- ia64)
- MACHINE="IA64"
- PATH64="${MSSDK}/Bin/Win64"
- ;;
- esac
- if test ! -d "${PATH64}" ; then
- AC_MSG_WARN([Could not find 64-bit $MACHINE SDK])
- fi
- AC_MSG_RESULT([ Using 64-bit $MACHINE mode])
- fi
-
- LIBS="netapi32.lib kernel32.lib user32.lib advapi32.lib userenv.lib ws2_32.lib"
-
- case "x`echo \${VisualStudioVersion}`" in
- x1[[4-9]]*)
- LIBS="$LIBS ucrt.lib"
- ;;
- *)
- ;;
- esac
-
- 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.
- # 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.
- CFLAGS_OPTIMIZE="-nologo -O1 ${runtime}"
- lflags="${lflags} -nologo -MACHINE:${MACHINE} -LIBPATH:\"${MSSDK}/Lib/${MACHINE}\""
- LINKBIN="\"${PATH64}/link.exe\""
- # Avoid 'unresolved external symbol __security_cookie' errors.
- # c.f. http://support.microsoft.com/?id=894573
- LIBS="$LIBS bufferoverflowU.lib"
- else
- RC="rc"
- # -Od - no optimization
- # -WX - warnings as errors
- CFLAGS_DEBUG="-nologo -Z7 -Od -WX ${runtime}d"
- # -O2 - create fast code (/Og /Oi /Ot /Oy /Ob2 /Gs /GF /Gy)
- CFLAGS_OPTIMIZE="-nologo -O2 ${runtime}"
- lflags="${lflags} -nologo"
- LINKBIN="link"
- fi
-
- if test "$doWince" != "no" ; then
- # Set defaults for common evc4/PPC2003 setup
- # Currently Tcl requires 300+, possibly 420+ for sockets
- CEVERSION=420; # could be 211 300 301 400 420 ...
- TARGETCPU=ARMV4; # could be ARMV4 ARM MIPS SH3 X86 ...
- ARCH=ARM; # could be ARM MIPS X86EM ...
- PLATFORM="Pocket PC 2003"; # or "Pocket PC 2002"
- if test "$doWince" != "yes"; then
- # If !yes then the user specified something
- # Reset ARCH to allow user to skip specifying it
- ARCH=
- eval `echo $doWince | awk -F "," '{ \
- if (length([$]1)) { printf "CEVERSION=\"%s\"\n", [$]1; \
- if ([$]1 < 400) { printf "PLATFORM=\"Pocket PC 2002\"\n" } }; \
- if (length([$]2)) { printf "TARGETCPU=\"%s\"\n", toupper([$]2) }; \
- if (length([$]3)) { printf "ARCH=\"%s\"\n", toupper([$]3) }; \
- if (length([$]4)) { printf "PLATFORM=\"%s\"\n", [$]4 }; \
- }'`
- if test "x${ARCH}" = "x" ; then
- ARCH=$TARGETCPU;
- fi
- fi
- OSVERSION=WCE$CEVERSION;
- if test "x${WCEROOT}" = "x" ; then
- WCEROOT="C:/Program Files/Microsoft eMbedded C++ 4.0"
- if test ! -d "${WCEROOT}" ; then
- WCEROOT="C:/Program Files/Microsoft eMbedded Tools"
- fi
- fi
- if test "x${SDKROOT}" = "x" ; then
- SDKROOT="C:/Program Files/Windows CE Tools"
- if test ! -d "${SDKROOT}" ; then
- SDKROOT="C:/Windows CE Tools"
- fi
- fi
- # The space-based-path will work for the Makefile, but will
- # not work if AC_TRY_COMPILE is called.
- WCEROOT=`echo "$WCEROOT" | sed -e 's!\\\!/!g'`
- SDKROOT=`echo "$SDKROOT" | sed -e 's!\\\!/!g'`
- CELIB_DIR=`echo "$CELIB_DIR" | sed -e 's!\\\!/!g'`
- if test ! -d "${CELIB_DIR}/inc"; then
- AC_MSG_ERROR([Invalid celib directory "${CELIB_DIR}"])
- fi
- if test ! -d "${SDKROOT}/${OSVERSION}/${PLATFORM}/Lib/${TARGETCPU}"\
- -o ! -d "${WCEROOT}/EVC/${OSVERSION}/bin"; then
- AC_MSG_ERROR([could not find PocketPC SDK or target compiler to enable WinCE mode [$CEVERSION,$TARGETCPU,$ARCH,$PLATFORM]])
- else
- CEINCLUDE="${SDKROOT}/${OSVERSION}/${PLATFORM}/include"
- if test -d "${CEINCLUDE}/${TARGETCPU}" ; then
- CEINCLUDE="${CEINCLUDE}/${TARGETCPU}"
- fi
- CELIBPATH="${SDKROOT}/${OSVERSION}/${PLATFORM}/Lib/${TARGETCPU}"
- fi
- fi
-
- if test "$doWince" != "no" ; then
- CEBINROOT="${WCEROOT}/EVC/${OSVERSION}/bin"
- if test "${TARGETCPU}" = "X86"; then
- CC="${CEBINROOT}/cl.exe"
- else
- CC="${CEBINROOT}/cl${ARCH}.exe"
- fi
- CC="\"${CC}\" -I\"${CELIB_DIR}/inc\" -I\"${CEINCLUDE}\""
- RC="\"${WCEROOT}/Common/EVC/bin/rc.exe\""
- arch=`echo ${ARCH} | awk '{print tolower([$]0)}'`
- defs="${ARCH} _${ARCH}_ ${arch} PALM_SIZE _MT _DLL _WINDOWS"
- for i in $defs ; do
- AC_DEFINE_UNQUOTED($i)
- done
-# if test "${ARCH}" = "X86EM"; then
-# AC_DEFINE_UNQUOTED(_WIN32_WCE_EMULATION)
-# fi
- AC_DEFINE_UNQUOTED(_WIN32_WCE, $CEVERSION)
- AC_DEFINE_UNQUOTED(UNDER_CE, $CEVERSION)
- 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\""
- AC_SUBST(CELIB_DIR)
- if test "${CEVERSION}" -lt 400 ; then
- LIBS="coredll.lib corelibc.lib winsock.lib"
- else
- LIBS="coredll.lib corelibc.lib ws2.lib"
- fi
- # celib currently stuck at wce300 status
- #LIBS="$LIBS \${CELIB_DIR}/wince-${ARCH}-pocket-${OSVERSION}-release/celib.lib"
- 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 uuid.lib"
- fi
-
- SHLIB_LD="${LINKBIN} -dll -incremental:no ${lflags}"
- SHLIB_LD_LIBS='${LIBS}'
- # link -lib only works when -lib is the first arg
- STLIB_LD="${LINKBIN} -lib ${lflags}"
- RC_OUT=-fo
- RC_TYPE=-r
- RC_INCLUDE=-i
- RC_DEFINE=-d
- RES=res
- MAKE_LIB="\${STLIB_LD} -out:\[$]@"
- MAKE_STUB_LIB="\${STLIB_LD} -nodefaultlib -out:\[$]@"
- POST_MAKE_LIB=
- MAKE_EXE="\${CC} -Fe\[$]@"
- LIBPREFIX=""
-
- CFLAGS_DEBUG="${CFLAGS_DEBUG} -D_CRT_SECURE_NO_DEPRECATE -D_CRT_NONSTDC_NO_DEPRECATE"
- CFLAGS_OPTIMIZE="${CFLAGS_OPTIMIZE} -D_CRT_SECURE_NO_DEPRECATE -D_CRT_NONSTDC_NO_DEPRECATE"
-
- EXTRA_CFLAGS=""
- CFLAGS_WARNING="-W3"
- LDFLAGS_DEBUG="-debug"
- LDFLAGS_OPTIMIZE="-release"
-
- # Specify the CC output file names based on the target name
- CC_OBJNAME="-Fo\[$]@"
- CC_EXENAME="-Fe\"\$(shell \$(CYGPATH) '\[$]@')\""
-
- # Specify linker flags depending on the type of app being
- # built -- Console vs. Window.
- if test "$doWince" != "no" -a "${TARGETCPU}" != "X86"; then
- LDFLAGS_CONSOLE="-link ${lflags}"
- LDFLAGS_WINDOW=${LDFLAGS_CONSOLE}
- else
- LDFLAGS_CONSOLE="-link -subsystem:console ${lflags}"
- LDFLAGS_WINDOW="-link -subsystem:windows ${lflags}"
- 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,
- AC_TRY_RUN([
- #define WIN32_LEAN_AND_MEAN
- #include <windows.h>
- #undef WIN32_LEAN_AND_MEAN
-
- int main(int argc, char** argv) {
- int a, b = 0;
- __try {
- a = 666 / b;
- }
- __except (EXCEPTION_EXECUTE_HANDLER) {
- return 0;
- }
- return 1;
- }
- ],
- tcl_cv_seh=yes,
- tcl_cv_seh=no,
- tcl_cv_seh=no)
- )
- if test "$tcl_cv_seh" = "no" ; then
- AC_DEFINE(HAVE_NO_SEH, 1,
- [Defined when mingw does not support SEH])
- fi
-
- #
- # Check to see if the excpt.h include file provided contains the
- # definition for EXCEPTION_DISPOSITION; if not, which is the case
- # with Cygwin's version as of 2002-04-10, define it to be int,
- # sufficient for getting the current code to work.
- #
- AC_CACHE_CHECK(for EXCEPTION_DISPOSITION support in include files,
- tcl_cv_eh_disposition,
- AC_TRY_COMPILE([
-# define WIN32_LEAN_AND_MEAN
-# include <windows.h>
-# undef WIN32_LEAN_AND_MEAN
- ],[
- EXCEPTION_DISPOSITION x;
- ],
- tcl_cv_eh_disposition=yes,
- tcl_cv_eh_disposition=no)
- )
- if test "$tcl_cv_eh_disposition" = "no" ; then
- AC_DEFINE(EXCEPTION_DISPOSITION, int,
- [Defined when cygwin/mingw does not support EXCEPTION DISPOSITION])
- fi
-
- # Check to see if winnt.h defines CHAR, SHORT, and LONG
- # even if VOID has already been #defined. The win32api
- # used by mingw and cygwin is known to do this.
-
- AC_CACHE_CHECK(for winnt.h that ignores VOID define,
- tcl_cv_winnt_ignore_void,
- AC_TRY_COMPILE([
- #define VOID void
- #define WIN32_LEAN_AND_MEAN
- #include <windows.h>
- #undef WIN32_LEAN_AND_MEAN
- ], [
- CHAR c;
- SHORT s;
- LONG l;
- ],
- tcl_cv_winnt_ignore_void=yes,
- tcl_cv_winnt_ignore_void=no)
- )
- if test "$tcl_cv_winnt_ignore_void" = "yes" ; then
- AC_DEFINE(HAVE_WINNT_IGNORE_VOID, 1,
- [Defined when cygwin/mingw ignores VOID define in winnt.h])
- fi
-
- # See if the compiler supports casting to a union type.
- # This is used to stop gcc from printing a compiler
- # warning when initializing a union member.
-
- AC_CACHE_CHECK(for cast to union support,
- tcl_cv_cast_to_union,
- AC_TRY_COMPILE([],
- [
- union foo { int i; double d; };
- union foo f = (union foo) (int) 0;
- ],
- tcl_cv_cast_to_union=yes,
- tcl_cv_cast_to_union=no)
- )
- if test "$tcl_cv_cast_to_union" = "yes"; then
- AC_DEFINE(HAVE_CAST_TO_UNION, 1,
- [Defined when compiler supports casting to union type.])
- fi
- fi
-
- # DL_LIBS is empty, but then we match the Unix version
- AC_SUBST(DL_LIBS)
- AC_SUBST(CFLAGS_DEBUG)
- AC_SUBST(CFLAGS_OPTIMIZE)
- AC_SUBST(CFLAGS_WARNING)
-])
-
-#------------------------------------------------------------------------
-# SC_WITH_TCL --
-#
-# Location of the Tcl build directory.
-#
-# Arguments:
-# none
-#
-# Results:
-#
-# Adds the following arguments to configure:
-# --with-tcl=...
-#
-# Defines the following vars:
-# TCL_BIN_DIR Full path to the tcl build dir.
-#------------------------------------------------------------------------
-
-AC_DEFUN([SC_WITH_TCL], [
- if test -d ../../tcl8.6$1/win; then
- TCL_BIN_DEFAULT=../../tcl8.6$1/win
- else
- TCL_BIN_DEFAULT=../../tcl8.6/win
- fi
-
- AC_ARG_WITH(tcl, [ --with-tcl=DIR use Tcl 8.6 binaries from DIR],
- TCL_BIN_DIR=$withval, TCL_BIN_DIR=`cd $TCL_BIN_DEFAULT; pwd`)
- if test ! -d $TCL_BIN_DIR; then
- AC_MSG_ERROR(Tcl directory $TCL_BIN_DIR does not exist)
- fi
- if test ! -f $TCL_BIN_DIR/Makefile; then
- AC_MSG_ERROR(There is no Makefile in $TCL_BIN_DIR: perhaps you did not specify the Tcl *build* directory (not the toplevel Tcl directory) or you forgot to configure Tcl?)
- else
- echo "building against Tcl binaries in: $TCL_BIN_DIR"
- fi
- AC_SUBST(TCL_BIN_DIR)
-])
-
-#------------------------------------------------------------------------
-# SC_PROG_TCLSH
-# Locate a tclsh shell installed on the system path. This macro
-# will only find a Tcl shell that already exists on the system.
-# It will not find a Tcl shell in the Tcl build directory or
-# a Tcl shell that has been installed from the Tcl build directory.
-# If a Tcl shell can't be located on the PATH, then TCLSH_PROG will
-# be set to "". Extensions should take care not to create Makefile
-# rules that are run by default and depend on TCLSH_PROG. An
-# extension can't assume that an executable Tcl shell exists at
-# build time.
-#
-# Arguments
-# none
-#
-# Results
-# Subst's the following values:
-# TCLSH_PROG
-#------------------------------------------------------------------------
-
-AC_DEFUN([SC_PROG_TCLSH], [
- AC_MSG_CHECKING([for tclsh])
-
- AC_CACHE_VAL(ac_cv_path_tclsh, [
- search_path=`echo ${PATH} | sed -e 's/:/ /g'`
- for dir in $search_path ; do
- for j in `ls -r $dir/tclsh[[8-9]]*.exe 2> /dev/null` \
- `ls -r $dir/tclsh* 2> /dev/null` ; do
- if test x"$ac_cv_path_tclsh" = x ; then
- if test -f "$j" ; then
- ac_cv_path_tclsh=$j
- break
- fi
- fi
- done
- done
- ])
-
- if test -f "$ac_cv_path_tclsh" ; then
- TCLSH_PROG="$ac_cv_path_tclsh"
- AC_MSG_RESULT($TCLSH_PROG)
- else
- # It is not an error if an installed version of Tcl can't be located.
- TCLSH_PROG=""
- AC_MSG_RESULT([No tclsh found on PATH])
- fi
- AC_SUBST(TCLSH_PROG)
-])
-
-#------------------------------------------------------------------------
-# SC_BUILD_TCLSH
-# Determine the fully qualified path name of the tclsh executable
-# in the Tcl build directory. This macro will correctly determine
-# the name of the tclsh executable even if tclsh has not yet
-# been built in the build directory. The build tclsh must be used
-# when running tests from an extension build directory. It is not
-# correct to use the TCLSH_PROG in cases like this.
-#
-# Arguments
-# none
-#
-# Results
-# Subst's the following values:
-# BUILD_TCLSH
-#------------------------------------------------------------------------
-
-AC_DEFUN([SC_BUILD_TCLSH], [
- AC_MSG_CHECKING([for tclsh in Tcl build directory])
- BUILD_TCLSH=${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}${TCL_DBGX}${EXEEXT}
- AC_MSG_RESULT($BUILD_TCLSH)
- AC_SUBST(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
-#
-# Arguments:
-# An optional manifest to merge into DLL/EXE.
-#
-# Results:
-# Will define the following vars:
-# VC_MANIFEST_EMBED_DLL
-# VC_MANIFEST_EMBED_EXE
-#
-#--------------------------------------------------------------------
-
-AC_DEFUN([SC_EMBED_MANIFEST], [
- AC_MSG_CHECKING(whether to embed manifest)
- AC_ARG_ENABLE(embedded-manifest,
- AC_HELP_STRING([--enable-embedded-manifest],
- [embed manifest if possible (default: yes)]),
- [embed_ok=$enableval], [embed_ok=yes])
-
- 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
- AC_EGREP_CPP([manifest needed], [
-#if defined(_MSC_VER) && _MSC_VER >= 1400
-print("manifest needed")
-#endif
- ], [
- # 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 $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)"
- fi
- ])
- fi
- AC_MSG_RESULT([$result])
- AC_SUBST(VC_MANIFEST_EMBED_DLL)
- AC_SUBST(VC_MANIFEST_EMBED_EXE)
-])
diff --git a/tcl8.6/win/tcl.rc b/tcl8.6/win/tcl.rc
deleted file mode 100644
index be5e0a7..0000000
--- a/tcl8.6/win/tcl.rc
+++ /dev/null
@@ -1,57 +0,0 @@
-// Version Resource Script
-//
-
-#include <winver.h>
-#include <tcl.h>
-
-//
-// build-up the name suffix that defines the type of build this is.
-//
-#if TCL_THREADS
-#define SUFFIX_THREADS "t"
-#else
-#define SUFFIX_THREADS ""
-#endif
-
-#if DEBUG && !UNCHECKED
-#define SUFFIX_DEBUG "g"
-#else
-#define SUFFIX_DEBUG ""
-#endif
-
-#define SUFFIX SUFFIX_THREADS SUFFIX_DEBUG
-
-
-LANGUAGE 0x9, 0x1 /* LANG_ENGLISH, SUBLANG_DEFAULT */
-
-VS_VERSION_INFO VERSIONINFO
- FILEVERSION TCL_MAJOR_VERSION,TCL_MINOR_VERSION,TCL_RELEASE_LEVEL,TCL_RELEASE_SERIAL
- PRODUCTVERSION TCL_MAJOR_VERSION,TCL_MINOR_VERSION,TCL_RELEASE_LEVEL,TCL_RELEASE_SERIAL
- FILEFLAGSMASK 0x3fL
-#ifdef DEBUG
- FILEFLAGS VS_FF_DEBUG
-#else
- FILEFLAGS 0x0L
-#endif
- FILEOS VOS__WINDOWS32
- FILETYPE VFT_DLL
- FILESUBTYPE 0x0L
-BEGIN
- BLOCK "StringFileInfo"
- BEGIN
- BLOCK "040904b0" /* LANG_ENGLISH/SUBLANG_ENGLISH_US, Unicode CP */
- BEGIN
- VALUE "FileDescription", "Tcl 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"
- VALUE "ProductName", "Tcl " TCL_VERSION " for Windows\0"
- VALUE "ProductVersion", TCL_PATCH_LEVEL
- END
- END
- BLOCK "VarFileInfo"
- BEGIN
- VALUE "Translation", 0x409, 1200
- END
-END
diff --git a/tcl8.6/win/tclAppInit.c b/tcl8.6/win/tclAppInit.c
deleted file mode 100644
index 2236da3..0000000
--- a/tcl8.6/win/tclAppInit.c
+++ /dev/null
@@ -1,340 +0,0 @@
-/*
- * tclAppInit.c --
- *
- * Provides a default version of the main program and Tcl_AppInit
- * procedure for tclsh and other Tcl-based applications (without Tk).
- * Note that this program must be built in Win32 console mode to work
- * properly.
- *
- * Copyright (c) 1993 The Regents of the University of California.
- * Copyright (c) 1994-1997 Sun Microsystems, Inc.
- * Copyright (c) 1998-1999 Scriptics Corporation.
- *
- * See the file "license.terms" for information on usage and redistribution of
- * this file, and for a DISCLAIMER OF ALL WARRANTIES.
- */
-
-#include "tcl.h"
-#define WIN32_LEAN_AND_MEAN
-#define STRICT /* See MSDN Article Q83456 */
-#include <windows.h>
-#undef STRICT
-#undef WIN32_LEAN_AND_MEAN
-#include <locale.h>
-#include <stdlib.h>
-#include <tchar.h>
-
-#ifdef TCL_TEST
-extern Tcl_PackageInitProc Tcltest_Init;
-extern Tcl_PackageInitProc Tcltest_SafeInit;
-#endif /* TCL_TEST */
-
-#if defined(STATIC_BUILD) && TCL_USE_STATIC_PACKAGES
-extern Tcl_PackageInitProc Registry_Init;
-extern Tcl_PackageInitProc Dde_Init;
-extern Tcl_PackageInitProc Dde_SafeInit;
-#endif
-
-#if defined(__GNUC__) || defined(TCL_BROKEN_MAINARGS)
-int _CRT_glob = 0;
-#endif /* __GNUC__ || TCL_BROKEN_MAINARGS */
-#ifdef TCL_BROKEN_MAINARGS
-static void setargv(int *argcPtr, TCHAR ***argvPtr);
-#endif /* TCL_BROKEN_MAINARGS */
-
-/*
- * The following #if block allows you to change the AppInit function by using
- * a #define of TCL_LOCAL_APPINIT instead of rewriting this entire file. The
- * #if checks for that #define and uses Tcl_AppInit if it does not exist.
- */
-
-#ifndef TCL_LOCAL_APPINIT
-#define TCL_LOCAL_APPINIT Tcl_AppInit
-#endif
-#ifndef MODULE_SCOPE
-# define MODULE_SCOPE extern
-#endif
-MODULE_SCOPE int TCL_LOCAL_APPINIT(Tcl_Interp *);
-
-/*
- * The following #if block allows you to change how Tcl finds the startup
- * script, prime the library or encoding paths, fiddle with the argv, etc.,
- * without needing to rewrite Tcl_Main()
- */
-
-#ifdef TCL_LOCAL_MAIN_HOOK
-MODULE_SCOPE int TCL_LOCAL_MAIN_HOOK(int *argc, TCHAR ***argv);
-#endif
-
-/*
- *----------------------------------------------------------------------
- *
- * main --
- *
- * This is the main program for the application.
- *
- * Results:
- * None: Tcl_Main never returns here, so this procedure never returns
- * either.
- *
- * Side effects:
- * Just about anything, since from here we call arbitrary Tcl code.
- *
- *----------------------------------------------------------------------
- */
-
-#ifdef TCL_BROKEN_MAINARGS
-int
-main(
- int argc, /* Number of command-line arguments. */
- char *dummy[]) /* Not used. */
-{
- TCHAR **argv;
-#else
-int
-_tmain(
- int argc, /* Number of command-line arguments. */
- TCHAR *argv[]) /* Values of command-line arguments. */
-{
-#endif
- TCHAR *p;
-
- /*
- * Set up the default locale to be standard "C" locale so parsing is
- * performed correctly.
- */
-
- setlocale(LC_ALL, "C");
-
-#ifdef TCL_BROKEN_MAINARGS
- /*
- * Get our args from the c-runtime. Ignore command line.
- */
-
- setargv(&argc, &argv);
-#endif
-
- /*
- * Forward slashes substituted for backslashes.
- */
-
- for (p = argv[0]; *p != '\0'; p++) {
- if (*p == '\\') {
- *p = '/';
- }
- }
-
-#ifdef TCL_LOCAL_MAIN_HOOK
- TCL_LOCAL_MAIN_HOOK(&argc, &argv);
-#endif
-
- Tcl_Main(argc, argv, TCL_LOCAL_APPINIT);
- 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.
- *
- * Results:
- * 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.
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_AppInit(
- Tcl_Interp *interp) /* Interpreter for application. */
-{
- if ((Tcl_Init)(interp) == TCL_ERROR) {
- return TCL_ERROR;
- }
-
-#if defined(STATIC_BUILD) && TCL_USE_STATIC_PACKAGES
- if (Registry_Init(interp) == TCL_ERROR) {
- return TCL_ERROR;
- }
- Tcl_StaticPackage(interp, "registry", Registry_Init, NULL);
-
- if (Dde_Init(interp) == TCL_ERROR) {
- return TCL_ERROR;
- }
- Tcl_StaticPackage(interp, "dde", Dde_Init, Dde_SafeInit);
-#endif
-
-#ifdef TCL_TEST
- if (Tcltest_Init(interp) == TCL_ERROR) {
- return TCL_ERROR;
- }
- Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init, Tcltest_SafeInit);
-#endif /* TCL_TEST */
-
- /*
- * Call the init procedures for included packages. Each call should look
- * like this:
- *
- * if (Mod_Init(interp) == TCL_ERROR) {
- * return TCL_ERROR;
- * }
- *
- * where "Mod" is the name of the module. (Dynamically-loadable packages
- * should have the same entry-point name.)
- */
-
- /*
- * Call Tcl_CreateCommand for application-specific commands, if they
- * weren't already created by the init procedures called above.
- */
-
- /*
- * Specify a user-specific startup file to invoke if the application is
- * run interactively. Typically the startup file is "~/.apprc" where "app"
- * is the name of the application. If this line is deleted then no
- * user-specific startup file will be run under any conditions.
- */
-
- (Tcl_ObjSetVar2)(interp, Tcl_NewStringObj("tcl_rcFileName", -1), NULL,
- Tcl_NewStringObj("~/tclshrc.tcl", -1), TCL_GLOBAL_ONLY);
- return TCL_OK;
-}
-
-/*
- *-------------------------------------------------------------------------
- *
- * 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.
- *
- * 2N backslashes + quote -> N backslashes + begin quoted string
- * 2N + 1 backslashes + quote -> literal
- * N backslashes + non-quote -> literal
- * quote + quote in a quoted string -> single quote
- * quote + quote not in quoted string -> empty string
- * quote -> begin quoted string
- *
- * Results:
- * Fills argcPtr with the number of arguments and argvPtr with the array
- * of arguments.
- *
- * Side effects:
- * Memory allocated.
- *
- *--------------------------------------------------------------------------
- */
-
-#ifdef TCL_BROKEN_MAINARGS
-static void
-setargv(
- int *argcPtr, /* Filled with number of argument strings. */
- TCHAR ***argvPtr) /* Filled with argument strings (malloc'd). */
-{
- TCHAR *cmdLine, *p, *arg, *argSpace;
- TCHAR **argv;
- int argc, size, inquote, copy, slashes;
-
- cmdLine = GetCommandLine();
-
- /*
- * Precompute an overly pessimistic guess at the number of arguments in
- * the command line by counting non-space spans.
- */
-
- size = 2;
- for (p = cmdLine; *p != '\0'; p++) {
- if ((*p == ' ') || (*p == '\t')) { /* INTL: ISO space. */
- size++;
- while ((*p == ' ') || (*p == '\t')) { /* INTL: ISO space. */
- p++;
- }
- if (*p == '\0') {
- break;
- }
- }
- }
-
- /* Make sure we don't call ckalloc through the (not yet initialized) stub table */
- #undef Tcl_Alloc
- #undef Tcl_DbCkalloc
-
- argSpace = ckalloc(size * sizeof(char *)
- + (_tcslen(cmdLine) * sizeof(TCHAR)) + sizeof(TCHAR));
- argv = (TCHAR **) argSpace;
- argSpace += size * (sizeof(char *)/sizeof(TCHAR));
- size--;
-
- p = cmdLine;
- for (argc = 0; argc < size; argc++) {
- argv[argc] = arg = argSpace;
- while ((*p == ' ') || (*p == '\t')) { /* INTL: ISO space. */
- p++;
- }
- if (*p == '\0') {
- break;
- }
-
- inquote = 0;
- slashes = 0;
- while (1) {
- copy = 1;
- while (*p == '\\') {
- slashes++;
- p++;
- }
- if (*p == '"') {
- if ((slashes & 1) == 0) {
- copy = 0;
- if ((inquote) && (p[1] == '"')) {
- p++;
- copy = 1;
- } else {
- inquote = !inquote;
- }
- }
- slashes >>= 1;
- }
-
- while (slashes) {
- *arg = '\\';
- arg++;
- slashes--;
- }
-
- if ((*p == '\0') || (!inquote &&
- ((*p == ' ') || (*p == '\t')))) { /* INTL: ISO space. */
- break;
- }
- if (copy != 0) {
- *arg = *p;
- arg++;
- }
- p++;
- }
- *arg = '\0';
- argSpace = arg + 1;
- }
- argv[argc] = NULL;
-
- *argcPtr = argc;
- *argvPtr = argv;
-}
-#endif /* TCL_BROKEN_MAINARGS */
-
-/*
- * Local Variables:
- * mode: c
- * c-basic-offset: 4
- * fill-column: 78
- * End:
- */
diff --git a/tcl8.6/win/tclConfig.sh.in b/tcl8.6/win/tclConfig.sh.in
deleted file mode 100644
index 6ed06e2..0000000
--- a/tcl8.6/win/tclConfig.sh.in
+++ /dev/null
@@ -1,181 +0,0 @@
-# tclConfig.sh --
-#
-# This shell script (for sh) is generated automatically by Tcl's
-# configure script. It will create shell variables for most of
-# the configuration options discovered by the configure script.
-# This script is intended to be included by the configure scripts
-# for Tcl extensions so that they don't have to figure this all
-# out for themselves.
-#
-# The information in this file is specific to a single platform.
-
-TCL_DLL_FILE="@TCL_DLL_FILE@"
-
-# Tcl's version number.
-TCL_VERSION='@TCL_VERSION@'
-TCL_MAJOR_VERSION='@TCL_MAJOR_VERSION@'
-TCL_MINOR_VERSION='@TCL_MINOR_VERSION@'
-TCL_PATCH_LEVEL='@TCL_PATCH_LEVEL@'
-
-# C compiler to use for compilation.
-TCL_CC='@CC@'
-
-# -D flags for use with the C compiler.
-TCL_DEFS='@DEFS@'
-
-# If TCL was built with debugging symbols, generated libraries contain
-# this string at the end of the library name (before the extension).
-TCL_DBGX=@TCL_DBGX@
-
-# Default flags used in an optimized and debuggable build, respectively.
-TCL_CFLAGS_DEBUG='@CFLAGS_DEBUG@'
-TCL_CFLAGS_OPTIMIZE='@CFLAGS_OPTIMIZE@'
-
-# Default linker flags used in an optimized and debuggable build, respectively.
-TCL_LDFLAGS_DEBUG='@LDFLAGS_DEBUG@'
-TCL_LDFLAGS_OPTIMIZE='@LDFLAGS_OPTIMIZE@'
-
-# Flag, 1: we built a shared lib, 0 we didn't
-TCL_SHARED_BUILD=@TCL_SHARED_BUILD@
-
-# The name of the Tcl library (may be either a .a file or a shared library):
-TCL_LIB_FILE='@TCL_LIB_FILE@'
-
-# Flag to indicate whether shared libraries need export files.
-TCL_NEEDS_EXP_FILE=@TCL_NEEDS_EXP_FILE@
-
-# String that can be evaluated to generate the part of the export file
-# name that comes after the "libxxx" (includes version number, if any,
-# extension, and anything else needed). May depend on the variables
-# VERSION. On most UNIX systems this is ${VERSION}.exp.
-TCL_EXPORT_FILE_SUFFIX='@CFG_TCL_EXPORT_FILE_SUFFIX@'
-
-# Additional libraries to use when linking Tcl.
-TCL_LIBS='@LIBS@'
-
-# Top-level directory in which Tcl's platform-independent files are
-# installed.
-TCL_PREFIX='@prefix@'
-
-# Top-level directory in which Tcl's platform-specific files (e.g.
-# executables) are installed.
-TCL_EXEC_PREFIX='@exec_prefix@'
-
-# Flags to pass to cc when compiling the components of a shared library:
-TCL_SHLIB_CFLAGS='@SHLIB_CFLAGS@'
-
-# Flags to pass to cc to get warning messages
-TCL_CFLAGS_WARNING='@CFLAGS_WARNING@'
-
-# Extra flags to pass to cc:
-TCL_EXTRA_CFLAGS='@EXTRA_CFLAGS@'
-
-# Base command to use for combining object files into a shared library:
-TCL_SHLIB_LD='@SHLIB_LD@'
-
-# Base command to use for combining object files into a static library:
-TCL_STLIB_LD='@STLIB_LD@'
-
-# Either '$LIBS' (if dependent libraries should be included when linking
-# shared libraries) or an empty string. See Tcl's configure.in for more
-# explanation.
-TCL_SHLIB_LD_LIBS='@SHLIB_LD_LIBS@'
-
-# Suffix to use for the name of a shared library.
-TCL_SHLIB_SUFFIX='@SHLIB_SUFFIX@'
-
-# Library file(s) to include in tclsh and other base applications
-# in order to provide facilities needed by DLOBJ above.
-TCL_DL_LIBS='@DL_LIBS@'
-
-# Flags to pass to the compiler when linking object files into
-# an executable tclsh or tcltest binary.
-TCL_LD_FLAGS='@LDFLAGS@'
-
-# Flags to pass to cc/ld, such as "-R /usr/local/tcl/lib", that tell the
-# run-time dynamic linker where to look for shared libraries such as
-# libtcl.so. Used when linking applications. Only works if there
-# is a variable "LIB_RUNTIME_DIR" defined in the Makefile.
-TCL_CC_SEARCH_FLAGS='@TCL_CC_SEARCH_FLAGS@'
-TCL_LD_SEARCH_FLAGS='@TCL_LD_SEARCH_FLAGS@'
-
-# Additional object files linked with Tcl to provide compatibility
-# with standard facilities from ANSI C or POSIX.
-TCL_COMPAT_OBJS='@LIBOBJS@'
-
-# Name of the ranlib program to use.
-TCL_RANLIB='@RANLIB@'
-
-# -l flag to pass to the linker to pick up the Tcl library
-TCL_LIB_FLAG='@TCL_LIB_FLAG@'
-
-# String to pass to linker to pick up the Tcl library from its
-# build directory.
-TCL_BUILD_LIB_SPEC='@TCL_BUILD_LIB_SPEC@'
-
-# String to pass to linker to pick up the Tcl library from its
-# installed directory.
-TCL_LIB_SPEC='@TCL_LIB_SPEC@'
-
-# String to pass to the compiler so that an extension can
-# find installed Tcl headers.
-TCL_INCLUDE_SPEC='@TCL_INCLUDE_SPEC@'
-
-# Indicates whether a version numbers should be used in -l switches
-# ("ok" means it's safe to use switches like -ltcl7.5; "nodots" means
-# use switches like -ltcl75). SunOS and FreeBSD require "nodots", for
-# example.
-TCL_LIB_VERSIONS_OK='@TCL_LIB_VERSIONS_OK@'
-
-# String that can be evaluated to generate the part of a shared library
-# name that comes after the "libxxx" (includes version number, if any,
-# extension, and anything else needed). May depend on the variables
-# VERSION and SHLIB_SUFFIX. On most UNIX systems this is
-# ${VERSION}${SHLIB_SUFFIX}.
-TCL_SHARED_LIB_SUFFIX='@CFG_TCL_SHARED_LIB_SUFFIX@'
-
-# String that can be evaluated to generate the part of an unshared library
-# name that comes after the "libxxx" (includes version number, if any,
-# extension, and anything else needed). May depend on the variable
-# VERSION. On most UNIX systems this is ${VERSION}.a.
-TCL_UNSHARED_LIB_SUFFIX='@CFG_TCL_UNSHARED_LIB_SUFFIX@'
-
-# Location of the top-level source directory from which Tcl was built.
-# This is the directory that contains a README file as well as
-# subdirectories such as generic, unix, etc. If Tcl was compiled in a
-# different place than the directory containing the source files, this
-# points to the location of the sources, not the location where Tcl was
-# compiled.
-TCL_SRC_DIR='@TCL_SRC_DIR@'
-
-# List of standard directories in which to look for packages during
-# "package require" commands. Contains the "prefix" directory plus also
-# the "exec_prefix" directory, if it is different.
-TCL_PACKAGE_PATH='@TCL_PACKAGE_PATH@'
-
-# Tcl supports stub.
-TCL_SUPPORTS_STUBS=1
-
-# The name of the Tcl stub library (.a):
-TCL_STUB_LIB_FILE='@TCL_STUB_LIB_FILE@'
-
-# -l flag to pass to the linker to pick up the Tcl stub library
-TCL_STUB_LIB_FLAG='@TCL_STUB_LIB_FLAG@'
-
-# String to pass to linker to pick up the Tcl stub library from its
-# build directory.
-TCL_BUILD_STUB_LIB_SPEC='@TCL_BUILD_STUB_LIB_SPEC@'
-
-# String to pass to linker to pick up the Tcl stub library from its
-# installed directory.
-TCL_STUB_LIB_SPEC='@TCL_STUB_LIB_SPEC@'
-
-# Path to the Tcl stub library in the build directory.
-TCL_BUILD_STUB_LIB_PATH='@TCL_BUILD_STUB_LIB_PATH@'
-
-# Path to the Tcl stub library in the install directory.
-TCL_STUB_LIB_PATH='@TCL_STUB_LIB_PATH@'
-
-# Flag, 1: we built Tcl with threads enabled, 0 we didn't
-TCL_THREADS=@TCL_THREADS@
-
diff --git a/tcl8.6/win/tclWin32Dll.c b/tcl8.6/win/tclWin32Dll.c
deleted file mode 100644
index 6fc2401..0000000
--- a/tcl8.6/win/tclWin32Dll.c
+++ /dev/null
@@ -1,792 +0,0 @@
-/*
- * tclWin32Dll.c --
- *
- * 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.
- */
-
-#include "tclWinInt.h"
-#if defined(HAVE_INTRIN_H)
-# include <intrin.h>
-#endif
-
-/*
- * 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? */
-
-/*
- * VC++ 5.x has no 'cpuid' assembler instruction, so we must emulate it
- */
-
-#if defined(_MSC_VER) && (_MSC_VER <= 1100) && defined (_M_IX86)
-#define cpuid __asm __emit 0fh __asm __emit 0a2h
-#endif
-
-/*
- * The following declaration is for the VC++ DLL entry point.
- */
-
-BOOL APIENTRY DllMain(HINSTANCE hInst, DWORD reason,
- LPVOID reserved);
-
-/*
- * 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).
- */
-
-typedef struct MountPointMap {
- TCHAR *volumeName; /* Native wide string volume name. */
- TCHAR driveLetter; /* Drive letter corresponding to the volume
- * name. */
- struct MountPointMap *nextPtr;
- /* Pointer to next structure in list, or
- * NULL. */
-} MountPointMap;
-
-/*
- * 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.
- */
-
-#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.
- *
- * Results:
- * See DllMain.
- *
- * Side effects:
- * See DllMain.
- *
- *----------------------------------------------------------------------
- */
-
-BOOL APIENTRY
-DllEntryPoint(
- HINSTANCE hInst, /* Library instance handle. */
- DWORD reason, /* Reason this function is being called. */
- LPVOID reserved) /* Not used. */
-{
- return DllMain(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.
- *
- * Results:
- * TRUE on sucess, FALSE on failure.
- *
- * Side effects:
- * Initializes most rudimentary Windows bits.
- *
- *----------------------------------------------------------------------
- */
-
-BOOL APIENTRY
-DllMain(
- HINSTANCE hInst, /* Library instance handle. */
- DWORD reason, /* Reason this function is being called. */
- LPVOID reserved) /* Not used. */
-{
- switch (reason) {
- case DLL_PROCESS_ATTACH:
- DisableThreadLibraryCalls(hInst);
- TclWinInit(hInst);
- return TRUE;
-
- /*
- * DLL_PROCESS_DETACH is unnecessary as the user should call
- * Tcl_Finalize explicitly before unloading Tcl.
- */
- }
-
- return TRUE;
-}
-#endif /* !STATIC_BUILD */
-#endif /* _WIN32 */
-
-/*
- *----------------------------------------------------------------------
- *
- * TclWinGetTclInstance --
- *
- * Retrieves the global library instance handle.
- *
- * Results:
- * Returns the global library instance handle.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-HINSTANCE
-TclWinGetTclInstance(void)
-{
- return hInstance;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclWinInit --
- *
- * This function initializes the internal state of the tcl library.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Initializes the tclPlatformId variable.
- *
- *----------------------------------------------------------------------
- */
-
-void
-TclWinInit(
- HINSTANCE hInst) /* Library instance handle. */
-{
- OSVERSIONINFOW os;
-
- hInstance = hInst;
- os.dwOSVersionInfoSize = sizeof(OSVERSIONINFOW);
- GetVersionExW(&os);
- platformId = os.dwPlatformId;
-
- /*
- * We no longer support Win32s or Win9x, so just in case someone manages
- * to get a runtime there, make sure they know that.
- */
-
- if (platformId == VER_PLATFORM_WIN32s) {
- Tcl_Panic("Win32s is not a supported platform");
- }
- if (platformId == VER_PLATFORM_WIN32_WINDOWS) {
- Tcl_Panic("Windows 9x is not a supported platform");
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclWinGetPlatformId --
- *
- * 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, 98, ME (not supported)
- * VER_PLATFORM_WIN32_NT Win32 on Windows NT, 2000, XP
- * VER_PLATFORM_WIN32_CE Win32 on Windows CE
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclWinGetPlatformId(void)
-{
- return platformId;
-}
-
-/*
- *-------------------------------------------------------------------------
- *
- * TclWinNoBackslash --
- *
- * We're always iterating through a string in Windows, changing the
- * backslashes to slashes for use in Tcl.
- *
- * Results:
- * All backslashes in given string are changed to slashes.
- *
- * Side effects:
- * None.
- *
- *-------------------------------------------------------------------------
- */
-
-char *
-TclWinNoBackslash(
- char *path) /* String to change. */
-{
- char *p;
-
- for (p = path; *p != '\0'; p++) {
- if (*p == '\\') {
- *p = '/';
- }
- }
- return path;
-}
-
-/*
- *---------------------------------------------------------------------------
- *
- * TclpSetInterfaces --
- *
- * A helper proc.
- *
- * Results:
- * None.
- *
- * Side effects:
- * None.
- *
- *---------------------------------------------------------------------------
- */
-
-void
-TclpSetInterfaces(void)
-{
-}
-
-/*
- *---------------------------------------------------------------------------
- *
- * TclWinEncodingsCleanup --
- *
- * Called during finalization to free up any encodings we use.
- *
- * 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.
- *
- * Side effects:
- * None.
- *
- *---------------------------------------------------------------------------
- */
-
-void
-TclWinEncodingsCleanup(void)
-{
- MountPointMap *dlIter, *dlIter2;
-
- /*
- * Clean up the mount point map.
- */
-
- Tcl_MutexLock(&mountPointMap);
- dlIter = driveLetterLookup;
- while (dlIter != NULL) {
- dlIter2 = dlIter->nextPtr;
- ckfree(dlIter->volumeName);
- ckfree(dlIter);
- dlIter = dlIter2;
- }
- Tcl_MutexUnlock(&mountPointMap);
-}
-
-/*
- *---------------------------------------------------------------------------
- *
- * TclWinResetInterfaces --
- *
- * Called during finalization to reset us to a safe state for reuse.
- *
- * Results:
- * None.
- *
- * Side effects:
- * None.
- *
- *---------------------------------------------------------------------------
- */
-void
-TclWinResetInterfaces(void)
-{
-}
-
-/*
- *--------------------------------------------------------------------
- *
- * 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.
- *
- *--------------------------------------------------------------------
- */
-
-char
-TclWinDriveLetterForVolMountPoint(
- const TCHAR *mountPoint)
-{
- MountPointMap *dlIter, *dlPtr2;
- TCHAR Target[55]; /* Target of mount at mount point */
- TCHAR drive[4] = TEXT("A:\\");
-
- /*
- * Detect the volume mounted there. Unfortunately, there is no simple way
- * to map a unique volume name to a DOS drive letter. So, we have to build
- * an associative array.
- */
-
- Tcl_MutexLock(&mountPointMap);
- dlIter = driveLetterLookup;
- while (dlIter != NULL) {
- if (_tcscmp(dlIter->volumeName, mountPoint) == 0) {
- /*
- * We need to check whether this information is still valid, since
- * either the user or various programs could have adjusted the
- * mount points on the fly.
- */
-
- drive[0] = (TCHAR) dlIter->driveLetter;
-
- /*
- * Try to read the volume mount point and see where it points.
- */
-
- if (GetVolumeNameForVolumeMountPoint(drive,
- Target, 55) != 0) {
- if (_tcscmp(dlIter->volumeName, Target) == 0) {
- /*
- * Nothing has changed.
- */
-
- Tcl_MutexUnlock(&mountPointMap);
- return (char) dlIter->driveLetter;
- }
- }
-
- /*
- * 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) {
- if (dlPtr2->nextPtr == dlIter) {
- dlPtr2->nextPtr = dlIter->nextPtr;
- dlPtr2 = dlIter;
- break;
- }
- }
- }
-
- /*
- * Now dlPtr2 points to the structure to free.
- */
-
- ckfree(dlPtr2->volumeName);
- ckfree(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.
- */
-
- dlIter = driveLetterLookup;
- continue;
- }
- dlIter = dlIter->nextPtr;
- }
-
- /*
- * 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 (GetVolumeNameForVolumeMountPoint(drive,
- Target, 55) != 0) {
- int alreadyStored = 0;
-
- for (dlIter = driveLetterLookup; dlIter != NULL;
- dlIter = dlIter->nextPtr) {
- if (_tcscmp(dlIter->volumeName, Target) == 0) {
- alreadyStored = 1;
- break;
- }
- }
- if (!alreadyStored) {
- dlPtr2 = ckalloc(sizeof(MountPointMap));
- dlPtr2->volumeName = TclNativeDupInternalRep(Target);
- dlPtr2->driveLetter = (char) drive[0];
- dlPtr2->nextPtr = driveLetterLookup;
- driveLetterLookup = dlPtr2;
- }
- }
- }
-
- /*
- * Try again.
- */
-
- for (dlIter = driveLetterLookup; dlIter != NULL;
- dlIter = dlIter->nextPtr) {
- if (_tcscmp(dlIter->volumeName, mountPoint) == 0) {
- Tcl_MutexUnlock(&mountPointMap);
- return (char) 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.
- */
-
- dlPtr2 = ckalloc(sizeof(MountPointMap));
- dlPtr2->volumeName = TclNativeDupInternalRep((ClientData) mountPoint);
- dlPtr2->driveLetter = -1;
- dlPtr2->nextPtr = driveLetterLookup;
- driveLetterLookup = dlPtr2;
- Tcl_MutexUnlock(&mountPointMap);
- return -1;
-}
-
-/*
- *---------------------------------------------------------------------------
- *
- * Tcl_WinUtfToTChar, Tcl_WinTCharToUtf --
- *
- * Convert between UTF-8 and Unicode when running Windows.
- *
- * On Mac and Unix, all strings exchanged between Tcl and the OS are
- * "char" oriented. We need only one Tcl_Encoding to convert between
- * UTF-8 and the system's native encoding. We use NULL to represent
- * that encoding.
- *
- * On Windows, some strings exchanged between Tcl and the OS are "char"
- * oriented, while others are in Unicode. We need two Tcl_Encoding APIs
- * depending on whether we are targeting a "char" or Unicode interface.
- *
- * Calling Tcl_UtfToExternal() or Tcl_ExternalToUtf() with an encoding
- * of NULL should always used to convert between UTF-8 and the system's
- * "char" oriented encoding. The following two functions are used in
- * Windows-specific code to convert between UTF-8 and Unicode strings.
- * This saves you the trouble of writing the
- * following type of fragment over and over:
- *
- * encoding <- Tcl_GetEncoding("unicode");
- * nativeBuffer <- UtfToExternal(encoding, utfBuffer);
- * Tcl_FreeEncoding(encoding);
- *
- * By convention, in Windows a TCHAR is a Unicode character. If you plan
- * on targeting a Unicode interface when running on Windows, these
- * functions should be used. If you plan on targetting a "char" oriented
- * function on Windows, use Tcl_UtfToExternal() with an encoding of NULL.
- *
- * Results:
- * The result is a pointer to the string in the desired target encoding.
- * Storage for the result string is allocated in dsPtr; the caller must
- * call Tcl_DStringFree() when the result is no longer needed.
- *
- * Side effects:
- * None.
- *
- *---------------------------------------------------------------------------
- */
-
-TCHAR *
-Tcl_WinUtfToTChar(
- const char *string, /* Source string in UTF-8. */
- int len, /* Source string length in bytes, or -1 for
- * strlen(). */
- Tcl_DString *dsPtr) /* Uninitialized or free DString in which the
- * converted string is stored. */
-{
- Tcl_DStringInit(dsPtr);
- if (!string) {
- return NULL;
- }
- return Tcl_UtfToUniCharDString(string, len, dsPtr);
-}
-
-char *
-Tcl_WinTCharToUtf(
- const TCHAR *string, /* Source string in Unicode. */
- int len, /* Source string length in bytes, or -1 for
- * platform-specific string length. */
- Tcl_DString *dsPtr) /* Uninitialized or free DString in which the
- * converted string is stored. */
-{
- Tcl_DStringInit(dsPtr);
- if (!string) {
- return NULL;
- }
- if (len < 0) {
- len = wcslen(string);
- } else {
- len /= 2;
- }
- return Tcl_UniCharToUtfDString(string, len, dsPtr);
-}
-
-/*
- *------------------------------------------------------------------------
- *
- * TclWinCPUID --
- *
- * Get CPU ID information on an Intel box under Windows
- *
- * Results:
- * Returns TCL_OK if successful, TCL_ERROR if CPUID is not supported or
- * fails.
- *
- * Side effects:
- * If successful, stores EAX, EBX, ECX and EDX registers after the CPUID
- * instruction in the four integers designated by 'regsPtr'
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclWinCPUID(
- unsigned int index, /* Which CPUID value to retrieve. */
- unsigned int *regsPtr) /* Registers after the CPUID. */
-{
- int status = TCL_ERROR;
-
-#if defined(HAVE_INTRIN_H) && defined(_WIN64)
-
- __cpuid((int *)regsPtr, index);
- status = TCL_OK;
-
-#elif defined(__GNUC__)
-# if defined(_WIN64)
- /*
- * Execute the CPUID instruction with the given index, and store results
- * off 'regPtr'.
- */
-
- __asm__ __volatile__(
- /*
- * Do the CPUID instruction, and save the results in the 'regsPtr'
- * area.
- */
-
- "movl %[rptr], %%edi" "\n\t"
- "movl %[index], %%eax" "\n\t"
- "cpuid" "\n\t"
- "movl %%eax, 0x0(%%edi)" "\n\t"
- "movl %%ebx, 0x4(%%edi)" "\n\t"
- "movl %%ecx, 0x8(%%edi)" "\n\t"
- "movl %%edx, 0xc(%%edi)" "\n\t"
-
- :
- /* No outputs */
- :
- [index] "m" (index),
- [rptr] "m" (regsPtr)
- :
- "%eax", "%ebx", "%ecx", "%edx", "%esi", "%edi", "memory");
- status = TCL_OK;
-
-# else
-
- TCLEXCEPTION_REGISTRATION registration;
-
- /*
- * Execute the CPUID instruction with the given index, and store results
- * off 'regPtr'.
- */
-
- __asm__ __volatile__(
- /*
- * Construct an TCLEXCEPTION_REGISTRATION to protect the CPUID
- * instruction (early 486's don't have CPUID)
- */
-
- "leal %[registration], %%edx" "\n\t"
- "movl %%fs:0, %%eax" "\n\t"
- "movl %%eax, 0x0(%%edx)" "\n\t" /* link */
- "leal 1f, %%eax" "\n\t"
- "movl %%eax, 0x4(%%edx)" "\n\t" /* handler */
- "movl %%ebp, 0x8(%%edx)" "\n\t" /* ebp */
- "movl %%esp, 0xc(%%edx)" "\n\t" /* esp */
- "movl %[error], 0x10(%%edx)" "\n\t" /* status */
-
- /*
- * Link the TCLEXCEPTION_REGISTRATION on the chain
- */
-
- "movl %%edx, %%fs:0" "\n\t"
-
- /*
- * Do the CPUID instruction, and save the results in the 'regsPtr'
- * area.
- */
-
- "movl %[rptr], %%edi" "\n\t"
- "movl %[index], %%eax" "\n\t"
- "cpuid" "\n\t"
- "movl %%eax, 0x0(%%edi)" "\n\t"
- "movl %%ebx, 0x4(%%edi)" "\n\t"
- "movl %%ecx, 0x8(%%edi)" "\n\t"
- "movl %%edx, 0xc(%%edi)" "\n\t"
-
- /*
- * Come here on a normal exit. Recover the TCLEXCEPTION_REGISTRATION and
- * store a TCL_OK status.
- */
-
- "movl %%fs:0, %%edx" "\n\t"
- "movl %[ok], %%eax" "\n\t"
- "movl %%eax, 0x10(%%edx)" "\n\t"
- "jmp 2f" "\n"
-
- /*
- * Come here on an exception. Get the TCLEXCEPTION_REGISTRATION that we
- * previously put on the chain.
- */
-
- "1:" "\t"
- "movl %%fs:0, %%edx" "\n\t"
- "movl 0x8(%%edx), %%edx" "\n\t"
-
- /*
- * Come here however we exited. Restore context from the
- * TCLEXCEPTION_REGISTRATION in case the stack is unbalanced.
- */
-
- "2:" "\t"
- "movl 0xc(%%edx), %%esp" "\n\t"
- "movl 0x8(%%edx), %%ebp" "\n\t"
- "movl 0x0(%%edx), %%eax" "\n\t"
- "movl %%eax, %%fs:0" "\n\t"
-
- :
- /* No outputs */
- :
- [index] "m" (index),
- [rptr] "m" (regsPtr),
- [registration] "m" (registration),
- [ok] "i" (TCL_OK),
- [error] "i" (TCL_ERROR)
- :
- "%eax", "%ebx", "%ecx", "%edx", "%esi", "%edi", "memory");
- status = registration.status;
-
-# endif /* !_WIN64 */
-#elif defined(_MSC_VER)
-# if defined(_WIN64)
-
- __cpuid(regsPtr, index);
- status = TCL_OK;
-
-# elif defined (_M_IX86)
- /*
- * Define a structure in the stack frame to hold the registers.
- */
-
- struct {
- DWORD dw0;
- DWORD dw1;
- DWORD dw2;
- DWORD dw3;
- } regs;
- regs.dw0 = index;
-
- /*
- * Execute the CPUID instruction and save regs in the stack frame.
- */
-
- _try {
- _asm {
- push ebx
- push ecx
- push edx
- mov eax, regs.dw0
- cpuid
- mov regs.dw0, eax
- mov regs.dw1, ebx
- mov regs.dw2, ecx
- mov regs.dw3, edx
- pop edx
- pop ecx
- pop ebx
- }
-
- /*
- * Copy regs back out to the caller.
- */
-
- regsPtr[0] = regs.dw0;
- regsPtr[1] = regs.dw1;
- regsPtr[2] = regs.dw2;
- regsPtr[3] = regs.dw3;
-
- status = TCL_OK;
- } __except(EXCEPTION_EXECUTE_HANDLER) {
- /* do nothing */
- }
-
-# endif
-#else
- /*
- * Don't know how to do assembly code for this compiler and/or
- * architecture.
- */
-#endif
- return status;
-}
-
-/*
- * Local Variables:
- * mode: c
- * c-basic-offset: 4
- * fill-column: 78
- * End:
- */
diff --git a/tcl8.6/win/tclWinChan.c b/tcl8.6/win/tclWinChan.c
deleted file mode 100644
index 78b510b..0000000
--- a/tcl8.6/win/tclWinChan.c
+++ /dev/null
@@ -1,1588 +0,0 @@
-/*
- * tclWinChan.c
- *
- * 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.
- */
-
-#include "tclWinInt.h"
-#include "tclIO.h"
-
-/*
- * State flags used in the info structures below.
- */
-
-#define FILE_PENDING (1<<0) /* Message is pending in the queue. */
-#define FILE_ASYNC (1<<1) /* Channel is non-blocking. */
-#define FILE_APPEND (1<<2) /* File is in append mode. */
-
-#define FILE_TYPE_SERIAL (FILE_TYPE_PIPE+1)
-#define FILE_TYPE_CONSOLE (FILE_TYPE_PIPE+2)
-
-/*
- * The following structure contains per-instance data for a file based channel.
- */
-
-typedef struct FileInfo {
- 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. */
- 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. */
-} FileInfo;
-
-typedef struct ThreadSpecificData {
- /*
- * List of all file channels currently open.
- */
-
- FileInfo *firstFilePtr;
-} ThreadSpecificData;
-
-static Tcl_ThreadDataKey dataKey;
-
-/*
- * 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
- * pointer. */
-} FileEvent;
-
-/*
- * Static routines for this file:
- */
-
-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);
-static int NativeIsComPort(const TCHAR *nativeName);
-/*
- * This structure describes the channel type structure for file based IO.
- */
-
-static const Tcl_ChannelType fileChannelType = {
- "file", /* Type name. */
- TCL_CHANNEL_VERSION_5, /* v5 channel */
- FileCloseProc, /* Close proc. */
- FileInputProc, /* Input proc. */
- FileOutputProc, /* Output proc. */
- FileSeekProc, /* Seek proc. */
- NULL, /* Set option proc. */
- NULL, /* Get option proc. */
- FileWatchProc, /* Set up the notifier to watch the channel. */
- FileGetHandleProc, /* Get an OS handle from channel. */
- NULL, /* close2proc. */
- FileBlockProc, /* Set blocking or non-blocking mode.*/
- NULL, /* flush proc. */
- NULL, /* handler proc. */
- FileWideSeekProc, /* Wide seek proc. */
- FileThreadActionProc, /* Thread action proc. */
- FileTruncateProc /* Truncate proc. */
-};
-
-/*
- *----------------------------------------------------------------------
- *
- * FileInit --
- *
- * This function creates the window used to simulate file events.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Creates a new window and creates an exit handler.
- *
- *----------------------------------------------------------------------
- */
-
-static ThreadSpecificData *
-FileInit(void)
-{
- ThreadSpecificData *tsdPtr =
- (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
-
- if (tsdPtr == NULL) {
- tsdPtr = TCL_TSD_INIT(&dataKey);
- tsdPtr->firstFilePtr = NULL;
- Tcl_CreateEventSource(FileSetupProc, FileCheckProc, NULL);
- Tcl_CreateThreadExitHandler(FileChannelExitHandler, NULL);
- }
- return tsdPtr;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * FileChannelExitHandler --
- *
- * This function is called to cleanup the channel driver before Tcl is
- * unloaded.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Destroys the communication window.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-FileChannelExitHandler(
- ClientData clientData) /* Old window proc */
-{
- Tcl_DeleteEventSource(FileSetupProc, FileCheckProc, NULL);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * FileSetupProc --
- *
- * This function is invoked before Tcl_DoOneEvent blocks waiting for an
- * event.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Adjusts the block time if needed.
- *
- *----------------------------------------------------------------------
- */
-
-void
-FileSetupProc(
- ClientData data, /* Not used. */
- int flags) /* Event flags as passed to Tcl_DoOneEvent. */
-{
- FileInfo *infoPtr;
- Tcl_Time blockTime = { 0, 0 };
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-
- if (!(flags & TCL_FILE_EVENTS)) {
- return;
- }
-
- /*
- * Check to see if there is a ready file. If so, poll.
- */
-
- for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL;
- infoPtr = infoPtr->nextPtr) {
- if (infoPtr->watchMask) {
- Tcl_SetMaxBlockTime(&blockTime);
- break;
- }
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * FileCheckProc --
- *
- * This function is called by Tcl_DoOneEvent to check the file event
- * source for events.
- *
- * Results:
- * None.
- *
- * Side effects:
- * May queue an event.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-FileCheckProc(
- ClientData data, /* Not used. */
- int flags) /* Event flags as passed to Tcl_DoOneEvent. */
-{
- FileEvent *evPtr;
- FileInfo *infoPtr;
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-
- 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).
- */
-
- for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL;
- infoPtr = infoPtr->nextPtr) {
- if (infoPtr->watchMask && !(infoPtr->flags & FILE_PENDING)) {
- infoPtr->flags |= FILE_PENDING;
- evPtr = ckalloc(sizeof(FileEvent));
- evPtr->header.proc = FileEventProc;
- evPtr->infoPtr = infoPtr;
- Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
- }
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * FileEventProc --
- *
- * 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.
- *
- * Side effects:
- * Whatever the notifier callback does.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-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;
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-
- if (!(flags & TCL_FILE_EVENTS)) {
- return 0;
- }
-
- /*
- * 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.
- */
-
- for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL;
- infoPtr = infoPtr->nextPtr) {
- if (fileEvPtr->infoPtr == infoPtr) {
- infoPtr->flags &= ~(FILE_PENDING);
- Tcl_NotifyChannel(infoPtr->channel, infoPtr->watchMask);
- break;
- }
- }
- return 1;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * FileBlockProc --
- *
- * Set blocking or non-blocking mode on channel.
- *
- * Results:
- * 0 if successful, errno when failed.
- *
- * Side effects:
- * Sets the device into blocking or non-blocking mode.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-FileBlockProc(
- ClientData instanceData, /* Instance data for channel. */
- int mode) /* TCL_MODE_BLOCKING or
- * TCL_MODE_NONBLOCKING. */
-{
- FileInfo *infoPtr = 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
- * 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) {
- infoPtr->flags |= FILE_ASYNC;
- } else {
- infoPtr->flags &= ~(FILE_ASYNC);
- }
- return 0;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * FileCloseProc --
- *
- * Closes the IO channel.
- *
- * Results:
- * 0 if successful, the value of errno if failed.
- *
- * Side effects:
- * Closes the physical channel
- *
- *----------------------------------------------------------------------
- */
-
-static int
-FileCloseProc(
- ClientData instanceData, /* Pointer to FileInfo structure. */
- Tcl_Interp *interp) /* Not used. */
-{
- FileInfo *fileInfoPtr = instanceData;
- FileInfo *infoPtr;
- ThreadSpecificData *tsdPtr;
- int errorCode = 0;
-
- /*
- * Remove the file from the watch list.
- */
-
- 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.
- */
-
- if (!TclInThreadExit()
- || ((GetStdHandle(STD_INPUT_HANDLE) != fileInfoPtr->handle)
- && (GetStdHandle(STD_OUTPUT_HANDLE) != fileInfoPtr->handle)
- && (GetStdHandle(STD_ERROR_HANDLE) != fileInfoPtr->handle))) {
- if (CloseHandle(fileInfoPtr->handle) == FALSE) {
- TclWinConvertError(GetLastError());
- errorCode = errno;
- }
- }
-
- /*
- * See if this FileInfo* is still on the thread local list.
- */
-
- tsdPtr = TCL_TSD_INIT(&dataKey);
- 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 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;
- }
- }
- ckfree(fileInfoPtr);
- return errorCode;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * FileSeekProc --
- *
- * Seeks on a file-based channel. Returns the new position.
- *
- * Results:
- * -1 if failed, the new position if successful. If failed, it also sets
- * *errorCodePtr to the error code.
- *
- * Side effects:
- * Moves the location at which the channel will be accessed in future
- * operations.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-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 = instanceData;
- LONG newPos, newPosHigh, oldPos, oldPosHigh;
- DWORD moveMethod;
-
- *errorCodePtr = 0;
- if (mode == SEEK_SET) {
- moveMethod = FILE_BEGIN;
- } else if (mode == SEEK_CUR) {
- moveMethod = FILE_CURRENT;
- } else {
- moveMethod = FILE_END;
- }
-
- /*
- * Save our current place in case we need to roll-back the seek.
- */
-
- oldPosHigh = 0;
- oldPos = SetFilePointer(infoPtr->handle, 0, &oldPosHigh, FILE_CURRENT);
- if (oldPos == (LONG)INVALID_SET_FILE_POINTER) {
- DWORD winError = GetLastError();
-
- if (winError != NO_ERROR) {
- TclWinConvertError(winError);
- *errorCodePtr = errno;
- return -1;
- }
- }
-
- newPosHigh = (offset < 0 ? -1 : 0);
- newPos = SetFilePointer(infoPtr->handle, offset, &newPosHigh, moveMethod);
- if (newPos == (LONG)INVALID_SET_FILE_POINTER) {
- DWORD winError = GetLastError();
-
- if (winError != NO_ERROR) {
- TclWinConvertError(winError);
- *errorCodePtr = errno;
- return -1;
- }
- }
-
- /*
- * Check for expressability in our return type, and roll-back otherwise.
- */
-
- if (newPosHigh != 0) {
- *errorCodePtr = EOVERFLOW;
- SetFilePointer(infoPtr->handle, oldPos, &oldPosHigh, FILE_BEGIN);
- return -1;
- }
- return (int) newPos;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * FileWideSeekProc --
- *
- * Seeks on a file-based channel. Returns the new position.
- *
- * Results:
- * -1 if failed, the new position if successful. If failed, it also sets
- * *errorCodePtr to the error code.
- *
- * Side effects:
- * Moves the location at which the channel will be accessed in future
- * operations.
- *
- *----------------------------------------------------------------------
- */
-
-static Tcl_WideInt
-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 = instanceData;
- DWORD moveMethod;
- LONG newPos, newPosHigh;
-
- *errorCodePtr = 0;
- if (mode == SEEK_SET) {
- moveMethod = FILE_BEGIN;
- } else if (mode == SEEK_CUR) {
- moveMethod = FILE_CURRENT;
- } else {
- moveMethod = FILE_END;
- }
-
- 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;
- return -1;
- }
- }
- return (((Tcl_WideInt)((unsigned)newPos)) | (Tcl_LongAsWide(newPosHigh) << 32));
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * 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 = 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.
- *
- * Results:
- * 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.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-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 = instanceData;
- DWORD bytesRead;
-
- *errorCode = 0;
-
- /*
- * TODO: This comment appears to be out of date. We *do* have a
- * console driver, over in tclWinConsole.c. After some Windows
- * developer confirms, this comment should be revised.
- *
- * Note that we will block on reads from a console buffer until a full
- * line has been entered. The only way I know of to get around this is to
- * write a console driver. We should probably do this at some point, but
- * 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) {
- return bytesRead;
- }
-
- TclWinConvertError(GetLastError());
- *errorCode = errno;
- if (errno == EPIPE) {
- return 0;
- }
- return -1;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * FileOutputProc --
- *
- * 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.
- *
- * Side effects:
- * Writes output on the actual channel.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-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 = instanceData;
- DWORD bytesWritten;
-
- *errorCode = 0;
-
- /*
- * If we are writing to a file that was opened with O_APPEND, we need to
- * seek to the end of the file before writing the current buffer.
- */
-
- if (infoPtr->flags & FILE_APPEND) {
- 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;
- }
- infoPtr->dirty = 1;
- return bytesWritten;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * FileWatchProc --
- *
- * Called by the notifier to set up to watch for events on this channel.
- *
- * Results:
- * None.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-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 = 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.
- */
-
- infoPtr->watchMask = mask & infoPtr->validMask;
- if (infoPtr->watchMask) {
- Tcl_SetMaxBlockTime(&blockTime);
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * FileGetHandleProc --
- *
- * 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.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-FileGetHandleProc(
- ClientData instanceData, /* The file state. */
- int direction, /* TCL_READABLE or TCL_WRITABLE */
- ClientData *handlePtr) /* Where to store the handle. */
-{
- FileInfo *infoPtr = instanceData;
-
- if (direction & infoPtr->validMask) {
- *handlePtr = (ClientData) infoPtr->handle;
- return TCL_OK;
- } else {
- return TCL_ERROR;
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclpOpenFileChannel --
- *
- * 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.
- *
- * Side effects:
- * May open the channel and may cause creation of a file on the file
- * system.
- *
- *----------------------------------------------------------------------
- */
-
-Tcl_Channel
-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;
- DWORD accessMode = 0, createMode, shareMode, flags;
- const TCHAR *nativeName;
- HANDLE handle;
- char channelName[16 + TCL_INTEGER_SPACE];
- TclFile readFile = NULL, writeFile = NULL;
-
- nativeName = Tcl_FSGetNativePath(pathPtr);
- if (nativeName == NULL) {
- if (interp != (Tcl_Interp *) NULL) {
- Tcl_AppendResult(interp, "couldn't open \"",
- TclGetString(pathPtr), "\": filename is invalid on this platform",
- 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:
- Tcl_Panic("TclpOpenFileChannel: invalid mode value");
- break;
- }
-
- /*
- * Map the creation flags to the NT create 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;
- }
-
- /*
- * [2413550] Avoid double-open of serial ports on Windows
- * Special handling for Windows serial ports by a "name-hint"
- * to directly open it with the OVERLAPPED flag set.
- */
-
- if( NativeIsComPort(nativeName) ) {
-
- handle = TclWinSerialOpen(INVALID_HANDLE_VALUE, nativeName, accessMode);
- if (handle == INVALID_HANDLE_VALUE) {
- TclWinConvertError(GetLastError());
- if (interp != (Tcl_Interp *) NULL) {
- Tcl_AppendResult(interp, "couldn't open serial \"",
- TclGetString(pathPtr), "\": ",
- Tcl_PosixError(interp), NULL);
- }
- return NULL;
- }
-
- /*
- * For natively named Windows serial ports we are done.
- */
- channel = TclWinOpenSerialChannel(handle, channelName,
- channelPermissions);
-
- return channel;
- }
- /*
- * If the file is being created, get the file attributes from the
- * permissions argument, else use the existing file attributes.
- */
-
- if (mode & O_CREAT) {
- if (permissions & S_IWRITE) {
- flags = FILE_ATTRIBUTE_NORMAL;
- } else {
- flags = FILE_ATTRIBUTE_READONLY;
- }
- } else {
- flags = GetFileAttributes(nativeName);
- if (flags == 0xFFFFFFFF) {
- flags = 0;
- }
- }
-
- /*
- * Set up the file sharing mode. We want to allow simultaneous access.
- */
-
- shareMode = FILE_SHARE_READ | FILE_SHARE_WRITE;
-
- /*
- * Now we get to create the file.
- */
-
- handle = CreateFile(nativeName, accessMode, shareMode,
- NULL, createMode, flags, (HANDLE) NULL);
-
- if (handle == INVALID_HANDLE_VALUE) {
- DWORD err = GetLastError();
-
- if ((err & 0xffffL) == ERROR_OPEN_FAILED) {
- err = (mode & O_CREAT) ? ERROR_FILE_EXISTS : ERROR_FILE_NOT_FOUND;
- }
- TclWinConvertError(err);
- if (interp != (Tcl_Interp *) NULL) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "couldn't open \"%s\": %s",
- TclGetString(pathPtr), Tcl_PosixError(interp)));
- }
- return NULL;
- }
-
- channel = NULL;
-
- switch (FileGetType(handle)) {
- case FILE_TYPE_SERIAL:
- /*
- * Natively named serial ports "com1-9", "\\\\.\\comXX" are
- * already done with the code above.
- * Here we handle all other serial port names.
- *
- * Reopen channel for OVERLAPPED operation. Normally this shouldn't
- * fail, because the channel exists.
- */
-
- handle = TclWinSerialOpen(handle, nativeName, accessMode);
- if (handle == INVALID_HANDLE_VALUE) {
- TclWinConvertError(GetLastError());
- if (interp != (Tcl_Interp *) NULL) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "couldn't reopen serial \"%s\": %s",
- TclGetString(pathPtr), Tcl_PosixError(interp)));
- }
- return NULL;
- }
- channel = TclWinOpenSerialChannel(handle, channelName,
- channelPermissions);
- break;
- case FILE_TYPE_CONSOLE:
- channel = TclWinOpenConsoleChannel(handle, channelName,
- channelPermissions);
- break;
- case FILE_TYPE_PIPE:
- if (channelPermissions & TCL_READABLE) {
- readFile = TclWinMakeFile(handle);
- }
- if (channelPermissions & TCL_WRITABLE) {
- writeFile = TclWinMakeFile(handle);
- }
- channel = TclpCreateCommandChannel(readFile, writeFile, NULL, 0, NULL);
- break;
- case FILE_TYPE_CHAR:
- case FILE_TYPE_DISK:
- case FILE_TYPE_UNKNOWN:
- channel = TclWinOpenFileChannel(handle, channelName,
- 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.
- */
-
- channel = NULL;
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "couldn't open \"%s\": bad file type",
- TclGetString(pathPtr)));
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "CHANNEL", "BAD_TYPE",
- NULL);
- break;
- }
-
- return channel;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_MakeFileChannel --
- *
- * Creates a Tcl_Channel from an existing platform specific file handle.
- *
- * Results:
- * The Tcl_Channel created around the preexisting file.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-Tcl_Channel
-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)
- TCLEXCEPTION_REGISTRATION registration;
-#endif
- char channelName[16 + TCL_INTEGER_SPACE];
- Tcl_Channel channel = NULL;
- HANDLE handle = (HANDLE) rawHandle;
- HANDLE dupedHandle;
- TclFile readFile = NULL, writeFile = NULL;
- BOOL result;
-
- if (mode == 0) {
- return NULL;
- }
-
- switch (FileGetType(handle)) {
- case FILE_TYPE_SERIAL:
- channel = TclWinOpenSerialChannel(handle, channelName, mode);
- break;
- case FILE_TYPE_CONSOLE:
- channel = TclWinOpenConsoleChannel(handle, channelName, mode);
- break;
- case FILE_TYPE_PIPE:
- if (mode & TCL_READABLE) {
- readFile = TclWinMakeFile(handle);
- }
- if (mode & TCL_WRITABLE) {
- writeFile = TclWinMakeFile(handle);
- }
- channel = TclpCreateCommandChannel(readFile, writeFile, NULL, 0, NULL);
- break;
-
- case FILE_TYPE_DISK:
- 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
- * doesn't provide an IsValidHandle() function, so we have to emulate
- * 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.
- */
-
- result = DuplicateHandle(GetCurrentProcess(), handle,
- GetCurrentProcess(), &dupedHandle, 0, FALSE,
- DUPLICATE_SAME_ACCESS);
-
- if (result == 0) {
- /*
- * Unable to make a duplicate. It's definately invalid at this
- * point.
- */
-
- return NULL;
- }
-
- /*
- * Use structured exception handling (Win32 SEH) to protect the close
- * of this duped handle which might throw EXCEPTION_INVALID_HANDLE.
- */
-
- 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.
- */
-
- __asm__ __volatile__ (
-
- /*
- * Pick up parameters before messing with the stack
- */
-
- "movl %[dupedHandle], %%ebx" "\n\t"
-
- /*
- * Construct an TCLEXCEPTION_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 */
- "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 TCLEXCEPTION_REGISTRATION on the chain.
- */
-
- "movl %%edx, %%fs:0" "\n\t"
-
- /*
- * Call CloseHandle(dupedHandle).
- */
-
- "pushl %%ebx" "\n\t"
- "call _CloseHandle@4" "\n\t"
-
- /*
- * Come here on normal exit. Recover the TCLEXCEPTION_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 TCLEXCEPTION_REGISTRATION
- */
-
- "1:" "\t"
- "movl %%fs:0, %%edx" "\n\t"
- "movl 0x8(%%edx), %%edx" "\n\t"
-
- /*
- * Come here however we exited. Restore context from the
- * TCLEXCEPTION_REGISTRATION in case the stack is unbalanced.
- */
-
- "2:" "\t"
- "movl 0xc(%%edx), %%esp" "\n\t"
- "movl 0x8(%%edx), %%ebp" "\n\t"
- "movl 0x0(%%edx), %%eax" "\n\t"
- "movl %%eax, %%fs:0" "\n\t"
-
- :
- /* No outputs */
- :
- [registration] "m" (registration),
- [dupedHandle] "m" (dupedHandle)
- :
- "%eax", "%ebx", "%ecx", "%edx", "%esi", "%edi", "memory"
- );
- result = registration.status;
-#else
-#ifndef HAVE_NO_SEH
- __try {
-#endif
- CloseHandle(dupedHandle);
- result = 1;
-#ifndef HAVE_NO_SEH
- } __except (EXCEPTION_EXECUTE_HANDLER) {}
-#endif
-#endif
- if (result == FALSE) {
- return NULL;
- }
-
- /*
- * Fall through, the handle is valid.
- *
- * Create the undefined channel, anyways, because we know the handle
- * is valid to something.
- */
-
- channel = TclWinOpenFileChannel(handle, channelName, mode, 0);
- }
-
- return channel;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclpGetDefaultStdChannel --
- *
- * Constructs a channel for the specified standard OS handle.
- *
- * Results:
- * Returns the specified default standard channel, or NULL.
- *
- * Side effects:
- * May cause the creation of a standard channel and the underlying file.
- *
- *----------------------------------------------------------------------
- */
-
-Tcl_Channel
-TclpGetDefaultStdChannel(
- int type) /* One of TCL_STDIN, TCL_STDOUT, or
- * TCL_STDERR. */
-{
- Tcl_Channel channel;
- HANDLE handle;
- int mode = -1;
- const char *bufMode = NULL;
- 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:
- Tcl_Panic("TclGetDefaultStdChannel: Unexpected channel type");
- break;
- }
-
- handle = GetStdHandle(handleId);
-
- /*
- * Note that we need to check for 0 because Windows may return 0 if this
- * is not a console mode application, even though this is not a valid
- * handle.
- */
-
- if ((handle == INVALID_HANDLE_VALUE) || (handle == 0)) {
- return (Tcl_Channel) NULL;
- }
-
- channel = Tcl_MakeFileChannel(handle, mode);
-
- if (channel == NULL) {
- return (Tcl_Channel) NULL;
- }
-
- /*
- * Set up the normal channel options for stdio handles.
- */
-
- 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.
- *
- * Results:
- * Returns the new channel, or NULL.
- *
- * Side effects:
- * May open the channel and may cause creation of a file on the file
- * system.
- *
- *----------------------------------------------------------------------
- */
-
-Tcl_Channel
-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 = FileInit();
-
- /*
- * See if a channel with this handle already exists.
- */
-
- for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL;
- infoPtr = infoPtr->nextPtr) {
- if (infoPtr->handle == (HANDLE) handle) {
- return (permissions==infoPtr->validMask) ? infoPtr->channel : NULL;
- }
- }
-
- infoPtr = ckalloc(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.
- */
-
- infoPtr->nextPtr = NULL;
- infoPtr->validMask = permissions;
- infoPtr->watchMask = 0;
- infoPtr->flags = appendMode;
- infoPtr->handle = handle;
- infoPtr->dirty = 0;
- sprintf(channelName, "file%" TCL_I_MODIFIER "x", (size_t) infoPtr);
-
- infoPtr->channel = Tcl_CreateChannel(&fileChannelType, channelName,
- infoPtr, permissions);
-
- /*
- * 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.
- *
- * 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).
- *
- *----------------------------------------------------------------------
- */
-
-void
-TclWinFlushDirtyChannels(void)
-{
- FileInfo *infoPtr;
- ThreadSpecificData *tsdPtr = FileInit();
-
- /*
- * Flush all channels which are dirty, i.e. may have data pending in the
- * OS.
- */
-
- for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL;
- infoPtr = infoPtr->nextPtr) {
- if (infoPtr->dirty) {
- FlushFileBuffers(infoPtr->handle);
- infoPtr->dirty = 0;
- }
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * FileThreadActionProc --
- *
- * Insert or remove any thread local refs to this channel.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Changes thread local list of valid channels.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-FileThreadActionProc(
- ClientData instanceData,
- int action)
-{
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- FileInfo *infoPtr = instanceData;
-
- if (action == TCL_CHANNEL_THREAD_INSERT) {
- infoPtr->nextPtr = tsdPtr->firstFilePtr;
- tsdPtr->firstFilePtr = infoPtr;
- } else {
- FileInfo **nextPtrPtr;
- int removed = 0;
-
- for (nextPtrPtr = &(tsdPtr->firstFilePtr); (*nextPtrPtr) != NULL;
- nextPtrPtr = &((*nextPtrPtr)->nextPtr)) {
- if ((*nextPtrPtr) == infoPtr) {
- (*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.
- */
-
- if (!removed) {
- Tcl_Panic("file info ptr not on thread channel list");
- }
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * FileGetType --
- *
- * Given a file handle, return its type
- *
- * Results:
- * None.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-DWORD
-FileGetType(
- HANDLE handle) /* Opened file handle */
-{
- DWORD type;
-
- 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 ((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;
-}
-
- /*
- *----------------------------------------------------------------------
- *
- * NativeIsComPort --
- *
- * Determines if a path refers to a Windows serial port.
- * A simple and efficient solution is to use a "name hint" to detect
- * COM ports by their filename instead of resorting to a syscall
- * to detect serialness after the fact.
- * The following patterns cover common serial port names:
- * COM[1-9]
- * \\.\COM[0-9]+
- *
- * Results:
- * 1 = serial port, 0 = not.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-NativeIsComPort(
- const TCHAR *nativePath) /* Path of file to access, native encoding. */
-{
- const WCHAR *p = (const WCHAR *) nativePath;
- int i, len = wcslen(p);
-
- /*
- * 1. Look for com[1-9]:?
- */
-
- if ( (len == 4) && (_wcsnicmp(p, L"com", 3) == 0) ) {
- /*
- * The 4th character must be a digit 1..9
- */
-
- if ( (p[3] < L'1') || (p[3] > L'9') ) {
- return 0;
- }
- return 1;
- }
-
- /*
- * 2. Look for \\.\com[0-9]+
- */
-
- if ((len >= 8) && (_wcsnicmp(p, L"\\\\.\\com", 7) == 0)) {
- /*
- * Charaters 8..end must be a digits 0..9
- */
-
- for ( i=7; i<len; i++ ) {
- if ( (p[i] < '0') || (p[i] > '9') ) {
- return 0;
- }
- }
- return 1;
- }
- return 0;
-}
-
-/*
- * Local Variables:
- * mode: c
- * c-basic-offset: 4
- * fill-column: 78
- * End:
- */
diff --git a/tcl8.6/win/tclWinConsole.c b/tcl8.6/win/tclWinConsole.c
deleted file mode 100644
index d61a030..0000000
--- a/tcl8.6/win/tclWinConsole.c
+++ /dev/null
@@ -1,1427 +0,0 @@
-/*
- * tclWinConsole.c --
- *
- * 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.
- */
-
-#include "tclWinInt.h"
-
-/*
- * The following variable is used to tell whether this module has been
- * initialized.
- */
-
-static int initialized = 0;
-
-/*
- * The consoleMutex locks around access to the initialized variable, and it is
- * used to protect background threads from being terminated while they are
- * using APIs that hold locks.
- */
-
-TCL_DECLARE_MUTEX(consoleMutex)
-
-/*
- * Bit masks used in the flags field of the ConsoleInfo structure below.
- */
-
-#define CONSOLE_PENDING (1<<0) /* Message is pending in the queue. */
-#define CONSOLE_ASYNC (1<<1) /* Channel is non-blocking. */
-
-/*
- * Bit masks used in the sharedFlags field of the ConsoleInfo structure below.
- */
-
-#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_BUFFER_SIZE (8*1024)
-
-/*
- * Structure containing handles associated with one of the special console
- * threads.
- */
-
-typedef struct ConsoleThreadInfo {
- HANDLE thread; /* Handle to reader or writer thread. */
- HANDLE readyEvent; /* Manual-reset event to signal _to_ the main
- * thread when the worker thread has finished
- * waiting for its normal work to happen. */
- TclPipeThreadInfo *TI; /* Thread info structure of writer and reader. */
-} ConsoleThreadInfo;
-
-/*
- * This structure describes per-instance data for a console based channel.
- */
-
-typedef struct ConsoleInfo {
- HANDLE handle;
- int type;
- struct ConsoleInfo *nextPtr;/* Pointer to next registered console. */
- 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. */
- Tcl_ThreadId threadId; /* Thread to which events should be reported.
- * This value is used by the reader/writer
- * threads. */
- ConsoleThreadInfo writer; /* A specialized thread for handling
- * asynchronous writes to the console; the
- * waiting starts when a control event is sent,
- * and a reset event is sent back to the main
- * thread when the write is done. */
- ConsoleThreadInfo reader; /* A specialized thread for handling
- * asynchronous reads from the console; the
- * waiting starts when a control event is sent,
- * and a reset event is sent back to the main
- * thread when input is available. */
- 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 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. */
- char buffer[CONSOLE_BUFFER_SIZE];
- /* 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.
- */
-
- ConsoleInfo *firstConsolePtr;
-} ThreadSpecificData;
-
-static Tcl_ThreadDataKey dataKey;
-
-/*
- * The following structure is what is added to the Tcl event queue when
- * console events are generated.
- */
-
-typedef struct ConsoleEvent {
- 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. */
-} ConsoleEvent;
-
-/*
- * Declarations for functions used only in this file.
- */
-
-static int ConsoleBlockModeProc(ClientData instanceData,
- int mode);
-static void ConsoleCheckProc(ClientData clientData, int flags);
-static int ConsoleCloseProc(ClientData instanceData,
- Tcl_Interp *interp);
-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 int ConsoleInputProc(ClientData instanceData, char *buf,
- int toRead, int *errorCode);
-static int ConsoleOutputProc(ClientData instanceData,
- const char *buf, int toWrite, int *errorCode);
-static DWORD WINAPI ConsoleReaderThread(LPVOID arg);
-static void ConsoleSetupProc(ClientData clientData, int flags);
-static void ConsoleWatchProc(ClientData instanceData, int mask);
-static DWORD WINAPI ConsoleWriterThread(LPVOID arg);
-static void ProcExitHandler(ClientData clientData);
-static int WaitForRead(ConsoleInfo *infoPtr, int blocking);
-static void ConsoleThreadActionProc(ClientData instanceData,
- int action);
-static BOOL ReadConsoleBytes(HANDLE hConsole, LPVOID lpBuffer,
- DWORD nbytes, LPDWORD nbytesread);
-static BOOL WriteConsoleBytes(HANDLE hConsole,
- const void *lpBuffer, DWORD nbytes,
- LPDWORD nbyteswritten);
-
-/*
- * This structure describes the channel type structure for command console
- * based IO.
- */
-
-static const Tcl_ChannelType consoleChannelType = {
- "console", /* Type name. */
- TCL_CHANNEL_VERSION_5, /* v5 channel */
- ConsoleCloseProc, /* Close proc. */
- ConsoleInputProc, /* Input proc. */
- ConsoleOutputProc, /* Output proc. */
- NULL, /* Seek proc. */
- NULL, /* Set option proc. */
- NULL, /* Get option proc. */
- ConsoleWatchProc, /* Set up notifier to watch the channel. */
- ConsoleGetHandleProc, /* Get an OS handle from channel. */
- NULL, /* close2proc. */
- ConsoleBlockModeProc, /* Set blocking or non-blocking mode. */
- NULL, /* Flush proc. */
- NULL, /* Handler proc. */
- NULL, /* Wide seek proc. */
- ConsoleThreadActionProc, /* Thread action proc. */
- NULL /* Truncation proc. */
-};
-
-/*
- *----------------------------------------------------------------------
- *
- * 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 = sizeof(TCHAR);
-
- /*
- * If user types a Ctrl-Break or Ctrl-C, ReadConsole will return
- * success with ntchars == 0 and GetLastError() will be
- * ERROR_OPERATION_ABORTED. We do not want to treat this case
- * as EOF so we will loop around again. If no Ctrl signal handlers
- * have been established, the default signal OS handler in a separate
- * thread will terminate the program. If a Ctrl signal handler
- * has been established (through an extension for example), it
- * will run and take whatever action it deems appropriate.
- */
- do {
- result = ReadConsole(hConsole, lpBuffer, nbytes / tcharsize, &ntchars,
- NULL);
- } while (result && ntchars == 0 && GetLastError() == ERROR_OPERATION_ABORTED);
- if (nbytesread != NULL) {
- *nbytesread = ntchars * tcharsize;
- }
- return result;
-}
-
-static BOOL
-WriteConsoleBytes(
- HANDLE hConsole,
- const void *lpBuffer,
- DWORD nbytes,
- LPDWORD nbyteswritten)
-{
- DWORD ntchars;
- BOOL result;
- int tcharsize = sizeof(TCHAR);
-
- result = WriteConsole(hConsole, lpBuffer, nbytes / tcharsize, &ntchars,
- NULL);
- if (nbyteswritten != NULL) {
- *nbyteswritten = ntchars * tcharsize;
- }
- return result;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ConsoleInit --
- *
- * This function initializes the static variables for this file.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Creates a new event source.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-ConsoleInit(void)
-{
- /*
- * Check the initialized flag first, then check again in the mutex. This
- * is a speed enhancement.
- */
-
- if (!initialized) {
- Tcl_MutexLock(&consoleMutex);
- if (!initialized) {
- initialized = 1;
- Tcl_CreateExitHandler(ProcExitHandler, NULL);
- }
- Tcl_MutexUnlock(&consoleMutex);
- }
-
- if (TclThreadDataKeyGet(&dataKey) == NULL) {
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-
- tsdPtr->firstConsolePtr = NULL;
- Tcl_CreateEventSource(ConsoleSetupProc, ConsoleCheckProc, NULL);
- Tcl_CreateThreadExitHandler(ConsoleExitHandler, NULL);
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ConsoleExitHandler --
- *
- * This function is called to cleanup the console module before Tcl is
- * unloaded.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Removes the console event source.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-ConsoleExitHandler(
- ClientData clientData) /* Old window proc. */
-{
- Tcl_DeleteEventSource(ConsoleSetupProc, ConsoleCheckProc, NULL);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ProcExitHandler --
- *
- * This function is called to cleanup the process list before Tcl is
- * unloaded.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Resets the process list.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-ProcExitHandler(
- ClientData clientData) /* Old window proc. */
-{
- Tcl_MutexLock(&consoleMutex);
- initialized = 0;
- Tcl_MutexUnlock(&consoleMutex);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ConsoleSetupProc --
- *
- * This procedure is invoked before Tcl_DoOneEvent blocks waiting for an
- * event.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Adjusts the block time if needed.
- *
- *----------------------------------------------------------------------
- */
-
-void
-ConsoleSetupProc(
- ClientData data, /* Not used. */
- int flags) /* Event flags as passed to Tcl_DoOneEvent. */
-{
- ConsoleInfo *infoPtr;
- Tcl_Time blockTime = { 0, 0 };
- int block = 1;
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-
- if (!(flags & TCL_FILE_EVENTS)) {
- return;
- }
-
- /*
- * Look to see if any events are already pending. If they are, poll.
- */
-
- for (infoPtr = tsdPtr->firstConsolePtr; infoPtr != NULL;
- infoPtr = infoPtr->nextPtr) {
- if (infoPtr->watchMask & TCL_WRITABLE) {
- if (WaitForSingleObject(infoPtr->writer.readyEvent,
- 0) != WAIT_TIMEOUT) {
- block = 0;
- }
- }
- if (infoPtr->watchMask & TCL_READABLE) {
- if (WaitForRead(infoPtr, 0) >= 0) {
- block = 0;
- }
- }
- }
- if (!block) {
- Tcl_SetMaxBlockTime(&blockTime);
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ConsoleCheckProc --
- *
- * This procedure is called by Tcl_DoOneEvent to check the console event
- * source for events.
- *
- * Results:
- * None.
- *
- * Side effects:
- * May queue an event.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-ConsoleCheckProc(
- ClientData data, /* Not used. */
- int flags) /* Event flags as passed to Tcl_DoOneEvent. */
-{
- ConsoleInfo *infoPtr;
- int needEvent;
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-
- 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;
- infoPtr = infoPtr->nextPtr) {
- if (infoPtr->flags & CONSOLE_PENDING) {
- continue;
- }
-
- /*
- * Queue an event if the console is signaled for reading or writing.
- */
-
- needEvent = 0;
- if (infoPtr->watchMask & TCL_WRITABLE) {
- if (WaitForSingleObject(infoPtr->writer.readyEvent,
- 0) != WAIT_TIMEOUT) {
- needEvent = 1;
- }
- }
-
- if (infoPtr->watchMask & TCL_READABLE) {
- if (WaitForRead(infoPtr, 0) >= 0) {
- needEvent = 1;
- }
- }
-
- if (needEvent) {
- ConsoleEvent *evPtr = ckalloc(sizeof(ConsoleEvent));
-
- infoPtr->flags |= CONSOLE_PENDING;
- evPtr->header.proc = ConsoleEventProc;
- evPtr->infoPtr = infoPtr;
- Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
- }
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ConsoleBlockModeProc --
- *
- * Set blocking or non-blocking mode on channel.
- *
- * Results:
- * 0 if successful, errno when failed.
- *
- * Side effects:
- * Sets the device into blocking or non-blocking mode.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-ConsoleBlockModeProc(
- ClientData instanceData, /* Instance data for channel. */
- int mode) /* TCL_MODE_BLOCKING or
- * TCL_MODE_NONBLOCKING. */
-{
- ConsoleInfo *infoPtr = 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.
- */
-
- if (mode == TCL_MODE_NONBLOCKING) {
- infoPtr->flags |= CONSOLE_ASYNC;
- } else {
- infoPtr->flags &= ~CONSOLE_ASYNC;
- }
- return 0;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ConsoleCloseProc --
- *
- * Closes a console based IO channel.
- *
- * Results:
- * 0 on success, errno otherwise.
- *
- * Side effects:
- * Closes the physical channel.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-ConsoleCloseProc(
- ClientData instanceData, /* Pointer to ConsoleInfo structure. */
- Tcl_Interp *interp) /* For error reporting. */
-{
- ConsoleInfo *consolePtr = instanceData;
- int errorCode = 0;
- ConsoleInfo *infoPtr, **nextPtrPtr;
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-
- /*
- * 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->reader.thread) {
- TclPipeThreadStop(&consolePtr->reader.TI, consolePtr->reader.thread);
- CloseHandle(consolePtr->reader.thread);
- CloseHandle(consolePtr->reader.readyEvent);
- consolePtr->reader.thread = NULL;
- }
- 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.
- */
-
- if (consolePtr->writer.thread) {
- if (consolePtr->toWrite) {
- /*
- * We only need to wait if there is something to write. This may
- * prevent infinite wait on exit. [Python Bug 216289]
- */
-
- WaitForSingleObject(consolePtr->writer.readyEvent, 5000);
- }
-
- TclPipeThreadStop(&consolePtr->writer.TI, consolePtr->writer.thread);
- CloseHandle(consolePtr->writer.thread);
- CloseHandle(consolePtr->writer.readyEvent);
- consolePtr->writer.thread = NULL;
- }
- consolePtr->validMask &= ~TCL_WRITABLE;
-
- /*
- * Don't close the Win32 handle if the handle is a standard channel during
- * the thread exit process. Otherwise, one thread may kill the stdio of
- * another.
- */
-
- if (!TclInThreadExit()
- || ((GetStdHandle(STD_INPUT_HANDLE) != consolePtr->handle)
- && (GetStdHandle(STD_OUTPUT_HANDLE) != consolePtr->handle)
- && (GetStdHandle(STD_ERROR_HANDLE) != consolePtr->handle))) {
- if (CloseHandle(consolePtr->handle) == FALSE) {
- TclWinConvertError(GetLastError());
- errorCode = errno;
- }
- }
-
- consolePtr->watchMask &= consolePtr->validMask;
-
- /*
- * Remove the file from the list of watched files.
- */
-
- for (nextPtrPtr = &(tsdPtr->firstConsolePtr), infoPtr = *nextPtrPtr;
- infoPtr != NULL;
- nextPtrPtr = &infoPtr->nextPtr, infoPtr = *nextPtrPtr) {
- if (infoPtr == (ConsoleInfo *) consolePtr) {
- *nextPtrPtr = infoPtr->nextPtr;
- break;
- }
- }
- if (consolePtr->writeBuf != NULL) {
- ckfree(consolePtr->writeBuf);
- consolePtr->writeBuf = 0;
- }
- ckfree(consolePtr);
-
- return errorCode;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ConsoleInputProc --
- *
- * 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.
- *
- * Side effects:
- * Reads input from the actual channel.
- *
- *----------------------------------------------------------------------
- */
-
-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. */
-{
- ConsoleInfo *infoPtr = instanceData;
- DWORD count, bytesRead = 0;
- int result;
-
- *errorCode = 0;
-
- /*
- * 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;
- }
-
- if (infoPtr->readFlags & CONSOLE_BUFFERED) {
- /*
- * Data is stored in the buffer.
- */
-
- if (bufSize < (infoPtr->bytesRead - infoPtr->offset)) {
- memcpy(buf, &infoPtr->buffer[infoPtr->offset], (size_t) bufSize);
- bytesRead = bufSize;
- infoPtr->offset += bufSize;
- } else {
- memcpy(buf, &infoPtr->buffer[infoPtr->offset], (size_t) bufSize);
- bytesRead = infoPtr->bytesRead - infoPtr->offset;
-
- /*
- * 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.
- */
-
- if (ReadConsoleBytes(infoPtr->handle, (LPVOID) buf, (DWORD) bufSize,
- &count) == TRUE) {
- /*
- * TODO: This potentially writes beyond the limits specified
- * by the caller. In practice this is harmless, since all writes
- * are into ChannelBuffers, and those have padding, but still
- * ought to remove this, unless some Windows wizard can give
- * a reason not to.
- */
- buf[count] = '\0';
- return count;
- }
-
- return -1;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ConsoleOutputProc --
- *
- * 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.
- *
- * Side effects:
- * Writes output on the actual channel.
- *
- *----------------------------------------------------------------------
- */
-
-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. */
-{
- ConsoleInfo *infoPtr = instanceData;
- ConsoleThreadInfo *threadInfo = &infoPtr->writer;
- DWORD bytesWritten, timeout;
-
- *errorCode = 0;
-
- /* avoid blocking if pipe-thread exited */
- timeout = (infoPtr->flags & CONSOLE_ASYNC) || !TclPipeThreadIsAlive(&threadInfo->TI)
- || TclInExit() || TclInThreadExit() ? 0 : INFINITE;
- if (WaitForSingleObject(threadInfo->readyEvent, timeout) == WAIT_TIMEOUT) {
- /*
- * The writer thread is blocked waiting for a write to complete and
- * the channel is in non-blocking mode.
- */
-
- errno = EWOULDBLOCK;
- goto error;
- }
-
- /*
- * Check for a background error on the last write.
- */
-
- if (infoPtr->writeError) {
- TclWinConvertError(infoPtr->writeError);
- infoPtr->writeError = 0;
- goto error;
- }
-
- if (infoPtr->flags & CONSOLE_ASYNC) {
- /*
- * The console 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(toWrite);
- }
- memcpy(infoPtr->writeBuf, buf, (size_t) toWrite);
- infoPtr->toWrite = toWrite;
- ResetEvent(threadInfo->readyEvent);
- TclPipeThreadSignal(&threadInfo->TI);
- bytesWritten = toWrite;
- } else {
- /*
- * In the blocking case, just try to write the buffer directly. This
- * avoids an unnecessary copy.
- */
-
- if (WriteConsoleBytes(infoPtr->handle, buf, (DWORD) toWrite,
- &bytesWritten) == FALSE) {
- TclWinConvertError(GetLastError());
- goto error;
- }
- }
- return bytesWritten;
-
- error:
- *errorCode = errno;
- return -1;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * 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.
- *
- * 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.
- *
- * Side effects:
- * Whatever the notifier callback does.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-ConsoleEventProc(
- Tcl_Event *evPtr, /* Event to service. */
- int flags) /* Flags that indicate what events to handle,
- * such as TCL_FILE_EVENTS. */
-{
- ConsoleEvent *consoleEvPtr = (ConsoleEvent *) evPtr;
- ConsoleInfo *infoPtr;
- int mask;
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-
- if (!(flags & TCL_FILE_EVENTS)) {
- return 0;
- }
-
- /*
- * 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.
- */
-
- for (infoPtr = tsdPtr->firstConsolePtr; infoPtr != NULL;
- infoPtr = infoPtr->nextPtr) {
- if (consoleEvPtr->infoPtr == infoPtr) {
- infoPtr->flags &= ~CONSOLE_PENDING;
- break;
- }
- }
-
- /*
- * Remove stale events.
- */
-
- if (!infoPtr) {
- return 1;
- }
-
- /*
- * 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;
- if (infoPtr->watchMask & TCL_WRITABLE) {
- if (WaitForSingleObject(infoPtr->writer.readyEvent,
- 0) != WAIT_TIMEOUT) {
- mask = TCL_WRITABLE;
- }
- }
-
- if (infoPtr->watchMask & TCL_READABLE) {
- if (WaitForRead(infoPtr, 0) >= 0) {
- if (infoPtr->readFlags & CONSOLE_EOF) {
- mask = TCL_READABLE;
- } else {
- mask |= TCL_READABLE;
- }
- }
- }
-
- /*
- * Inform the channel of the events.
- */
-
- Tcl_NotifyChannel(infoPtr->channel, infoPtr->watchMask & mask);
- return 1;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ConsoleWatchProc --
- *
- * Called by the notifier to set up to watch for events on this channel.
- *
- * Results:
- * None.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-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. */
-{
- ConsoleInfo **nextPtrPtr, *ptr;
- ConsoleInfo *infoPtr = instanceData;
- int oldMask = infoPtr->watchMask;
- 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.
- */
-
- infoPtr->watchMask = mask & infoPtr->validMask;
- if (infoPtr->watchMask) {
- Tcl_Time blockTime = { 0, 0 };
-
- if (!oldMask) {
- infoPtr->nextPtr = tsdPtr->firstConsolePtr;
- tsdPtr->firstConsolePtr = infoPtr;
- }
- Tcl_SetMaxBlockTime(&blockTime);
- } 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;
- }
- }
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ConsoleGetHandleProc --
- *
- * 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.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-ConsoleGetHandleProc(
- ClientData instanceData, /* The console state. */
- int direction, /* TCL_READABLE or TCL_WRITABLE. */
- ClientData *handlePtr) /* Where to store the handle. */
-{
- ConsoleInfo *infoPtr = instanceData;
-
- *handlePtr = infoPtr->handle;
- return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * 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).
- *
- * 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.
- *
- * Side effects:
- * 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. */
-{
- DWORD timeout, count;
- HANDLE *handle = infoPtr->handle;
- ConsoleThreadInfo *threadInfo = &infoPtr->reader;
- INPUT_RECORD input;
-
- while (1) {
- /*
- * Synchronize with the reader thread.
- */
-
- /* avoid blocking if pipe-thread exited */
- timeout = (!blocking || !TclPipeThreadIsAlive(&threadInfo->TI)
- || TclInExit() || TclInThreadExit()) ? 0 : INFINITE;
- if (WaitForSingleObject(threadInfo->readyEvent, timeout) == WAIT_TIMEOUT) {
- /*
- * The reader thread is blocked waiting for data and the channel
- * is in non-blocking mode.
- */
-
- errno = EWOULDBLOCK;
- return -1;
- }
-
- /*
- * 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;
- }
-
- /*
- * Ignore errors if there is data in the buffer.
- */
-
- if (infoPtr->readFlags & CONSOLE_BUFFERED) {
- return 0;
- } else {
- return -1;
- }
- }
-
- /*
- * 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.
- */
-
- ResetEvent(threadInfo->readyEvent);
- TclPipeThreadSignal(&threadInfo->TI);
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ConsoleReaderThread --
- *
- * 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.
- *
- *----------------------------------------------------------------------
- */
-
-static DWORD WINAPI
-ConsoleReaderThread(
- LPVOID arg)
-{
- TclPipeThreadInfo *pipeTI = (TclPipeThreadInfo *)arg;
- ConsoleInfo *infoPtr = NULL; /* access info only after success init/wait */
- HANDLE *handle = NULL;
- ConsoleThreadInfo *threadInfo = NULL;
- int done = 0;
-
- while (!done) {
- /*
- * Wait for the main thread to signal before attempting to read.
- */
-
- if (!TclPipeThreadWaitForSignal(&pipeTI)) {
- /* exit */
- break;
- }
- if (!infoPtr) {
- infoPtr = (ConsoleInfo *)pipeTI->clientData;
- handle = infoPtr->handle;
- threadInfo = &infoPtr->reader;
- }
-
-
- /*
- * Look for data on the console, but first ignore any events that are
- * not KEY_EVENTs.
- */
-
- 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 = GetLastError();
-
- if (err == (DWORD) EOF) {
- infoPtr->readFlags = CONSOLE_EOF;
- }
- done = 1;
- }
-
- /*
- * Signal the main thread by signalling the readable event and then
- * waking up the notifier thread.
- */
-
- SetEvent(threadInfo->readyEvent);
-
- /*
- * 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.
- */
-
- Tcl_ThreadAlert(infoPtr->threadId);
- }
- Tcl_MutexUnlock(&consoleMutex);
- }
-
- /* Worker exit, so inform the main thread or free TI-structure (if owned) */
- TclPipeThreadExit(&pipeTI);
-
- return 0;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ConsoleWriterThread --
- *
- * 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.
- *
- *----------------------------------------------------------------------
- */
-
-static DWORD WINAPI
-ConsoleWriterThread(
- LPVOID arg)
-{
- TclPipeThreadInfo *pipeTI = (TclPipeThreadInfo *)arg;
- ConsoleInfo *infoPtr = NULL; /* access info only after success init/wait */
- HANDLE *handle = NULL;
- ConsoleThreadInfo *threadInfo = NULL;
- DWORD count, toWrite;
- char *buf;
- int done = 0;
-
- while (!done) {
- /*
- * Wait for the main thread to signal before attempting to write.
- */
- if (!TclPipeThreadWaitForSignal(&pipeTI)) {
- /* exit */
- break;
- }
- if (!infoPtr) {
- infoPtr = (ConsoleInfo *)pipeTI->clientData;
- handle = infoPtr->handle;
- threadInfo = &infoPtr->writer;
- }
-
- buf = infoPtr->writeBuf;
- toWrite = infoPtr->toWrite;
-
- /*
- * Loop until all of the bytes are written or an error occurs.
- */
-
- while (toWrite > 0) {
- if (WriteConsoleBytes(handle, buf, (DWORD) toWrite,
- &count) == FALSE) {
- infoPtr->writeError = GetLastError();
- done = 1;
- break;
- }
- toWrite -= count;
- buf += count;
- }
-
- /*
- * Signal the main thread by signalling the writable event and then
- * waking up the notifier thread.
- */
-
- SetEvent(threadInfo->readyEvent);
-
- /*
- * 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.
- */
-
- Tcl_ThreadAlert(infoPtr->threadId);
- }
- Tcl_MutexUnlock(&consoleMutex);
- }
-
- /* Worker exit, so inform the main thread or free TI-structure (if owned) */
- TclPipeThreadExit(&pipeTI);
-
- return 0;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * 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.
- *
- * Results:
- * Returns the new channel, or NULL.
- *
- * Side effects:
- * May open the channel.
- *
- *----------------------------------------------------------------------
- */
-
-Tcl_Channel
-TclWinOpenConsoleChannel(
- HANDLE handle,
- char *channelName,
- int permissions)
-{
- char encoding[4 + TCL_INTEGER_SPACE];
- ConsoleInfo *infoPtr;
- DWORD modes;
-
- ConsoleInit();
-
- /*
- * See if a channel with this handle already exists.
- */
-
- infoPtr = ckalloc(sizeof(ConsoleInfo));
- memset(infoPtr, 0, sizeof(ConsoleInfo));
-
- infoPtr->validMask = permissions;
- infoPtr->handle = handle;
- infoPtr->channel = (Tcl_Channel) NULL;
-
- wsprintfA(encoding, "cp%d", GetConsoleCP());
-
- 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).
- */
-
- sprintf(channelName, "file%" TCL_I_MODIFIER "x", (size_t) infoPtr);
-
- infoPtr->channel = Tcl_CreateChannel(&consoleChannelType, channelName,
- 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.
- */
-
- GetConsoleMode(infoPtr->handle, &modes);
- modes &= ~(ENABLE_WINDOW_INPUT | ENABLE_MOUSE_INPUT);
- modes |= ENABLE_LINE_INPUT;
- SetConsoleMode(infoPtr->handle, modes);
-
- infoPtr->reader.readyEvent = CreateEvent(NULL, TRUE, TRUE, NULL);
- infoPtr->reader.thread = CreateThread(NULL, 256, ConsoleReaderThread,
- TclPipeThreadCreateTI(&infoPtr->reader.TI, infoPtr,
- infoPtr->reader.readyEvent), 0, NULL);
- SetThreadPriority(infoPtr->reader.thread, THREAD_PRIORITY_HIGHEST);
- }
-
- if (permissions & TCL_WRITABLE) {
-
- infoPtr->writer.readyEvent = CreateEvent(NULL, TRUE, TRUE, NULL);
- infoPtr->writer.thread = CreateThread(NULL, 256, ConsoleWriterThread,
- TclPipeThreadCreateTI(&infoPtr->writer.TI, infoPtr,
- infoPtr->writer.readyEvent), 0, NULL);
- SetThreadPriority(infoPtr->writer.thread, 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.
- */
-
- Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto");
- Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "\032 {}");
-#ifdef UNICODE
- Tcl_SetChannelOption(NULL, infoPtr->channel, "-encoding", "unicode");
-#else
- Tcl_SetChannelOption(NULL, infoPtr->channel, "-encoding", encoding);
-#endif
- return infoPtr->channel;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ConsoleThreadActionProc --
- *
- * Insert or remove any thread local refs to this channel.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Changes thread local list of valid channels.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-ConsoleThreadActionProc(
- ClientData instanceData,
- int action)
-{
- ConsoleInfo *infoPtr = 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.
- */
-
- 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.
- */
-
- 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/tcl8.6/win/tclWinDde.c b/tcl8.6/win/tclWinDde.c
deleted file mode 100644
index 27ddfc8..0000000
--- a/tcl8.6/win/tclWinDde.c
+++ /dev/null
@@ -1,1942 +0,0 @@
-/*
- * tclWinDde.c --
- *
- * 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.
- */
-
-#undef STATIC_BUILD
-#ifndef USE_TCL_STUBS
-# define USE_TCL_STUBS
-#endif
-#include "tclInt.h"
-#include <dde.h>
-#include <ddeml.h>
-#include <tchar.h>
-
-#if !defined(NDEBUG)
- /* test POKE server Implemented for debug mode only */
-# undef CBF_FAIL_POKES
-# define CBF_FAIL_POKES 0
-#endif
-
-/*
- * The following structure is used to keep track of the interpreters
- * registered by this process.
- */
-
-typedef struct RegisteredInterp {
- struct RegisteredInterp *nextPtr;
- /* The next interp this application knows
- * about. */
- TCHAR *name; /* Interpreter's name (malloc-ed). */
- Tcl_Obj *handlerPtr; /* The server handler command */
- Tcl_Interp *interp; /* The interpreter attached to this name. */
-} RegisteredInterp;
-
-/*
- * Used to keep track of conversations.
- */
-
-typedef struct Conversation {
- struct Conversation *nextPtr;
- /* The next conversation in the list. */
- RegisteredInterp *riPtr; /* The info we know about the conversation. */
- HCONV hConv; /* The DDE handle for this conversation. */
- Tcl_Obj *returnPackagePtr; /* The result package for this conversation. */
-} Conversation;
-
-typedef struct {
- Tcl_Interp *interp;
- int result;
- ATOM service;
- ATOM topic;
- HWND hwnd;
-} DdeEnumServices;
-
-typedef struct {
- Conversation *currentConversations;
- /* A list of conversations currently being
- * processed. */
- RegisteredInterp *interpListPtr;
- /* 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.
- */
-
-static HSZ ddeServiceGlobal = 0;
-static DWORD ddeInstance; /* The application instance handle given to us
- * by DdeInitialize. */
-static int ddeIsServer = 0;
-
-#define TCL_DDE_VERSION "1.4.1"
-#define TCL_DDE_PACKAGE_NAME "dde"
-#define TCL_DDE_SERVICE_NAME TEXT("TclEval")
-#define TCL_DDE_EXECUTE_RESULT TEXT("$TCLEVAL$EXECUTE$RESULT")
-
-#define DDE_FLAG_ASYNC 1
-#define DDE_FLAG_BINARY 2
-#define DDE_FLAG_FORCE 4
-
-TCL_DECLARE_MUTEX(ddeMutex)
-
-/*
- * Forward declarations for functions defined later in this file.
- */
-
-static LRESULT CALLBACK DdeClientWindowProc(HWND hwnd, UINT uMsg,
- WPARAM wParam, LPARAM lParam);
-static int DdeCreateClient(DdeEnumServices *es);
-static BOOL CALLBACK DdeEnumWindowsCallback(HWND hwndTarget,
- LPARAM lParam);
-static void DdeExitProc(ClientData clientData);
-static int DdeGetServicesList(Tcl_Interp *interp,
- const TCHAR *serviceName, const TCHAR *topicName);
-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,
- const TCHAR *name, HCONV *ddeConvPtr);
-static void SetDdeError(Tcl_Interp *interp);
-static int DdeObjCmd(ClientData clientData,
- Tcl_Interp *interp, int objc,
- Tcl_Obj *const objv[]);
-
-static unsigned char *
-getByteArrayFromObj(
- Tcl_Obj *objPtr,
- size_t *lengthPtr
-) {
- int length;
-
- unsigned char *result = Tcl_GetByteArrayFromObj(objPtr, &length);
-#if TCL_MAJOR_VERSION > 8
- if (sizeof(TCL_HASH_TYPE) > sizeof(int)) {
- /* 64-bit and TIP #494 situation: */
- *lengthPtr = *(TCL_HASH_TYPE *) objPtr->internalRep.twoPtrValue.ptr1;
- } else
-#endif
- /* 32-bit or without TIP #494 */
- *lengthPtr = (size_t) (unsigned) length;
- return result;
-}
-
-DLLEXPORT int Dde_Init(Tcl_Interp *interp);
-DLLEXPORT int Dde_SafeInit(Tcl_Interp *interp);
-
-/*
- *----------------------------------------------------------------------
- *
- * Dde_Init --
- *
- * This function initializes the dde command.
- *
- * Results:
- * A standard Tcl result.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-int
-Dde_Init(
- Tcl_Interp *interp)
-{
- if (!Tcl_InitStubs(interp, "8.1", 0)) {
- return TCL_ERROR;
- }
-
- Tcl_CreateObjCommand(interp, "dde", 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.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Registers the DDE server proc.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-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.
- */
-
- if (tsdPtr->interpListPtr != NULL) {
- nameFound = 1;
- }
-
- /*
- * 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) {
- ddeInstance = 0;
- }
- }
- Tcl_MutexUnlock(&ddeMutex);
- }
- if ((ddeServiceGlobal == 0) && (nameFound != 0)) {
- Tcl_MutexLock(&ddeMutex);
- if ((ddeServiceGlobal == 0) && (nameFound != 0)) {
- ddeIsServer = 1;
- Tcl_CreateExitHandler(DdeExitProc, NULL);
- ddeServiceGlobal = DdeCreateStringHandle(ddeInstance,
- TCL_DDE_SERVICE_NAME, CP_WINUNICODE);
- DdeNameService(ddeInstance, ddeServiceGlobal, 0L, DNS_REGISTER);
- } else {
- ddeIsServer = 0;
- }
- Tcl_MutexUnlock(&ddeMutex);
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * DdeSetServerName --
- *
- * 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.
- *
- * 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.
- *
- *----------------------------------------------------------------------
- */
-
-static const TCHAR *
-DdeSetServerName(
- Tcl_Interp *interp,
- const TCHAR *name, /* The name that will be used to refer to the
- * interpreter in later "send" commands. Must
- * be globally unique. */
- int flags, /* DDE_FLAG_FORCE or 0 */
- Tcl_Obj *handlerPtr) /* Name of the optional proc/command to handle
- * incoming Dde eval's */
-{
- int suffix, offset;
- RegisteredInterp *riPtr, *prevPtr;
- Tcl_DString dString;
- const TCHAR *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.
- */
-
- for (riPtr = tsdPtr->interpListPtr, prevPtr = NULL; riPtr != NULL;
- prevPtr = riPtr, riPtr = riPtr->nextPtr) {
- if (riPtr->interp == interp) {
- if (name != NULL) {
- if (prevPtr == NULL) {
- tsdPtr->interpListPtr = tsdPtr->interpListPtr->nextPtr;
- } else {
- prevPtr->nextPtr = riPtr->nextPtr;
- }
- break;
- } else {
- /*
- * The name was NULL, so the caller is asking for the name of
- * the current interp.
- */
-
- return riPtr->name;
- }
- }
- }
-
- 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.
- */
-
- return TEXT("");
- }
-
- /*
- * Get the list of currently registered Tcl interpreters by calling the
- * internal implementation of the 'dde services' command.
- */
-
- Tcl_DStringInit(&dString);
- actualName = name;
-
- if (!(flags & DDE_FLAG_FORCE)) {
- 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) {
- Tcl_WinUtfToTChar(Tcl_GetStringResult(interp), -1, &dString);
- OutputDebugString((TCHAR *) Tcl_DStringValue(&dString));
- Tcl_DStringFree(&dString);
- 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, (char *)name, _tcslen(name) * sizeof(TCHAR));
- Tcl_DStringAppend(&dString, (char *)TEXT(" #"), 2 * sizeof(TCHAR));
- offset = Tcl_DStringLength(&dString);
- Tcl_DStringSetLength(&dString, offset + sizeof(TCHAR) * TCL_INTEGER_SPACE);
- actualName = (TCHAR *) Tcl_DStringValue(&dString);
- }
- _sntprintf((TCHAR *) (Tcl_DStringValue(&dString) + offset),
- TCL_INTEGER_SPACE, TEXT("%d"), suffix);
- }
-
- /*
- * See if the name is already in use, if so increment suffix.
- */
-
- for (n = 0; n < srvCount; ++n) {
- Tcl_Obj* namePtr;
- Tcl_DString ds;
-
- Tcl_ListObjIndex(interp, srvPtrPtr[n], 1, &namePtr);
- Tcl_WinUtfToTChar(Tcl_GetString(namePtr), -1, &ds);
- if (_tcscmp(actualName, (TCHAR *)Tcl_DStringValue(&ds)) == 0) {
- suffix++;
- Tcl_DStringFree(&ds);
- break;
- }
- Tcl_DStringFree(&ds);
- }
- }
- }
-
- /*
- * We have found a unique name. Now add it to the registry.
- */
-
- riPtr = (RegisteredInterp *) Tcl_Alloc(sizeof(RegisteredInterp));
- riPtr->interp = interp;
- riPtr->name = (TCHAR *) Tcl_Alloc((_tcslen(actualName) + 1) * sizeof(TCHAR));
- riPtr->nextPtr = tsdPtr->interpListPtr;
- riPtr->handlerPtr = handlerPtr;
- if (riPtr->handlerPtr != NULL) {
- Tcl_IncrRefCount(riPtr->handlerPtr);
- }
- tsdPtr->interpListPtr = riPtr;
- _tcscpy(riPtr->name, actualName);
-
- if (Tcl_IsSafe(interp)) {
- Tcl_ExposeCommand(interp, "dde", "dde");
- }
-
- Tcl_CreateObjCommand(interp, "dde", DdeObjCmd,
- riPtr, DeleteProc);
- if (Tcl_IsSafe(interp)) {
- Tcl_HideCommand(interp, "dde", "dde");
- }
- Tcl_DStringFree(&dString);
-
- /*
- * 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 function is called when the command "dde" is destroyed.
- *
- * Results:
- * none
- *
- * Side effects:
- * The interpreter given by riPtr is unregistered.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-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);
- prevPtr = searchPtr, searchPtr = searchPtr->nextPtr) {
- /*
- * Empty loop body.
- */
- }
-
- if (searchPtr != NULL) {
- if (prevPtr == NULL) {
- tsdPtr->interpListPtr = tsdPtr->interpListPtr->nextPtr;
- } else {
- prevPtr->nextPtr = searchPtr->nextPtr;
- }
- }
- Tcl_Free((char *) 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.
- *
- * 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.
- *
- * Side effects:
- * A Tcl script is run, which can cause all kinds of other things to
- * happen.
- *
- *----------------------------------------------------------------------
- */
-
-static Tcl_Obj *
-ExecuteRemoteObject(
- RegisteredInterp *riPtr, /* Info about this server. */
- Tcl_Obj *ddeObjectPtr) /* The object to execute. */
-{
- Tcl_Obj *returnPackagePtr;
- int result = TCL_OK;
-
- 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));
- Tcl_SetErrorCode(riPtr->interp, "TCL", "DDE", "SECURITY_CHECK", NULL);
- 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) {
- Tcl_Obj *errorObjPtr = Tcl_GetVar2Ex(riPtr->interp, "errorCode", NULL,
- TCL_GLOBAL_ONLY);
- if (errorObjPtr) {
- Tcl_ListObjAppendElement(NULL, returnPackagePtr, errorObjPtr);
- }
- errorObjPtr = Tcl_GetVar2Ex(riPtr->interp, "errorInfo", NULL,
- TCL_GLOBAL_ONLY);
- 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.
- *
- * 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.
- *
- *----------------------------------------------------------------------
- */
-
-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
- * current transaction. */
- HSZ ddeTopic, HSZ ddeItem, /* String handles. Transaction-type
- * dependent. */
- HDDEDATA hData, /* DDE data. Transaction-type dependent. */
- DWORD dwData1, DWORD dwData2)
- /* Transaction-dependent data. */
-{
- Tcl_DString dString;
- size_t len;
- DWORD dlen;
- TCHAR *utilString;
- Tcl_Obj *ddeObjectPtr;
- HDDEDATA ddeReturn = NULL;
- RegisteredInterp *riPtr;
- Conversation *convPtr, *prevConvPtr;
- 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.
- */
-
- len = DdeQueryString(ddeInstance, ddeTopic, NULL, 0, CP_WINUNICODE);
- Tcl_DStringInit(&dString);
- Tcl_DStringSetLength(&dString, (len + 1) * sizeof(TCHAR) - 1);
- utilString = (TCHAR *) Tcl_DStringValue(&dString);
- DdeQueryString(ddeInstance, ddeTopic, utilString, (DWORD) len + 1,
- CP_WINUNICODE);
-
- for (riPtr = tsdPtr->interpListPtr; riPtr != NULL;
- riPtr = riPtr->nextPtr) {
- if (_tcsicmp(utilString, riPtr->name) == 0) {
- Tcl_DStringFree(&dString);
- return (HDDEDATA) TRUE;
- }
- }
-
- Tcl_DStringFree(&dString);
- return (HDDEDATA) FALSE;
-
- 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, CP_WINUNICODE);
- Tcl_DStringInit(&dString);
- Tcl_DStringSetLength(&dString, (len + 1) * sizeof(TCHAR) - 1);
- utilString = (TCHAR *) Tcl_DStringValue(&dString);
- DdeQueryString(ddeInstance, ddeTopic, utilString, (DWORD) len + 1,
- CP_WINUNICODE);
- for (riPtr = tsdPtr->interpListPtr; riPtr != NULL;
- riPtr = riPtr->nextPtr) {
- if (_tcsicmp(riPtr->name, utilString) == 0) {
- convPtr = (Conversation *) Tcl_Alloc(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:
- /*
- * 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);
- }
- Tcl_Free((char *) convPtr);
- break;
- }
- }
- return (HDDEDATA) TRUE;
-
- 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) && (uFmt != CF_UNICODETEXT)) {
- return (HDDEDATA) FALSE;
- }
-
- ddeReturn = (HDDEDATA) FALSE;
- for (convPtr = tsdPtr->currentConversations; (convPtr != NULL)
- && (convPtr->hConv != hConv); convPtr = convPtr->nextPtr) {
- /*
- * Empty loop body.
- */
- }
-
- if (convPtr != NULL) {
- Tcl_DString dsBuf;
- char *returnString;
-
- len = DdeQueryString(ddeInstance, ddeItem, NULL, 0, CP_WINUNICODE);
- Tcl_DStringInit(&dString);
- Tcl_DStringInit(&dsBuf);
- Tcl_DStringSetLength(&dString, (len + 1) * sizeof(TCHAR) - 1);
- utilString = (TCHAR *) Tcl_DStringValue(&dString);
- DdeQueryString(ddeInstance, ddeItem, utilString, (DWORD) len + 1,
- CP_WINUNICODE);
- if (_tcsicmp(utilString, TCL_DDE_EXECUTE_RESULT) == 0) {
- returnString =
- Tcl_GetString(convPtr->returnPackagePtr);
- len = convPtr->returnPackagePtr->length;
- if (uFmt != CF_TEXT) {
- Tcl_WinUtfToTChar(returnString, len, &dsBuf);
- returnString = Tcl_DStringValue(&dsBuf);
- len = Tcl_DStringLength(&dsBuf) + sizeof(TCHAR) - 1;
- }
- ddeReturn = DdeCreateDataHandle(ddeInstance, (BYTE *)returnString,
- (DWORD) len+1, 0, ddeItem, uFmt, 0);
- } else {
- if (Tcl_IsSafe(convPtr->riPtr->interp)) {
- ddeReturn = NULL;
- } else {
- Tcl_DString ds;
- Tcl_Obj *variableObjPtr;
-
- Tcl_WinTCharToUtf(utilString, -1, &ds);
- variableObjPtr = Tcl_GetVar2Ex(
- convPtr->riPtr->interp, Tcl_DStringValue(&ds), NULL,
- TCL_GLOBAL_ONLY);
- if (variableObjPtr != NULL) {
- returnString = Tcl_GetString(variableObjPtr);
- len = variableObjPtr->length;
- if (uFmt != CF_TEXT) {
- Tcl_WinUtfToTChar(returnString, len, &dsBuf);
- returnString = Tcl_DStringValue(&dsBuf);
- len = Tcl_DStringLength(&dsBuf) + sizeof(TCHAR) - 1;
- }
- ddeReturn = DdeCreateDataHandle(ddeInstance,
- (BYTE *)returnString, (DWORD) len+1, 0, ddeItem,
- uFmt, 0);
- } else {
- ddeReturn = NULL;
- }
- Tcl_DStringFree(&ds);
- }
- }
- Tcl_DStringFree(&dsBuf);
- Tcl_DStringFree(&dString);
- }
- return ddeReturn;
-
-#if !CBF_FAIL_POKES
- case XTYP_POKE:
- /*
- * This is a poke for a Tcl variable, only implemented in
- * debug/UNICODE mode.
- */
- ddeReturn = DDE_FNOTPROCESSED;
-
- if ((uFmt != CF_TEXT) && (uFmt != CF_UNICODETEXT)) {
- return ddeReturn;
- }
-
- for (convPtr = tsdPtr->currentConversations; (convPtr != NULL)
- && (convPtr->hConv != hConv); convPtr = convPtr->nextPtr) {
- /*
- * Empty loop body.
- */
- }
-
- if (convPtr && !Tcl_IsSafe(convPtr->riPtr->interp)) {
- Tcl_DString ds, ds2;
- Tcl_Obj *variableObjPtr;
- DWORD len2;
-
- Tcl_DStringInit(&dString);
- Tcl_DStringInit(&ds2);
- len = DdeQueryString(ddeInstance, ddeItem, NULL, 0, CP_WINUNICODE);
- Tcl_DStringSetLength(&dString, (len + 1) * sizeof(TCHAR) - 1);
- utilString = (TCHAR *) Tcl_DStringValue(&dString);
- DdeQueryString(ddeInstance, ddeItem, utilString, (DWORD) len + 1,
- CP_WINUNICODE);
- Tcl_WinTCharToUtf(utilString, -1, &ds);
- utilString = (TCHAR *) DdeAccessData(hData, &len2);
- len = len2;
- if (uFmt != CF_TEXT) {
- Tcl_WinTCharToUtf(utilString, -1, &ds2);
- utilString = (TCHAR *) Tcl_DStringValue(&ds2);
- }
- variableObjPtr = Tcl_NewStringObj((char *)utilString, -1);
-
- Tcl_SetVar2Ex(convPtr->riPtr->interp, Tcl_DStringValue(&ds), NULL,
- variableObjPtr, TCL_GLOBAL_ONLY);
-
- Tcl_DStringFree(&ds2);
- Tcl_DStringFree(&ds);
- Tcl_DStringFree(&dString);
- ddeReturn = (HDDEDATA) DDE_FACK;
- }
- return ddeReturn;
-
-#endif
- case XTYP_EXECUTE: {
- /*
- * Execute this script. The results will be saved into a list object
- * which will be retreived later. See ExecuteRemoteObject.
- */
-
- Tcl_Obj *returnPackagePtr;
- char *string;
-
- for (convPtr = tsdPtr->currentConversations; (convPtr != NULL)
- && (convPtr->hConv != hConv); convPtr = convPtr->nextPtr) {
- /*
- * Empty loop body.
- */
- }
-
- if (convPtr == NULL) {
- return (HDDEDATA) DDE_FNOTPROCESSED;
- }
-
- utilString = (TCHAR *) DdeAccessData(hData, &dlen);
- string = (char *) utilString;
- if (!dlen) {
- /* Empty binary array. */
- ddeObjectPtr = Tcl_NewObj();
- } else if ((dlen & 1) || utilString[(dlen>>1)-1]) {
- /* Cannot be unicode, so assume utf-8 */
- if (!string[dlen-1]) {
- dlen--;
- }
- ddeObjectPtr = Tcl_NewStringObj(string, dlen);
- } else {
- /* unicode */
- Tcl_DString dsBuf;
-
- Tcl_WinTCharToUtf(utilString, dlen - sizeof(TCHAR), &dsBuf);
- ddeObjectPtr = Tcl_NewStringObj(Tcl_DStringValue(&dsBuf),
- Tcl_DStringLength(&dsBuf));
- Tcl_DStringFree(&dsBuf);
- }
- 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;
- }
- }
-
- case XTYP_WILDCONNECT: {
- /*
- * Dde wants a list of services and topics that we support.
- */
-
- 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,
- TCL_DDE_SERVICE_NAME, CP_WINUNICODE);
- returnPtr[i].hszTopic = DdeCreateStringHandle(ddeInstance,
- riPtr->name, CP_WINUNICODE);
- }
- returnPtr[i].hszSvc = NULL;
- returnPtr[i].hszTopic = NULL;
- DdeUnaccessData(ddeReturn);
- return ddeReturn;
- }
-
- default:
- return NULL;
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * DdeExitProc --
- *
- * Gets rid of our DDE server when we go away.
- *
- * Results:
- * None.
- *
- * Side effects:
- * The DDE server is deleted.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-DdeExitProc(
- ClientData clientData) /* Not used in this handler. */
-{
- DdeNameService(ddeInstance, NULL, 0, DNS_UNREGISTER);
- DdeUninitialize(ddeInstance);
- ddeInstance = 0;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * MakeDdeConnection --
- *
- * 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
-MakeDdeConnection(
- Tcl_Interp *interp, /* Used to report errors. */
- const TCHAR *name, /* The connection to use. */
- HCONV *ddeConvPtr)
-{
- HSZ ddeTopic, ddeService;
- HCONV ddeConv;
-
- ddeService = DdeCreateStringHandle(ddeInstance, TCL_DDE_SERVICE_NAME, CP_WINUNICODE);
- ddeTopic = DdeCreateStringHandle(ddeInstance, name, CP_WINUNICODE);
-
- ddeConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL);
- DdeFreeStringHandle(ddeInstance, ddeService);
- DdeFreeStringHandle(ddeInstance, ddeTopic);
-
- if (ddeConv == (HCONV) NULL) {
- if (interp != NULL) {
- Tcl_DString dString;
-
- Tcl_WinTCharToUtf(name, -1, &dString);
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "no registered server named \"%s\"", Tcl_DStringValue(&dString)));
- Tcl_DStringFree(&dString);
- Tcl_SetErrorCode(interp, "TCL", "DDE", "NO_SERVER", NULL);
- }
- return TCL_ERROR;
- }
-
- *ddeConvPtr = ddeConv;
- return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * DdeGetServicesList --
- *
- * This function obtains the list of DDE services.
- *
- * 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.
- *
- * Side effects:
- * Sets the services list into the interp result.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-DdeCreateClient(
- DdeEnumServices *es)
-{
- WNDCLASSEX wc;
- static const TCHAR *szDdeClientClassName = TEXT("TclEval client class");
- static const TCHAR *szDdeClientWindowName = TEXT("TclEval client window");
-
- memset(&wc, 0, sizeof(wc));
- wc.cbSize = sizeof(wc);
- wc.lpfnWndProc = DdeClientWindowProc;
- wc.lpszClassName = szDdeClientClassName;
- wc.cbWndExtra = sizeof(DdeEnumServices *);
-
- /*
- * 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);
- return TCL_OK;
-}
-
-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 */
-{
- switch (uMsg) {
- case WM_CREATE: {
- LPCREATESTRUCT lpcs = (LPCREATESTRUCT) lParam;
- DdeEnumServices *es =
- (DdeEnumServices *) lpcs->lpCreateParams;
-
-#ifdef _WIN64
- SetWindowLongPtr(hwnd, GWLP_USERDATA, (LONG_PTR) es);
-#else
- SetWindowLong(hwnd, GWL_USERDATA, (LONG) es);
-#endif
- return (LRESULT) 0L;
- }
- case WM_DDE_ACK:
- return DdeServicesOnAck(hwnd, wParam, lParam);
- default:
- return DefWindowProc(hwnd, uMsg, wParam, lParam);
- }
-}
-
-static LRESULT
-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];
- Tcl_DString dString;
-
-#ifdef _WIN64
- es = (DdeEnumServices *) GetWindowLongPtr(hwnd, GWLP_USERDATA);
-#else
- es = (DdeEnumServices *) GetWindowLong(hwnd, GWL_USERDATA);
-#endif
-
- if (((es->service == (ATOM)0) || (es->service == service))
- && ((es->topic == (ATOM)0) || (es->topic == topic))) {
- Tcl_Obj *matchPtr = Tcl_NewListObj(0, NULL);
- Tcl_Obj *resultPtr = Tcl_GetObjResult(es->interp);
-
- GlobalGetAtomName(service, sz, 255);
- Tcl_WinTCharToUtf(sz, -1, &dString);
- Tcl_ListObjAppendElement(NULL, matchPtr, Tcl_NewStringObj(Tcl_DStringValue(&dString), -1));
- Tcl_DStringFree(&dString);
- GlobalGetAtomName(topic, sz, 255);
- Tcl_WinTCharToUtf(sz, -1, &dString);
- Tcl_ListObjAppendElement(NULL, matchPtr, Tcl_NewStringObj(Tcl_DStringValue(&dString), -1));
- Tcl_DStringFree(&dString);
-
- /*
- * 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(NULL, matchPtr,
- * Tcl_NewLongObj((long)hwndRemote));
- */
-
- 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.
- */
-
- PostMessage(hwndRemote, WM_DDE_TERMINATE, (WPARAM)hwnd, 0L);
- return 0L;
-}
-
-static BOOL CALLBACK
-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);
- return TRUE;
-}
-
-static int
-DdeGetServicesList(
- Tcl_Interp *interp,
- const TCHAR *serviceName,
- const TCHAR *topicName)
-{
- 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);
-
- 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) {
- GlobalDeleteAtom(es.service);
- }
- 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.
- *
- * Results:
- * None.
- *
- * Side effects:
- * The interp's result object is changed.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-SetDdeError(
- Tcl_Interp *interp) /* The interp to put the message in. */
-{
- const char *errorMessage, *errorCode;
-
- switch (DdeGetLastError(ddeInstance)) {
- case DMLERR_DATAACKTIMEOUT:
- case DMLERR_EXECACKTIMEOUT:
- case DMLERR_POKEACKTIMEOUT:
- errorMessage = "remote interpreter did not respond";
- errorCode = "TIMEOUT";
- break;
- case DMLERR_BUSY:
- errorMessage = "remote server is busy";
- errorCode = "BUSY";
- break;
- case DMLERR_NOTPROCESSED:
- errorMessage = "remote server cannot handle this command";
- errorCode = "NOCANDO";
- break;
- default:
- errorMessage = "dde command failed";
- errorCode = "FAILED";
- }
-
- Tcl_SetObjResult(interp, Tcl_NewStringObj(errorMessage, -1));
- Tcl_SetErrorCode(interp, "TCL", "DDE", errorCode, NULL);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * DdeObjCmd --
- *
- * 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.
- *
- * Side effects:
- * See the user documentation.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-DdeObjCmd(
- ClientData clientData, /* Used only for deletion */
- Tcl_Interp *interp, /* The interp we are sending from */
- int objc, /* Number of arguments */
- Tcl_Obj *const *objv) /* The arguments */
-{
- static const char *const ddeCommands[] = {
- "servername", "execute", "poke", "request", "services", "eval",
- (char *) NULL};
- enum DdeSubcommands {
- DDE_SERVERNAME, DDE_EXECUTE, DDE_POKE, DDE_REQUEST, DDE_SERVICES,
- DDE_EVAL
- };
- static const char *const ddeSrvOptions[] = {
- "-force", "-handler", "--", NULL
- };
- enum DdeSrvOptions {
- DDE_SERVERNAME_EXACT, DDE_SERVERNAME_HANDLER, DDE_SERVERNAME_LAST,
- };
- static const char *const ddeExecOptions[] = {
- "-async", "-binary", NULL
- };
- enum DdeExecOptions {
- DDE_EXEC_ASYNC, DDE_EXEC_BINARY
- };
- static const char *const ddeEvalOptions[] = {
- "-async", NULL
- };
- static const char *const ddeReqOptions[] = {
- "-binary", NULL
- };
-
- int index, i, argIndex;
- size_t length;
- int flags = 0, result = TCL_OK, firstArg = 0;
- HSZ ddeService = NULL, ddeTopic = NULL, ddeItem = NULL, ddeCookie = NULL;
- HDDEDATA ddeData = NULL, ddeItemData = NULL, ddeReturn;
- HCONV hConv = NULL;
- const TCHAR *serviceName = NULL, *topicName = NULL;
- const char *string;
- DWORD ddeResult;
- Tcl_Obj *objPtr, *handlerPtr = NULL;
- Tcl_DString serviceBuf, topicBuf, itemBuf;
-
- /*
- * Initialize DDE server/client
- */
-
- if (objc < 2) {
- Tcl_WrongNumArgs(interp, 1, objv, "command ?arg ...?");
- return TCL_ERROR;
- }
-
- if (Tcl_GetIndexFromObj(interp, objv[1], ddeCommands, "command", 0,
- &index) != TCL_OK) {
- return TCL_ERROR;
- }
-
- Tcl_DStringInit(&serviceBuf);
- Tcl_DStringInit(&topicBuf);
- Tcl_DStringInit(&itemBuf);
- switch ((enum DdeSubcommands) index) {
- case DDE_SERVERNAME:
- for (i = 2; i < objc; i++) {
- 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;
- }
- Tcl_ResetResult(interp);
- break;
- }
- if (argIndex == DDE_SERVERNAME_EXACT) {
- flags |= DDE_FLAG_FORCE;
- } 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;
- }
- 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;
- } else if ((objc >= 6) && (objc <= 7)) {
- firstArg = objc - 3;
- for (i = 2; i < firstArg; i++) {
- if (Tcl_GetIndexFromObj(interp, objv[i], ddeExecOptions,
- "option", 0, &argIndex) != TCL_OK) {
- goto wrongDdeExecuteArgs;
- }
- if (argIndex == DDE_EXEC_ASYNC) {
- flags |= DDE_FLAG_ASYNC;
- } else {
- flags |= DDE_FLAG_BINARY;
- }
- }
- break;
- }
- /* otherwise... */
- wrongDdeExecuteArgs:
- Tcl_WrongNumArgs(interp, 2, objv,
- "?-async? ?-binary? serviceName topicName value");
- return TCL_ERROR;
- case DDE_POKE:
- if (objc == 6) {
- firstArg = 2;
- break;
- } else if ((objc == 7) && (Tcl_GetIndexFromObj(NULL, objv[2],
- ddeReqOptions, "option", 0, &argIndex) == TCL_OK)) {
- flags |= DDE_FLAG_BINARY;
- firstArg = 3;
- break;
- }
-
- /*
- * Otherwise...
- */
-
- Tcl_WrongNumArgs(interp, 2, objv,
- "?-binary? serviceName topicName item value");
- return TCL_ERROR;
- case DDE_REQUEST:
- if (objc == 5) {
- firstArg = 2;
- break;
- } else if ((objc == 6) && (Tcl_GetIndexFromObj(NULL, objv[2],
- ddeReqOptions, "option", 0, &argIndex) == TCL_OK)) {
- flags |= DDE_FLAG_BINARY;
- firstArg = 3;
- break;
- }
-
- /*
- * 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 {
- firstArg = 2;
- if (Tcl_GetIndexFromObj(NULL, objv[2], ddeEvalOptions, "option",
- 0, &argIndex) == TCL_OK) {
- if (objc < 5) {
- goto wrongDdeEvalArgs;
- }
- flags |= DDE_FLAG_ASYNC;
- firstArg++;
- }
- break;
- }
- }
-
- Initialize();
-
- if (firstArg != 1) {
- const char *src = Tcl_GetString(objv[firstArg]);
-
- length = objv[firstArg]->length;
- Tcl_WinUtfToTChar(src, length, &serviceBuf);
- serviceName = (TCHAR *) Tcl_DStringValue(&serviceBuf);
- length = Tcl_DStringLength(&serviceBuf) / sizeof(TCHAR);
- } else {
- length = 0;
- }
-
- if (length == 0) {
- serviceName = NULL;
- } else if ((index != DDE_SERVERNAME) && (index != DDE_EVAL)) {
- ddeService = DdeCreateStringHandle(ddeInstance, (void *) serviceName,
- CP_WINUNICODE);
- }
-
- if ((index != DDE_SERVERNAME) && (index != DDE_EVAL)) {
- const char *src = Tcl_GetString(objv[firstArg + 1]);
-
- length = objv[firstArg + 1]->length;
- topicName = Tcl_WinUtfToTChar(src, length, &topicBuf);
- length = Tcl_DStringLength(&topicBuf) / sizeof(TCHAR);
- if (length == 0) {
- topicName = NULL;
- } else {
- ddeTopic = DdeCreateStringHandle(ddeInstance, (void *) topicName,
- CP_WINUNICODE);
- }
- }
-
- switch ((enum DdeSubcommands) index) {
- case DDE_SERVERNAME:
- serviceName = DdeSetServerName(interp, serviceName, flags,
- handlerPtr);
- if (serviceName != NULL) {
- Tcl_DString dsBuf;
-
- Tcl_WinTCharToUtf(serviceName, -1, &dsBuf);
- Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_DStringValue(&dsBuf),
- Tcl_DStringLength(&dsBuf)));
- Tcl_DStringFree(&dsBuf);
- } else {
- Tcl_ResetResult(interp);
- }
- break;
-
- case DDE_EXECUTE: {
- size_t dataLength;
- const void *dataString;
- Tcl_DString dsBuf;
-
- Tcl_DStringInit(&dsBuf);
- if (flags & DDE_FLAG_BINARY) {
- dataString =
- getByteArrayFromObj(objv[firstArg + 2], &dataLength);
- } else {
- const char *src;
-
- src = Tcl_GetString(objv[firstArg + 2]);
- dataLength = objv[firstArg + 2]->length;
- dataString = (const TCHAR *)
- Tcl_WinUtfToTChar(src, dataLength, &dsBuf);
- dataLength = Tcl_DStringLength(&dsBuf) + sizeof(TCHAR);
- }
-
- if (dataLength + 1 < 2) {
- Tcl_SetObjResult(interp,
- Tcl_NewStringObj("cannot execute null data", -1));
- Tcl_DStringFree(&dsBuf);
- Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", NULL);
- result = TCL_ERROR;
- break;
- }
- hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL);
- DdeFreeStringHandle(ddeInstance, ddeService);
- DdeFreeStringHandle(ddeInstance, ddeTopic);
-
- if (hConv == NULL) {
- Tcl_DStringFree(&dsBuf);
- SetDdeError(interp);
- result = TCL_ERROR;
- break;
- }
-
- ddeData = DdeCreateDataHandle(ddeInstance, (BYTE *) dataString,
- (DWORD) dataLength, 0, 0, (flags & DDE_FLAG_BINARY) ? CF_TEXT : CF_UNICODETEXT, 0);
- if (ddeData != NULL) {
- if (flags & DDE_FLAG_ASYNC) {
- DdeClientTransaction((LPBYTE) ddeData, 0xFFFFFFFF, hConv, 0,
- (flags & DDE_FLAG_BINARY) ? CF_TEXT : CF_UNICODETEXT, XTYP_EXECUTE, TIMEOUT_ASYNC, &ddeResult);
- DdeAbandonTransaction(ddeInstance, hConv, ddeResult);
- } else {
- ddeReturn = DdeClientTransaction((LPBYTE) ddeData, 0xFFFFFFFF,
- hConv, 0, (flags & DDE_FLAG_BINARY) ? CF_TEXT : CF_UNICODETEXT, XTYP_EXECUTE, 30000, NULL);
- if (ddeReturn == 0) {
- SetDdeError(interp);
- result = TCL_ERROR;
- }
- }
- DdeFreeDataHandle(ddeData);
- } else {
- SetDdeError(interp);
- result = TCL_ERROR;
- }
- Tcl_DStringFree(&dsBuf);
- break;
- }
- case DDE_REQUEST: {
- const TCHAR *itemString;
- const char *src;
-
- src = Tcl_GetString(objv[firstArg + 2]);
- length = objv[firstArg + 2]->length;
- itemString = Tcl_WinUtfToTChar(src, length, &itemBuf);
- length = Tcl_DStringLength(&itemBuf) / sizeof(TCHAR);
-
- if (length == 0) {
- Tcl_SetObjResult(interp,
- Tcl_NewStringObj("cannot request value of null data", -1));
- Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", NULL);
- result = TCL_ERROR;
- goto cleanup;
- }
- 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, (void *) itemString,
- CP_WINUNICODE);
- if (ddeItem != NULL) {
- ddeData = DdeClientTransaction(NULL, 0, hConv, ddeItem,
- (flags & DDE_FLAG_BINARY) ? CF_TEXT : CF_UNICODETEXT, XTYP_REQUEST, 5000, NULL);
- if (ddeData == NULL) {
- SetDdeError(interp);
- result = TCL_ERROR;
- } else {
- DWORD tmp;
- TCHAR *dataString = (TCHAR *) DdeAccessData(ddeData, &tmp);
-
- if (flags & DDE_FLAG_BINARY) {
- returnObjPtr =
- Tcl_NewByteArrayObj((BYTE *) dataString, tmp);
- } else {
- Tcl_DString dsBuf;
-
- if ((tmp >= sizeof(TCHAR))
- && !dataString[tmp / sizeof(TCHAR) - 1]) {
- tmp -= sizeof(TCHAR);
- }
- Tcl_WinTCharToUtf(dataString, tmp, &dsBuf);
- returnObjPtr =
- Tcl_NewStringObj(Tcl_DStringValue(&dsBuf),
- Tcl_DStringLength(&dsBuf));
- Tcl_DStringFree(&dsBuf);
- }
- DdeUnaccessData(ddeData);
- DdeFreeDataHandle(ddeData);
- Tcl_SetObjResult(interp, returnObjPtr);
- }
- } else {
- SetDdeError(interp);
- result = TCL_ERROR;
- }
- }
- break;
- }
- case DDE_POKE: {
- Tcl_DString dsBuf;
- const TCHAR *itemString;
- BYTE *dataString;
- const char *src;
-
- src = Tcl_GetString(objv[firstArg + 2]);
- length = objv[firstArg + 2]->length;
- itemString = Tcl_WinUtfToTChar(src, length, &itemBuf);
- length = Tcl_DStringLength(&itemBuf) / sizeof(TCHAR);
- if (length == 0) {
- Tcl_SetObjResult(interp,
- Tcl_NewStringObj("cannot have a null item", -1));
- Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", NULL);
- result = TCL_ERROR;
- goto cleanup;
- }
- Tcl_DStringInit(&dsBuf);
- if (flags & DDE_FLAG_BINARY) {
- dataString = (BYTE *)
- getByteArrayFromObj(objv[firstArg + 3], &length);
- } else {
- const char *data =
- Tcl_GetString(objv[firstArg + 3]);
- length = objv[firstArg + 3]->length;
- dataString = (BYTE *)
- Tcl_WinUtfToTChar(data, length, &dsBuf);
- length = Tcl_DStringLength(&dsBuf) + sizeof(TCHAR);
- }
-
- 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_WINUNICODE);
- if (ddeItem != NULL) {
- ddeData = DdeClientTransaction(dataString, (DWORD) length,
- hConv, ddeItem, (flags & DDE_FLAG_BINARY) ? CF_TEXT : CF_UNICODETEXT, XTYP_POKE, 5000, NULL);
- if (ddeData == NULL) {
- SetDdeError(interp);
- result = TCL_ERROR;
- }
- } else {
- SetDdeError(interp);
- result = TCL_ERROR;
- }
- }
- Tcl_DStringFree(&dsBuf);
- 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));
- Tcl_SetErrorCode(interp, "TCL", "DDE", "NO_SERVER", NULL);
- result = TCL_ERROR;
- goto cleanup;
- }
-
- objc -= firstArg + 1;
- objv += firstArg + 1;
-
- /*
- * 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 (_tcsicmp(serviceName, riPtr->name) == 0) {
- break;
- }
- }
-
- if (riPtr != NULL) {
- Tcl_Interp *sendInterp;
-
- /*
- * This command is to a local interp. No need to go through the
- * server.
- */
-
- Tcl_Preserve(riPtr);
- sendInterp = riPtr->interp;
- Tcl_Preserve(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.
- */
-
- if (Tcl_IsSafe(riPtr->interp) && (riPtr->handlerPtr == NULL)) {
- Tcl_SetObjResult(riPtr->interp, Tcl_NewStringObj(
- "permission denied: a handler procedure must be"
- " defined for use in a safe interp", -1));
- Tcl_SetErrorCode(interp, "TCL", "DDE", "SECURITY_CHECK",
- NULL);
- result = TCL_ERROR;
- }
-
- if (result == TCL_OK) {
- if (objc == 1)
- objPtr = objv[0];
- else {
- objPtr = Tcl_ConcatObj(objc, objv);
- }
- 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) {
- Tcl_AppendObjToErrorInfo(interp, objPtr);
- }
-
- objPtr = Tcl_GetVar2Ex(sendInterp, "errorCode", NULL,
- TCL_GLOBAL_ONLY);
- if (objPtr) {
- Tcl_SetObjErrorCode(interp, objPtr);
- }
- }
- Tcl_SetObjResult(interp, Tcl_GetObjResult(sendInterp));
- }
- Tcl_Release(riPtr);
- Tcl_Release(sendInterp);
- } else {
- Tcl_DString dsBuf;
-
- /*
- * 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));
- Tcl_SetErrorCode(interp, "TCL", "DDE", "BAD_RESPONSE", NULL);
- result = TCL_ERROR;
- goto cleanup;
- }
-
- objPtr = Tcl_ConcatObj(objc, objv);
- string = Tcl_GetString(objPtr);
- length = objPtr->length;
- Tcl_WinUtfToTChar(string, length, &dsBuf);
- string = Tcl_DStringValue(&dsBuf);
- length = Tcl_DStringLength(&dsBuf) + sizeof(TCHAR);
- ddeItemData = DdeCreateDataHandle(ddeInstance, (BYTE *) string,
- (DWORD) length, 0, 0, CF_UNICODETEXT, 0);
- Tcl_DStringFree(&dsBuf);
-
- if (flags & DDE_FLAG_ASYNC) {
- ddeData = DdeClientTransaction((LPBYTE) ddeItemData,
- 0xFFFFFFFF, hConv, 0,
- CF_UNICODETEXT, XTYP_EXECUTE, TIMEOUT_ASYNC, &ddeResult);
- DdeAbandonTransaction(ddeInstance, hConv, ddeResult);
- } else {
- ddeData = DdeClientTransaction((LPBYTE) ddeItemData,
- 0xFFFFFFFF, hConv, 0,
- CF_UNICODETEXT, XTYP_EXECUTE, 30000, NULL);
- if (ddeData != 0) {
- ddeCookie = DdeCreateStringHandle(ddeInstance,
- TCL_DDE_EXECUTE_RESULT, CP_WINUNICODE);
- ddeData = DdeClientTransaction(NULL, 0, hConv, ddeCookie,
- CF_UNICODETEXT, XTYP_REQUEST, 30000, NULL);
- }
- }
-
- Tcl_DecrRefCount(objPtr);
-
- if (ddeData == 0) {
- SetDdeError(interp);
- result = TCL_ERROR;
- goto cleanup;
- }
-
- if (!(flags & DDE_FLAG_ASYNC)) {
- Tcl_Obj *resultPtr;
- TCHAR *ddeDataString;
-
- /*
- * 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".
- */
-
- length = DdeGetData(ddeData, NULL, 0, 0);
- ddeDataString = (TCHAR *) Tcl_Alloc(length);
- DdeGetData(ddeData, (BYTE *) ddeDataString, (DWORD) length, 0);
- if (length > sizeof(TCHAR)) {
- length -= sizeof(TCHAR);
- }
- Tcl_WinTCharToUtf(ddeDataString, length, &dsBuf);
- resultPtr = Tcl_NewStringObj(Tcl_DStringValue(&dsBuf),
- Tcl_DStringLength(&dsBuf));
- Tcl_DStringFree(&dsBuf);
- Tcl_Free((char *) ddeDataString);
-
- if (Tcl_ListObjIndex(NULL, resultPtr, 0, &objPtr) != TCL_OK) {
- Tcl_DecrRefCount(resultPtr);
- goto invalidServerResponse;
- }
- if (Tcl_GetIntFromObj(NULL, objPtr, &result) != TCL_OK) {
- Tcl_DecrRefCount(resultPtr);
- goto invalidServerResponse;
- }
- if (result == TCL_ERROR) {
- Tcl_ResetResult(interp);
-
- if (Tcl_ListObjIndex(NULL, resultPtr, 3,
- &objPtr) != TCL_OK) {
- Tcl_DecrRefCount(resultPtr);
- goto invalidServerResponse;
- }
- Tcl_AppendObjToErrorInfo(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);
- }
- }
- }
- }
-
- cleanup:
- 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);
- }
- Tcl_DStringFree(&itemBuf);
- Tcl_DStringFree(&topicBuf);
- Tcl_DStringFree(&serviceBuf);
- return result;
-}
-
-/*
- * Local variables:
- * mode: c
- * indent-tabs-mode: t
- * tab-width: 8
- * c-basic-offset: 4
- * fill-column: 78
- * End:
- */
diff --git a/tcl8.6/win/tclWinError.c b/tcl8.6/win/tclWinError.c
deleted file mode 100644
index fea4b0f..0000000
--- a/tcl8.6/win/tclWinError.c
+++ /dev/null
@@ -1,428 +0,0 @@
-/*
- * tclWinError.c --
- *
- * This file contains code for converting from Win32 errors to errno
- * errors.
- *
- * Copyright (c) 1995-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.
- */
-
-#include "tclInt.h"
-/*
- * The following table contains the mapping from Win32 errors to errno errors.
- */
-
-static const unsigned char errorTable[] = {
- 0,
- EINVAL, /* ERROR_INVALID_FUNCTION 1 */
- ENOENT, /* ERROR_FILE_NOT_FOUND 2 */
- ENOENT, /* ERROR_PATH_NOT_FOUND 3 */
- EMFILE, /* ERROR_TOO_MANY_OPEN_FILES 4 */
- EACCES, /* ERROR_ACCESS_DENIED 5 */
- EBADF, /* ERROR_INVALID_HANDLE 6 */
- ENOMEM, /* ERROR_ARENA_TRASHED 7 */
- ENOMEM, /* ERROR_NOT_ENOUGH_MEMORY 8 */
- ENOMEM, /* ERROR_INVALID_BLOCK 9 */
- E2BIG, /* ERROR_BAD_ENVIRONMENT 10 */
- ENOEXEC, /* ERROR_BAD_FORMAT 11 */
- EACCES, /* ERROR_INVALID_ACCESS 12 */
- EINVAL, /* ERROR_INVALID_DATA 13 */
- ENOMEM, /* ERROR_OUT_OF_MEMORY 14 */
- ENOENT, /* ERROR_INVALID_DRIVE 15 */
- EACCES, /* ERROR_CURRENT_DIRECTORY 16 */
- EXDEV, /* ERROR_NOT_SAME_DEVICE 17 */
- ENOENT, /* ERROR_NO_MORE_FILES 18 */
- EROFS, /* ERROR_WRITE_PROTECT 19 */
- ENXIO, /* ERROR_BAD_UNIT 20 */
- EBUSY, /* ERROR_NOT_READY 21 */
- EIO, /* ERROR_BAD_COMMAND 22 */
- EIO, /* ERROR_CRC 23 */
- EIO, /* ERROR_BAD_LENGTH 24 */
- EIO, /* ERROR_SEEK 25 */
- EIO, /* ERROR_NOT_DOS_DISK 26 */
- ENXIO, /* ERROR_SECTOR_NOT_FOUND 27 */
- EBUSY, /* ERROR_OUT_OF_PAPER 28 */
- EIO, /* ERROR_WRITE_FAULT 29 */
- EIO, /* ERROR_READ_FAULT 30 */
- EIO, /* ERROR_GEN_FAILURE 31 */
- EACCES, /* ERROR_SHARING_VIOLATION 32 */
- EACCES, /* ERROR_LOCK_VIOLATION 33 */
- ENXIO, /* ERROR_WRONG_DISK 34 */
- ENFILE, /* ERROR_FCB_UNAVAILABLE 35 */
- ENFILE, /* ERROR_SHARING_BUFFER_EXCEEDED 36 */
- EINVAL, /* 37 */
- EINVAL, /* 38 */
- ENOSPC, /* ERROR_HANDLE_DISK_FULL 39 */
- EINVAL, /* 40 */
- EINVAL, /* 41 */
- EINVAL, /* 42 */
- EINVAL, /* 43 */
- EINVAL, /* 44 */
- EINVAL, /* 45 */
- EINVAL, /* 46 */
- EINVAL, /* 47 */
- EINVAL, /* 48 */
- EINVAL, /* 49 */
- ENODEV, /* ERROR_NOT_SUPPORTED 50 */
- EBUSY, /* ERROR_REM_NOT_LIST 51 */
- EEXIST, /* ERROR_DUP_NAME 52 */
- ENOENT, /* ERROR_BAD_NETPATH 53 */
- EBUSY, /* ERROR_NETWORK_BUSY 54 */
- ENODEV, /* ERROR_DEV_NOT_EXIST 55 */
- EAGAIN, /* ERROR_TOO_MANY_CMDS 56 */
- EIO, /* ERROR_ADAP_HDW_ERR 57 */
- EIO, /* ERROR_BAD_NET_RESP 58 */
- EIO, /* ERROR_UNEXP_NET_ERR 59 */
- EINVAL, /* ERROR_BAD_REM_ADAP 60 */
- EFBIG, /* ERROR_PRINTQ_FULL 61 */
- ENOSPC, /* ERROR_NO_SPOOL_SPACE 62 */
- ENOENT, /* ERROR_PRINT_CANCELLED 63 */
- ENOENT, /* ERROR_NETNAME_DELETED 64 */
- EACCES, /* ERROR_NETWORK_ACCESS_DENIED 65 */
- ENODEV, /* ERROR_BAD_DEV_TYPE 66 */
- ENOENT, /* ERROR_BAD_NET_NAME 67 */
- ENFILE, /* ERROR_TOO_MANY_NAMES 68 */
- EIO, /* ERROR_TOO_MANY_SESS 69 */
- EAGAIN, /* ERROR_SHARING_PAUSED 70 */
- EINVAL, /* ERROR_REQ_NOT_ACCEP 71 */
- EAGAIN, /* ERROR_REDIR_PAUSED 72 */
- EINVAL, /* 73 */
- EINVAL, /* 74 */
- EINVAL, /* 75 */
- EINVAL, /* 76 */
- EINVAL, /* 77 */
- EINVAL, /* 78 */
- EINVAL, /* 79 */
- EEXIST, /* ERROR_FILE_EXISTS 80 */
- EINVAL, /* 81 */
- ENOSPC, /* ERROR_CANNOT_MAKE 82 */
- EIO, /* ERROR_FAIL_I24 83 */
- ENFILE, /* ERROR_OUT_OF_STRUCTURES 84 */
- EEXIST, /* ERROR_ALREADY_ASSIGNED 85 */
- EPERM, /* ERROR_INVALID_PASSWORD 86 */
- EINVAL, /* ERROR_INVALID_PARAMETER 87 */
- EIO, /* ERROR_NET_WRITE_FAULT 88 */
- EAGAIN, /* ERROR_NO_PROC_SLOTS 89 */
- EINVAL, /* 90 */
- EINVAL, /* 91 */
- EINVAL, /* 92 */
- EINVAL, /* 93 */
- EINVAL, /* 94 */
- EINVAL, /* 95 */
- EINVAL, /* 96 */
- EINVAL, /* 97 */
- EINVAL, /* 98 */
- EINVAL, /* 99 */
- EINVAL, /* 100 */
- EINVAL, /* 101 */
- EINVAL, /* 102 */
- EINVAL, /* 103 */
- EINVAL, /* 104 */
- EINVAL, /* 105 */
- EINVAL, /* 106 */
- EXDEV, /* ERROR_DISK_CHANGE 107 */
- EAGAIN, /* ERROR_DRIVE_LOCKED 108 */
- EPIPE, /* ERROR_BROKEN_PIPE 109 */
- ENOENT, /* ERROR_OPEN_FAILED 110 */
- EINVAL, /* ERROR_BUFFER_OVERFLOW 111 */
- ENOSPC, /* ERROR_DISK_FULL 112 */
- EMFILE, /* ERROR_NO_MORE_SEARCH_HANDLES 113 */
- EBADF, /* ERROR_INVALID_TARGET_HANDLE 114 */
- EFAULT, /* ERROR_PROTECTION_VIOLATION 115 */
- EINVAL, /* 116 */
- EINVAL, /* 117 */
- EINVAL, /* 118 */
- EINVAL, /* 119 */
- EINVAL, /* 120 */
- EINVAL, /* 121 */
- EINVAL, /* 122 */
- ENOENT, /* ERROR_INVALID_NAME 123 */
- EINVAL, /* 124 */
- EINVAL, /* 125 */
- EINVAL, /* 126 */
- EINVAL, /* ERROR_PROC_NOT_FOUND 127 */
- ECHILD, /* ERROR_WAIT_NO_CHILDREN 128 */
- ECHILD, /* ERROR_CHILD_NOT_COMPLETE 129 */
- EBADF, /* ERROR_DIRECT_ACCESS_HANDLE 130 */
- EINVAL, /* ERROR_NEGATIVE_SEEK 131 */
- ESPIPE, /* ERROR_SEEK_ON_DEVICE 132 */
- EINVAL, /* 133 */
- EINVAL, /* 134 */
- EINVAL, /* 135 */
- EINVAL, /* 136 */
- EINVAL, /* 137 */
- EINVAL, /* 138 */
- EINVAL, /* 139 */
- EINVAL, /* 140 */
- EINVAL, /* 141 */
- EAGAIN, /* ERROR_BUSY_DRIVE 142 */
- EINVAL, /* 143 */
- EINVAL, /* 144 */
- EEXIST, /* ERROR_DIR_NOT_EMPTY 145 */
- EINVAL, /* 146 */
- EINVAL, /* 147 */
- EINVAL, /* 148 */
- EINVAL, /* 149 */
- EINVAL, /* 150 */
- EINVAL, /* 151 */
- EINVAL, /* 152 */
- EINVAL, /* 153 */
- EINVAL, /* 154 */
- EINVAL, /* 155 */
- EINVAL, /* 156 */
- EINVAL, /* 157 */
- EACCES, /* ERROR_NOT_LOCKED 158 */
- EINVAL, /* 159 */
- EINVAL, /* 160 */
- ENOENT, /* ERROR_BAD_PATHNAME 161 */
- EINVAL, /* 162 */
- EINVAL, /* 163 */
- EINVAL, /* 164 */
- EINVAL, /* 165 */
- EINVAL, /* 166 */
- EACCES, /* ERROR_LOCK_FAILED 167 */
- EINVAL, /* 168 */
- EINVAL, /* 169 */
- EINVAL, /* 170 */
- EINVAL, /* 171 */
- EINVAL, /* 172 */
- EINVAL, /* 173 */
- EINVAL, /* 174 */
- EINVAL, /* 175 */
- EINVAL, /* 176 */
- EINVAL, /* 177 */
- EINVAL, /* 178 */
- EINVAL, /* 179 */
- EINVAL, /* 180 */
- EINVAL, /* 181 */
- EINVAL, /* 182 */
- EEXIST, /* ERROR_ALREADY_EXISTS 183 */
- ECHILD, /* ERROR_NO_CHILD_PROCESS 184 */
- EINVAL, /* 185 */
- EINVAL, /* 186 */
- EINVAL, /* 187 */
- EINVAL, /* 188 */
- EINVAL, /* 189 */
- EINVAL, /* 190 */
- EINVAL, /* 191 */
- EINVAL, /* 192 */
- EINVAL, /* 193 */
- EINVAL, /* 194 */
- EINVAL, /* 195 */
- EINVAL, /* 196 */
- EINVAL, /* 197 */
- EINVAL, /* 198 */
- EINVAL, /* 199 */
- EINVAL, /* 200 */
- EINVAL, /* 201 */
- EINVAL, /* 202 */
- EINVAL, /* 203 */
- EINVAL, /* 204 */
- EINVAL, /* 205 */
- ENAMETOOLONG,/* ERROR_FILENAME_EXCED_RANGE 206 */
- EINVAL, /* 207 */
- EINVAL, /* 208 */
- EINVAL, /* 209 */
- EINVAL, /* 210 */
- EINVAL, /* 211 */
- EINVAL, /* 212 */
- EINVAL, /* 213 */
- EINVAL, /* 214 */
- EINVAL, /* 215 */
- EINVAL, /* 216 */
- EINVAL, /* 217 */
- EINVAL, /* 218 */
- EINVAL, /* 219 */
- EINVAL, /* 220 */
- EINVAL, /* 221 */
- EINVAL, /* 222 */
- EINVAL, /* 223 */
- EINVAL, /* 224 */
- EINVAL, /* 225 */
- EINVAL, /* 226 */
- EINVAL, /* 227 */
- EINVAL, /* 228 */
- EINVAL, /* 229 */
- EPIPE, /* ERROR_BAD_PIPE 230 */
- EAGAIN, /* ERROR_PIPE_BUSY 231 */
- EPIPE, /* ERROR_NO_DATA 232 */
- EPIPE, /* ERROR_PIPE_NOT_CONNECTED 233 */
- EINVAL, /* 234 */
- EINVAL, /* 235 */
- EINVAL, /* 236 */
- EINVAL, /* 237 */
- EINVAL, /* 238 */
- EINVAL, /* 239 */
- EINVAL, /* 240 */
- EINVAL, /* 241 */
- EINVAL, /* 242 */
- EINVAL, /* 243 */
- EINVAL, /* 244 */
- EINVAL, /* 245 */
- EINVAL, /* 246 */
- EINVAL, /* 247 */
- EINVAL, /* 248 */
- EINVAL, /* 249 */
- EINVAL, /* 250 */
- EINVAL, /* 251 */
- EINVAL, /* 252 */
- EINVAL, /* 253 */
- EINVAL, /* 254 */
- EINVAL, /* 255 */
- EINVAL, /* 256 */
- EINVAL, /* 257 */
- EINVAL, /* 258 */
- EINVAL, /* 259 */
- EINVAL, /* 260 */
- EINVAL, /* 261 */
- EINVAL, /* 262 */
- EINVAL, /* 263 */
- EINVAL, /* 264 */
- EINVAL, /* 265 */
- EINVAL, /* 266 */
- ENOTDIR /* ERROR_DIRECTORY 267 */
-};
-
-/*
- * The following table contains the mapping from WinSock errors to
- * errno errors.
- */
-
-static const unsigned char wsaErrorTable[] = {
- EWOULDBLOCK, /* WSAEWOULDBLOCK */
- EINPROGRESS, /* WSAEINPROGRESS */
- EALREADY, /* WSAEALREADY */
- ENOTSOCK, /* WSAENOTSOCK */
- EDESTADDRREQ, /* WSAEDESTADDRREQ */
- EMSGSIZE, /* WSAEMSGSIZE */
- EPROTOTYPE, /* WSAEPROTOTYPE */
- ENOPROTOOPT, /* WSAENOPROTOOPT */
- EPROTONOSUPPORT, /* WSAEPROTONOSUPPORT */
- ESOCKTNOSUPPORT, /* WSAESOCKTNOSUPPORT */
- EOPNOTSUPP, /* WSAEOPNOTSUPP */
- EPFNOSUPPORT, /* WSAEPFNOSUPPORT */
- EAFNOSUPPORT, /* WSAEAFNOSUPPORT */
- EADDRINUSE, /* WSAEADDRINUSE */
- EADDRNOTAVAIL, /* WSAEADDRNOTAVAIL */
- ENETDOWN, /* WSAENETDOWN */
- ENETUNREACH, /* WSAENETUNREACH */
- ENETRESET, /* WSAENETRESET */
- ECONNABORTED, /* WSAECONNABORTED */
- ECONNRESET, /* WSAECONNRESET */
- ENOBUFS, /* WSAENOBUFS */
- EISCONN, /* WSAEISCONN */
- ENOTCONN, /* WSAENOTCONN */
- ESHUTDOWN, /* WSAESHUTDOWN */
- ETOOMANYREFS, /* WSAETOOMANYREFS */
- ETIMEDOUT, /* WSAETIMEDOUT */
- ECONNREFUSED, /* WSAECONNREFUSED */
- ELOOP, /* WSAELOOP */
- ENAMETOOLONG, /* WSAENAMETOOLONG */
- EHOSTDOWN, /* WSAEHOSTDOWN */
- EHOSTUNREACH, /* WSAEHOSTUNREACH */
- ENOTEMPTY, /* WSAENOTEMPTY */
- EAGAIN, /* WSAEPROCLIM */
- EUSERS, /* WSAEUSERS */
- EDQUOT, /* WSAEDQUOT */
- ESTALE, /* WSAESTALE */
- EREMOTE /* WSAEREMOTE */
-};
-
-/*
- *----------------------------------------------------------------------
- *
- * TclWinConvertError --
- *
- * This routine converts a Win32 error into an errno value.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Sets the errno global variable.
- *
- *----------------------------------------------------------------------
- */
-
-void
-TclWinConvertError(
- DWORD errCode) /* Win32 error code. */
-{
- if (errCode >= sizeof(errorTable)/sizeof(errorTable[0])) {
- errCode -= WSAEWOULDBLOCK;
- if (errCode >= sizeof(wsaErrorTable)/sizeof(wsaErrorTable[0])) {
- Tcl_SetErrno(errorTable[1]);
- } else {
- Tcl_SetErrno(wsaErrorTable[errCode]);
- }
- } else {
- Tcl_SetErrno(errorTable[errCode]);
- }
-}
-
-#ifdef __CYGWIN__
-/*
- *----------------------------------------------------------------------
- *
- * tclWinDebugPanic --
- *
- * Display a message. If a debugger is present, present it directly to
- * the debugger, otherwise send it to stderr.
- *
- * Results:
- * None.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-TCL_NORETURN void
-tclWinDebugPanic(
- const char *format, ...)
-{
-#define TCL_MAX_WARN_LEN 1024
- va_list argList;
- va_start(argList, format);
-
- if (IsDebuggerPresent()) {
- WCHAR msgString[TCL_MAX_WARN_LEN];
- char buf[TCL_MAX_WARN_LEN * TCL_UTF_MAX];
-
- vsnprintf(buf, sizeof(buf), format, argList);
- msgString[TCL_MAX_WARN_LEN-1] = L'\0';
- MultiByteToWideChar(CP_UTF8, 0, buf, -1, msgString, TCL_MAX_WARN_LEN);
-
- /*
- * Truncate MessageBox string if it is too long to not overflow the buffer.
- */
-
- if (msgString[TCL_MAX_WARN_LEN-1] != L'\0') {
- memcpy(msgString + (TCL_MAX_WARN_LEN - 5), L" ...", 5 * sizeof(WCHAR));
- }
- OutputDebugStringW(msgString);
- } else {
- vfprintf(stderr, format, argList);
- fprintf(stderr, "\n");
- fflush(stderr);
- }
-# if defined(__GNUC__)
- __builtin_trap();
-# else
- DebugBreak();
-# endif
- abort();
-}
-#endif
-/*
- * Local Variables:
- * mode: c
- * c-basic-offset: 4
- * fill-column: 78
- * tab-width: 8
- * End:
- */
diff --git a/tcl8.6/win/tclWinFCmd.c b/tcl8.6/win/tclWinFCmd.c
deleted file mode 100644
index 2f28154..0000000
--- a/tcl8.6/win/tclWinFCmd.c
+++ /dev/null
@@ -1,1967 +0,0 @@
-/*
- * tclWinFCmd.c
- *
- * 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.
- */
-
-#include "tclWinInt.h"
-
-/*
- * The following constants specify the type of callback when
- * 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_LINK 4 /* symbolic link */
-
-/*
- * Callbacks for file attributes code.
- */
-
-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.
- */
-
-enum {
- WIN_ARCHIVE_ATTRIBUTE,
- WIN_HIDDEN_ATTRIBUTE,
- WIN_LONGNAME_ATTRIBUTE,
- WIN_READONLY_ATTRIBUTE,
- WIN_SHORTNAME_ATTRIBUTE,
- WIN_SYSTEM_ATTRIBUTE
-};
-
-static const int attributeArray[] = {FILE_ATTRIBUTE_ARCHIVE, FILE_ATTRIBUTE_HIDDEN,
- 0, FILE_ATTRIBUTE_READONLY, 0, FILE_ATTRIBUTE_SYSTEM};
-
-
-const char *const tclpFileAttrStrings[] = {
- "-archive", "-hidden", "-longname", "-readonly",
- "-shortname", "-system", (char *) NULL
-};
-
-const TclFileAttrProcs tclpFileAttrProcs[] = {
- {GetWinFileAttributes, SetWinFileAttributes},
- {GetWinFileAttributes, SetWinFileAttributes},
- {GetWinFileLongName, CannotSetAttribute},
- {GetWinFileAttributes, SetWinFileAttributes},
- {GetWinFileShortName, CannotSetAttribute},
- {GetWinFileAttributes, SetWinFileAttributes}};
-
-/*
- * Prototype for the TraverseWinTree callback function.
- */
-
-typedef int (TraversalProc)(const TCHAR *srcPtr, const TCHAR *dstPtr,
- int type, Tcl_DString *errorPtr);
-
-/*
- * Declarations for local functions defined in this file:
- */
-
-static void StatError(Tcl_Interp *interp, Tcl_Obj *fileName);
-static int ConvertFileNameFormat(Tcl_Interp *interp,
- int objIndex, Tcl_Obj *fileName, int longShort,
- Tcl_Obj **attributePtrPtr);
-static int DoCopyFile(const TCHAR *srcPtr, const TCHAR *dstPtr);
-static int DoCreateDirectory(const TCHAR *pathPtr);
-static int DoRemoveJustDirectory(const TCHAR *nativeSrc,
- int ignoreError, Tcl_DString *errorPtr);
-static int DoRemoveDirectory(Tcl_DString *pathPtr, int recursive,
- Tcl_DString *errorPtr);
-static int DoRenameFile(const TCHAR *nativeSrc,
- const TCHAR *dstPtr);
-static int TraversalCopy(const TCHAR *srcPtr, const TCHAR *dstPtr,
- 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 *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:
- * 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.
- *
- * 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:
- *
- * ENAMETOOLONG: src or dst names are too long.
- * 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.
- * 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.)
- * 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.
- *
- *---------------------------------------------------------------------------
- */
-
-int
-TclpObjRenameFile(
- Tcl_Obj *srcPathPtr,
- Tcl_Obj *destPathPtr)
-{
- return DoRenameFile(Tcl_FSGetNativePath(srcPathPtr),
- Tcl_FSGetNativePath(destPathPtr));
-}
-
-static int
-DoRenameFile(
- const TCHAR *nativeSrc, /* Pathname of file or dir to be renamed
- * (native). */
- const TCHAR *nativeDst) /* New pathname for file or directory
- * (native). */
-{
-#if defined(HAVE_NO_SEH) && !defined(_WIN64)
- TCLEXCEPTION_REGISTRATION registration;
-#endif
- DWORD srcAttr, dstAttr;
- int retval = -1;
-
- /*
- * 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') {
- 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.
- */
-
-#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.
- */
-
- __asm__ __volatile__ (
- /*
- * Pick up params before messing with the stack.
- */
-
- "movl %[nativeDst], %%ebx" "\n\t"
- "movl %[nativeSrc], %%ecx" "\n\t"
-
- /*
- * Construct an TCLEXCEPTION_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 TCLEXCEPTION_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 TCLEXCEPTION_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 TCLEXCEPTION_REGISTRATION
- */
-
- "1:" "\t"
- "movl %%fs:0, %%edx" "\n\t"
- "movl 0x8(%%edx), %%edx" "\n\t"
-
- /*
- * Come here however we exited. Restore context from the
- * TCLEXCEPTION_REGISTRATION in case the stack is unbalanced.
- */
-
- "2:" "\t"
- "movl 0xc(%%edx), %%esp" "\n\t"
- "movl 0x8(%%edx), %%ebp" "\n\t"
- "movl 0x0(%%edx), %%eax" "\n\t"
- "movl %%eax, %%fs:0" "\n\t"
-
- :
- /* No outputs */
- :
- [registration] "m" (registration),
- [nativeDst] "m" (nativeDst),
- [nativeSrc] "m" (nativeSrc),
- [moveFile] "r" (MoveFile)
- :
- "%eax", "%ebx", "%ecx", "%edx", "memory"
- );
- if (registration.status != FALSE) {
- retval = TCL_OK;
- }
-#else
-#ifndef HAVE_NO_SEH
- __try {
-#endif
- if ((*MoveFile)(nativeSrc, nativeDst) != FALSE) {
- retval = TCL_OK;
- }
-#ifndef HAVE_NO_SEH
- } __except (EXCEPTION_EXECUTE_HANDLER) {}
-#endif
-#endif
-
- if (retval != -1) {
- return retval;
- }
-
- TclWinConvertError(GetLastError());
-
- srcAttr = GetFileAttributes(nativeSrc);
- dstAttr = GetFileAttributes(nativeDst);
- if (srcAttr == 0xffffffff) {
- if (GetFullPathName(nativeSrc, 0, NULL,
- NULL) >= MAX_PATH) {
- errno = ENAMETOOLONG;
- return TCL_ERROR;
- }
- srcAttr = 0;
- }
- if (dstAttr == 0xffffffff) {
- if (GetFullPathName(nativeDst, 0, NULL,
- NULL) >= MAX_PATH) {
- errno = ENAMETOOLONG;
- return TCL_ERROR;
- }
- dstAttr = 0;
- }
-
- if (errno == EBADF) {
- errno = EACCES;
- return TCL_ERROR;
- }
- if (errno == EACCES) {
- decode:
- if (srcAttr & FILE_ATTRIBUTE_DIRECTORY) {
- TCHAR *nativeSrcRest, *nativeDstRest;
- const char **srcArgv, **dstArgv;
- int size, srcArgc, dstArgc;
- TCHAR nativeSrcPath[MAX_PATH];
- TCHAR nativeDstPath[MAX_PATH];
- Tcl_DString srcString, dstString;
- const char *src, *dst;
-
- size = GetFullPathName(nativeSrc, MAX_PATH,
- nativeSrcPath, &nativeSrcRest);
- if ((size == 0) || (size > MAX_PATH)) {
- return TCL_ERROR;
- }
- size = GetFullPathName(nativeDst, MAX_PATH,
- nativeDstPath, &nativeDstRest);
- if ((size == 0) || (size > MAX_PATH)) {
- return TCL_ERROR;
- }
- CharLower(nativeSrcPath);
- CharLower(nativeDstPath);
-
- src = Tcl_WinTCharToUtf(nativeSrcPath, -1, &srcString);
- dst = Tcl_WinTCharToUtf(nativeDstPath, -1, &dstString);
-
- /*
- * 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.
- */
-
- errno = EINVAL;
- Tcl_DStringFree(&srcString);
- Tcl_DStringFree(&dstString);
- return TCL_ERROR;
- }
- Tcl_SplitPath(src, &srcArgc, &srcArgv);
- Tcl_SplitPath(dst, &dstArgc, &dstArgv);
- Tcl_DStringFree(&srcString);
- Tcl_DStringFree(&dstString);
-
- if (srcArgc == 1) {
- /*
- * 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.
- */
-
- Tcl_SetErrno(EXDEV);
- }
-
- ckfree(srcArgv);
- ckfree(dstArgv);
- }
-
- /*
- * 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.
- */
-
- } else if (Tcl_GetErrno() == EEXIST) {
- /*
- * 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.
- */
-
- 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
- * directory back, for completeness.
- */
-
- if (MoveFile(nativeSrc,
- nativeDst) != FALSE) {
- return TCL_OK;
- }
-
- /*
- * Some new error has occurred. Don't know what it could
- * be, but report this one.
- */
-
- TclWinConvertError(GetLastError());
- CreateDirectory(nativeDst, NULL);
- SetFileAttributes(nativeDst, dstAttr);
- if (Tcl_GetErrno() == EACCES) {
- /*
- * Decode the EACCES to a more meaningful error.
- */
-
- goto decode;
- }
- }
- } else { /* (dstAttr & FILE_ATTRIBUTE_DIRECTORY) == 0 */
- Tcl_SetErrno(ENOTDIR);
- }
- } else { /* (srcAttr & FILE_ATTRIBUTE_DIRECTORY) == 0 */
- if (dstAttr & FILE_ATTRIBUTE_DIRECTORY) {
- Tcl_SetErrno(EISDIR);
- } 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.
- */
-
- TCHAR *nativeRest, *nativeTmp, *nativePrefix;
- int result, size;
- TCHAR tempBuf[MAX_PATH];
-
- size = GetFullPathName(nativeDst, MAX_PATH,
- tempBuf, &nativeRest);
- if ((size == 0) || (size > MAX_PATH) || (nativeRest == NULL)) {
- return TCL_ERROR;
- }
- nativeTmp = (TCHAR *) tempBuf;
- nativeRest[0] = L'\0';
-
- result = TCL_ERROR;
- nativePrefix = (TCHAR *) L"tclr";
- if (GetTempFileName(nativeTmp, nativePrefix,
- 0, tempBuf) != 0) {
- /*
- * Strictly speaking, need the following DeleteFile and
- * MoveFile to be joined as an atomic operation so no
- * other app comes along in the meantime and creates the
- * same temp file.
- */
-
- nativeTmp = tempBuf;
- DeleteFile(nativeTmp);
- if (MoveFile(nativeDst, nativeTmp) != FALSE) {
- if (MoveFile(nativeSrc, nativeDst) != FALSE) {
- SetFileAttributes(nativeTmp, FILE_ATTRIBUTE_NORMAL);
- DeleteFile(nativeTmp);
- return TCL_OK;
- } else {
- DeleteFile(nativeDst);
- MoveFile(nativeTmp, nativeDst);
- }
- }
-
- /*
- * Can't backup dst file or move src file. Return that
- * error. Could happen if an open file refers to dst.
- */
-
- TclWinConvertError(GetLastError());
- if (Tcl_GetErrno() == EACCES) {
- /*
- * Decode the EACCES to a more meaningful error.
- */
-
- goto decode;
- }
- }
- return result;
- }
- }
- }
- return TCL_ERROR;
-}
-
-/*
- *---------------------------------------------------------------------------
- *
- * TclpObjCopyFile, DoCopyFile --
- *
- * 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:
- *
- * 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 "".
- *
- * 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)
- *
- * Side effects:
- * It is not an error to copy to a char device.
- *
- *---------------------------------------------------------------------------
- */
-
-int
-TclpObjCopyFile(
- Tcl_Obj *srcPathPtr,
- Tcl_Obj *destPathPtr)
-{
- return DoCopyFile(Tcl_FSGetNativePath(srcPathPtr),
- 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). */
-{
-#if defined(HAVE_NO_SEH) && !defined(_WIN64)
- TCLEXCEPTION_REGISTRATION registration;
-#endif
- int retval = -1;
-
- /*
- * 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') {
- 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.
- */
-
-#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.
- */
-
- __asm__ __volatile__ (
-
- /*
- * Pick up parameters before messing with the stack
- */
-
- "movl %[nativeDst], %%ebx" "\n\t"
- "movl %[nativeSrc], %%ecx" "\n\t"
-
- /*
- * Construct an TCLEXCEPTION_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 */
-
- /*
- * Link the TCLEXCEPTION_REGISTRATION on the chain.
- */
-
- "movl %%edx, %%fs:0" "\n\t"
-
- /*
- * Call CopyFile(nativeSrc, nativeDst, 0)
- */
-
- "movl %[copyFile], %%eax" "\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 TCLEXCEPTION_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 TCLEXCEPTION_REGISTRATION
- */
-
- "1:" "\t"
- "movl %%fs:0, %%edx" "\n\t"
- "movl 0x8(%%edx), %%edx" "\n\t"
-
- /*
- * Come here however we exited. Restore context from the
- * TCLEXCEPTION_REGISTRATION in case the stack is unbalanced.
- */
-
- "2:" "\t"
- "movl 0xc(%%edx), %%esp" "\n\t"
- "movl 0x8(%%edx), %%ebp" "\n\t"
- "movl 0x0(%%edx), %%eax" "\n\t"
- "movl %%eax, %%fs:0" "\n\t"
-
- :
- /* No outputs */
- :
- [registration] "m" (registration),
- [nativeDst] "m" (nativeDst),
- [nativeSrc] "m" (nativeSrc),
- [copyFile] "r" (CopyFile)
- :
- "%eax", "%ebx", "%ecx", "%edx", "memory"
- );
- if (registration.status != FALSE) {
- retval = TCL_OK;
- }
-#else
-#ifndef HAVE_NO_SEH
- __try {
-#endif
- if (CopyFile(nativeSrc, nativeDst, 0) != FALSE) {
- retval = TCL_OK;
- }
-#ifndef HAVE_NO_SEH
- } __except (EXCEPTION_EXECUTE_HANDLER) {}
-#endif
-#endif
-
- if (retval != -1) {
- return retval;
- }
-
- TclWinConvertError(GetLastError());
- if (Tcl_GetErrno() == EBADF) {
- Tcl_SetErrno(EACCES);
- return TCL_ERROR;
- }
- if (Tcl_GetErrno() == EACCES) {
- DWORD srcAttr, dstAttr;
-
- srcAttr = GetFileAttributes(nativeSrc);
- dstAttr = GetFileAttributes(nativeDst);
- if (srcAttr != 0xffffffff) {
- if (dstAttr == 0xffffffff) {
- dstAttr = 0;
- }
- if ((srcAttr & FILE_ATTRIBUTE_DIRECTORY) ||
- (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;
- }
- }
- Tcl_SetErrno(EISDIR);
- }
- if (dstAttr & FILE_ATTRIBUTE_READONLY) {
- SetFileAttributes(nativeDst,
- dstAttr & ~((DWORD)FILE_ATTRIBUTE_READONLY));
- if (CopyFile(nativeSrc, nativeDst,
- 0) != FALSE) {
- return TCL_OK;
- }
-
- /*
- * Still can't copy onto dst. Return that error, and restore
- * attributes of dst.
- */
-
- TclWinConvertError(GetLastError());
- SetFileAttributes(nativeDst, dstAttr);
- }
- }
- }
- return TCL_ERROR;
-}
-
-/*
- *---------------------------------------------------------------------------
- *
- * TclpObjDeleteFile, TclpDeleteFile --
- *
- * 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:
- *
- * 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: path is a char device (nul:, com1:, etc.)
- *
- * Side effects:
- * The file is deleted, even if it is read-only.
- *
- *---------------------------------------------------------------------------
- */
-
-int
-TclpObjDeleteFile(
- Tcl_Obj *pathPtr)
-{
- return TclpDeleteFile(Tcl_FSGetNativePath(pathPtr));
-}
-
-int
-TclpDeleteFile(
- const void *nativePath) /* Pathname of file to be removed (native). */
-{
- DWORD attr;
- const TCHAR *path = nativePath;
-
- /*
- * The DeleteFile API acts differently under Win95/98 and NT WRT NULL and
- * "". Avoid passing these values.
- */
-
- if (path == NULL || path[0] == '\0') {
- Tcl_SetErrno(ENOENT);
- return TCL_ERROR;
- }
-
- if (DeleteFile(path) != FALSE) {
- return TCL_OK;
- }
- TclWinConvertError(GetLastError());
-
- if (Tcl_GetErrno() == EACCES) {
- attr = GetFileAttributes(path);
- if (attr != 0xffffffff) {
- if (attr & FILE_ATTRIBUTE_DIRECTORY) {
- if (attr & FILE_ATTRIBUTE_REPARSE_POINT) {
- /*
- * It is a symbolic link - remove it.
- */
- if (TclWinSymLinkDelete(path, 0) == 0) {
- 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 = SetFileAttributes(path,
- attr & ~((DWORD) FILE_ATTRIBUTE_READONLY));
-
- if ((res != 0) &&
- (DeleteFile(path) != FALSE)) {
- return TCL_OK;
- }
- TclWinConvertError(GetLastError());
- if (res != 0) {
- SetFileAttributes(path, attr);
- }
- }
- }
- } else if (Tcl_GetErrno() == ENOENT) {
- attr = GetFileAttributes(path);
- if (attr != 0xffffffff) {
- if (attr & FILE_ATTRIBUTE_DIRECTORY) {
- /*
- * Windows 95 reports removing a directory as ENOENT instead
- * of EISDIR.
- */
-
- Tcl_SetErrno(EISDIR);
- }
- }
- } else if (Tcl_GetErrno() == EINVAL) {
- /*
- * Windows NT reports removing a char device as EINVAL instead of
- * EACCES.
- */
-
- Tcl_SetErrno(EACCES);
- }
-
- return TCL_ERROR;
-}
-
-/*
- *---------------------------------------------------------------------------
- *
- * 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.
- *
- * 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:
- *
- * 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.
- *
- *---------------------------------------------------------------------------
- */
-
-int
-TclpObjCreateDirectory(
- Tcl_Obj *pathPtr)
-{
- return DoCreateDirectory(Tcl_FSGetNativePath(pathPtr));
-}
-
-static int
-DoCreateDirectory(
- const TCHAR *nativePath) /* Pathname of directory to create (native). */
-{
- if (CreateDirectory(nativePath, NULL) == 0) {
- DWORD error = GetLastError();
-
- TclWinConvertError(error);
- return TCL_ERROR;
- }
- return TCL_OK;
-}
-
-/*
- *---------------------------------------------------------------------------
- *
- * 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.
- *
- * 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.
- *
- * 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.
- *
- *---------------------------------------------------------------------------
- */
-
-int
-TclpObjCopyDirectory(
- Tcl_Obj *srcPathPtr,
- Tcl_Obj *destPathPtr,
- Tcl_Obj **errorPtr)
-{
- Tcl_DString ds;
- Tcl_DString srcString, dstString;
- Tcl_Obj *normSrcPtr, *normDestPtr;
- int ret;
-
- normSrcPtr = Tcl_FSGetNormalizedPath(NULL,srcPathPtr);
- normDestPtr = Tcl_FSGetNormalizedPath(NULL,destPathPtr);
- 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);
-
- Tcl_DStringFree(&srcString);
- Tcl_DStringFree(&dstString);
-
- if (ret != TCL_OK) {
- if (!strcmp(Tcl_DStringValue(&ds), TclGetString(normSrcPtr))) {
- *errorPtr = srcPathPtr;
- } else if (!strcmp(Tcl_DStringValue(&ds), TclGetString(normDestPtr))) {
- *errorPtr = destPathPtr;
- } else {
- *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1);
- }
- Tcl_DStringFree(&ds);
- Tcl_IncrRefCount(*errorPtr);
- }
- return ret;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * 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:
- *
- * 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.
- *
- * 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
- * immediately, and remaining files will not be deleted.
- *
- *----------------------------------------------------------------------
- */
-
-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 native;
- normPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr);
- if (normPtr == NULL) {
- return TCL_ERROR;
- }
- Tcl_WinUtfToTChar(Tcl_GetString(normPtr), -1, &native);
- ret = DoRemoveDirectory(&native, recursive, &ds);
- Tcl_DStringFree(&native);
- } else {
- ret = DoRemoveJustDirectory(Tcl_FSGetNativePath(pathPtr), 0, &ds);
- }
-
- if (ret != TCL_OK) {
- if (Tcl_DStringLength(&ds) > 0) {
- if (normPtr != NULL &&
- !strcmp(Tcl_DStringValue(&ds), TclGetString(normPtr))) {
- *errorPtr = pathPtr;
- } else {
- *errorPtr = TclDStringToObj(&ds);
- }
- Tcl_IncrRefCount(*errorPtr);
- }
- Tcl_DStringFree(&ds);
- }
-
- return ret;
-}
-
-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. */
-{
- DWORD attr;
-
- /*
- * The RemoveDirectory API acts differently under Win95/98 and NT WRT NULL
- * and "". Avoid passing these values.
- */
-
- if (nativePath == NULL || nativePath[0] == '\0') {
- Tcl_SetErrno(ENOENT);
- Tcl_DStringInit(errorPtr);
- return TCL_ERROR;
- }
-
- attr = GetFileAttributes(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 (RemoveDirectory(nativePath) != FALSE) {
- return TCL_OK;
- }
- }
-
- TclWinConvertError(GetLastError());
-
- if (Tcl_GetErrno() == EACCES) {
- attr = GetFileAttributes(nativePath);
- if (attr != 0xffffffff) {
- if ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0) {
- /*
- * 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.
- */
-
- if (TclWinSymLinkDelete(nativePath, 1) != 0) {
- goto end;
- }
- }
-
- if (attr & FILE_ATTRIBUTE_READONLY) {
- attr &= ~FILE_ATTRIBUTE_READONLY;
- if (SetFileAttributes(nativePath,
- attr) == FALSE) {
- goto end;
- }
- if (RemoveDirectory(nativePath) != FALSE) {
- return TCL_OK;
- }
- TclWinConvertError(GetLastError());
- SetFileAttributes(nativePath,
- attr | FILE_ATTRIBUTE_READONLY);
- }
- }
- }
-
- if (Tcl_GetErrno() == 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.
- */
- return TCL_ERROR;
- }
-
- end:
- if (errorPtr != NULL) {
- char *p = Tcl_WinTCharToUtf(nativePath, -1, errorPtr);
- for (; *p; ++p) {
- if (*p == '\\') *p = '/';
- }
- }
- return TCL_ERROR;
-
-}
-
-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 res = DoRemoveJustDirectory((const TCHAR *)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;
- }
-}
-
-/*
- *---------------------------------------------------------------------------
- *
- * 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().
- *
- * Results:
- * 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.
- *
- *---------------------------------------------------------------------------
- */
-
-static int
-TraverseWinTree(
- TraversalProc *traverseProc,/* Function to call for every file and
- * directory in source hierarchy. */
- Tcl_DString *sourcePtr, /* Pathname of source directory to be
- * traversed (native). */
- 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. */
-{
- DWORD sourceAttr;
- TCHAR *nativeSource, *nativeTarget, *nativeErrfile;
- int result, found, sourceLen, targetLen = 0, oldSourceLen, oldTargetLen;
- HANDLE handle;
- WIN32_FIND_DATA data;
-
- nativeErrfile = NULL;
- result = TCL_OK;
- oldTargetLen = 0; /* lint. */
-
- nativeSource = (TCHAR *) Tcl_DStringValue(sourcePtr);
- nativeTarget = (TCHAR *)
- (targetPtr == NULL ? NULL : Tcl_DStringValue(targetPtr));
-
- oldSourceLen = Tcl_DStringLength(sourcePtr);
- sourceAttr = GetFileAttributes(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
- */
-
- return traverseProc(nativeSource, nativeTarget, DOTREE_F, errorPtr);
- }
-
- Tcl_DStringAppend(sourcePtr, (char *) TEXT("\\*.*"), 4 * sizeof(TCHAR) + 1);
- Tcl_DStringSetLength(sourcePtr, Tcl_DStringLength(sourcePtr) - 1);
-
- nativeSource = (TCHAR *) Tcl_DStringValue(sourcePtr);
- handle = FindFirstFile(nativeSource, &data);
- if (handle == INVALID_HANDLE_VALUE) {
- /*
- * Can't read directory.
- */
-
- TclWinConvertError(GetLastError());
- nativeErrfile = nativeSource;
- goto end;
- }
-
- Tcl_DStringSetLength(sourcePtr, oldSourceLen + 1);
- Tcl_DStringSetLength(sourcePtr, oldSourceLen);
- result = traverseProc(nativeSource, nativeTarget, DOTREE_PRED,
- errorPtr);
- if (result != TCL_OK) {
- FindClose(handle);
- return result;
- }
-
- sourceLen = oldSourceLen + sizeof(TCHAR);
- Tcl_DStringAppend(sourcePtr, (char *) TEXT("\\"), sizeof(TCHAR) + 1);
- Tcl_DStringSetLength(sourcePtr, sourceLen);
- if (targetPtr != NULL) {
- oldTargetLen = Tcl_DStringLength(targetPtr);
-
- targetLen = oldTargetLen;
- targetLen += sizeof(TCHAR);
- Tcl_DStringAppend(targetPtr, (char *) TEXT("\\"), sizeof(TCHAR) + 1);
- Tcl_DStringSetLength(targetPtr, targetLen);
- }
-
- found = 1;
- for (; found; found = FindNextFile(handle, &data)) {
- TCHAR *nativeName;
- int len;
-
- TCHAR *wp = data.cFileName;
- if (*wp == '.') {
- wp++;
- if (*wp == '.') {
- wp++;
- }
- if (*wp == '\0') {
- continue;
- }
- }
- nativeName = (TCHAR *) data.cFileName;
- len = _tcslen(data.cFileName) * sizeof(TCHAR);
-
- /*
- * Append name after slash, and recurse on the file.
- */
-
- Tcl_DStringAppend(sourcePtr, (char *) nativeName, len + 1);
- Tcl_DStringSetLength(sourcePtr, Tcl_DStringLength(sourcePtr) - 1);
- if (targetPtr != NULL) {
- Tcl_DStringAppend(targetPtr, (char *) nativeName, len + 1);
- Tcl_DStringSetLength(targetPtr, Tcl_DStringLength(targetPtr) - 1);
- }
- result = TraverseWinTree(traverseProc, sourcePtr, targetPtr,
- errorPtr);
- if (result != TCL_OK) {
- break;
- }
-
- /*
- * Remove name after slash.
- */
-
- Tcl_DStringSetLength(sourcePtr, sourceLen);
- if (targetPtr != NULL) {
- Tcl_DStringSetLength(targetPtr, targetLen);
- }
- }
- FindClose(handle);
-
- /*
- * Strip off the trailing slash we added.
- */
-
- Tcl_DStringSetLength(sourcePtr, oldSourceLen + 1);
- Tcl_DStringSetLength(sourcePtr, oldSourceLen);
- if (targetPtr != NULL) {
- Tcl_DStringSetLength(targetPtr, oldTargetLen + 1);
- Tcl_DStringSetLength(targetPtr, oldTargetLen);
- }
- if (result == TCL_OK) {
- /*
- * Call traverseProc() on a directory after visiting all the
- * files in that directory.
- */
-
- result = traverseProc((const TCHAR *)Tcl_DStringValue(sourcePtr),
- (const TCHAR *)(targetPtr == NULL ? NULL : Tcl_DStringValue(targetPtr)),
- DOTREE_POSTD, errorPtr);
- }
-
- end:
- if (nativeErrfile != NULL) {
- TclWinConvertError(GetLastError());
- if (errorPtr != NULL) {
- Tcl_WinTCharToUtf(nativeErrfile, -1, errorPtr);
- }
- result = TCL_ERROR;
- }
-
- return result;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TraversalCopy
- *
- * Called from TraverseUnixTree in order to execute a recursive copy of a
- * directory.
- *
- * Results:
- * Standard Tcl result.
- *
- * Side effects:
- * Depending on the value of type, src may be copied to dst.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-TraversalCopy(
- const TCHAR *nativeSrc, /* Source pathname to copy. */
- const TCHAR *nativeDst, /* Destination pathname of copy. */
- int type, /* Reason for call - see TraverseWinTree() */
- Tcl_DString *errorPtr) /* If non-NULL, initialized DString filled
- * with UTF-8 name of file causing error. */
-{
- switch (type) {
- case DOTREE_F:
- if (DoCopyFile(nativeSrc, nativeDst) == TCL_OK) {
- return TCL_OK;
- }
- break;
- case DOTREE_LINK:
- if (TclWinSymLinkCopyDirectory(nativeSrc, nativeDst) == TCL_OK) {
- return TCL_OK;
- }
- break;
- case DOTREE_PRED:
- if (DoCreateDirectory(nativeDst) == TCL_OK) {
- DWORD attr = GetFileAttributes(nativeSrc);
-
- if (SetFileAttributes(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.
- */
-
- if (errorPtr != NULL) {
- Tcl_WinTCharToUtf(nativeDst, -1, errorPtr);
- }
- return TCL_ERROR;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TraversalDelete --
- *
- * 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.
- *
- * 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.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-TraversalDelete(
- const TCHAR *nativeSrc, /* Source pathname to delete. */
- const TCHAR *dstPtr, /* Not used. */
- int type, /* Reason for call - see TraverseWinTree() */
- Tcl_DString *errorPtr) /* If non-NULL, initialized DString filled
- * with UTF-8 name of file causing error. */
-{
- switch (type) {
- case DOTREE_F:
- if (TclpDeleteFile(nativeSrc) == TCL_OK) {
- return TCL_OK;
- }
- break;
- case DOTREE_LINK:
- if (DoRemoveJustDirectory(nativeSrc, 0, NULL) == TCL_OK) {
- return TCL_OK;
- }
- break;
- case DOTREE_PRED:
- return TCL_OK;
- case DOTREE_POSTD:
- if (DoRemoveJustDirectory(nativeSrc, 0, NULL) == TCL_OK) {
- return TCL_OK;
- }
- break;
- }
-
- if (errorPtr != NULL) {
- Tcl_WinTCharToUtf(nativeSrc, -1, errorPtr);
- }
- return TCL_ERROR;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * StatError --
- *
- * Sets the object result with the appropriate error.
- *
- * Results:
- * None.
- *
- * Side effects:
- * The interp's object result is set with an error message based on the
- * objIndex, fileName and errno.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-StatError(
- Tcl_Interp *interp, /* The interp that has the error */
- Tcl_Obj *fileName) /* The name of the file which caused the
- * error. */
-{
- TclWinConvertError(GetLastError());
- Tcl_SetObjResult(interp, Tcl_ObjPrintf("could not read \"%s\": %s",
- TclGetString(fileName), Tcl_PosixError(interp)));
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * GetWinFileAttributes --
- *
- * 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.
- *
- * Side effects:
- * A new object is allocated if the file is valid.
- *
- *----------------------------------------------------------------------
- */
-
-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 **attributePtrPtr) /* A pointer to return the object with. */
-{
- DWORD result;
- const TCHAR *nativeName;
- int attr;
-
- nativeName = Tcl_FSGetNativePath(fileName);
- result = GetFileAttributes(nativeName);
-
- if (result == 0xffffffff) {
- StatError(interp, fileName);
- return TCL_ERROR;
- }
-
- 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).
- *
- * We test for, and fix that case, here.
- */
-
- int len;
- const char *str = Tcl_GetStringFromObj(fileName,&len);
-
- if (len < 4) {
- if (len == 0) {
- /*
- * 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.
- */
-
- attr = 0;
- } 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;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ConvertFileNameFormat --
- *
- * 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:/'.
- *
- * Side effects:
- * A new object is allocated if the file is valid.
- *
- *----------------------------------------------------------------------
- */
-
-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. */
- 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;
-
- splitPath = Tcl_FSSplitPath(fileName, &pathc);
-
- if (splitPath == NULL || pathc == 0) {
- if (interp != NULL) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "could not read \"%s\": no such file or directory",
- Tcl_GetString(fileName)));
- errno = ENOENT;
- Tcl_PosixError(interp);
- }
- 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)) {
- /*
- * 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.
- */
-
- 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;
- Tcl_DString ds;
- Tcl_DString dsTemp;
- const TCHAR *nativeName;
- const char *tempString;
- int tempLen;
- WIN32_FIND_DATA data;
- HANDLE handle;
- DWORD attr;
-
- 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.
- */
-
- Tcl_DStringInit(&ds);
- tempString = Tcl_GetStringFromObj(tempPath,&tempLen);
- nativeName = Tcl_WinUtfToTChar(tempString, tempLen, &ds);
- Tcl_DecrRefCount(tempPath);
- handle = FindFirstFile(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
- */
-
- attr = GetFileAttributes(nativeName);
- if ((attr!=0xFFFFFFFF) && (attr & FILE_ATTRIBUTE_DIRECTORY)) {
- Tcl_DStringFree(&ds);
- goto simple;
- }
- }
-
- if (handle == INVALID_HANDLE_VALUE) {
- Tcl_DStringFree(&ds);
- if (interp != NULL) {
- StatError(interp, fileName);
- }
- goto cleanup;
- }
- nativeName = data.cAlternateFileName;
- if (longShort) {
- if (data.cFileName[0] != '\0') {
- nativeName = data.cFileName;
- }
- } else {
- if (data.cAlternateFileName[0] == '\0') {
- nativeName = (TCHAR *) data.cFileName;
- }
- }
-
- /*
- * 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]);
- */
-
- Tcl_DStringInit(&dsTemp);
- Tcl_WinTCharToUtf(nativeName, -1, &dsTemp);
- Tcl_DStringFree(&ds);
-
- /*
- * Deal with issues of tildes being absolute.
- */
-
- if (Tcl_DStringValue(&dsTemp)[0] == '~') {
- TclNewLiteralStringObj(tempPath, "./");
- Tcl_AppendToObj(tempPath, Tcl_DStringValue(&dsTemp),
- Tcl_DStringLength(&dsTemp));
- Tcl_DStringFree(&dsTemp);
- } else {
- tempPath = TclDStringToObj(&dsTemp);
- }
- Tcl_ListObjReplace(NULL, splitPath, i, 1, 1, &tempPath);
- FindClose(handle);
- }
- }
-
- *attributePtrPtr = Tcl_FSJoinPath(splitPath, -1);
-
- 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 TCL_ERROR;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * GetWinFileLongName --
- *
- * 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.
- *
- * Side effects:
- * A new object is allocated if the file is valid.
- *
- *----------------------------------------------------------------------
- */
-
-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 **attributePtrPtr) /* A pointer to return the object with. */
-{
- return ConvertFileNameFormat(interp, objIndex, fileName, 1,
- attributePtrPtr);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * GetWinFileShortName --
- *
- * 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.
- *
- * Side effects:
- * A new object is allocated if the file is valid.
- *
- *----------------------------------------------------------------------
- */
-
-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 **attributePtrPtr) /* A pointer to return the object with. */
-{
- return ConvertFileNameFormat(interp, objIndex, fileName, 0,
- attributePtrPtr);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * SetWinFileAttributes --
- *
- * Set the file attributes to the value given by attributePtr. This
- * routine sets the -hidden, -readonly, or -system attributes.
- *
- * Results:
- * Standard TCL error.
- *
- * Side effects:
- * The file's attribute is set.
- *
- *----------------------------------------------------------------------
- */
-
-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 *attributePtr) /* The new value of the attribute. */
-{
- DWORD fileAttributes, old;
- int yesNo, result;
- const TCHAR *nativeName;
-
- nativeName = Tcl_FSGetNativePath(fileName);
- fileAttributes = old = GetFileAttributes(nativeName);
-
- if (fileAttributes == 0xffffffff) {
- StatError(interp, fileName);
- return TCL_ERROR;
- }
-
- result = Tcl_GetBooleanFromObj(interp, attributePtr, &yesNo);
- if (result != TCL_OK) {
- return result;
- }
-
- if (yesNo) {
- fileAttributes |= (attributeArray[objIndex]);
- } else {
- fileAttributes &= ~(attributeArray[objIndex]);
- }
-
- if ((fileAttributes != old)
- && !SetFileAttributes(nativeName, fileAttributes)) {
- StatError(interp, fileName);
- return TCL_ERROR;
- }
-
- return result;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * SetWinFileLongName --
- *
- * The attribute in question is a readonly attribute and cannot be set.
- *
- * Results:
- * TCL_ERROR
- *
- * Side effects:
- * The object result is set to a pertinent error message.
- *
- *----------------------------------------------------------------------
- */
-
-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 *attributePtr) /* The new value of the attribute. */
-{
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "cannot set attribute \"%s\" for file \"%s\": attribute is readonly",
- tclpFileAttrStrings[objIndex], Tcl_GetString(fileName)));
- errno = EINVAL;
- Tcl_PosixError(interp);
- return TCL_ERROR;
-}
-
-/*
- *---------------------------------------------------------------------------
- *
- * TclpObjListVolumes --
- *
- * Lists the currently mounted volumes
- *
- * Results:
- * The list of volumes.
- *
- * Side effects:
- * None
- *
- *---------------------------------------------------------------------------
- */
-
-Tcl_Obj *
-TclpObjListVolumes(void)
-{
- Tcl_Obj *resultPtr, *elemPtr;
- char buf[40 * 4]; /* There couldn't be more than 30 drives??? */
- int i;
- char *p;
-
- resultPtr = Tcl_NewObj();
-
- /*
- * On Win32s:
- * GetLogicalDriveStrings() isn't implemented.
- * GetLogicalDrives() returns incorrect information.
- */
-
- 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.
- */
-
- buf[1] = ':';
- buf[2] = '/';
- buf[3] = '\0';
-
- for (i = 0; i < 26; i++) {
- buf[0] = (char) ('a' + i);
- if (GetVolumeInformationA(buf, NULL, 0, NULL, NULL, NULL, NULL, 0)
- || (GetLastError() == ERROR_NOT_READY)) {
- elemPtr = Tcl_NewStringObj(buf, -1);
- Tcl_ListObjAppendElement(NULL, resultPtr, elemPtr);
- }
- }
- } else {
- for (p = buf; *p != '\0'; p += 4) {
- p[2] = '/';
- elemPtr = Tcl_NewStringObj(p, -1);
- 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/tcl8.6/win/tclWinFile.c b/tcl8.6/win/tclWinFile.c
deleted file mode 100755
index b9787c7..0000000
--- a/tcl8.6/win/tclWinFile.c
+++ /dev/null
@@ -1,3264 +0,0 @@
-/*
- * 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.
- *
- * 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.
- */
-
-#include "tclWinInt.h"
-#include "tclFileSystem.h"
-#include <winioctl.h>
-#include <shlobj.h>
-#include <lm.h> /* For TclpGetUserHome(). */
-#include <userenv.h> /* For TclpGetUserHome(). */
-#include <aclapi.h> /* For GetNamedSecurityInfo */
-
-#ifdef _MSC_VER
-# pragma comment(lib, "userenv.lib")
-#endif
-/*
- * The number of 100-ns intervals between the Windows system epoch (1601-01-01
- * on the proleptic Gregorian calendar) and the Posix epoch (1970-01-01).
- */
-
-#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.
- */
-
-#ifndef IO_REPARSE_TAG_RESERVED_ONE
-# define IO_REPARSE_TAG_RESERVED_ONE 0x000000001
-#endif
-#ifndef IO_REPARSE_TAG_RESERVED_RANGE
-# define IO_REPARSE_TAG_RESERVED_RANGE 0x000000001
-#endif
-#ifndef IO_REPARSE_TAG_VALID_VALUES
-# define IO_REPARSE_TAG_VALID_VALUES 0x0E000FFFF
-#endif
-#ifndef IO_REPARSE_TAG_HSM
-# define IO_REPARSE_TAG_HSM 0x0C0000004
-#endif
-#ifndef IO_REPARSE_TAG_NSS
-# define IO_REPARSE_TAG_NSS 0x080000005
-#endif
-#ifndef IO_REPARSE_TAG_NSSRECOVER
-# define IO_REPARSE_TAG_NSSRECOVER 0x080000006
-#endif
-#ifndef IO_REPARSE_TAG_SIS
-# define IO_REPARSE_TAG_SIS 0x080000007
-#endif
-#ifndef IO_REPARSE_TAG_DFS
-# define IO_REPARSE_TAG_DFS 0x080000008
-#endif
-
-#ifndef IO_REPARSE_TAG_RESERVED_ZERO
-# define IO_REPARSE_TAG_RESERVED_ZERO 0x00000000
-#endif
-#ifndef FILE_FLAG_OPEN_REPARSE_POINT
-# define FILE_FLAG_OPEN_REPARSE_POINT 0x00200000
-#endif
-#ifndef IO_REPARSE_TAG_MOUNT_POINT
-# 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))
-#endif
-#ifndef IO_REPARSE_TAG_SYMBOLIC_LINK
-# define IO_REPARSE_TAG_SYMBOLIC_LINK IO_REPARSE_TAG_RESERVED_ZERO
-#endif
-#ifndef FILE_SPECIAL_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)
-#endif
-#ifndef INVALID_FILE_ATTRIBUTES
-#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.
- */
-
-#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.
- */
-
-#define REPARSE_MOUNTPOINT_HEADER_SIZE 8
-#ifndef REPARSE_DATA_BUFFER_HEADER_SIZE
-typedef struct _REPARSE_DATA_BUFFER {
- DWORD ReparseTag;
- WORD ReparseDataLength;
- WORD Reserved;
- union {
- 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];
-} DUMMY_REPARSE_BUFFER;
-
-/*
- * Other typedefs required by this code.
- */
-
-static time_t ToCTime(FILETIME fileTime);
-static void FromCTime(time_t posixTime, FILETIME *fileTime);
-
-/*
- * Declarations for local functions defined in this file:
- */
-
-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, DWORD desiredAccess);
-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);
-MODULE_SCOPE TCL_NORETURN void tclWinDebugPanic(const char *format, ...);
-
-/*
- *--------------------------------------------------------------------
- *
- * WinLink --
- *
- * Make a link from source to target.
- *
- *--------------------------------------------------------------------
- */
-
-static int
-WinLink(
- const TCHAR *linkSourcePath,
- const TCHAR *linkTargetPath,
- int linkAction)
-{
- TCHAR tempFileName[MAX_PATH];
- TCHAR *tempFilePart;
- DWORD attr;
-
- /*
- * Get the full path referenced by the target.
- */
-
- if (!GetFullPathName(linkTargetPath, MAX_PATH, tempFileName,
- &tempFilePart)) {
- /*
- * Invalid file.
- */
-
- TclWinConvertError(GetLastError());
- return -1;
- }
-
- /*
- * Make sure source file doesn't exist.
- */
-
- attr = GetFileAttributes(linkSourcePath);
- if (attr != INVALID_FILE_ATTRIBUTES) {
- Tcl_SetErrno(EEXIST);
- return -1;
- }
-
- /*
- * Get the full path referenced by the source file/directory.
- */
-
- if (!GetFullPathName(linkSourcePath, MAX_PATH, tempFileName,
- &tempFilePart)) {
- /*
- * Invalid file.
- */
-
- TclWinConvertError(GetLastError());
- return -1;
- }
-
- /*
- * Check the target.
- */
-
- attr = GetFileAttributes(linkTargetPath);
- if (attr == INVALID_FILE_ATTRIBUTES) {
- /*
- * The target doesn't exist.
- */
-
- TclWinConvertError(GetLastError());
- } else if ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0) {
- /*
- * It is a file.
- */
-
- if (linkAction & TCL_CREATE_HARD_LINK) {
- if (CreateHardLink(linkSourcePath, linkTargetPath, NULL)) {
- /*
- * Success!
- */
-
- return 0;
- }
-
- TclWinConvertError(GetLastError());
- } else if (linkAction & TCL_CREATE_SYMBOLIC_LINK) {
- /*
- * Can't symlink files.
- */
-
- Tcl_SetErrno(ENOTDIR);
- } else {
- Tcl_SetErrno(ENODEV);
- }
- } 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(linkSourcePath, linkTargetPath);
-
- } else if (linkAction & TCL_CREATE_HARD_LINK) {
- /*
- * Can't hard link directories.
- */
-
- Tcl_SetErrno(EISDIR);
- } else {
- Tcl_SetErrno(ENODEV);
- }
- }
- return -1;
-}
-
-/*
- *--------------------------------------------------------------------
- *
- * WinReadLink --
- *
- * What does 'LinkSource' point to?
- *
- *--------------------------------------------------------------------
- */
-
-static Tcl_Obj *
-WinReadLink(
- const TCHAR *linkSourcePath)
-{
- TCHAR tempFileName[MAX_PATH];
- TCHAR *tempFilePart;
- DWORD attr;
-
- /*
- * Get the full path referenced by the target.
- */
-
- if (!GetFullPathName(linkSourcePath, MAX_PATH, tempFileName,
- &tempFilePart)) {
- /*
- * Invalid file.
- */
-
- TclWinConvertError(GetLastError());
- return NULL;
- }
-
- /*
- * Make sure source file does exist.
- */
-
- attr = GetFileAttributes(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.
- */
-
- Tcl_SetErrno(ENOTDIR);
- return NULL;
- }
-
- return WinReadLinkDirectory(linkSourcePath);
-}
-
-/*
- *--------------------------------------------------------------------
- *
- * 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.
- *
- * Returns:
- * Zero on success.
- *
- *--------------------------------------------------------------------
- */
-
-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(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!
- */
-
- for (loop = nativeTarget; *loop != 0; loop++) {
- if (*loop == L'/') {
- *loop = L'\\';
- }
- }
- if ((nativeTarget[len-1] == L'\\') && (nativeTarget[len-2] != L':')) {
- nativeTarget[len-1] = 0;
- }
-
- /*
- * Build the reparse info.
- */
-
- memset(reparseBuffer, 0, sizeof(DUMMY_REPARSE_BUFFER));
- reparseBuffer->ReparseTag = IO_REPARSE_TAG_MOUNT_POINT;
- reparseBuffer->MountPointReparseBuffer.SubstituteNameLength =
- wcslen(nativeTarget) * sizeof(WCHAR);
- reparseBuffer->Reserved = 0;
- 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 --
- *
- * 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(
- 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(linkOrigPath, reparseBuffer, GENERIC_READ)) {
- return -1;
- }
- return NativeWriteReparse(linkCopyPath, reparseBuffer);
-}
-
-/*
- *--------------------------------------------------------------------
- *
- * 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.
- *
- *--------------------------------------------------------------------
- */
-
-int
-TclWinSymLinkDelete(
- const TCHAR *linkOrigPath,
- int linkOnly)
-{
- /*
- * It is a symbolic link - remove it.
- */
-
- DUMMY_REPARSE_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 = CreateFile(linkOrigPath, GENERIC_WRITE, 0, NULL, OPEN_EXISTING,
- FILE_FLAG_OPEN_REPARSE_POINT | FILE_FLAG_BACKUP_SEMANTICS, NULL);
-
- if (hFile != INVALID_HANDLE_VALUE) {
- if (!DeviceIoControl(hFile, FSCTL_DELETE_REPARSE_POINT, reparseBuffer,
- REPARSE_MOUNTPOINT_HEADER_SIZE,NULL,0,&returnedLength,NULL)) {
- /*
- * Error setting junction.
- */
-
- TclWinConvertError(GetLastError());
- CloseHandle(hFile);
- } else {
- CloseHandle(hFile);
- if (!linkOnly) {
- RemoveDirectory(linkOrigPath);
- }
- return 0;
- }
- }
- return -1;
-}
-
-/*
- *--------------------------------------------------------------------
- *
- * WinReadLinkDirectory --
- *
- * 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.
- *
- *--------------------------------------------------------------------
- */
-
-#if defined (__clang__) || ((__GNUC__) && ((__GNUC__ > 4) || ((__GNUC__ == 4) && (__GNUC_MINOR__ > 5))))
-#pragma GCC diagnostic push
-#pragma GCC diagnostic ignored "-Warray-bounds"
-#endif
-
-static Tcl_Obj *
-WinReadLinkDirectory(
- const TCHAR *linkDirPath)
-{
- int attr, len, offset;
- DUMMY_REPARSE_BUFFER dummy;
- REPARSE_DATA_BUFFER *reparseBuffer = (REPARSE_DATA_BUFFER *) &dummy;
- Tcl_Obj *retVal;
- Tcl_DString ds;
- const char *copy;
-
- attr = GetFileAttributes(linkDirPath);
- if (!(attr & FILE_ATTRIBUTE_REPARSE_POINT)) {
- goto invalidError;
- }
- if (NativeReadReparse(linkDirPath, reparseBuffer, 0)) {
- return NULL;
- }
-
- switch (reparseBuffer->ReparseTag) {
- 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;
-#ifdef UNICODE
- if (reparseBuffer->MountPointReparseBuffer.PathBuffer[0] == L'\\') {
- /*
- * Check whether this is a mounted volume.
- */
-
- 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;
- }
- }
-#endif /* UNICODE */
-
- Tcl_WinTCharToUtf((const TCHAR *)
- 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;
-}
-
-#if defined (__clang__) || ((__GNUC__) && ((__GNUC__ > 4) || ((__GNUC__ == 4) && (__GNUC_MINOR__ > 5))))
-#pragma GCC diagnostic pop
-#endif
-
-/*
- *--------------------------------------------------------------------
- *
- * NativeReadReparse --
- *
- * Read the junction/reparse information from a given NTFS directory.
- *
- * Assumption that linkDirPath is a valid, existing directory.
- *
- * Returns:
- * Zero on success.
- *
- *--------------------------------------------------------------------
- */
-
-static int
-NativeReadReparse(
- const TCHAR *linkDirPath, /* The junction to read */
- REPARSE_DATA_BUFFER *buffer,/* Pointer to buffer. Cannot be NULL */
- DWORD desiredAccess)
-{
- HANDLE hFile;
- DWORD returnedLength;
-
- hFile = CreateFile(linkDirPath, desiredAccess, FILE_SHARE_READ, NULL, OPEN_EXISTING,
- FILE_FLAG_OPEN_REPARSE_POINT | FILE_FLAG_BACKUP_SEMANTICS, NULL);
-
- if (hFile == INVALID_HANDLE_VALUE) {
- /*
- * 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.
- */
-
- TclWinConvertError(GetLastError());
- CloseHandle(hFile);
- return -1;
- }
- CloseHandle(hFile);
-
- if (!IsReparseTagValid(buffer->ReparseTag)) {
- Tcl_SetErrno(EINVAL);
- return -1;
- }
- return 0;
-}
-
-/*
- *--------------------------------------------------------------------
- *
- * NativeWriteReparse --
- *
- * Write the reparse information for a given directory.
- *
- * Assumption that LinkDirectory does not exist.
- *
- *--------------------------------------------------------------------
- */
-
-static int
-NativeWriteReparse(
- const TCHAR *linkDirPath,
- REPARSE_DATA_BUFFER *buffer)
-{
- HANDLE hFile;
- DWORD returnedLength;
-
- /*
- * Create the directory - it must not already exist.
- */
-
- if (CreateDirectory(linkDirPath, NULL) == 0) {
- /*
- * Error creating directory.
- */
-
- TclWinConvertError(GetLastError());
- return -1;
- }
- hFile = CreateFile(linkDirPath, GENERIC_WRITE, 0, NULL,
- OPEN_EXISTING, FILE_FLAG_OPEN_REPARSE_POINT
- | FILE_FLAG_BACKUP_SEMANTICS, NULL);
- if (hFile == INVALID_HANDLE_VALUE) {
- /*
- * Error creating directory.
- */
-
- 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.
- */
-
- TclWinConvertError(GetLastError());
- CloseHandle(hFile);
- RemoveDirectory(linkDirPath);
- return -1;
- }
- CloseHandle(hFile);
-
- /*
- * We succeeded.
- */
-
- return 0;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * tclWinDebugPanic --
- *
- * Display a message. If a debugger is present, present it directly to
- * the debugger, otherwise use a MessageBox.
- *
- * Results:
- * None.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-TCL_NORETURN void
-tclWinDebugPanic(
- const char *format, ...)
-{
-#define TCL_MAX_WARN_LEN 1024
- va_list argList;
- char buf[TCL_MAX_WARN_LEN * TCL_UTF_MAX];
- WCHAR msgString[TCL_MAX_WARN_LEN];
-
- va_start(argList, format);
- vsnprintf(buf, sizeof(buf), format, argList);
-
- msgString[TCL_MAX_WARN_LEN-1] = L'\0';
- MultiByteToWideChar(CP_UTF8, 0, buf, -1, msgString, TCL_MAX_WARN_LEN);
-
- /*
- * Truncate MessageBox string if it is too long to not overflow the screen
- * and cause possible oversized window error.
- */
-
- if (msgString[TCL_MAX_WARN_LEN-1] != L'\0') {
- memcpy(msgString + (TCL_MAX_WARN_LEN - 5), L" ...", 5 * sizeof(WCHAR));
- }
- if (IsDebuggerPresent()) {
- OutputDebugStringW(msgString);
- } else {
- MessageBeep(MB_ICONEXCLAMATION);
- MessageBoxW(NULL, msgString, L"Fatal Error",
- MB_ICONSTOP | MB_OK | MB_TASKMODAL | MB_SETFOREGROUND);
- }
-#if defined(__GNUC__)
- __builtin_trap();
-#elif defined(_WIN64)
- __debugbreak();
-#elif defined(_MSC_VER) && defined (_M_IX86)
- _asm {int 3}
-#else
- DebugBreak();
-#endif
- abort();
-}
-
-/*
- *---------------------------------------------------------------------------
- *
- * TclpFindExecutable --
- *
- * This function computes the absolute path name of the current
- * application.
- *
- * Results:
- * None.
- *
- * Side effects:
- * The computed path is stored.
- *
- *---------------------------------------------------------------------------
- */
-
-void
-TclpFindExecutable(
- const char *argv0) /* If NULL, install PanicMessageBox, otherwise
- * ignore. */
-{
- WCHAR wName[MAX_PATH];
- char name[MAX_PATH * TCL_UTF_MAX];
-
- /*
- * Under Windows we ignore argv0, and return the path for the file used to
- * create this process. Only if it is NULL, install a new panic handler.
- */
-
- if (argv0 == NULL) {
- Tcl_SetPanicProc(tclWinDebugPanic);
- }
-
-#ifdef UNICODE
- GetModuleFileNameW(NULL, wName, MAX_PATH);
-#else
- GetModuleFileNameA(NULL, name, sizeof(name));
-
- /*
- * Convert to WCHAR to get out of ANSI codepage
- */
-
- MultiByteToWideChar(CP_ACP, 0, name, -1, wName, MAX_PATH);
-#endif
- WideCharToMultiByte(CP_UTF8, 0, wName, -1, name, sizeof(name), NULL, NULL);
- TclWinNoBackslash(name);
- TclSetObjNameOfExecutable(Tcl_NewStringObj(name, -1), NULL);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclpMatchInDirectory --
- *
- * 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).
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-int
-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;
-
- 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.
- */
-
- int len;
- DWORD attr;
- WIN32_FILE_ATTRIBUTE_DATA data;
- const char *str = Tcl_GetStringFromObj(norm,&len);
-
- native = Tcl_FSGetNativePath(pathPtr);
-
- if (GetFileAttributesEx(native,
- GetFileExInfoStandard, &data) != TRUE) {
- return TCL_OK;
- }
- attr = data.dwFileAttributes;
-
- if (NativeMatchType(WinIsDrive(str,len), attr, native, types)) {
- Tcl_ListObjAppendElement(interp, resultPtr, pathPtr);
- }
- }
- return TCL_OK;
- } else {
- DWORD attr;
- HANDLE handle;
- WIN32_FIND_DATA data;
- const char *dirName; /* UTF-8 dir name, later with pattern
- * appended. */
- int dirLength;
- int matchSpecialDots;
- 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;
-
- /*
- * Get the normalized path representation (the main thing is we dont
- * want any '~' sequences).
- */
-
- fileNamePtr = Tcl_FSGetNormalizedPath(interp, pathPtr);
- if (fileNamePtr == NULL) {
- return TCL_ERROR;
- }
-
- /*
- * Verify that the specified path exists and is actually a directory.
- */
-
- native = Tcl_FSGetNativePath(pathPtr);
- if (native == NULL) {
- return TCL_OK;
- }
- attr = GetFileAttributes(native);
-
- if ((attr == INVALID_FILE_ATTRIBUTES)
- || ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0)) {
- return TCL_OK;
- }
-
- /*
- * Build up the directory name for searching, including a trailing
- * directory separator.
- */
-
- Tcl_DStringInit(&dsOrig);
- dirName = Tcl_GetStringFromObj(fileNamePtr, &dirLength);
- Tcl_DStringAppend(&dsOrig, dirName, dirLength);
-
- lastChar = dirName[dirLength -1];
- if ((lastChar != '\\') && (lastChar != '/') && (lastChar != ':')) {
- TclDStringAppendLiteral(&dsOrig, "/");
- 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 = TclDStringAppendLiteral(&dsOrig, "*.*");
- }
-
- native = Tcl_WinUtfToTChar(dirName, -1, &ds);
- if ((types == NULL) || (types->type != TCL_GLOB_TYPE_DIR)) {
- handle = FindFirstFile(native, &data);
- } else {
- /*
- * We can be more efficient, for pure directory requests.
- */
-
- handle = FindFirstFileEx(native,
- FindExInfoStandard, &data,
- FindExSearchLimitToDirectories, NULL, 0);
- }
-
- if (handle == INVALID_HANDLE_VALUE) {
- DWORD err = GetLastError();
-
- Tcl_DStringFree(&ds);
- if (err == ERROR_FILE_NOT_FOUND) {
- /*
- * 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_SetObjResult(interp, Tcl_ObjPrintf(
- "couldn't read directory \"%s\": %s",
- Tcl_DStringValue(&dsOrig), Tcl_PosixError(interp)));
- }
- Tcl_DStringFree(&dsOrig);
- return TCL_ERROR;
- }
- Tcl_DStringFree(&ds);
-
- /*
- * 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] == '.')
- || ((pattern[0] == '\\') && (pattern[1] == '.'))) {
- matchSpecialDots = 1;
- } else {
- matchSpecialDots = 0;
- }
-
- /*
- * Now iterate over all of the files in the directory, starting with
- * the first one we found.
- */
-
- do {
- const char *utfname;
- int checkDrive = 0, isDrive;
- DWORD attr;
-
- native = data.cFileName;
- attr = data.dwFileAttributes;
- utfname = Tcl_WinTCharToUtf(native, -1, &ds);
-
- if (!matchSpecialDots) {
- /*
- * 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.
- */
-
- 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
- * the system.
- */
-
- if (Tcl_StringCaseMatch(utfname, pattern, 1)) {
- /*
- * If the file matches, then we need to process the remainder
- * of the path.
- */
-
- if (checkDrive) {
- const char *fullname = Tcl_DStringAppend(&dsOrig, utfname,
- Tcl_DStringLength(&ds));
-
- isDrive = WinIsDrive(fullname, Tcl_DStringLength(&dsOrig));
- Tcl_DStringSetLength(&dsOrig, dirLength);
- } else {
- isDrive = 0;
- }
- if (NativeMatchType(isDrive, attr, native, types)) {
- Tcl_ListObjAppendElement(interp, resultPtr,
- TclNewFSPathObj(pathPtr, utfname,
- Tcl_DStringLength(&ds)));
- }
- }
-
- /*
- * Free ds here to ensure that native is valid above.
- */
-
- Tcl_DStringFree(&ds);
- } while (FindNextFile(handle, &data) == TRUE);
-
- FindClose(handle);
- 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.
- */
-
-static int
-WinIsDrive(
- 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 (remove == 0) {
- break;
- }
- remove--;
- while (len > 0) {
- len--;
- if (name[len] == '/' || name[len] == '\\') {
- break;
- }
- }
- if (len < 4) {
- len++;
- break;
- }
- } 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.
- */
- } else if (len == 1 && (name[0] == '/' || name[0] == '\\')) {
- /*
- * Path is pointing to the root volume.
- */
-
- return 1;
- } else if ((name[1] == ':')
- && (len == 2 || (name[2] == '/' || name[2] == '\\'))) {
- /*
- * 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 :).
- */
-
-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[2] == 'm' || path[2] == 'M')
- && path[3] >= '1' && path[3] <= '9') {
- /*
- * May have match for 'com[1-9]:?', 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'
- */
-
- return 3;
- }
-
- } else if ((path[0] == 'l' || path[0] == 'L')
- && (path[1] == 'p' || path[1] == 'P')
- && (path[2] == 't' || path[2] == 'T')) {
- if (path[3] >= '1' && path[3] <= '9') {
- /*
- * May have match for 'lpt[1-9]:?'
- */
-
- if (path[4] == '\0') {
- return 4;
- } else if (path [4] == ':' && path[5] == '\0') {
- return 4;
- }
- }
-
- } else if (!strcasecmp(path, "prn") || !strcasecmp(path, "nul")
- || !strcasecmp(path, "aux")) {
- /*
- * Have match for 'prn', 'nul' or 'aux'.
- */
-
- return 3;
- }
- return 0;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * 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.
- *
- * Results:
- * 0 = file doesn't match
- * 1 = file matches
- *
- *----------------------------------------------------------------------
- */
-
-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. */
-{
- /*
- * '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.
- */
-
- return !(attr & FILE_ATTRIBUTE_HIDDEN && !isDrive);
- }
-
- if (attr & FILE_ATTRIBUTE_HIDDEN && !isDrive) {
- /*
- * If invisible.
- */
-
- if ((types->perm == 0) || !(types->perm & TCL_GLOB_PERM_HIDDEN)) {
- return 0;
- }
- } else {
- /*
- * Visible.
- */
-
- if (types->perm & TCL_GLOB_PERM_HIDDEN) {
- return 0;
- }
- }
-
- if (types->perm != 0) {
- if (((types->perm & TCL_GLOB_PERM_RONLY) &&
- !(attr & FILE_ATTRIBUTE_READONLY)) ||
- ((types->perm & TCL_GLOB_PERM_R) &&
- (0 /* File exists => R_OK on Windows */)) ||
- ((types->perm & TCL_GLOB_PERM_W) &&
- (attr & FILE_ATTRIBUTE_READONLY)) ||
- ((types->perm & TCL_GLOB_PERM_X) &&
- (!(attr & FILE_ATTRIBUTE_DIRECTORY)
- && !NativeIsExec(nativeName)))) {
- return 0;
- }
- }
-
- if ((types->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)) ||
-#ifdef S_ISSOCK
- ((types->type&TCL_GLOB_TYPE_SOCK) && S_ISSOCK(st_mode)) ||
-#endif
- ((types->type&TCL_GLOB_TYPE_FILE) && S_ISREG(st_mode))) {
- /*
- * Do nothing - this file is ok.
- */
- } else {
-#ifdef S_ISLNK
- if (types->type & TCL_GLOB_TYPE_LINK) {
- st_mode = NativeStatMode(attr, 1, isExec);
- if (S_ISLNK(st_mode)) {
- return 1;
- }
- }
-#endif /* S_ISLNK */
- return 0;
- }
- }
- return 1;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclpGetUserHome --
- *
- * This function takes the passed in user name and finds the
- * corresponding home directory specified in the password file.
- *
- * 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.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-const char *
-TclpGetUserHome(
- const char *name, /* User name for desired home directory. */
- Tcl_DString *bufferPtr) /* Uninitialized or free DString filled with
- * name of user's home directory. */
-{
- char *result = NULL;
- USER_INFO_1 *uiPtr;
- Tcl_DString ds;
- int nameLen = -1;
- int rc = 0;
- const char *domain;
- WCHAR *wName, *wHomeDir, *wDomain;
- WCHAR buf[MAX_PATH];
-
- Tcl_DStringInit(bufferPtr);
-
- wDomain = NULL;
- domain = Tcl_UtfFindFirst(name, '@');
- if (domain == NULL) {
- const char *ptr;
-
- /* no domain - firstly check it's the current user */
- if ( (ptr = TclpGetUserName(&ds)) != NULL
- && strcasecmp(name, ptr) == 0
- ) {
- /* try safest and fastest way to get current user home */
- ptr = TclGetEnv("HOME", &ds);
- if (ptr != NULL) {
- Tcl_JoinPath(1, &ptr, bufferPtr);
- rc = 1;
- result = Tcl_DStringValue(bufferPtr);
- }
- }
- Tcl_DStringFree(&ds);
- } else {
- Tcl_DStringInit(&ds);
- wName = Tcl_UtfToUniCharDString(domain + 1, -1, &ds);
- rc = NetGetDCName(NULL, wName, (LPBYTE *) &wDomain);
- Tcl_DStringFree(&ds);
- nameLen = domain - name;
- }
- if (rc == 0) {
- Tcl_DStringInit(&ds);
- wName = Tcl_UtfToUniCharDString(name, nameLen, &ds);
- while (NetUserGetInfo(wDomain, wName, 1, (LPBYTE *) &uiPtr) != 0) {
- /*
- * user does not exists - if domain was not specified,
- * try again using current domain.
- */
- rc = 1;
- if (domain != NULL) break;
- /* get current domain */
- rc = NetGetDCName(NULL, NULL, (LPBYTE *) &wDomain);
- if (rc != 0) break;
- domain = INT2PTR(-1); /* repeat once */
- }
- if (rc == 0) {
- DWORD i, size = MAX_PATH;
- wHomeDir = uiPtr->usri1_home_dir;
- if ((wHomeDir != NULL) && (wHomeDir[0] != L'\0')) {
- size = lstrlenW(wHomeDir);
- Tcl_UniCharToUtfDString(wHomeDir, size, bufferPtr);
- } else {
- /*
- * User exists but has no home dir. Return
- * "{GetProfilesDirectory}/<user>".
- */
- GetProfilesDirectoryW(buf, &size);
- Tcl_UniCharToUtfDString(buf, size-1, bufferPtr);
- Tcl_DStringAppend(bufferPtr, "/", 1);
- Tcl_DStringAppend(bufferPtr, name, nameLen);
- }
- result = Tcl_DStringValue(bufferPtr);
- /* be sure we returns normalized path */
- for (i = 0; i < size; ++i){
- if (result[i] == '\\') result[i] = '/';
- }
- NetApiBufferFree((void *) uiPtr);
- }
- Tcl_DStringFree(&ds);
- }
- if (wDomain != NULL) {
- NetApiBufferFree((void *) wDomain);
- }
- 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 "*".
- */
-
- char buf[MAX_PATH];
-
- if (name[0] != '*') {
- 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}:/".
- */
-
- GetWindowsDirectoryA(buf, MAX_PATH);
- Tcl_DStringAppend(bufferPtr, buf, 3);
- result = Tcl_DStringValue(bufferPtr);
- }
- }
- }
-
- return result;
-}
-
-/*
- *---------------------------------------------------------------------------
- *
- * NativeAccess --
- *
- * This function replaces the library version of access(), fixing the
- * following bugs:
- *
- * 1. access() returns that all files have execute permission.
- *
- * Results:
- * See access documentation.
- *
- * Side effects:
- * See access documentation.
- *
- *---------------------------------------------------------------------------
- */
-
-static int
-NativeAccess(
- const TCHAR *nativePath, /* Path of file to access, native encoding. */
- int mode) /* Permission setting. */
-{
- DWORD attr;
-
- attr = GetFileAttributes(nativePath);
-
- if (attr == INVALID_FILE_ATTRIBUTES) {
- /*
- * File might not exist.
- */
-
- DWORD lasterror = GetLastError();
- if (lasterror != ERROR_SHARING_VIOLATION) {
- TclWinConvertError(lasterror);
- return -1;
- }
- }
-
- if (mode == F_OK) {
- /*
- * File exists, nothing else to check.
- */
-
- return 0;
- }
-
- /*
- * If it's not a directory (assume file), do several fast checks:
- */
- if (!(attr & FILE_ATTRIBUTE_DIRECTORY)) {
- /*
- * If the attributes say this is not writable at all. The file is a
- * regular file (i.e., not a directory), then the file is not
- * writable, full stop. For directories, the read-only bit is
- * (mostly) ignored by Windows, so we can't ascertain anything about
- * directory access from the attrib data. However, if we have the
- * advanced 'getFileSecurityProc', then more robust ACL checks
- * will be done below.
- */
- if ((mode & W_OK) && (attr & FILE_ATTRIBUTE_READONLY)) {
- Tcl_SetErrno(EACCES);
- return -1;
- }
-
- /* If doesn't have the correct extension, it can't be executable */
- if ((mode & X_OK) && !NativeIsExec(nativePath)) {
- Tcl_SetErrno(EACCES);
- return -1;
- }
- /* Special case for read/write/executable check on file */
- if ((mode & (R_OK|W_OK|X_OK)) && !(mode & ~(R_OK|W_OK|X_OK))) {
- DWORD mask = 0;
- HANDLE hFile;
- if (mode & R_OK) { mask |= GENERIC_READ; }
- if (mode & W_OK) { mask |= GENERIC_WRITE; }
- if (mode & X_OK) { mask |= GENERIC_EXECUTE; }
-
- hFile = CreateFile(nativePath, mask,
- FILE_SHARE_READ | FILE_SHARE_WRITE | FILE_SHARE_DELETE, NULL,
- OPEN_EXISTING, FILE_FLAG_NO_BUFFERING, NULL);
- if (hFile != INVALID_HANDLE_VALUE) {
- CloseHandle(hFile);
- return 0;
- }
- /* fast exit if access was denied */
- if (GetLastError() == ERROR_ACCESS_DENIED) {
- Tcl_SetErrno(EACCES);
- return -1;
- }
- }
- /* We cannnot verify the access fast, check it below using security info. */
- }
-
- /*
- * It looks as if the permissions are ok, but if we are on NT, 2000 or XP,
- * we have a more complex permissions structure so we try to check that.
- * The code below is remarkably complex for such a simple thing as finding
- * what permissions the OS has set for a file.
- */
-
-#ifdef UNICODE
- {
- SECURITY_DESCRIPTOR *sdPtr = NULL;
- unsigned long size;
- PSID pSid = 0;
- BOOL SidDefaulted;
- SID_IDENTIFIER_AUTHORITY samba_unmapped = {{0, 0, 0, 0, 0, 22}};
- GENERIC_MAPPING genMap;
- HANDLE hToken = NULL;
- DWORD desiredAccess = 0, grantedAccess = 0;
- BOOL accessYesNo = FALSE;
- PRIVILEGE_SET privSet;
- DWORD privSetSize = sizeof(PRIVILEGE_SET);
- int error;
-
- /*
- * First find out how big the buffer needs to be.
- */
-
- size = 0;
- GetFileSecurity(nativePath,
- OWNER_SECURITY_INFORMATION | GROUP_SECURITY_INFORMATION
- | DACL_SECURITY_INFORMATION | LABEL_SECURITY_INFORMATION,
- 0, 0, &size);
-
- /*
- * Should have failed with ERROR_INSUFFICIENT_BUFFER
- */
-
- error = GetLastError();
- if (error != ERROR_INSUFFICIENT_BUFFER) {
- /*
- * Most likely case is ERROR_ACCESS_DENIED, which we will convert
- * to EACCES - just what we want!
- */
-
- TclWinConvertError((DWORD) error);
- return -1;
- }
-
- /*
- * Now size contains the size of buffer needed.
- */
-
- sdPtr = (SECURITY_DESCRIPTOR *) HeapAlloc(GetProcessHeap(), 0, size);
-
- if (sdPtr == NULL) {
- goto accessError;
- }
-
- /*
- * Call GetFileSecurity() for real.
- */
-
- if (!GetFileSecurity(nativePath,
- OWNER_SECURITY_INFORMATION | GROUP_SECURITY_INFORMATION
- | DACL_SECURITY_INFORMATION | LABEL_SECURITY_INFORMATION,
- sdPtr, size, &size)) {
- /*
- * Error getting owner SD
- */
-
- goto accessError;
- }
-
- /*
- * As of Samba 3.0.23 (10-Jul-2006), unmapped users and groups are
- * assigned to SID domains S-1-22-1 and S-1-22-2, where "22" is the
- * top-level authority. If the file owner and group is unmapped then
- * the ACL access check below will only test against world access,
- * which is likely to be more restrictive than the actual access
- * restrictions. Since the ACL tests are more likely wrong than
- * right, skip them. Moreover, the unix owner access permissions are
- * usually mapped to the Windows attributes, so if the user is the
- * file owner then the attrib checks above are correct (as far as they
- * go).
- */
-
- if(!GetSecurityDescriptorOwner(sdPtr,&pSid,&SidDefaulted) ||
- memcmp(GetSidIdentifierAuthority(pSid),&samba_unmapped,
- sizeof(SID_IDENTIFIER_AUTHORITY))==0) {
- HeapFree(GetProcessHeap(), 0, sdPtr);
- return 0; /* Attrib tests say access allowed. */
- }
-
- /*
- * Perform security impersonation of the user and open the resulting
- * thread token.
- */
-
- if (!ImpersonateSelf(SecurityImpersonation)) {
- /*
- * Unable to perform security impersonation.
- */
-
- goto accessError;
- }
- if (!OpenThreadToken(GetCurrentThread(),
- TOKEN_DUPLICATE | TOKEN_QUERY, FALSE, &hToken)) {
- /*
- * Unable to get current thread's token.
- */
-
- goto accessError;
- }
-
- RevertToSelf();
-
- /*
- * Setup desiredAccess according to the access priveleges we are
- * checking.
- */
-
- if (mode & R_OK) {
- desiredAccess |= FILE_GENERIC_READ;
- }
- if (mode & W_OK) {
- desiredAccess |= FILE_GENERIC_WRITE;
- }
- if (mode & X_OK) {
- desiredAccess |= FILE_GENERIC_EXECUTE;
- }
-
- 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.
- */
-
- if (!AccessCheck(sdPtr, hToken, desiredAccess,
- &genMap, &privSet, &privSetSize, &grantedAccess,
- &accessYesNo)) {
- /*
- * Unable to perform access check.
- */
-
- accessError:
- TclWinConvertError(GetLastError());
- if (sdPtr != NULL) {
- HeapFree(GetProcessHeap(), 0, sdPtr);
- }
- if (hToken != NULL) {
- CloseHandle(hToken);
- }
- return -1;
- }
-
- /*
- * Clean up.
- */
-
- HeapFree(GetProcessHeap(), 0, sdPtr);
- CloseHandle(hToken);
- if (!accessYesNo) {
- Tcl_SetErrno(EACCES);
- return -1;
- }
-
- }
-#endif /* !UNICODE */
- return 0;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * NativeIsExec --
- *
- * Determines if a path is executable. On windows this is simply defined
- * by whether the path ends in a standard executable extension.
- *
- * Results:
- * 1 = executable, 0 = not.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-NativeIsExec(
- const TCHAR *path)
-{
- int len = _tcslen(path);
-
- if (len < 5) {
- return 0;
- }
-
- if (path[len-4] != '.') {
- return 0;
- }
-
- path += len-3;
- if ((_tcsicmp(path, TEXT("exe")) == 0)
- || (_tcsicmp(path, TEXT("com")) == 0)
- || (_tcsicmp(path, TEXT("cmd")) == 0)
- || (_tcsicmp(path, TEXT("cmd")) == 0)
- || (_tcsicmp(path, TEXT("bat")) == 0)) {
- return 1;
- }
- return 0;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclpObjChdir --
- *
- * This function replaces the library version of chdir().
- *
- * Results:
- * See chdir() documentation.
- *
- * Side effects:
- * See chdir() documentation.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclpObjChdir(
- Tcl_Obj *pathPtr) /* Path to new working directory. */
-{
- int result;
- const TCHAR *nativePath;
-
- nativePath = Tcl_FSGetNativePath(pathPtr);
-
- if (!nativePath) {
- return -1;
- }
- result = SetCurrentDirectory(nativePath);
-
- if (result == 0) {
- TclWinConvertError(GetLastError());
- return -1;
- }
- return 0;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclpGetCwd --
- *
- * 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.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-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. */
-{
- TCHAR buffer[MAX_PATH];
- char *p;
- WCHAR *native;
-
- if (GetCurrentDirectory(MAX_PATH, buffer) == 0) {
- TclWinConvertError(GetLastError());
- if (interp != NULL) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "error getting working directory name: %s",
- Tcl_PosixError(interp)));
- }
- return NULL;
- }
-
- /*
- * Watch for the weird Windows c:\\UNC syntax.
- */
-
- native = (WCHAR *) buffer;
- if ((native[0] != '\0') && (native[1] == ':')
- && (native[2] == '\\') && (native[3] == '\\')) {
- native += 2;
- }
- Tcl_WinTCharToUtf((TCHAR *) native, -1, bufferPtr);
-
- /*
- * Convert to forward slashes for easier use in scripts.
- */
-
- for (p = Tcl_DStringValue(bufferPtr); *p != '\0'; p++) {
- if (*p == '\\') {
- *p = '/';
- }
- }
- return Tcl_DStringValue(bufferPtr);
-}
-
-int
-TclpObjStat(
- Tcl_Obj *pathPtr, /* Path of file to stat. */
- Tcl_StatBuf *statPtr) /* Filled with results of stat call. */
-{
- /*
- * 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();
-
- return NativeStat(Tcl_FSGetNativePath(pathPtr), statPtr, 0);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * NativeStat --
- *
- * 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.
- * 3. stat("\\server\mount") would return error.
- * 4. Accepts slashes or backslashes.
- * 5. st_dev and st_rdev were wrong for UNC paths.
- *
- * Results:
- * See stat documentation.
- *
- * Side effects:
- * See stat documentation.
- *
- *----------------------------------------------------------------------
- */
-
-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' */
-{
- DWORD attr;
- int dev, nlink = 1;
- unsigned short mode;
- unsigned int inode = 0;
- HANDLE fileHandle;
- DWORD fileType = FILE_TYPE_UNKNOWN;
-
- /*
- * 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.
- *
- * Special consideration must be given to Windows hardcoded names
- * like CON, NULL, COM1, LPT1 etc. For these, we still need to
- * do the CreateFile as some may not exist (e.g. there is no CON
- * in wish by default). However the subsequent GetFileInformationByHandle
- * will fail. We do a WinIsReserved to see if it is one of the special
- * names, and if successful, mock up a BY_HANDLE_FILE_INFORMATION
- * structure.
- */
-
- fileHandle = CreateFile(nativePath, GENERIC_READ,
- FILE_SHARE_READ | FILE_SHARE_WRITE | FILE_SHARE_DELETE,
- 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) {
- fileType = GetFileType(fileHandle);
- CloseHandle(fileHandle);
- if (fileType != FILE_TYPE_CHAR && fileType != FILE_TYPE_DISK) {
- Tcl_SetErrno(ENOENT);
- return -1;
- }
- /* Mock up the expected structure */
- memset(&data, 0, sizeof(data));
- statPtr->st_atime = 0;
- statPtr->st_mtime = 0;
- statPtr->st_ctime = 0;
- } else {
- CloseHandle(fileHandle);
- statPtr->st_atime = ToCTime(data.ftLastAccessTime);
- statPtr->st_mtime = ToCTime(data.ftLastWriteTime);
- statPtr->st_ctime = ToCTime(data.ftCreationTime);
- }
- attr = data.dwFileAttributes;
- statPtr->st_size = ((Tcl_WideInt) data.nFileSizeLow) |
- (((Tcl_WideInt) data.nFileSizeHigh) << 32);
-
- /*
- * 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 {
- /*
- * Fall back on the less capable routines. This means no nlink or ino.
- */
-
- WIN32_FILE_ATTRIBUTE_DATA data;
-
- if (GetFileAttributesEx(nativePath,
- GetFileExInfoStandard, &data) != TRUE) {
- HANDLE hFind;
- WIN32_FIND_DATA ffd;
- DWORD lasterror = GetLastError();
-
- if (lasterror != ERROR_SHARING_VIOLATION) {
- TclWinConvertError(lasterror);
- return -1;
- }
- hFind = FindFirstFile(nativePath, &ffd);
- if (hFind == INVALID_HANDLE_VALUE) {
- TclWinConvertError(GetLastError());
- return -1;
- }
- memcpy(&data, &ffd, sizeof(data));
- FindClose(hFind);
- }
-
- 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);
- }
-
- dev = NativeDev(nativePath);
- mode = NativeStatMode(attr, checkLinks, NativeIsExec(nativePath));
- if (fileType == FILE_TYPE_CHAR) {
- mode &= ~S_IFMT;
- mode |= S_IFCHR;
- } else if (fileType == FILE_TYPE_DISK) {
- mode &= ~S_IFMT;
- mode |= S_IFBLK;
- }
-
- 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.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-NativeDev(
- const TCHAR *nativePath) /* Full path of file to stat */
-{
- int dev;
- Tcl_DString ds;
- TCHAR nativeFullPath[MAX_PATH];
- TCHAR *nativePart;
- const char *fullPath;
-
- GetFullPathName(nativePath, MAX_PATH, nativeFullPath, &nativePart);
- fullPath = Tcl_WinTCharToUtf(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) {
- /*
- * Add terminating backslash to fullpath or GetVolumeInformation()
- * won't work.
- */
-
- fullPath = TclDStringAppendLiteral(&ds, "\\");
- p = fullPath + Tcl_DStringLength(&ds);
- } else {
- p++;
- }
- nativeVol = Tcl_WinUtfToTChar(fullPath, p - fullPath, &volString);
- dw = (DWORD) -1;
- GetVolumeInformation(nativeVol, NULL, 0, &dw, NULL, NULL, NULL, 0);
-
- /*
- * 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);
-
- return dev;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * NativeStatMode --
- *
- * 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)
-{
- int mode;
-
- if (checkLinks && (attr & FILE_ATTRIBUTE_REPARSE_POINT)) {
- /*
- * It is a link.
- */
-
- mode = S_IFLNK;
- } else {
- mode = (attr & FILE_ATTRIBUTE_DIRECTORY) ? S_IFDIR|S_IEXEC : S_IFREG;
- }
- 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.
- */
-
- mode |= (mode & (S_IREAD|S_IWRITE|S_IEXEC)) >> 3;
- mode |= (mode & (S_IREAD|S_IWRITE|S_IEXEC)) >> 6;
- return (unsigned short) mode;
-}
-
-/*
- *------------------------------------------------------------------------
- *
- * ToCTime --
- *
- * Converts a Windows FILETIME to a time_t in UTC.
- *
- * Results:
- * Returns the count of seconds from the Posix epoch.
- *
- *------------------------------------------------------------------------
- */
-
-static time_t
-ToCTime(
- FILETIME fileTime) /* UTC time */
-{
- LARGE_INTEGER convertedTime;
-
- convertedTime.LowPart = fileTime.dwLowDateTime;
- convertedTime.HighPart = (LONG) fileTime.dwHighDateTime;
-
- return (time_t) ((convertedTime.QuadPart -
- (Tcl_WideInt) POSIX_EPOCH_AS_FILETIME) / (Tcl_WideInt) 10000000);
-}
-
-/*
- *------------------------------------------------------------------------
- *
- * FromCTime --
- *
- * Converts a time_t to a Windows FILETIME
- *
- * Results:
- * Returns the count of 100-ns ticks seconds from the Windows epoch.
- *
- *------------------------------------------------------------------------
- */
-
-static void
-FromCTime(
- time_t posixTime,
- FILETIME *fileTime) /* UTC Time */
-{
- LARGE_INTEGER convertedTime;
-
- convertedTime.QuadPart = ((LONGLONG) posixTime) * 10000000
- + POSIX_EPOCH_AS_FILETIME;
- fileTime->dwLowDateTime = convertedTime.LowPart;
- fileTime->dwHighDateTime = convertedTime.HighPart;
-}
-
-/*
- *---------------------------------------------------------------------------
- *
- * TclpGetNativeCwd --
- *
- * This function replaces the library version of getcwd().
- *
- * Results:
- * 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:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-ClientData
-TclpGetNativeCwd(
- ClientData clientData)
-{
- TCHAR buffer[MAX_PATH];
-
- if (GetCurrentDirectory(MAX_PATH, buffer) == 0) {
- TclWinConvertError(GetLastError());
- return NULL;
- }
-
- if (clientData != NULL) {
- if (_tcscmp((const TCHAR*)clientData, buffer) == 0) {
- return clientData;
- }
- }
-
- return TclNativeDupInternalRep(buffer);
-}
-
-int
-TclpObjAccess(
- Tcl_Obj *pathPtr,
- int mode)
-{
- return NativeAccess(Tcl_FSGetNativePath(pathPtr), mode);
-}
-
-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.
- */
-
- TclWinFlushDirtyChannels();
-
- return NativeStat(Tcl_FSGetNativePath(pathPtr), statPtr, 1);
-}
-
-#ifdef S_IFLNK
-Tcl_Obj *
-TclpObjLink(
- Tcl_Obj *pathPtr,
- Tcl_Obj *toPtr,
- int linkAction)
-{
- if (toPtr != NULL) {
- int res;
- const TCHAR *LinkTarget;
- const TCHAR *LinkSource = Tcl_FSGetNativePath(pathPtr);
- Tcl_Obj *normalizedToPtr = Tcl_FSGetNormalizedPath(NULL, toPtr);
-
- if (normalizedToPtr == NULL) {
- return NULL;
- }
-
- LinkTarget = Tcl_FSGetNativePath(normalizedToPtr);
-
- if (LinkSource == NULL || LinkTarget == NULL) {
- return NULL;
- }
- res = WinLink(LinkSource, LinkTarget, linkAction);
- if (res == 0) {
- return toPtr;
- } else {
- return NULL;
- }
- } else {
- const TCHAR *LinkSource = Tcl_FSGetNativePath(pathPtr);
-
- if (LinkSource == NULL) {
- return NULL;
- }
- return WinReadLink(LinkSource);
- }
-}
-#endif /* S_IFLNK */
-
-/*
- *---------------------------------------------------------------------------
- *
- * 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.
- *
- * Results:
- * NULL at present.
- *
- * Side effects:
- * None.
- *
- *---------------------------------------------------------------------------
- */
-
-Tcl_Obj *
-TclpFilesystemPathType(
- Tcl_Obj *pathPtr)
-{
-#define VOL_BUF_SIZE 32
- int found;
- TCHAR volType[VOL_BUF_SIZE];
- 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;
- }
-
- firstSeparator = strchr(path, '/');
- if (firstSeparator == NULL) {
- found = GetVolumeInformation(Tcl_FSGetNativePath(pathPtr),
- NULL, 0, NULL, NULL, NULL, volType, VOL_BUF_SIZE);
- } else {
- Tcl_Obj *driveName = Tcl_NewStringObj(path, firstSeparator - path+1);
-
- Tcl_IncrRefCount(driveName);
- found = GetVolumeInformation(Tcl_FSGetNativePath(driveName),
- NULL, 0, NULL, NULL, NULL, volType, VOL_BUF_SIZE);
- Tcl_DecrRefCount(driveName);
- }
-
- if (found == 0) {
- return NULL;
- } else {
- Tcl_DString ds;
-
- Tcl_WinTCharToUtf(volType, -1, &ds);
- return TclDStringToObj(&ds);
- }
-#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.
- *
- * Results:
- * 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.
- *
- *---------------------------------------------------------------------------
- */
-
-int
-TclpObjNormalizePath(
- Tcl_Interp *interp,
- Tcl_Obj *pathPtr,
- int nextCheckpoint)
-{
- char *lastValidPathEnd = NULL;
- Tcl_DString dsNorm; /* This will hold the normalized string. */
- char *path, *currentPathEndPosition;
- Tcl_Obj *temp = NULL;
- int isDrive = 1;
- Tcl_DString ds; /* Some workspace. */
-
- Tcl_DStringInit(&dsNorm);
- path = Tcl_GetString(pathPtr);
-
- currentPathEndPosition = path + nextCheckpoint;
- if (*currentPathEndPosition == '/') {
- currentPathEndPosition++;
- }
- while (1) {
- char cur = *currentPathEndPosition;
-
- if ((cur=='/' || cur==0) && (path != currentPathEndPosition)) {
- /*
- * Reached directory separator, or end of string.
- */
-
- WIN32_FILE_ATTRIBUTE_DATA data;
- const TCHAR *nativePath = Tcl_WinUtfToTChar(path,
- currentPathEndPosition - path, &ds);
-
- if (GetFileAttributesEx(nativePath,
- GetFileExInfoStandard, &data) != TRUE) {
- /*
- * File doesn't exist.
- */
-
- if (isDrive) {
- int len = WinIsReserved(path);
-
- if (len > 0) {
- /*
- * Actually it does exist - COM1, etc.
- */
-
- int 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;
- }
- }
- Tcl_DStringAppend(&dsNorm,
- (const char *)nativePath,
- (int)(sizeof(WCHAR) * len));
- lastValidPathEnd = currentPathEndPosition;
- } else if (nextCheckpoint == 0) {
- /* Path starts with a drive designation
- * that's not actually on the system.
- * We still must normalize up past the
- * first separator. [Bug 3603434] */
- currentPathEndPosition++;
- }
- }
- Tcl_DStringFree(&ds);
- break;
- }
-
- /*
- * 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 drives.
- */
-
- if (cur != 0 && !isDrive &&
- data.dwFileAttributes & FILE_ATTRIBUTE_REPARSE_POINT){
- Tcl_Obj *to = WinReadLinkDirectory(nativePath);
-
- if (to != NULL) {
- /*
- * Read the reparse point ok. Now, reparse points need
- * not be normalized, otherwise we could use:
- *
- * Tcl_GetStringFromObj(to, &pathLen);
- * nextCheckpoint = pathLen;
- *
- * So, instead we have to start from the beginning.
- */
-
- nextCheckpoint = 0;
- Tcl_AppendToObj(to, currentPathEndPosition, -1);
-
- /*
- * Convert link to forward slashes.
- */
-
- for (path = Tcl_GetString(to); *path != 0; path++) {
- if (*path == '\\') {
- *path = '/';
- }
- }
- path = Tcl_GetString(to);
- currentPathEndPosition = path + nextCheckpoint;
- if (temp != NULL) {
- Tcl_DecrRefCount(temp);
- }
- temp = to;
-
- /*
- * Reset variables so we can restart normalization.
- */
-
- isDrive = 1;
- Tcl_DStringFree(&dsNorm);
- Tcl_DStringFree(&ds);
- 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
- */
-
- if (isDrive) {
- WCHAR drive = ((WCHAR *) nativePath)[0];
-
- if (drive >= L'a') {
- drive -= (L'a' - L'A');
- ((WCHAR *) nativePath)[0] = drive;
- }
- Tcl_DStringAppend(&dsNorm, (const char *)nativePath,
- Tcl_DStringLength(&ds));
- } else {
- char *checkDots = NULL;
-
- if (lastValidPathEnd[1] == '.') {
- checkDots = lastValidPathEnd + 1;
- while (checkDots < currentPathEndPosition) {
- if (*checkDots != '.') {
- checkDots = NULL;
- break;
- }
- checkDots++;
- }
- }
- if (checkDots != NULL) {
- int dotLen = currentPathEndPosition-lastValidPathEnd;
-
- /*
- * Path is just dots. We shouldn't really ever see a
- * path like that. However, to be nice we at least
- * don't mangle the path - we just add the dots as a
- * path segment and continue.
- */
-
- Tcl_DStringAppend(&dsNorm, ((const char *)nativePath)
- + Tcl_DStringLength(&ds)
- - (dotLen * sizeof(TCHAR)),
- (int)(dotLen * sizeof(TCHAR)));
- } else {
- /*
- * Normal path.
- */
-
- WIN32_FIND_DATAW fData;
- HANDLE handle;
-
- handle = FindFirstFileW((WCHAR *) nativePath, &fData);
- if (handle == INVALID_HANDLE_VALUE) {
- /*
- * This is usually the '/' in 'c:/' at end of
- * string.
- */
-
- Tcl_DStringAppend(&dsNorm, (const char *) L"/",
- sizeof(WCHAR));
- } else {
- 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,
- (const char *) nativeName,
- (int) (wcslen(nativeName)*sizeof(WCHAR)));
- }
- }
- }
-#endif /* !TclNORM_LONG_PATH */
- 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.
- */
-
- isDrive = 0;
- }
- currentPathEndPosition++;
-
-#ifdef TclNORM_LONG_PATH
- /*
- * Convert the entire known path to long form.
- */
-
- if (1) {
- WCHAR wpath[MAX_PATH];
- const TCHAR *nativePath =
- Tcl_WinUtfToTChar(path, lastValidPathEnd - path, &ds);
- DWORD wpathlen = 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, (const char *) wpath,
- wpathlen * sizeof(WCHAR));
- Tcl_DStringFree(&ds);
- }
-#endif /* TclNORM_LONG_PATH */
- }
-
- /*
- * 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.
- */
-
- Tcl_WinTCharToUtf((const TCHAR *) Tcl_DStringValue(&dsNorm),
- Tcl_DStringLength(&dsNorm), &ds);
- nextCheckpoint = Tcl_DStringLength(&ds);
- if (*lastValidPathEnd != 0) {
- /*
- * Not the end of the string.
- */
-
- int len;
- char *path;
- Tcl_Obj *tmpPathPtr;
-
- tmpPathPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds),
- nextCheckpoint);
- Tcl_AppendToObj(tmpPathPtr, lastValidPathEnd, -1);
- path = Tcl_GetStringFromObj(tmpPathPtr, &len);
- Tcl_SetStringObj(pathPtr, path, len);
- Tcl_DecrRefCount(tmpPathPtr);
- } else {
- /*
- * End of string was reached above.
- */
-
- Tcl_SetStringObj(pathPtr, Tcl_DStringValue(&ds), nextCheckpoint);
- }
- Tcl_DStringFree(&ds);
- }
- Tcl_DStringFree(&dsNorm);
-
- /*
- * This must be done after we are totally finished with 'path' as we are
- * sharing the same underlying string.
- */
-
- 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 TCHAR *) 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)
-{
- WCHAR *nativePathPtr = NULL;
- const char *str;
- Tcl_Obj *validPathPtr;
- size_t len;
- WCHAR *wp;
-
- 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;
- }
- /* refCount of validPathPtr was already incremented in Tcl_FSGetTranslatedPath */
- } else {
- /*
- * Make sure the normalized path is set.
- */
-
- validPathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr);
- if (validPathPtr == NULL) {
- return NULL;
- }
- /* validPathPtr returned from Tcl_FSGetNormalizedPath is owned by Tcl, so incr refCount here */
- Tcl_IncrRefCount(validPathPtr);
- }
-
- str = Tcl_GetString(validPathPtr);
- len = validPathPtr->length;
-
- if (strlen(str)!=(unsigned int)len) {
- /* String contains NUL-bytes. This is invalid. */
- goto done;
- }
- /* For a reserved device, strip a possible postfix ':' */
- len = WinIsReserved(str);
- if (len == 0) {
- /* Let MultiByteToWideChar check for other invalid sequences, like
- * 0xC0 0x80 (== overlong NUL). See bug [3118489]: NUL in filenames */
- len = MultiByteToWideChar(CP_UTF8, MB_ERR_INVALID_CHARS, str, -1, 0, 0);
- if (len==0) {
- goto done;
- }
- }
- /* Overallocate 6 chars, making some room for extended paths */
- wp = nativePathPtr = ckalloc( (len+6) * sizeof(WCHAR) );
- if (nativePathPtr==0) {
- goto done;
- }
- MultiByteToWideChar(CP_UTF8, MB_ERR_INVALID_CHARS, str, -1, nativePathPtr, len+1);
- /*
- ** If path starts with "//?/" or "\\?\" (extended path), translate
- ** any slashes to backslashes but leave the '?' intact
- */
- if ((str[0]=='\\' || str[0]=='/') && (str[1]=='\\' || str[1]=='/')
- && str[2]=='?' && (str[3]=='\\' || str[3]=='/')) {
- wp[0] = wp[1] = wp[3] = '\\';
- str += 4;
- wp += 4;
- }
- /*
- ** If there is no "\\?\" prefix but there is a drive or UNC
- ** path prefix and the path is larger than MAX_PATH chars,
- ** no Win32 API function can handle that unless it is
- ** prefixed with the extended path prefix. See:
- ** <http://msdn.microsoft.com/en-us/library/aa365247(VS.85).aspx#maxpath>
- **/
- if (((str[0]>='A'&&str[0]<='Z') || (str[0]>='a'&&str[0]<='z'))
- && str[1]==':') {
- if (wp==nativePathPtr && len>MAX_PATH && (str[2]=='\\' || str[2]=='/')) {
- memmove(wp+4, wp, len*sizeof(WCHAR));
- memcpy(wp, L"\\\\?\\", 4*sizeof(WCHAR));
- wp += 4;
- }
- /*
- ** If (remainder of) path starts with "<drive>:",
- ** leave the ':' intact.
- */
- wp += 2;
- } else if (wp==nativePathPtr && len>MAX_PATH
- && (str[0]=='\\' || str[0]=='/')
- && (str[1]=='\\' || str[1]=='/') && str[2]!='?') {
- memmove(wp+6, wp, len*sizeof(WCHAR));
- memcpy(wp, L"\\\\?\\UNC", 7*sizeof(WCHAR));
- wp += 7;
- }
- /*
- ** In the remainder of the path, translate invalid characters to
- ** characters in the Unicode private use area.
- */
- while (*wp != '\0') {
- if ((*wp < ' ') || wcschr(L"\"*:<>?|", *wp)) {
- *wp |= 0xF000;
- } else if (*wp == '/') {
- *wp = '\\';
- }
- ++wp;
- }
-
- done:
-
- TclDecrRefCount(validPathPtr);
- return 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;
- }
-
- len = sizeof(TCHAR) * (_tcslen((const TCHAR *) clientData) + 1);
-
- copy = ckalloc(len);
- memcpy(copy, clientData, len);
- return copy;
-}
-
-/*
- *---------------------------------------------------------------------------
- *
- * TclpUtime --
- *
- * Set the modification date for a file.
- *
- * Results:
- * 0 on success, -1 on error.
- *
- * Side effects:
- * Sets errno to a representation of any Windows problem that's observed
- * in the process.
- *
- *---------------------------------------------------------------------------
- */
-
-int
-TclpUtime(
- Tcl_Obj *pathPtr, /* File to modify */
- struct utimbuf *tval) /* New modification date structure */
-{
- int res = 0;
- HANDLE fileHandle;
- const TCHAR *native;
- DWORD attr = 0;
- DWORD flags = FILE_ATTRIBUTE_NORMAL;
- FILETIME lastAccessTime, lastModTime;
-
- FromCTime(tval->actime, &lastAccessTime);
- FromCTime(tval->modtime, &lastModTime);
-
- native = Tcl_FSGetNativePath(pathPtr);
-
- attr = GetFileAttributes(native);
-
- if (attr != INVALID_FILE_ATTRIBUTES && attr & FILE_ATTRIBUTE_DIRECTORY) {
- flags = FILE_FLAG_BACKUP_SEMANTICS;
- }
-
- /*
- * We use the native APIs (not 'utime') because there are some daylight
- * savings complications that utime gets wrong.
- */
-
- fileHandle = CreateFile(native, FILE_WRITE_ATTRIBUTES, 0, NULL,
- OPEN_EXISTING, flags, NULL);
-
- if (fileHandle == INVALID_HANDLE_VALUE ||
- !SetFileTime(fileHandle, NULL, &lastAccessTime, &lastModTime)) {
- TclWinConvertError(GetLastError());
- res = -1;
- }
- if (fileHandle != INVALID_HANDLE_VALUE) {
- CloseHandle(fileHandle);
- }
- return res;
-}
-
-/*
- *---------------------------------------------------------------------------
- *
- * TclWinFileOwned --
- *
- * Returns 1 if the specified file exists and is owned by the current
- * user and 0 otherwise. Like the Unix case, the check is made using
- * the real process SID, not the effective (impersonation) one.
- *
- *---------------------------------------------------------------------------
- */
-
-int
-TclWinFileOwned(
- Tcl_Obj *pathPtr) /* File whose ownership is to be checked */
-{
- const TCHAR *native;
- PSID ownerSid = NULL;
- PSECURITY_DESCRIPTOR secd = NULL;
- HANDLE token;
- LPBYTE buf = NULL;
- DWORD bufsz;
- int owned = 0;
-
- native = Tcl_FSGetNativePath(pathPtr);
-
- if (GetNamedSecurityInfo((LPTSTR) native, SE_FILE_OBJECT,
- OWNER_SECURITY_INFORMATION, &ownerSid,
- NULL, NULL, NULL, &secd) != ERROR_SUCCESS) {
- /* Either not a file, or we do not have access to it in which
- case we are in all likelihood not the owner */
- return 0;
- }
-
- /*
- * Getting the current process SID is a multi-step process.
- * We make the assumption that if a call fails, this process is
- * so underprivileged it could not possibly own anything. Normally
- * a process can *always* look up its own token.
- */
- if (OpenProcessToken(GetCurrentProcess(), TOKEN_QUERY, &token)) {
- /* Find out how big the buffer needs to be */
- bufsz = 0;
- GetTokenInformation(token, TokenUser, NULL, 0, &bufsz);
- if (bufsz) {
- buf = ckalloc(bufsz);
- if (GetTokenInformation(token, TokenUser, buf, bufsz, &bufsz)) {
- owned = EqualSid(ownerSid, ((PTOKEN_USER) buf)->User.Sid);
- }
- }
- CloseHandle(token);
- }
-
- /* Free allocations and be done */
- if (secd)
- LocalFree(secd); /* Also frees ownerSid */
- if (buf)
- ckfree(buf);
-
- return (owned != 0); /* Convert non-0 to 1 */
-}
-
-/*
- * Local Variables:
- * mode: c
- * c-basic-offset: 4
- * fill-column: 78
- * End:
- */
diff --git a/tcl8.6/win/tclWinInit.c b/tcl8.6/win/tclWinInit.c
deleted file mode 100644
index ff5327d..0000000
--- a/tcl8.6/win/tclWinInit.c
+++ /dev/null
@@ -1,748 +0,0 @@
-/*
- * tclWinInit.c --
- *
- * Contains the Windows-specific interpreter initialization functions.
- *
- * 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"
-#include <winnt.h>
-#include <winbase.h>
-#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.
- */
-
-typedef struct {
- WORD wProcessorArchitecture;
- WORD wReserved;
-} OemId;
-
-/*
- * The following macros are missing from some versions of winnt.h.
- */
-
-#ifndef PROCESSOR_ARCHITECTURE_INTEL
-#define PROCESSOR_ARCHITECTURE_INTEL 0
-#endif
-#ifndef PROCESSOR_ARCHITECTURE_MIPS
-#define PROCESSOR_ARCHITECTURE_MIPS 1
-#endif
-#ifndef PROCESSOR_ARCHITECTURE_ALPHA
-#define PROCESSOR_ARCHITECTURE_ALPHA 2
-#endif
-#ifndef PROCESSOR_ARCHITECTURE_PPC
-#define PROCESSOR_ARCHITECTURE_PPC 3
-#endif
-#ifndef PROCESSOR_ARCHITECTURE_SHX
-#define PROCESSOR_ARCHITECTURE_SHX 4
-#endif
-#ifndef PROCESSOR_ARCHITECTURE_ARM
-#define PROCESSOR_ARCHITECTURE_ARM 5
-#endif
-#ifndef PROCESSOR_ARCHITECTURE_IA64
-#define PROCESSOR_ARCHITECTURE_IA64 6
-#endif
-#ifndef PROCESSOR_ARCHITECTURE_ALPHA64
-#define PROCESSOR_ARCHITECTURE_ALPHA64 7
-#endif
-#ifndef PROCESSOR_ARCHITECTURE_MSIL
-#define PROCESSOR_ARCHITECTURE_MSIL 8
-#endif
-#ifndef PROCESSOR_ARCHITECTURE_AMD64
-#define PROCESSOR_ARCHITECTURE_AMD64 9
-#endif
-#ifndef PROCESSOR_ARCHITECTURE_IA32_ON_WIN64
-#define PROCESSOR_ARCHITECTURE_IA32_ON_WIN64 10
-#endif
-#ifndef PROCESSOR_ARCHITECTURE_UNKNOWN
-#define PROCESSOR_ARCHITECTURE_UNKNOWN 0xFFFF
-#endif
-
-
-/*
- * Windows version dependend functions
- */
-TclWinProcs tclWinProcs;
-
-/*
- * The following arrays contain the human readable strings for the Windows
- * platform and processor values.
- */
-
-
-#define NUMPLATFORMS 4
-static const char *const platforms[NUMPLATFORMS] = {
- "Win32s", "Windows 95", "Windows NT", "Windows CE"
-};
-
-#define NUMPROCESSORS 11
-static const char *const processors[NUMPROCESSORS] = {
- "intel", "mips", "alpha", "ppc", "shx", "arm", "ia64", "alpha64", "msil",
- "amd64", "ia32_on_win64"
-};
-
-/*
- * The default directory in which the init.tcl file is expected to be found.
- */
-
-static TclInitProcessGlobalValueProc InitializeDefaultLibraryDir;
-static ProcessGlobalValue defaultLibraryDir =
- {0, 0, NULL, NULL, InitializeDefaultLibraryDir, NULL, NULL};
-
-static TclInitProcessGlobalValueProc InitializeSourceLibraryDir;
-static ProcessGlobalValue sourceLibraryDir =
- {0, 0, NULL, NULL, InitializeSourceLibraryDir, NULL, NULL};
-
-static void AppendEnvironment(Tcl_Obj *listPtr, const char *lib);
-
-#if TCL_UTF_MAX < 4
-static void ToUtf(const WCHAR *wSrc, char *dst);
-#else
-#define ToUtf(wSrc, dst) WideCharToMultiByte(CP_UTF8, 0, wSrc, -1, dst, MAX_PATH * TCL_UTF_MAX, NULL, NULL)
-#endif
-
-/*
- *---------------------------------------------------------------------------
- *
- * TclpInitPlatform --
- *
- * Initialize all the platform-dependant things like signals,
- * floating-point error handling and sockets.
- *
- * Called at process initialization time.
- *
- * Results:
- * None.
- *
- * Side effects:
- * None.
- *
- *---------------------------------------------------------------------------
- */
-
-void
-TclpInitPlatform(void)
-{
- WSADATA wsaData;
- WORD wVersionRequested = MAKEWORD(2, 2);
- HMODULE handle;
-
- tclPlatform = TCL_PLATFORM_WINDOWS;
-
- /*
- * Initialize the winsock library. On Windows XP and higher this
- * can never fail.
- */
- WSAStartup(wVersionRequested, &wsaData);
-
-#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.
- */
-
- TclWinInit(GetModuleHandle(NULL));
-#endif
-
- /*
- * Fill available functions depending on windows version
- */
- handle = GetModuleHandle(TEXT("KERNEL32"));
- tclWinProcs.cancelSynchronousIo =
- (BOOL (WINAPI *)(HANDLE)) GetProcAddress(handle,
- "CancelSynchronousIo");
-}
-
-/*
- *-------------------------------------------------------------------------
- *
- * TclpInitLibraryPath --
- *
- * 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:
- * None.
- *
- * Side effects:
- * Sets the library path to an initial value.
- *
- *-------------------------------------------------------------------------
- */
-
-void
-TclpInitLibraryPath(
- char **valuePtr,
- int *lengthPtr,
- Tcl_Encoding *encodingPtr)
-{
-#define LIBRARY_SIZE 64
- Tcl_Obj *pathPtr;
- char installLib[LIBRARY_SIZE];
- const char *bytes;
-
- pathPtr = Tcl_NewObj();
-
- /*
- * 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);
-
- /*
- * 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 in its default location.
- */
-
- Tcl_ListObjAppendElement(NULL, pathPtr,
- TclGetProcessGlobalValue(&defaultLibraryDir));
-
- /*
- * Look for the library in its source checkout location.
- */
-
- Tcl_ListObjAppendElement(NULL, pathPtr,
- TclGetProcessGlobalValue(&sourceLibraryDir));
-
- *encodingPtr = NULL;
- bytes = Tcl_GetStringFromObj(pathPtr, lengthPtr);
- *valuePtr = ckalloc((*lengthPtr) + 1);
- memcpy(*valuePtr, bytes, (size_t)(*lengthPtr)+1);
- Tcl_DecrRefCount(pathPtr);
-}
-
-/*
- *---------------------------------------------------------------------------
- *
- * 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.,
- * "tcl7.6/../tcl8.2")
- *
- * Results:
- * None.
- *
- * Side effects:
- * None.
- *
- *---------------------------------------------------------------------------
- */
-
-static void
-AppendEnvironment(
- Tcl_Obj *pathPtr,
- const char *lib)
-{
- int pathc;
- WCHAR wBuf[MAX_PATH];
- char buf[MAX_PATH * TCL_UTF_MAX];
- Tcl_Obj *objPtr;
- Tcl_DString ds;
- const char **pathv;
- 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".
- */
-
- 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");
- }
-
- /*
- * 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';
- GetEnvironmentVariableA("TCL_LIBRARY", buf, MAX_PATH);
- } else {
- ToUtf(wBuf, buf);
- }
-
- if (buf[0] != '\0') {
- objPtr = Tcl_NewStringObj(buf, -1);
- Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
-
- 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.
- */
-
- if ((pathc > 0) && (lstrcmpiA(shortlib, pathv[pathc - 1]) != 0)) {
- /*
- * 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);
- (void) Tcl_JoinPath(pathc, pathv, &ds);
- objPtr = TclDStringToObj(&ds);
- } else {
- objPtr = Tcl_NewStringObj(buf, -1);
- }
- Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
- ckfree(pathv);
- }
-}
-
-/*
- *---------------------------------------------------------------------------
- *
- * InitializeDefaultLibraryDir --
- *
- * Locate the Tcl script library default location relative to the
- * location of the Tcl DLL.
- *
- * Results:
- * None.
- *
- * Side effects:
- * None.
- *
- *---------------------------------------------------------------------------
- */
-
-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);
- }
-
- end = strrchr(name, '\\');
- *end = '\0';
- p = strrchr(name, '\\');
- if (p != NULL) {
- end = p;
- }
- *end = '\\';
-
- TclWinNoBackslash(name);
- sprintf(end + 1, "lib/tcl%s", TCL_VERSION);
- *lengthPtr = strlen(name);
- *valuePtr = ckalloc(*lengthPtr + 1);
- *encodingPtr = NULL;
- memcpy(*valuePtr, name, (size_t) *lengthPtr + 1);
-}
-
-/*
- *---------------------------------------------------------------------------
- *
- * InitializeSourceLibraryDir --
- *
- * Locate the Tcl script library default location relative to the
- * location of the Tcl DLL as it exists in the build output directory
- * associated with the source checkout.
- *
- * Results:
- * None.
- *
- * Side effects:
- * None.
- *
- *---------------------------------------------------------------------------
- */
-
-static void
-InitializeSourceLibraryDir(
- 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);
- }
-
- end = strrchr(name, '\\');
- *end = '\0';
- p = strrchr(name, '\\');
- if (p != NULL) {
- end = p;
- }
- *end = '\\';
-
- TclWinNoBackslash(name);
- sprintf(end + 1, "../library");
- *lengthPtr = strlen(name);
- *valuePtr = ckalloc(*lengthPtr + 1);
- *encodingPtr = NULL;
- memcpy(*valuePtr, name, (size_t) *lengthPtr + 1);
-}
-
-/*
- *---------------------------------------------------------------------------
- *
- * ToUtf --
- *
- * Convert a wchar string to a UTF string.
- *
- * Results:
- * None.
- *
- * Side effects:
- * None.
- *
- *---------------------------------------------------------------------------
- */
-
-#if TCL_UTF_MAX < 4
-static void
-ToUtf(
- const WCHAR *wSrc,
- char *dst)
-{
- while (*wSrc != '\0') {
- dst += Tcl_UniCharToUtf(*wSrc, dst);
- wSrc++;
- }
- *dst = '\0';
-}
-#endif
-
-/*
- *---------------------------------------------------------------------------
- *
- * TclpSetInitialEncodings --
- *
- * 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).
- *
- * 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.
- *
- *---------------------------------------------------------------------------
- */
-
-void
-TclpSetInitialEncodings(void)
-{
- Tcl_DString encodingName;
-
- TclpSetInterfaces();
- Tcl_SetSystemEncoding(NULL,
- Tcl_GetEncodingNameFromEnvironment(&encodingName));
- Tcl_DStringFree(&encodingName);
-}
-
-void TclWinSetInterfaces(
- int dummy) /* Not used. */
-{
- TclpSetInterfaces();
-}
-
-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);
-}
-
-const char *
-TclpGetUserName(
- Tcl_DString *bufferPtr) /* Uninitialized or free DString filled with
- * the name of user. */
-{
- Tcl_DStringInit(bufferPtr);
-
- if (TclGetEnv("USERNAME", bufferPtr) == NULL) {
- TCHAR szUserName[UNLEN+1];
- DWORD cchUserNameLen = UNLEN;
-
- if (!GetUserName(szUserName, &cchUserNameLen)) {
- return NULL;
- }
- cchUserNameLen--;
- cchUserNameLen *= sizeof(TCHAR);
- Tcl_WinTCharToUtf(szUserName, cchUserNameLen, bufferPtr);
- }
- return Tcl_DStringValue(bufferPtr);
-}
-
-/*
- *---------------------------------------------------------------------------
- *
- * TclpSetVariables --
- *
- * Performs platform-specific interpreter initialization related to the
- * tcl_platform and env variables, and other platform-specific things.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Sets "tcl_platform", and "env(HOME)" Tcl variables.
- *
- *----------------------------------------------------------------------
- */
-
-void
-TclpSetVariables(
- Tcl_Interp *interp) /* Interp to initialize. */
-{
- const char *ptr;
- char buffer[TCL_INTEGER_SPACE * 2];
- union {
- SYSTEM_INFO info;
- OemId oemId;
- } sys;
- static OSVERSIONINFOW osInfo;
- static int osInfoInitialized = 0;
- Tcl_DString ds;
-
- Tcl_SetVar2Ex(interp, "tclDefaultLibrary", NULL,
- TclGetProcessGlobalValue(&defaultLibraryDir), TCL_GLOBAL_ONLY);
-
- if (!osInfoInitialized) {
- HMODULE handle = GetModuleHandle(TEXT("NTDLL"));
- int(__stdcall *getversion)(void *) =
- (int(__stdcall *)(void *)) GetProcAddress(handle, "RtlGetVersion");
- osInfo.dwOSVersionInfoSize = sizeof(OSVERSIONINFOW);
- if (!getversion || getversion(&osInfo)) {
- GetVersionExW(&osInfo);
- }
- osInfoInitialized = 1;
- }
- GetSystemInfo(&sys.info);
-
- /*
- * Define the tcl_platform array.
- */
-
- Tcl_SetVar2(interp, "tcl_platform", "platform", "windows",
- TCL_GLOBAL_ONLY);
- if (osInfo.dwPlatformId < NUMPLATFORMS) {
- Tcl_SetVar2(interp, "tcl_platform", "os",
- platforms[osInfo.dwPlatformId], TCL_GLOBAL_ONLY);
- }
- wsprintfA(buffer, "%d.%d", osInfo.dwMajorVersion, osInfo.dwMinorVersion);
- Tcl_SetVar2(interp, "tcl_platform", "osVersion", buffer, TCL_GLOBAL_ONLY);
- if (sys.oemId.wProcessorArchitecture < NUMPROCESSORS) {
- Tcl_SetVar2(interp, "tcl_platform", "machine",
- processors[sys.oemId.wProcessorArchitecture],
- TCL_GLOBAL_ONLY);
- }
-
-#ifdef _DEBUG
- /*
- * The existence of the "debug" element of the tcl_platform array
- * indicates that this particular Tcl shell has been compiled with debug
- * information. Using "info exists tcl_platform(debug)" a Tcl script can
- * direct the interpreter to load debug versions of DLLs with the load
- * command.
- */
-
- Tcl_SetVar2(interp, "tcl_platform", "debug", "1",
- TCL_GLOBAL_ONLY);
-#endif
-
- /*
- * Set up the HOME environment variable from the HOMEDRIVE & HOMEPATH
- * environment variables, if necessary.
- */
-
- Tcl_DStringInit(&ds);
- ptr = Tcl_GetVar2(interp, "env", "HOME", TCL_GLOBAL_ONLY);
- if (ptr == NULL) {
- ptr = Tcl_GetVar2(interp, "env", "HOMEDRIVE", TCL_GLOBAL_ONLY);
- if (ptr != NULL) {
- Tcl_DStringAppend(&ds, ptr, -1);
- }
- ptr = Tcl_GetVar2(interp, "env", "HOMEPATH", TCL_GLOBAL_ONLY);
- if (ptr != NULL) {
- Tcl_DStringAppend(&ds, ptr, -1);
- }
- if (Tcl_DStringLength(&ds) > 0) {
- Tcl_SetVar2(interp, "env", "HOME", Tcl_DStringValue(&ds),
- TCL_GLOBAL_ONLY);
- } else {
- Tcl_SetVar2(interp, "env", "HOME", "c:\\", TCL_GLOBAL_ONLY);
- }
- }
-
- /*
- * 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.
- */
-
- ptr = TclpGetUserName(&ds);
- Tcl_SetVar2(interp, "tcl_platform", "user", ptr ? ptr : "",
- TCL_GLOBAL_ONLY);
- Tcl_DStringFree(&ds);
-
- /*
- * Define what the platform PATH separator is. [TIP #315]
- */
-
- Tcl_SetVar2(interp, "tcl_platform","pathSeparator", ";", TCL_GLOBAL_ONLY);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclpFindVariable --
- *
- * Locate the entry in environ for a given name. On Unix this routine is
- * case sensitive, on Windows this matches mixed 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).
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclpFindVariable(
- const char *name, /* Name of desired environment variable
- * (UTF-8). */
- int *lengthPtr) /* Used to return length of name (for
- * successful searches) or number of non-NULL
- * entries in environ (for unsuccessful
- * searches). */
-{
- int i, length, result = -1;
- register const char *env, *p1, *p2;
- char *envUpper, *nameUpper;
- Tcl_DString envString;
-
- /*
- * Convert the name to all upper case for the case insensitive comparison.
- */
-
- length = strlen(name);
- nameUpper = ckalloc(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.
- */
-
- envUpper = Tcl_ExternalToUtfDString(NULL, env, -1, &envString);
- p1 = strchr(envUpper, '=');
- if (p1 == NULL) {
- continue;
- }
- length = (int) (p1 - envUpper);
- Tcl_DStringSetLength(&envString, length+1);
- Tcl_UtfToUpper(envUpper);
-
- p1 = envUpper;
- p2 = nameUpper;
- for (; *p2 == *p1; p1++, p2++) {
- /* NULL loop body. */
- }
- if ((*p1 == '=') && (*p2 == '\0')) {
- *lengthPtr = length;
- result = i;
- goto done;
- }
-
- Tcl_DStringFree(&envString);
- }
-
- *lengthPtr = i;
-
- done:
- Tcl_DStringFree(&envString);
- ckfree(nameUpper);
- return result;
-}
-
-/*
- * Local Variables:
- * mode: c
- * c-basic-offset: 4
- * fill-column: 78
- * End:
- */
diff --git a/tcl8.6/win/tclWinInt.h b/tcl8.6/win/tclWinInt.h
deleted file mode 100644
index d0844da..0000000
--- a/tcl8.6/win/tclWinInt.h
+++ /dev/null
@@ -1,166 +0,0 @@
-/*
- * tclWinInt.h --
- *
- * Declarations of Windows-specific shared variables and procedures.
- *
- * Copyright (c) 1994-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.
- */
-
-#ifndef _TCLWININT
-#define _TCLWININT
-
-#include "tclInt.h"
-
-#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 TCLEXCEPTION_REGISTRATION within the activation record.
- */
-
-typedef struct TCLEXCEPTION_REGISTRATION {
- struct TCLEXCEPTION_REGISTRATION *link;
- EXCEPTION_DISPOSITION (*handler)(
- struct _EXCEPTION_RECORD*, void*, struct _CONTEXT*, void*);
- void *ebp;
- void *esp;
- int status;
-} TCLEXCEPTION_REGISTRATION;
-#endif
-
-/*
- * Windows version dependend functions
- */
-typedef struct TclWinProcs {
- BOOL (WINAPI *cancelSynchronousIo)(HANDLE);
-} TclWinProcs;
-
-MODULE_SCOPE TclWinProcs tclWinProcs;
-
-/*
- * Some versions of Borland C have a define for the OSVERSIONINFO for
- * Win32s and for NT, but not for Windows 95.
- * Define VER_PLATFORM_WIN32_CE for those without newer headers.
- */
-
-#ifndef VER_PLATFORM_WIN32_WINDOWS
-#define VER_PLATFORM_WIN32_WINDOWS 1
-#endif
-#ifndef VER_PLATFORM_WIN32_CE
-#define VER_PLATFORM_WIN32_CE 3
-#endif
-
-#ifdef _WIN64
-# define TCL_I_MODIFIER "I"
-#else
-# define TCL_I_MODIFIER ""
-#endif
-
-/*
- * Declarations of functions that are not accessible by way of the
- * stubs table.
- */
-
-MODULE_SCOPE char TclWinDriveLetterForVolMountPoint(
- const TCHAR *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 HANDLE TclWinSerialOpen(HANDLE handle, const TCHAR *name,
- DWORD access);
-MODULE_SCOPE int TclWinSymLinkCopyDirectory(const TCHAR *LinkOriginal,
- const TCHAR *LinkCopy);
-MODULE_SCOPE int TclWinSymLinkDelete(const TCHAR *LinkOriginal,
- int linkOnly);
-MODULE_SCOPE int TclWinFileOwned(Tcl_Obj *);
-#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
-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 */
-
-MODULE_SCOPE const char*TclpGetUserName(Tcl_DString *bufferPtr);
-
-/* Needed by tclWinFile.c and tclWinFCmd.c */
-#ifndef FILE_ATTRIBUTE_REPARSE_POINT
-#define FILE_ATTRIBUTE_REPARSE_POINT 0x00000400
-#endif
-
-/*
- *----------------------------------------------------------------------
- * Declarations of helper-workers threaded facilities for a pipe based channel.
- *
- * Corresponding functionality provided in "tclWinPipe.c".
- *----------------------------------------------------------------------
- */
-
-typedef struct TclPipeThreadInfo {
- HANDLE evControl; /* Auto-reset event used by the main thread to
- * signal when the pipe thread should attempt
- * to do read/write operation. Additionally
- * used as signal to stop (state set to -1) */
- volatile LONG state; /* Indicates current state of the thread */
- ClientData clientData; /* Referenced data of the main thread */
- HANDLE evWakeUp; /* Optional wake-up event worker set by shutdown */
-} TclPipeThreadInfo;
-
-
-/* If pipe-workers will use some tcl subsystem, we can use ckalloc without
- * more overhead for finalize thread (should be executed anyway)
- *
- * #define _PTI_USE_CKALLOC 1
- */
-
-/*
- * State of the pipe-worker.
- *
- * State PTI_STATE_STOP possible from idle state only, worker owns TI structure.
- * Otherwise PTI_STATE_END used (main thread hold ownership of the TI).
- */
-
-#define PTI_STATE_IDLE 0 /* idle or not yet initialzed */
-#define PTI_STATE_WORK 1 /* in work */
-#define PTI_STATE_STOP 2 /* thread should stop work (owns TI structure) */
-#define PTI_STATE_END 4 /* thread should stop work (worker is busy) */
-#define PTI_STATE_DOWN 8 /* worker is down */
-
-
-MODULE_SCOPE
-TclPipeThreadInfo * TclPipeThreadCreateTI(TclPipeThreadInfo **pipeTIPtr,
- ClientData clientData, HANDLE wakeEvent);
-MODULE_SCOPE int TclPipeThreadWaitForSignal(TclPipeThreadInfo **pipeTIPtr);
-
-static inline void
-TclPipeThreadSignal(
- TclPipeThreadInfo **pipeTIPtr)
-{
- TclPipeThreadInfo *pipeTI = *pipeTIPtr;
- if (pipeTI) {
- SetEvent(pipeTI->evControl);
- }
-};
-
-static inline int
-TclPipeThreadIsAlive(
- TclPipeThreadInfo **pipeTIPtr)
-{
- TclPipeThreadInfo *pipeTI = *pipeTIPtr;
- return (pipeTI && pipeTI->state != PTI_STATE_DOWN);
-};
-
-MODULE_SCOPE int TclPipeThreadStopSignal(TclPipeThreadInfo **pipeTIPtr, HANDLE wakeEvent);
-MODULE_SCOPE void TclPipeThreadStop(TclPipeThreadInfo **pipeTIPtr, HANDLE hThread);
-MODULE_SCOPE void TclPipeThreadExit(TclPipeThreadInfo **pipeTIPtr);
-
-#endif /* _TCLWININT */
diff --git a/tcl8.6/win/tclWinLoad.c b/tcl8.6/win/tclWinLoad.c
deleted file mode 100644
index 2946ea2..0000000
--- a/tcl8.6/win/tclWinLoad.c
+++ /dev/null
@@ -1,430 +0,0 @@
-/*
- * tclWinLoad.c --
- *
- * 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.
- */
-
-#include "tclWinInt.h"
-
-/*
- * Native name of the directory in the native filesystem where DLLs used in
- * this process are copied prior to loading, and mutex used to protect its
- * allocation.
- */
-
-static WCHAR *dllDirectoryName = NULL;
-static Tcl_Mutex dllDirectoryNameMutex;
-
-/*
- * Static functions defined within this file.
- */
-
-static void * FindSymbol(Tcl_Interp *interp,
- Tcl_LoadHandle loadHandle, const char *symbol);
-static int InitDLLDirectoryName(void);
-static void UnloadFile(Tcl_LoadHandle loadHandle);
-
-/*
- *----------------------------------------------------------------------
- *
- * TclpDlopen --
- *
- * 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.
- *
- * Side effects:
- * New code suddenly appears in memory.
- *
- *----------------------------------------------------------------------
- */
-
-int
-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
- * (*unloadProcPtr)() to unload the file. */
- Tcl_FSUnloadFileProc **unloadProcPtr,
- /* Filled with address of Tcl_FSUnloadFileProc
- * function which should be used for this
- * file. */
- int flags)
-{
- HINSTANCE hInstance = NULL;
- const TCHAR *nativeName;
- Tcl_LoadHandle handlePtr;
- DWORD firstError;
-
- /*
- * 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);
- if (nativeName != NULL) {
- hInstance = LoadLibraryEx(nativeName, NULL,
- LOAD_WITH_ALTERED_SEARCH_PATH);
- }
- if (hInstance == NULL) {
- /*
- * Let the OS loader examine the binary search path for whatever
- * string the user gave us which hopefully refers to a file on the
- * binary path.
- */
-
- Tcl_DString ds;
-
- /*
- * Remember the first error on load attempt to be used if the
- * second load attempt below also fails.
- */
- firstError = (nativeName == NULL) ?
- ERROR_MOD_NOT_FOUND : GetLastError();
-
- nativeName = Tcl_WinUtfToTChar(Tcl_GetString(pathPtr), -1, &ds);
- hInstance = LoadLibraryEx(nativeName, NULL,
- LOAD_WITH_ALTERED_SEARCH_PATH);
- Tcl_DStringFree(&ds);
- }
-
- if (hInstance == NULL) {
- DWORD lastError;
- Tcl_Obj *errMsg;
-
- /*
- * We choose to only use the error from the second call if the first
- * call failed due to the file not being found. Else stick to the
- * first error for reporting purposes.
- */
- if (firstError == ERROR_MOD_NOT_FOUND ||
- firstError == ERROR_DLL_NOT_FOUND)
- lastError = GetLastError();
- else
- lastError = firstError;
-
- errMsg = Tcl_ObjPrintf("couldn't load library \"%s\": ",
- Tcl_GetString(pathPtr));
-
- /*
- * 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
- */
-
- if (interp) {
- switch (lastError) {
- case ERROR_MOD_NOT_FOUND:
- Tcl_SetErrorCode(interp, "WIN_LOAD", "MOD_NOT_FOUND", NULL);
- goto notFoundMsg;
- case ERROR_DLL_NOT_FOUND:
- Tcl_SetErrorCode(interp, "WIN_LOAD", "DLL_NOT_FOUND", NULL);
- notFoundMsg:
- Tcl_AppendToObj(errMsg, "this library or a dependent library"
- " could not be found in library path", -1);
- break;
- case ERROR_PROC_NOT_FOUND:
- Tcl_SetErrorCode(interp, "WIN_LOAD", "PROC_NOT_FOUND", NULL);
- Tcl_AppendToObj(errMsg, "A function specified in the import"
- " table could not be resolved by the system. Windows"
- " is not telling which one, I'm sorry.", -1);
- break;
- case ERROR_INVALID_DLL:
- Tcl_SetErrorCode(interp, "WIN_LOAD", "INVALID_DLL", NULL);
- Tcl_AppendToObj(errMsg, "this library or a dependent library"
- " is damaged", -1);
- break;
- case ERROR_DLL_INIT_FAILED:
- Tcl_SetErrorCode(interp, "WIN_LOAD", "DLL_INIT_FAILED", NULL);
- Tcl_AppendToObj(errMsg, "the library initialization"
- " routine failed", -1);
- break;
- case ERROR_BAD_EXE_FORMAT:
- Tcl_SetErrorCode(interp, "WIN_LOAD", "BAD_EXE_FORMAT", NULL);
- Tcl_AppendToObj(errMsg, "Bad exe format. Possibly a 32/64-bit mismatch.", -1);
- break;
- default:
- TclWinConvertError(lastError);
- Tcl_AppendToObj(errMsg, Tcl_PosixError(interp), -1);
- }
- Tcl_SetObjResult(interp, errMsg);
- }
- return TCL_ERROR;
- }
-
- /*
- * Succeded; package everything up for Tcl.
- */
-
- handlePtr = ckalloc(sizeof(struct Tcl_LoadHandle_));
- handlePtr->clientData = (ClientData) hInstance;
- handlePtr->findSymbolProcPtr = &FindSymbol;
- handlePtr->unloadFileProcPtr = &UnloadFile;
- *loadHandle = handlePtr;
- *unloadProcPtr = &UnloadFile;
- return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * FindSymbol --
- *
- * 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.
- *
- *----------------------------------------------------------------------
- */
-
-static void *
-FindSymbol(
- Tcl_Interp *interp,
- Tcl_LoadHandle loadHandle,
- const char *symbol)
-{
- HINSTANCE hInstance = (HINSTANCE) loadHandle->clientData;
- Tcl_PackageInitProc *proc = NULL;
-
- /*
- * For each symbol, check for both Symbol and _Symbol, since Borland
- * generates C symbols with a leading '_' by default.
- */
-
- proc = (void *) GetProcAddress(hInstance, symbol);
- if (proc == NULL) {
- Tcl_DString ds;
- const char *sym2;
-
- Tcl_DStringInit(&ds);
- TclDStringAppendLiteral(&ds, "_");
- sym2 = Tcl_DStringAppend(&ds, symbol, -1);
- proc = (Tcl_PackageInitProc *) GetProcAddress(hInstance, sym2);
- Tcl_DStringFree(&ds);
- }
- if (proc == NULL && interp != NULL) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "cannot find symbol \"%s\"", symbol));
- Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LOAD_SYMBOL", symbol, NULL);
- }
- return proc;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * UnloadFile --
- *
- * 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.
- *
- * Side effects:
- * Code removed from memory.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-UnloadFile(
- Tcl_LoadHandle loadHandle) /* loadHandle returned by a previous call to
- * TclpDlopen(). The loadHandle is a token
- * that represents the loaded file. */
-{
- HINSTANCE hInstance = (HINSTANCE) loadHandle->clientData;
-
- FreeLibrary(hInstance);
- ckfree(loadHandle);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclGuessPackageName --
- *
- * 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.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-int
-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. */
-{
- return 0;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclpTempFileNameForLibrary --
- *
- * Constructs a temporary file name for loading a shared object (DLL).
- *
- * Results:
- * Returns the constructed file name.
- *
- * On Windows, a DLL is identified by the final component of its path name.
- * Cross linking among DLL's (and hence, preloading) will not work unless this
- * name is preserved when copying a DLL from a VFS to a temp file for
- * preloading. For this reason, all DLLs in a given process are copied to a
- * temp directory, and their names are preserved.
- *
- *----------------------------------------------------------------------
- */
-
-Tcl_Obj *
-TclpTempFileNameForLibrary(
- Tcl_Interp *interp, /* Tcl interpreter. */
- Tcl_Obj *path) /* Path name of the DLL in the VFS. */
-{
- Tcl_Obj *fileName; /* Name of the temp file. */
- Tcl_Obj *tail; /* Tail of the source path. */
-
- Tcl_MutexLock(&dllDirectoryNameMutex);
- if (dllDirectoryName == NULL) {
- if (InitDLLDirectoryName() == TCL_ERROR) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "couldn't create temporary directory: %s",
- Tcl_PosixError(interp)));
- Tcl_MutexUnlock(&dllDirectoryNameMutex);
- return NULL;
- }
- }
- Tcl_MutexUnlock(&dllDirectoryNameMutex);
-
- /*
- * Now we know where to put temporary DLLs, construct the name.
- */
-
- fileName = TclpNativeToNormalized(dllDirectoryName);
- tail = TclPathPart(interp, path, TCL_PATH_TAIL);
- if (tail == NULL) {
- Tcl_DecrRefCount(fileName);
- return NULL;
- }
- Tcl_AppendToObj(fileName, "/", 1);
- Tcl_AppendObjToObj(fileName, tail);
- return fileName;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * InitDLLDirectoryName --
- *
- * Helper for TclpTempFileNameForLibrary; builds a temporary directory
- * that is specific to the current process. Should only be called once
- * per process start. Caller must hold dllDirectoryNameMutex.
- *
- * Results:
- * Tcl result code.
- *
- * Side-effects:
- * Creates temp directory.
- * Allocates memory pointed to by dllDirectoryName.
- *
- *----------------------------------------------------------------------
- * [Candidate for process global?]
- */
-
-static int
-InitDLLDirectoryName(void)
-{
- size_t nameLen; /* Length of the temp folder name. */
- WCHAR name[MAX_PATH]; /* Path name of the temp folder. */
- DWORD id; /* The process id. */
- DWORD lastError; /* Last error to happen in Win API. */
- int i;
-
- /*
- * Determine the name of the directory to use, and create it. (Keep
- * trying with new names until an attempt to create the directory
- * succeeds)
- */
-
- nameLen = GetTempPathW(MAX_PATH, name);
- if (nameLen >= MAX_PATH-12) {
- Tcl_SetErrno(ENAMETOOLONG);
- return TCL_ERROR;
- }
-
- wcscpy(name+nameLen, L"TCLXXXXXXXX");
- nameLen += 11;
-
- id = GetCurrentProcessId();
- lastError = ERROR_ALREADY_EXISTS;
-
- for (i=0 ; i<256 ; i++) {
- wsprintfW(name+nameLen-8, L"%08x", id);
- if (CreateDirectoryW(name, NULL)) {
- /*
- * Issue: we don't schedule this directory for deletion by anyone.
- * Can we ask the OS to do this for us? There appears to be
- * potential for using CreateFile (with the flag
- * FILE_FLAG_BACKUP_SEMANTICS) and RemoveDirectory to do this...
- */
-
- goto copyToGlobalBuffer;
- }
- lastError = GetLastError();
- if (lastError != ERROR_ALREADY_EXISTS) {
- break;
- }
- id *= 16777619;
- }
-
- TclWinConvertError(lastError);
- return TCL_ERROR;
-
- /*
- * Store our computed value in the global.
- */
-
- copyToGlobalBuffer:
- dllDirectoryName = ckalloc((nameLen+1) * sizeof(WCHAR));
- wcscpy(dllDirectoryName, name);
- return TCL_OK;
-}
-
-/*
- * Local Variables:
- * mode: c
- * c-basic-offset: 4
- * fill-column: 78
- * End:
- */
diff --git a/tcl8.6/win/tclWinNotify.c b/tcl8.6/win/tclWinNotify.c
deleted file mode 100644
index 4543b02..0000000
--- a/tcl8.6/win/tclWinNotify.c
+++ /dev/null
@@ -1,608 +0,0 @@
-/*
- * 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.
- *
- * 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.
- */
-
-#include "tclInt.h"
-
-/*
- * The follwing static indicates whether this module has been initialized.
- */
-
-#define INTERVAL_TIMER 1 /* Handle of interval timer. */
-
-#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.
- */
-
-typedef struct ThreadSpecificData {
- CRITICAL_SECTION crit; /* Monitor for this notifier. */
- DWORD thread; /* Identifier for thread associated with this
- * notifier. */
- HANDLE event; /* Event object used to wake up the notifier
- * thread. */
- 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. */
-} ThreadSpecificData;
-
-static Tcl_ThreadDataKey dataKey;
-
-/*
- * 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.
- */
-
-static int notifierCount = 0;
-static const TCHAR classname[] = TEXT("TclNotifier");
-TCL_DECLARE_MUTEX(notifierMutex)
-
-/*
- * Static routines defined in this file.
- */
-
-static LRESULT CALLBACK NotifierProc(HWND hwnd, UINT message,
- WPARAM wParam, LPARAM lParam);
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_InitNotifier --
- *
- * Initializes the platform specific notifier state.
- *
- * Results:
- * Returns a handle to the notifier state for this thread..
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-ClientData
-Tcl_InitNotifier(void)
-{
- if (tclNotifierHooks.initNotifierProc) {
- return tclNotifierHooks.initNotifierProc();
- } else {
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- WNDCLASS class;
-
- /*
- * Register Notifier window class if this is the first thread to use
- * this module.
- */
-
- Tcl_MutexLock(&notifierMutex);
- if (notifierCount == 0) {
- class.style = 0;
- class.cbClsExtra = 0;
- class.cbWndExtra = 0;
- class.hInstance = TclWinGetTclInstance();
- class.hbrBackground = NULL;
- class.lpszMenuName = NULL;
- class.lpszClassName = classname;
- class.lpfnWndProc = NotifierProc;
- class.hIcon = NULL;
- class.hCursor = NULL;
-
- if (!RegisterClass(&class)) {
- Tcl_Panic("Unable to register TclNotifier window class");
- }
- }
- notifierCount++;
- Tcl_MutexUnlock(&notifierMutex);
-
- tsdPtr->pending = 0;
- tsdPtr->timerActive = 0;
-
- InitializeCriticalSection(&tsdPtr->crit);
-
- tsdPtr->hwnd = NULL;
- tsdPtr->thread = GetCurrentThreadId();
- tsdPtr->event = CreateEvent(NULL, TRUE /* manual */,
- FALSE /* !signaled */, NULL);
-
- return tsdPtr;
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_FinalizeNotifier --
- *
- * This function is called to cleanup the notifier state before a thread
- * is terminated.
- *
- * Results:
- * None.
- *
- * Side effects:
- * May dispose of the notifier window and class.
- *
- *----------------------------------------------------------------------
- */
-
-void
-Tcl_FinalizeNotifier(
- ClientData clientData) /* Pointer to notifier data. */
-{
- if (tclNotifierHooks.finalizeNotifierProc) {
- tclNotifierHooks.finalizeNotifierProc(clientData);
- return;
- } else {
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData;
-
- /*
- * Only finalize the notifier if a notifier was installed in the
- * current thread; there is a route in which this is not guaranteed to
- * be true (when tclWin32Dll.c:DllMain() is called with the flag
- * DLL_PROCESS_DETACH by the OS, which could be doing so from a thread
- * that's never previously been involved with Tcl, e.g. the task
- * manager) so this check is important.
- *
- * Fixes Bug #217982 reported by Hugh Vu and Gene Leache.
- */
-
- if (tsdPtr == NULL) {
- return;
- }
-
- DeleteCriticalSection(&tsdPtr->crit);
- CloseHandle(tsdPtr->event);
-
- /*
- * Clean up the timer and messaging window for this thread.
- */
-
- if (tsdPtr->hwnd) {
- KillTimer(tsdPtr->hwnd, INTERVAL_TIMER);
- DestroyWindow(tsdPtr->hwnd);
- }
-
- /*
- * If this is the last thread to use the notifier, unregister the
- * notifier window class.
- */
-
- Tcl_MutexLock(&notifierMutex);
- notifierCount--;
- if (notifierCount == 0) {
- UnregisterClass(classname, TclWinGetTclInstance());
- }
- Tcl_MutexUnlock(&notifierMutex);
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * 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.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Sends a message to the messaging window for the notifier if there
- * isn't already one pending.
- *
- *----------------------------------------------------------------------
- */
-
-void
-Tcl_AlertNotifier(
- ClientData clientData) /* Pointer to thread data. */
-{
- if (tclNotifierHooks.alertNotifierProc) {
- tclNotifierHooks.alertNotifierProc(clientData);
- return;
- } else {
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData;
-
- /*
- * Note that we do not need to lock around access to the hwnd because
- * the race condition has no effect since any race condition implies
- * that the notifier thread is already awake.
- */
-
- if (tsdPtr->hwnd) {
- /*
- * We do need to lock around access to the pending flag.
- */
-
- EnterCriticalSection(&tsdPtr->crit);
- if (!tsdPtr->pending) {
- PostMessage(tsdPtr->hwnd, WM_WAKEUP, 0, 0);
- }
- tsdPtr->pending = 1;
- LeaveCriticalSection(&tsdPtr->crit);
- } else {
- SetEvent(tsdPtr->event);
- }
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * 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.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Replaces any previous timer.
- *
- *----------------------------------------------------------------------
- */
-
-void
-Tcl_SetTimer(
- const Tcl_Time *timePtr) /* Maximum block time, or NULL. */
-{
- if (tclNotifierHooks.setTimerProc) {
- tclNotifierHooks.setTimerProc(timePtr);
- return;
- } else {
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- UINT timeout;
-
- /*
- * We only need to set up an interval timer if we're being called from
- * an external event loop. If we don't have a window handle then we
- * just return immediately and let Tcl_WaitForEvent handle timeouts.
- */
-
- if (!tsdPtr->hwnd) {
- return;
- }
-
- if (!timePtr) {
- timeout = 0;
- } else {
- /*
- * Make sure we pass a non-zero value into the timeout argument.
- * Windows seems to get confused by zero length timers.
- */
-
- timeout = timePtr->sec * 1000 + timePtr->usec / 1000;
- if (timeout == 0) {
- timeout = 1;
- }
- }
- tsdPtr->timeout = timeout;
- if (timeout != 0) {
- tsdPtr->timerActive = 1;
- SetTimer(tsdPtr->hwnd, INTERVAL_TIMER,
- (unsigned long) tsdPtr->timeout, NULL);
- } else {
- tsdPtr->timerActive = 0;
- KillTimer(tsdPtr->hwnd, INTERVAL_TIMER);
- }
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_ServiceModeHook --
- *
- * This function is invoked whenever the service mode changes.
- *
- * Results:
- * None.
- *
- * Side effects:
- * If this is the first time the notifier is set into TCL_SERVICE_ALL,
- * then the communication window is created.
- *
- *----------------------------------------------------------------------
- */
-
-void
-Tcl_ServiceModeHook(
- int mode) /* Either TCL_SERVICE_ALL, or
- * TCL_SERVICE_NONE. */
-{
- if (tclNotifierHooks.serviceModeHookProc) {
- tclNotifierHooks.serviceModeHookProc(mode);
- return;
- } else {
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-
- /*
- * If this is the first time that the notifier has been used from a
- * modal loop, then create a communication window. Note that after this
- * point, the application needs to service events in a timely fashion
- * or Windows will hang waiting for the window to respond to
- * synchronous system messages. At some point, we may want to consider
- * destroying the window if we leave the modal loop, but for now we'll
- * leave it around.
- */
-
- if (mode == TCL_SERVICE_ALL && !tsdPtr->hwnd) {
- tsdPtr->hwnd = CreateWindow(classname, classname,
- WS_TILED, 0, 0, 0, 0, NULL, NULL, TclWinGetTclInstance(),
- NULL);
-
- /*
- * Send an initial message to the window to ensure that we wake up
- * the notifier once we get into the modal loop. This will force
- * the notifier to recompute the timeout value and schedule a timer
- * if one is needed.
- */
-
- Tcl_AlertNotifier(tsdPtr);
- }
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * 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->
- *
- * Results:
- * A standard windows result.
- *
- * Side effects:
- * Services any pending events.
- *
- *----------------------------------------------------------------------
- */
-
-static LRESULT CALLBACK
-NotifierProc(
- HWND hwnd, /* Passed on... */
- UINT message, /* What messsage is this? */
- WPARAM wParam, /* Passed on... */
- LPARAM lParam) /* Passed on... */
-{
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-
- if (message == WM_WAKEUP) {
- EnterCriticalSection(&tsdPtr->crit);
- tsdPtr->pending = 0;
- LeaveCriticalSection(&tsdPtr->crit);
- } else if (message != WM_TIMER) {
- return DefWindowProc(hwnd, message, wParam, lParam);
- }
-
- /*
- * Process all of the runnable events.
- */
-
- Tcl_ServiceAll();
- return 0;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * 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.
- *
- * Results:
- * 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.
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_WaitForEvent(
- const Tcl_Time *timePtr) /* Maximum block time, or NULL. */
-{
- if (tclNotifierHooks.waitForEventProc) {
- return tclNotifierHooks.waitForEventProc(timePtr);
- } else {
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- MSG msg;
- DWORD timeout, result;
- int status;
-
- /*
- * Compute the timeout in milliseconds.
- */
-
- if (timePtr) {
- /*
- * 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;
- }
-
- /*
- * Check to see if there are any messages in the queue before waiting
- * because MsgWaitForMultipleObjects will not wake up if there are
- * events currently sitting in the queue.
- */
-
- if (!PeekMessage(&msg, NULL, 0, 0, PM_NOREMOVE)) {
- /*
- * Wait for something to happen (a signal from another thread, a
- * message, or timeout) or loop servicing asynchronous procedure
- * calls queued to this thread.
- */
-
- again:
- result = MsgWaitForMultipleObjectsEx(1, &tsdPtr->event, timeout,
- QS_ALLINPUT, MWMO_ALERTABLE);
- if (result == WAIT_IO_COMPLETION) {
- goto again;
- } else if (result == WAIT_FAILED) {
- status = -1;
- goto end;
- }
- }
-
- /*
- * Check to see if there are any messages to process.
- */
-
- if (PeekMessage(&msg, NULL, 0, 0, PM_NOREMOVE)) {
- /*
- * Retrieve and dispatch the first message.
- */
-
- result = GetMessage(&msg, NULL, 0, 0);
- if (result == 0) {
- /*
- * We received a request to exit this thread (WM_QUIT), so
- * propagate the quit message and start unwinding.
- */
-
- PostQuitMessage((int) msg.wParam);
- status = -1;
- } else if (result == (DWORD)-1) {
- /*
- * We got an error from the system. I have no idea why this
- * would happen, so we'll just unwind.
- */
-
- status = -1;
- } else {
- TranslateMessage(&msg);
- DispatchMessage(&msg);
- status = 1;
- }
- } else {
- status = 0;
- }
-
- end:
- ResetEvent(tsdPtr->event);
- return status;
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_Sleep --
- *
- * Delay execution for the specified number of milliseconds.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Time passes.
- *
- *----------------------------------------------------------------------
- */
-
-void
-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.
- */
-
- 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 + vdelay.sec;
- desired.usec = now.usec + vdelay.usec;
- if (desired.usec > 1000000) {
- ++desired.sec;
- desired.usec -= 1000000;
- }
-
- /*
- * TIP #233: Scale delay from virtual to real-time.
- */
-
- tclScaleTimeProcPtr(&vdelay, tclTimeClientData);
- sleepTime = vdelay.sec * 1000 + vdelay.usec / 1000;
-
- for (;;) {
- SleepEx(sleepTime, TRUE);
- Tcl_GetTime(&now);
- if (now.sec > desired.sec) {
- break;
- } else if ((now.sec == desired.sec) && (now.usec >= desired.usec)) {
- break;
- }
-
- 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/tcl8.6/win/tclWinPipe.c b/tcl8.6/win/tclWinPipe.c
deleted file mode 100644
index 826265a..0000000
--- a/tcl8.6/win/tclWinPipe.c
+++ /dev/null
@@ -1,3588 +0,0 @@
-/*
- * tclWinPipe.c --
- *
- * 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.
- */
-
-#include "tclWinInt.h"
-
-/*
- * The following variable is used to tell whether this module has been
- * initialized.
- */
-
-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.
- */
-
-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.
- */
-
-#define APPL_NONE 0
-#define APPL_DOS 1
-#define APPL_WIN3X 2
-#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.
- */
-
-#define WIN_FILE 3 /* Basic Win32 file. */
-
-/*
- * This structure encapsulates the common state associated with all file types
- * used in a pipeline.
- */
-
-typedef struct {
- int type; /* One of the file types defined above. */
- HANDLE handle; /* Open file handle. */
-} WinFile;
-
-/*
- * This list is used to map from pids to process handles.
- */
-
-typedef struct ProcInfo {
- HANDLE hProcess;
- DWORD dwProcessId;
- struct ProcInfo *nextPtr;
-} ProcInfo;
-
-static ProcInfo *procList;
-
-/*
- * Bit masks used in the flags field of the PipeInfo structure below.
- */
-
-#define PIPE_PENDING (1<<0) /* Message is pending in the queue. */
-#define PIPE_ASYNC (1<<1) /* Channel is non-blocking. */
-
-/*
- * Bit masks used in the sharedFlags field of the PipeInfo structure below.
- */
-
-#define PIPE_EOF (1<<2) /* Pipe has reached EOF. */
-#define PIPE_EXTRABYTE (1<<3) /* The reader thread has consumed one byte. */
-
-/*
- * TODO: It appears the whole EXTRABYTE machinery is in place to support
- * outdated Win 95 systems. If this can be confirmed, much code can be
- * deleted.
- */
-
-/*
- * This structure describes per-instance data for a pipe based channel.
- */
-
-typedef struct PipeInfo {
- struct PipeInfo *nextPtr; /* Pointer to next registered pipe. */
- 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. */
- TclFile readFile; /* Output from pipe. */
- TclFile writeFile; /* Input from pipe. */
- TclFile errorFile; /* Error output from pipe. */
- int numPids; /* Number of processes attached to pipe. */
- Tcl_Pid *pidPtr; /* Pids of attached processes. */
- Tcl_ThreadId threadId; /* Thread to which events should be reported.
- * This value is used by the reader/writer
- * threads. */
- TclPipeThreadInfo *writeTI; /* Thread info of writer and reader, this */
- TclPipeThreadInfo *readTI; /* structure owned by corresponding thread. */
- HANDLE writeThread; /* Handle to writer thread. */
- HANDLE readThread; /* Handle to reader thread. */
-
- HANDLE writable; /* Manual-reset event to signal when the
- * writer thread has finished waiting for the
- * current buffer to be written. */
- HANDLE readable; /* Manual-reset event to signal when the
- * reader thread has finished waiting for
- * input. */
- 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 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. */
- char extraByte; /* Buffer for extra character consumed by
- * reader thread. This byte is shared with the
- * reader thread so access must be
- * synchronized with the readable object. */
-} PipeInfo;
-
-typedef struct {
- /*
- * 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.
- */
-
-typedef struct {
- 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;
-
-/*
- * Declarations for functions used only in this file.
- */
-
-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 BOOL HasConsole(void);
-static int PipeBlockModeProc(ClientData instanceData, int mode);
-static void PipeCheckProc(ClientData clientData, int flags);
-static int PipeClose2Proc(ClientData instanceData,
- Tcl_Interp *interp, int flags);
-static int PipeEventProc(Tcl_Event *evPtr, int flags);
-static int PipeGetHandleProc(ClientData instanceData,
- int direction, ClientData *handlePtr);
-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);
-static DWORD WINAPI PipeReaderThread(LPVOID arg);
-static void PipeSetupProc(ClientData clientData, int flags);
-static void PipeWatchProc(ClientData instanceData, int mask);
-static DWORD WINAPI PipeWriterThread(LPVOID arg);
-static int TempFileName(TCHAR name[MAX_PATH]);
-static int WaitForRead(PipeInfo *infoPtr, int blocking);
-static void PipeThreadActionProc(ClientData instanceData,
- int action);
-
-/*
- * This structure describes the channel type structure for command pipe based
- * I/O.
- */
-
-static const Tcl_ChannelType pipeChannelType = {
- "pipe", /* Type name. */
- TCL_CHANNEL_VERSION_5, /* v5 channel */
- TCL_CLOSE2PROC, /* Close proc. */
- PipeInputProc, /* Input proc. */
- PipeOutputProc, /* Output proc. */
- NULL, /* Seek proc. */
- NULL, /* Set option proc. */
- NULL, /* Get option proc. */
- PipeWatchProc, /* Set up notifier to watch the channel. */
- PipeGetHandleProc, /* Get an OS handle from channel. */
- PipeClose2Proc, /* close2proc */
- PipeBlockModeProc, /* Set blocking or non-blocking mode.*/
- NULL, /* flush proc. */
- NULL, /* handler proc. */
- NULL, /* wide seek proc */
- PipeThreadActionProc, /* thread action proc */
- NULL /* truncate */
-};
-
-/*
- *----------------------------------------------------------------------
- *
- * PipeInit --
- *
- * This function initializes the static variables for this file.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Creates a new event source.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-PipeInit(void)
-{
- ThreadSpecificData *tsdPtr;
-
- /*
- * Check the initialized flag first, then check again in the mutex. This
- * is a speed enhancement.
- */
-
- if (!initialized) {
- Tcl_MutexLock(&pipeMutex);
- if (!initialized) {
- initialized = 1;
- procList = NULL;
- }
- Tcl_MutexUnlock(&pipeMutex);
- }
-
- tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
- if (tsdPtr == NULL) {
- tsdPtr = TCL_TSD_INIT(&dataKey);
- tsdPtr->firstPipePtr = NULL;
- Tcl_CreateEventSource(PipeSetupProc, PipeCheckProc, NULL);
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclpFinalizePipes --
- *
- * This function is called from Tcl_FinalizeThread to finalize the
- * platform specific pipe subsystem.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Removes the pipe event source.
- *
- *----------------------------------------------------------------------
- */
-
-void
-TclpFinalizePipes(void)
-{
- ThreadSpecificData *tsdPtr;
-
- tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
- if (tsdPtr != NULL) {
- Tcl_DeleteEventSource(PipeSetupProc, PipeCheckProc, NULL);
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * PipeSetupProc --
- *
- * This function is invoked before Tcl_DoOneEvent blocks waiting for an
- * event.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Adjusts the block time if needed.
- *
- *----------------------------------------------------------------------
- */
-
-void
-PipeSetupProc(
- ClientData data, /* Not used. */
- int flags) /* Event flags as passed to Tcl_DoOneEvent. */
-{
- PipeInfo *infoPtr;
- Tcl_Time blockTime = { 0, 0 };
- int block = 1;
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-
- 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;
- infoPtr = infoPtr->nextPtr) {
- if (infoPtr->watchMask & TCL_WRITABLE) {
- if (WaitForSingleObject(infoPtr->writable, 0) != WAIT_TIMEOUT) {
- block = 0;
- }
- }
- if (infoPtr->watchMask & TCL_READABLE) {
- if (WaitForRead(infoPtr, 0) >= 0) {
- block = 0;
- }
- }
- }
- if (!block) {
- Tcl_SetMaxBlockTime(&blockTime);
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * PipeCheckProc --
- *
- * This function is called by Tcl_DoOneEvent to check the pipe event
- * source for events.
- *
- * Results:
- * None.
- *
- * Side effects:
- * May queue an event.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-PipeCheckProc(
- ClientData data, /* Not used. */
- int flags) /* Event flags as passed to Tcl_DoOneEvent. */
-{
- PipeInfo *infoPtr;
- PipeEvent *evPtr;
- int needEvent;
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-
- if (!(flags & TCL_FILE_EVENTS)) {
- return;
- }
-
- /*
- * Queue events for any ready pipes that don't already have events queued.
- */
-
- 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.
- */
-
- needEvent = 0;
- if ((infoPtr->watchMask & TCL_WRITABLE) &&
- (WaitForSingleObject(infoPtr->writable, 0) != WAIT_TIMEOUT)) {
- needEvent = 1;
- }
-
- if ((infoPtr->watchMask & TCL_READABLE) &&
- (WaitForRead(infoPtr, 0) >= 0)) {
- needEvent = 1;
- }
-
- if (needEvent) {
- infoPtr->flags |= PIPE_PENDING;
- evPtr = ckalloc(sizeof(PipeEvent));
- evPtr->header.proc = PipeEventProc;
- evPtr->infoPtr = infoPtr;
- Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
- }
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclWinMakeFile --
- *
- * This function constructs a new TclFile from a given data and type
- * value.
- *
- * Results:
- * Returns a newly allocated WinFile as a TclFile.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-TclFile
-TclWinMakeFile(
- HANDLE handle) /* Type-specific data. */
-{
- WinFile *filePtr;
-
- filePtr = ckalloc(sizeof(WinFile));
- filePtr->type = WIN_FILE;
- filePtr->handle = handle;
-
- return (TclFile)filePtr;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * 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.
- *
- * 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.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-TempFileName(
- TCHAR name[MAX_PATH]) /* Buffer in which name for temporary file
- * gets stored. */
-{
- const TCHAR *prefix = TEXT("TCL");
- if (GetTempPath(MAX_PATH, name) != 0) {
- if (GetTempFileName(name, prefix, 0, name) != 0) {
- return 1;
- }
- }
- name[0] = '.';
- name[1] = '\0';
- return GetTempFileName(name, prefix, 0, name);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclpMakeFile --
- *
- * Make a TclFile from a channel.
- *
- * Results:
- * Returns a new TclFile or NULL on failure.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-TclFile
-TclpMakeFile(
- Tcl_Channel channel, /* Channel to get file from. */
- int direction) /* Either TCL_READABLE or TCL_WRITABLE. */
-{
- HANDLE handle;
-
- if (Tcl_GetChannelHandle(channel, direction,
- (ClientData *) &handle) == TCL_OK) {
- return TclWinMakeFile(handle);
- } else {
- return (TclFile) NULL;
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclpOpenFile --
- *
- * This function opens files for use in a pipeline.
- *
- * Results:
- * Returns a newly allocated TclFile structure containing the file
- * handle.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-TclFile
-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;
-
- /*
- * 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;
- }
-
- /*
- * Map the creation flags to the NT create 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;
- }
-
- nativePath = Tcl_WinUtfToTChar(path, -1, &ds);
-
- /*
- * If the file is not being created, use the existing file attributes.
- */
-
- flags = 0;
- if (!(mode & O_CREAT)) {
- flags = GetFileAttributes(nativePath);
- if (flags == 0xFFFFFFFF) {
- flags = 0;
- }
- }
-
- /*
- * Set up the file sharing mode. We want to allow simultaneous access.
- */
-
- shareMode = FILE_SHARE_READ | FILE_SHARE_WRITE;
-
- /*
- * Now we get to create the file.
- */
-
- handle = CreateFile(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;
- }
-
- /*
- * Seek to the end of file if we are writing.
- */
-
- if (mode & (O_WRONLY|O_APPEND)) {
- SetFilePointer(handle, 0, NULL, FILE_END);
- }
-
- return TclWinMakeFile(handle);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * 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.
- *
- * Results:
- * Returns a valid TclFile, or NULL on failure.
- *
- * Side effects:
- * Creates a new temporary file.
- *
- *----------------------------------------------------------------------
- */
-
-TclFile
-TclpCreateTempFile(
- const char *contents) /* String to write into temp file, or NULL. */
-{
- TCHAR name[MAX_PATH];
- const char *native;
- Tcl_DString dstring;
- HANDLE handle;
-
- if (TempFileName(name) == 0) {
- return NULL;
- }
-
- handle = CreateFile(name,
- GENERIC_READ | GENERIC_WRITE, 0, NULL, CREATE_ALWAYS,
- FILE_ATTRIBUTE_TEMPORARY|FILE_FLAG_DELETE_ON_CLOSE, NULL);
- if (handle == INVALID_HANDLE_VALUE) {
- goto error;
- }
-
- /*
- * Write the file out, doing line translations on the way.
- */
-
- if (contents != NULL) {
- DWORD result, length;
- const char *p;
- int toCopy;
-
- /*
- * Convert the contents from UTF to native encoding
- */
-
- native = Tcl_UtfToExternalDString(NULL, contents, -1, &dstring);
-
- toCopy = Tcl_DStringLength(&dstring);
- for (p = native; toCopy > 0; p++, toCopy--) {
- if (*p == '\n') {
- length = p - native;
- if (length > 0) {
- if (!WriteFile(handle, native, length, &result, NULL)) {
- goto error;
- }
- }
- if (!WriteFile(handle, "\r\n", 2, &result, NULL)) {
- goto error;
- }
- native = p+1;
- }
- }
- length = p - native;
- if (length > 0) {
- if (!WriteFile(handle, native, length, &result, NULL)) {
- goto error;
- }
- }
- Tcl_DStringFree(&dstring);
- if (SetFilePointer(handle, 0, NULL, FILE_BEGIN) == 0xFFFFFFFF) {
- goto error;
- }
- }
-
- return TclWinMakeFile(handle);
-
- error:
- /*
- * Free the native representation of the contents if necessary.
- */
-
- if (contents != NULL) {
- Tcl_DStringFree(&dstring);
- }
-
- TclWinConvertError(GetLastError());
- CloseHandle(handle);
- DeleteFile(name);
- return NULL;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclpTempFileName --
- *
- * This function returns a unique filename.
- *
- * Results:
- * Returns a valid Tcl_Obj* with refCount 0, or NULL on failure.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-Tcl_Obj *
-TclpTempFileName(void)
-{
- TCHAR fileName[MAX_PATH];
-
- if (TempFileName(fileName) == 0) {
- return NULL;
- }
-
- return TclpNativeToNormalized(fileName);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclpCreatePipe --
- *
- * Creates an anonymous pipe.
- *
- * Results:
- * Returns 1 on success, 0 on failure.
- *
- * Side effects:
- * 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. */
-{
- HANDLE readHandle, writeHandle;
-
- if (CreatePipe(&readHandle, &writeHandle, NULL, 0) != 0) {
- *readPipe = TclWinMakeFile(readHandle);
- *writePipe = TclWinMakeFile(writeHandle);
- return 1;
- }
-
- TclWinConvertError(GetLastError());
- return 0;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclpCloseFile --
- *
- * Closes a pipeline file handle. These handles are created by
- * TclpOpenFile, TclpCreatePipe, or TclpMakeFile.
- *
- * Results:
- * 0 on success, -1 on failure.
- *
- * Side effects:
- * The file is closed and deallocated.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclpCloseFile(
- 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.
- */
-
- 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(filePtr);
- return -1;
- }
- }
- break;
-
- default:
- Tcl_Panic("TclpCloseFile: unexpected file type");
- }
-
- ckfree(filePtr);
- return 0;
-}
-
-/*
- *--------------------------------------------------------------------------
- *
- * TclpGetPid --
- *
- * Given a HANDLE to a child process, return the process id for that
- * 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.
- *
- * Side effects:
- * None.
- *
- *--------------------------------------------------------------------------
- */
-
-int
-TclpGetPid(
- Tcl_Pid pid) /* The HANDLE of the child process. */
-{
- ProcInfo *infoPtr;
-
- PipeInit();
-
- Tcl_MutexLock(&pipeMutex);
- for (infoPtr = procList; infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
- if (infoPtr->hProcess == (HANDLE) pid) {
- Tcl_MutexUnlock(&pipeMutex);
- return infoPtr->dwProcessId;
- }
- }
- Tcl_MutexUnlock(&pipeMutex);
- return (unsigned long) -1;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * 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.
- *
- * 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 standard extensions 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.
- *
- * Side effects:
- * A process is created.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclpCreateProcess(
- Tcl_Interp *interp, /* Interpreter in which to leave errors that
- * occurred when creating the child process.
- * 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
- * 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
- * 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 function is successful, pidPtr is
- * filled with the process id of the child
- * process. */
-{
- int result, applType, createFlags;
- Tcl_DString cmdLine; /* Complete command line (TCHAR). */
- STARTUPINFO startInfo;
- PROCESS_INFORMATION procInfo;
- SECURITY_ATTRIBUTES secAtts;
- HANDLE hProcess, h, inputHandle, outputHandle, errorHandle;
- char execPath[MAX_PATH * TCL_UTF_MAX];
- WinFile *filePtr;
-
- PipeInit();
-
- applType = ApplicationType(interp, argv[0], execPath);
- if (applType == APPL_NONE) {
- return TCL_ERROR;
- }
-
- result = TCL_ERROR;
- Tcl_DStringInit(&cmdLine);
- hProcess = GetCurrentProcess();
-
- /*
- * STARTF_USESTDHANDLES must be used to pass handles to child process.
- * 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.hStdInput = INVALID_HANDLE_VALUE;
- startInfo.hStdOutput= INVALID_HANDLE_VALUE;
- startInfo.hStdError = INVALID_HANDLE_VALUE;
-
- secAtts.nLength = sizeof(SECURITY_ATTRIBUTES);
- secAtts.lpSecurityDescriptor = NULL;
- secAtts.bInheritHandle = TRUE;
-
- /*
- * We have to check the type of each file, since we cannot duplicate some
- * file types.
- */
-
- inputHandle = INVALID_HANDLE_VALUE;
- if (inputFile != NULL) {
- filePtr = (WinFile *)inputFile;
- if (filePtr->type == WIN_FILE) {
- inputHandle = filePtr->handle;
- }
- }
- outputHandle = INVALID_HANDLE_VALUE;
- if (outputFile != NULL) {
- filePtr = (WinFile *)outputFile;
- if (filePtr->type == WIN_FILE) {
- outputHandle = filePtr->handle;
- }
- }
- errorHandle = INVALID_HANDLE_VALUE;
- if (errorFile != NULL) {
- filePtr = (WinFile *)errorFile;
- if (filePtr->type == WIN_FILE) {
- errorHandle = filePtr->handle;
- }
- }
-
- /*
- * 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.
- *
- * 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) {
- CloseHandle(h);
- }
- } else {
- DuplicateHandle(hProcess, inputHandle, hProcess, &startInfo.hStdInput,
- 0, TRUE, DUPLICATE_SAME_ACCESS);
- }
- if (startInfo.hStdInput == INVALID_HANDLE_VALUE) {
- TclWinConvertError(GetLastError());
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "couldn't duplicate input handle: %s",
- Tcl_PosixError(interp)));
- goto end;
- }
-
- 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.
- *
- * Fortunately, the helper application will detect a closed pipe as a
- * sink.
- */
-
- startInfo.hStdOutput = CreateFile(TEXT("NUL:"), GENERIC_WRITE, 0,
- &secAtts, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, NULL);
- } else {
- DuplicateHandle(hProcess, outputHandle, hProcess,
- &startInfo.hStdOutput, 0, TRUE, DUPLICATE_SAME_ACCESS);
- }
- if (startInfo.hStdOutput == INVALID_HANDLE_VALUE) {
- TclWinConvertError(GetLastError());
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "couldn't duplicate output handle: %s",
- Tcl_PosixError(interp)));
- goto end;
- }
-
- if (errorHandle == INVALID_HANDLE_VALUE) {
- /*
- * If handle was not set, errors should be sent to an infinitely deep
- * sink.
- */
-
- startInfo.hStdError = CreateFile(TEXT("NUL:"), GENERIC_WRITE, 0,
- &secAtts, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL);
- } else {
- DuplicateHandle(hProcess, errorHandle, hProcess, &startInfo.hStdError,
- 0, TRUE, DUPLICATE_SAME_ACCESS);
- }
- if (startInfo.hStdError == INVALID_HANDLE_VALUE) {
- TclWinConvertError(GetLastError());
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "couldn't duplicate error handle: %s",
- Tcl_PosixError(interp)));
- 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 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.
- */
-
- if (TclWinGetPlatformId() == VER_PLATFORM_WIN32_NT) {
- if (HasConsole()) {
- 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.
- */
-
- startInfo.wShowWindow = SW_HIDE;
- startInfo.dwFlags |= STARTF_USESHOWWINDOW;
- createFlags = CREATE_NEW_CONSOLE;
- TclDStringAppendLiteral(&cmdLine, "cmd.exe /c");
- } else {
- createFlags = DETACHED_PROCESS;
- }
- } else {
- if (HasConsole()) {
- createFlags = 0;
- } else {
- createFlags = DETACHED_PROCESS;
- }
-
- if (applType == APPL_DOS) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "DOS application process not supported on this platform",
- -1));
- Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC", "DOS_APP",
- NULL);
- goto end;
- }
- }
-
- /*
- * 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.
- *
- * 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").
- */
-
- BuildCommandLine(execPath, argc, argv, &cmdLine);
-
- if (CreateProcess(NULL, (TCHAR *) Tcl_DStringValue(&cmdLine),
- NULL, NULL, TRUE, (DWORD) createFlags, NULL, NULL, &startInfo,
- &procInfo) == 0) {
- TclWinConvertError(GetLastError());
- Tcl_SetObjResult(interp, Tcl_ObjPrintf("couldn't execute \"%s\": %s",
- argv[0], Tcl_PosixError(interp)));
- goto end;
- }
-
- /*
- * 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
- */
-
- WaitForInputIdle(procInfo.hProcess, 5000);
- CloseHandle(procInfo.hThread);
-
- *pidPtr = (Tcl_Pid) procInfo.hProcess;
- if (*pidPtr != 0) {
- TclWinAddProcess(procInfo.hProcess, procInfo.dwProcessId);
- }
- result = TCL_OK;
-
- end:
- Tcl_DStringFree(&cmdLine);
- if (startInfo.hStdInput != INVALID_HANDLE_VALUE) {
- CloseHandle(startInfo.hStdInput);
- }
- if (startInfo.hStdOutput != INVALID_HANDLE_VALUE) {
- CloseHandle(startInfo.hStdOutput);
- }
- if (startInfo.hStdError != INVALID_HANDLE_VALUE) {
- CloseHandle(startInfo.hStdError);
- }
- return result;
-}
-
-
-/*
- *----------------------------------------------------------------------
- *
- * HasConsole --
- *
- * Determines whether the current application is attached to a console.
- *
- * Results:
- * Returns TRUE if this application has a console, else FALSE.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-static BOOL
-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);
- return TRUE;
- } else {
- return FALSE;
- }
-}
-
-/*
- *--------------------------------------------------------------------
- *
- * 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 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.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-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;
- HANDLE hFile;
- TCHAR *rest;
- char *ext;
- char buf[2];
- DWORD attr, read;
- IMAGE_DOS_HEADER header;
- Tcl_DString nameBuf, ds;
- const TCHAR *nativeName;
- TCHAR nativeFullPath[MAX_PATH];
- static const char extensions[][5] = {"", ".com", ".exe", ".bat", ".cmd"};
-
- /*
- * Look for the program as an external program. First try the name as it
- * is, then try adding .com, .exe, .bat and .cmd, in that order, to the name,
- * looking for an executable.
- *
- * 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;
- Tcl_DStringInit(&nameBuf);
- Tcl_DStringAppend(&nameBuf, originalName, -1);
- nameLen = Tcl_DStringLength(&nameBuf);
-
- 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),
- Tcl_DStringLength(&nameBuf), &ds);
- found = SearchPath(NULL, nativeName, NULL, MAX_PATH,
- nativeFullPath, &rest);
- Tcl_DStringFree(&ds);
- if (found == 0) {
- continue;
- }
-
- /*
- * Ignore matches on directories or data files, return if identified a
- * known type.
- */
-
- attr = GetFileAttributes(nativeFullPath);
- if ((attr == 0xffffffff) || (attr & FILE_ATTRIBUTE_DIRECTORY)) {
- continue;
- }
- strcpy(fullName, Tcl_WinTCharToUtf(nativeFullPath, -1, &ds));
- Tcl_DStringFree(&ds);
-
- ext = strrchr(fullName, '.');
- if ((ext != NULL) &&
- (strcasecmp(ext, ".cmd") == 0 || strcasecmp(ext, ".bat") == 0)) {
- applType = APPL_DOS;
- break;
- }
-
- hFile = CreateFile(nativeFullPath,
- GENERIC_READ, FILE_SHARE_READ, NULL, OPEN_EXISTING,
- FILE_ATTRIBUTE_NORMAL, NULL);
- if (hFile == INVALID_HANDLE_VALUE) {
- continue;
- }
-
- 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
- * 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.
- */
-
- CloseHandle(hFile);
- 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
- * other magic number it was a DOS application.
- */
-
- CloseHandle(hFile);
- applType = APPL_DOS;
- break;
- }
-
- /*
- * The DWORD at header.e_lfanew points to yet another magic number.
- */
-
- buf[0] = '\0';
- SetFilePointer(hFile, header.e_lfanew, NULL, FILE_BEGIN);
- ReadFile(hFile, (void *) buf, 2, &read, NULL);
- CloseHandle(hFile);
-
- if ((buf[0] == 'N') && (buf[1] == 'E')) {
- applType = APPL_WIN3X;
- } else if ((buf[0] == 'P') && (buf[1] == 'E')) {
- 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.
- */
-
- applType = APPL_DOS;
- }
- break;
- }
- Tcl_DStringFree(&nameBuf);
-
- if (applType == APPL_NONE) {
- TclWinConvertError(GetLastError());
- Tcl_SetObjResult(interp, Tcl_ObjPrintf("couldn't execute \"%s\": %s",
- originalName, Tcl_PosixError(interp)));
- return APPL_NONE;
- }
-
- if (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
- * application name from the arguments.
- */
-
- GetShortPathName(nativeFullPath, nativeFullPath, MAX_PATH);
- strcpy(fullName, Tcl_WinTCharToUtf(nativeFullPath, -1, &ds));
- Tcl_DStringFree(&ds);
- }
- 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.
- *
- * Results:
- * None.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-static const char *
-BuildCmdLineBypassBS(
- const char *current,
- const char **bspos
-) {
- /* mark first backslash possition */
- if (!*bspos) {
- *bspos = current;
- }
- do {
- current++;
- } while (*current == '\\');
- return current;
-}
-
-static void
-QuoteCmdLineBackslash(
- Tcl_DString *dsPtr,
- const char *start,
- const char *current,
- const char *bspos
-) {
- if (!bspos) {
- if (current > start) { /* part before current (special) */
- Tcl_DStringAppend(dsPtr, start, (int) (current - start));
- }
- } else {
- if (bspos > start) { /* part before first backslash */
- Tcl_DStringAppend(dsPtr, start, (int) (bspos - start));
- }
- while (bspos++ < current) { /* each backslash twice */
- TclDStringAppendLiteral(dsPtr, "\\\\");
- }
- }
-}
-
-static const char *
-QuoteCmdLinePart(
- Tcl_DString *dsPtr,
- const char *start,
- const char *special,
- const char *specMetaChars,
- const char **bspos
-) {
- if (!*bspos) {
- /* rest before special (before quote) */
- QuoteCmdLineBackslash(dsPtr, start, special, NULL);
- start = special;
- } else {
- /* rest before first backslash and backslashes into new quoted block */
- QuoteCmdLineBackslash(dsPtr, start, *bspos, NULL);
- start = *bspos;
- }
- /*
- * escape all special chars enclosed in quotes like `"..."`, note that here we
- * don't must escape `\` (with `\`), because it's outside of the main quotes,
- * so `\` remains `\`, but important - not at end of part, because results as
- * before the quote, so `%\%\` should be escaped as `"%\%"\\`).
- */
- TclDStringAppendLiteral(dsPtr, "\""); /* opening escape quote-char */
- do {
- *bspos = NULL;
- special++;
- if (*special == '\\') {
- /* bypass backslashes (and mark first backslash possition)*/
- special = BuildCmdLineBypassBS(special, bspos);
- if (*special == '\0') break;
- }
- } while (*special && strchr(specMetaChars, *special));
- if (!*bspos) {
- /* unescaped rest before quote */
- QuoteCmdLineBackslash(dsPtr, start, special, NULL);
- } else {
- /* unescaped rest before first backslash (rather belongs to the main block) */
- QuoteCmdLineBackslash(dsPtr, start, *bspos, NULL);
- }
- TclDStringAppendLiteral(dsPtr, "\""); /* closing escape quote-char */
- return special;
-}
-
-static void
-BuildCommandLine(
- 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. */
- Tcl_DString *linePtr) /* Initialized Tcl_DString that receives the
- * command line (TCHAR). */
-{
- const char *arg, *start, *special, *bspos;
- int quote = 0, i;
- Tcl_DString ds;
-
- /* characters to enclose in quotes if unpaired quote flag set */
- const static char *specMetaChars = "&|^<>!()%";
- /* characters to enclose in quotes in any case (regardless unpaired-flag) */
- const static char *specMetaChars2 = "%";
-
- /* Quote flags:
- * CL_ESCAPE - escape argument;
- * CL_QUOTE - enclose in quotes;
- * CL_UNPAIRED - previous arguments chain contains unpaired quote-char;
- */
- enum {CL_ESCAPE = 1, CL_QUOTE = 2, CL_UNPAIRED = 4};
-
- Tcl_DStringInit(&ds);
-
- /*
- * Prime the path. Add a space separator if we were primed with something.
- */
-
- TclDStringAppendDString(&ds, linePtr);
- if (Tcl_DStringLength(linePtr) > 0) {
- TclDStringAppendLiteral(&ds, " ");
- }
-
- for (i = 0; i < argc; i++) {
- if (i == 0) {
- arg = executable;
- } else {
- arg = argv[i];
- TclDStringAppendLiteral(&ds, " ");
- }
-
- quote &= ~(CL_ESCAPE|CL_QUOTE); /* reset escape flags */
- bspos = NULL;
- if (arg[0] == '\0') {
- quote = CL_QUOTE;
- } else {
- int count;
- Tcl_UniChar ch;
- for (start = arg;
- *start != '\0' &&
- (quote & (CL_ESCAPE|CL_QUOTE)) != (CL_ESCAPE|CL_QUOTE);
- start += count
- ) {
- count = Tcl_UtfToUniChar(start, &ch);
- if (count > 1) continue;
- if (Tcl_UniCharIsSpace(ch)) {
- quote |= CL_QUOTE; /* quote only */
- if (bspos) { /* if backslash found - escape & quote */
- quote |= CL_ESCAPE;
- break;
- }
- continue;
- }
- if (strchr(specMetaChars, *start)) {
- quote |= (CL_ESCAPE|CL_QUOTE); /*escape & quote */
- break;
- }
- if (*start == '"') {
- quote |= CL_ESCAPE; /* escape only */
- continue;
- }
- if (*start == '\\') {
- bspos = start;
- if (quote & CL_QUOTE) { /* if quote - escape & quote */
- quote |= CL_ESCAPE;
- break;
- }
- continue;
- }
- }
- bspos = NULL;
- }
- if (quote & CL_QUOTE) {
- /* start of argument (main opening quote-char) */
- TclDStringAppendLiteral(&ds, "\"");
- }
- if (!(quote & CL_ESCAPE)) {
- /* nothing to escape */
- Tcl_DStringAppend(&ds, arg, -1);
- } else {
- start = arg;
- for (special = arg; *special != '\0'; ) {
- /* position of `\` is important before quote or at end (equal `\"` because quoted) */
- if (*special == '\\') {
- /* bypass backslashes (and mark first backslash possition)*/
- special = BuildCmdLineBypassBS(special, &bspos);
- if (*special == '\0') break;
- }
- /* ["] */
- if (*special == '"') {
- quote ^= CL_UNPAIRED; /* invert unpaired flag - observe unpaired quotes */
- /* add part before (and escape backslashes before quote) */
- QuoteCmdLineBackslash(&ds, start, special, bspos);
- bspos = NULL;
- /* escape using backslash */
- TclDStringAppendLiteral(&ds, "\\\"");
- start = ++special;
- continue;
- }
- /* unpaired (escaped) quote causes special handling on meta-chars */
- if ((quote & CL_UNPAIRED) && strchr(specMetaChars, *special)) {
- special = QuoteCmdLinePart(&ds, start, special, specMetaChars, &bspos);
- /* start to current or first backslash */
- start = !bspos ? special : bspos;
- continue;
- }
- /* special case for % - should be enclosed always (paired also) */
- if (strchr(specMetaChars2, *special)) {
- special = QuoteCmdLinePart(&ds, start, special, specMetaChars2, &bspos);
- /* start to current or first backslash */
- start = !bspos ? special : bspos;
- continue;
- }
- /* other not special (and not meta) character */
- bspos = NULL; /* reset last backslash possition (not interesting) */
- special++;
- }
- /* rest of argument (and escape backslashes before closing main quote) */
- QuoteCmdLineBackslash(&ds, start, special,
- (quote & CL_QUOTE) ? bspos : NULL);
- }
- if (quote & CL_QUOTE) {
- /* end of argument (main closing quote-char) */
- TclDStringAppendLiteral(&ds, "\"");
- }
- }
- Tcl_DStringFree(linePtr);
- Tcl_WinUtfToTChar(Tcl_DStringValue(&ds), Tcl_DStringLength(&ds), linePtr);
- Tcl_DStringFree(&ds);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclpCreateCommandChannel --
- *
- * 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.
- *
- * Side effects:
- * Allocates a new channel.
- *
- *----------------------------------------------------------------------
- */
-
-Tcl_Channel
-TclpCreateCommandChannel(
- TclFile readFile, /* If non-null, gives the file for reading. */
- TclFile writeFile, /* If non-null, gives the file for writing. */
- TclFile errorFile, /* If non-null, gives the file where errors
- * can be read. */
- int numPids, /* The number of pids in the pid array. */
- Tcl_Pid *pidPtr) /* An array of process identifiers. */
-{
- char channelName[16 + TCL_INTEGER_SPACE];
- PipeInfo *infoPtr = ckalloc(sizeof(PipeInfo));
-
- PipeInit();
-
- infoPtr->watchMask = 0;
- infoPtr->flags = 0;
- infoPtr->readFlags = 0;
- infoPtr->readFile = readFile;
- infoPtr->writeFile = writeFile;
- infoPtr->errorFile = errorFile;
- infoPtr->numPids = numPids;
- infoPtr->pidPtr = pidPtr;
- infoPtr->writeBuf = 0;
- infoPtr->writeBufLen = 0;
- infoPtr->writeError = 0;
- infoPtr->channel = NULL;
-
- infoPtr->validMask = 0;
-
- infoPtr->threadId = Tcl_GetCurrentThread();
-
- if (readFile != NULL) {
- /*
- * Start the background reader thread.
- */
-
- infoPtr->readable = CreateEvent(NULL, TRUE, TRUE, NULL);
- infoPtr->readThread = CreateThread(NULL, 256, PipeReaderThread,
- TclPipeThreadCreateTI(&infoPtr->readTI, infoPtr, infoPtr->readable),
- 0, NULL);
- SetThreadPriority(infoPtr->readThread, THREAD_PRIORITY_HIGHEST);
- infoPtr->validMask |= TCL_READABLE;
- } else {
- infoPtr->readTI = NULL;
- infoPtr->readThread = 0;
- }
- if (writeFile != NULL) {
- /*
- * Start the background writer thread.
- */
-
- infoPtr->writable = CreateEvent(NULL, TRUE, TRUE, NULL);
- infoPtr->writeThread = CreateThread(NULL, 256, PipeWriterThread,
- TclPipeThreadCreateTI(&infoPtr->writeTI, infoPtr, infoPtr->writable),
- 0, NULL);
- SetThreadPriority(infoPtr->writeThread, THREAD_PRIORITY_HIGHEST);
- infoPtr->validMask |= TCL_WRITABLE;
- } else {
- infoPtr->writeTI = NULL;
- infoPtr->writeThread = 0;
- }
-
- /*
- * 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).
- */
-
- sprintf(channelName, "file%" TCL_I_MODIFIER "x", (size_t) infoPtr);
- infoPtr->channel = Tcl_CreateChannel(&pipeChannelType, channelName,
- infoPtr, infoPtr->validMask);
-
- /*
- * Pipes have AUTO translation mode on Windows and ^Z eof char, which
- * means that a ^Z will be appended to them at close. This is needed for
- * Windows programs that expect a ^Z at EOF.
- */
-
- Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto");
- Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "\032 {}");
- return infoPtr->channel;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_CreatePipe --
- *
- * System dependent interface to create a pipe for the [chan pipe]
- * command. Stolen from TclX.
- *
- * Results:
- * TCL_OK or TCL_ERROR.
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_CreatePipe(
- Tcl_Interp *interp, /* Errors returned in result.*/
- Tcl_Channel *rchan, /* Where to return the read side. */
- Tcl_Channel *wchan, /* Where to return the write side. */
- int flags) /* Reserved for future use. */
-{
- HANDLE readHandle, writeHandle;
- SECURITY_ATTRIBUTES sec;
-
- sec.nLength = sizeof(SECURITY_ATTRIBUTES);
- sec.lpSecurityDescriptor = NULL;
- sec.bInheritHandle = FALSE;
-
- if (!CreatePipe(&readHandle, &writeHandle, &sec, 0)) {
- TclWinConvertError(GetLastError());
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "pipe creation failed: %s", Tcl_PosixError(interp)));
- return TCL_ERROR;
- }
-
- *rchan = Tcl_MakeFileChannel((ClientData) readHandle, TCL_READABLE);
- Tcl_RegisterChannel(interp, *rchan);
-
- *wchan = Tcl_MakeFileChannel((ClientData) writeHandle, TCL_WRITABLE);
- Tcl_RegisterChannel(interp, *wchan);
-
- return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclGetAndDetachPids --
- *
- * Stores a list of the command PIDs for a command channel in the
- * interp's result.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Modifies the interp's result.
- *
- *----------------------------------------------------------------------
- */
-
-void
-TclGetAndDetachPids(
- Tcl_Interp *interp,
- Tcl_Channel chan)
-{
- PipeInfo *pipePtr;
- const Tcl_ChannelType *chanTypePtr;
- Tcl_Obj *pidsObj;
- int i;
-
- /*
- * Punt if the channel is not a command channel.
- */
-
- chanTypePtr = Tcl_GetChannelType(chan);
- if (chanTypePtr != &pipeChannelType) {
- return;
- }
-
- pipePtr = Tcl_GetChannelInstanceData(chan);
- TclNewObj(pidsObj);
- for (i = 0; i < pipePtr->numPids; i++) {
- Tcl_ListObjAppendElement(NULL, pidsObj,
- Tcl_NewWideIntObj((unsigned)
- TclpGetPid(pipePtr->pidPtr[i])));
- Tcl_DetachPids(1, &pipePtr->pidPtr[i]);
- }
- Tcl_SetObjResult(interp, pidsObj);
- if (pipePtr->numPids > 0) {
- ckfree(pipePtr->pidPtr);
- pipePtr->numPids = 0;
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * PipeBlockModeProc --
- *
- * Set blocking or non-blocking mode on channel.
- *
- * Results:
- * 0 if successful, errno when failed.
- *
- * Side effects:
- * Sets the device into blocking or non-blocking mode.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-PipeBlockModeProc(
- ClientData instanceData, /* Instance data for channel. */
- int mode) /* TCL_MODE_BLOCKING or
- * 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
- * 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) {
- infoPtr->flags |= PIPE_ASYNC;
- } else {
- infoPtr->flags &= ~(PIPE_ASYNC);
- }
- return 0;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * PipeClose2Proc --
- *
- * Closes a pipe based IO channel.
- *
- * Results:
- * 0 on success, errno otherwise.
- *
- * Side effects:
- * Closes the physical channel.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-PipeClose2Proc(
- ClientData instanceData, /* Pointer to PipeInfo structure. */
- Tcl_Interp *interp, /* For error reporting. */
- int flags) /* Flags that indicate which side to close. */
-{
- PipeInfo *pipePtr = (PipeInfo *) instanceData;
- Tcl_Channel errChan;
- int errorCode, result;
- PipeInfo *infoPtr, **nextPtrPtr;
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- int inExit = (TclInExit() || TclInThreadExit());
-
- errorCode = 0;
- 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.
- */
-
- if (pipePtr->readThread) {
-
- TclPipeThreadStop(&pipePtr->readTI, pipePtr->readThread);
- CloseHandle(pipePtr->readThread);
- CloseHandle(pipePtr->readable);
- pipePtr->readThread = NULL;
- }
- if (TclpCloseFile(pipePtr->readFile) != 0) {
- errorCode = errno;
- }
- pipePtr->validMask &= ~TCL_READABLE;
- pipePtr->readFile = 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 or may block during exit, bail out since the worker
- * thread is not interruptible and we want TIP#398-fast-exit.
- */
- if ((pipePtr->flags & PIPE_ASYNC) && inExit) {
-
- /* give it a chance to leave honorably */
- TclPipeThreadStopSignal(&pipePtr->writeTI, pipePtr->writable);
-
- if (WaitForSingleObject(pipePtr->writable, 20) == WAIT_TIMEOUT) {
- return EWOULDBLOCK;
- }
-
- } else {
-
- WaitForSingleObject(pipePtr->writable, inExit ? 5000 : INFINITE);
-
- }
-
- TclPipeThreadStop(&pipePtr->writeTI, pipePtr->writeThread);
-
- CloseHandle(pipePtr->writable);
- CloseHandle(pipePtr->writeThread);
- pipePtr->writeThread = NULL;
- }
- if (TclpCloseFile(pipePtr->writeFile) != 0) {
- if (errorCode == 0) {
- errorCode = errno;
- }
- }
- pipePtr->validMask &= ~TCL_WRITABLE;
- pipePtr->writeFile = NULL;
- }
-
- pipePtr->watchMask &= pipePtr->validMask;
-
- /*
- * Don't free the channel if any of the flags were set.
- */
-
- if (flags) {
- return errorCode;
- }
-
- /*
- * Remove the file from the list of watched files.
- */
-
- for (nextPtrPtr = &(tsdPtr->firstPipePtr), infoPtr = *nextPtrPtr;
- infoPtr != NULL;
- nextPtrPtr = &infoPtr->nextPtr, infoPtr = *nextPtrPtr) {
- if (infoPtr == (PipeInfo *)pipePtr) {
- *nextPtrPtr = infoPtr->nextPtr;
- break;
- }
- }
-
- if ((pipePtr->flags & PIPE_ASYNC) || inExit) {
- /*
- * 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);
- Tcl_ReapDetachedProcs();
-
- if (pipePtr->errorFile) {
- if (TclpCloseFile(pipePtr->errorFile) != 0) {
- if (errorCode == 0) {
- errorCode = errno;
- }
- }
- }
- result = 0;
- } else {
- /*
- * Wrap the error file into a channel and give it to the cleanup
- * routine.
- */
-
- if (pipePtr->errorFile) {
- WinFile *filePtr = (WinFile *) pipePtr->errorFile;
-
- errChan = Tcl_MakeFileChannel((ClientData) filePtr->handle,
- TCL_READABLE);
- ckfree(filePtr);
- } else {
- errChan = NULL;
- }
-
- result = TclCleanupChildren(interp, pipePtr->numPids,
- pipePtr->pidPtr, errChan);
- }
-
- if (pipePtr->numPids > 0) {
- ckfree(pipePtr->pidPtr);
- }
-
- if (pipePtr->writeBuf != NULL) {
- ckfree(pipePtr->writeBuf);
- }
-
- ckfree(pipePtr);
-
- if (errorCode == 0) {
- return result;
- }
- return errorCode;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * PipeInputProc --
- *
- * 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.
- *
- * Side effects:
- * Reads input from the actual channel.
- *
- *----------------------------------------------------------------------
- */
-
-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. */
-{
- PipeInfo *infoPtr = (PipeInfo *) instanceData;
- WinFile *filePtr = (WinFile*) infoPtr->readFile;
- DWORD count, bytesRead = 0;
- int result;
-
- *errorCode = 0;
- /*
- * Synchronize with the reader thread.
- */
-
- result = WaitForRead(infoPtr, (infoPtr->flags & PIPE_ASYNC) ? 0 : 1);
-
- /*
- * If an error occurred, return immediately.
- */
-
- if (result == -1) {
- *errorCode = errno;
- return -1;
- }
-
- 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.
- */
-
- *buf = infoPtr->extraByte;
- infoPtr->readFlags &= ~PIPE_EXTRABYTE;
- buf++;
- bufSize--;
- bytesRead = 1;
-
- /*
- * If further read attempts would block, return what we have.
- */
-
- if (result == 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.
- */
-
- if (ReadFile(filePtr->handle, (LPVOID) buf, (DWORD) bufSize, &count,
- (LPOVERLAPPED) NULL) == TRUE) {
- return bytesRead + count;
- } else if (bytesRead) {
- /*
- * Ignore errors if we have data to return.
- */
-
- return bytesRead;
- }
-
- TclWinConvertError(GetLastError());
- if (errno == EPIPE) {
- infoPtr->readFlags |= PIPE_EOF;
- return 0;
- }
- *errorCode = errno;
- return -1;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * PipeOutputProc --
- *
- * 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.
- *
- * Side effects:
- * Writes output on the actual channel.
- *
- *----------------------------------------------------------------------
- */
-
-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. */
-{
- PipeInfo *infoPtr = (PipeInfo *) instanceData;
- WinFile *filePtr = (WinFile*) infoPtr->writeFile;
- DWORD bytesWritten, timeout;
-
- *errorCode = 0;
-
- /* avoid blocking if pipe-thread exited */
- timeout = ((infoPtr->flags & PIPE_ASYNC) || !TclPipeThreadIsAlive(&infoPtr->writeTI)
- || TclInExit() || TclInThreadExit()) ? 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.
- */
-
- errno = EWOULDBLOCK;
- goto error;
- }
-
- /*
- * Check for a background error on the last write.
- */
-
- if (infoPtr->writeError) {
- TclWinConvertError(infoPtr->writeError);
- infoPtr->writeError = 0;
- goto error;
- }
-
- if (infoPtr->flags & PIPE_ASYNC) {
- /*
- * The pipe 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(toWrite);
- }
- memcpy(infoPtr->writeBuf, buf, (size_t) toWrite);
- infoPtr->toWrite = toWrite;
- ResetEvent(infoPtr->writable);
- TclPipeThreadSignal(&infoPtr->writeTI);
- bytesWritten = toWrite;
- } else {
- /*
- * In the blocking case, just try to write the buffer directly. This
- * avoids an unnecessary copy.
- */
-
- if (WriteFile(filePtr->handle, (LPVOID) buf, (DWORD) toWrite,
- &bytesWritten, (LPOVERLAPPED) NULL) == FALSE) {
- TclWinConvertError(GetLastError());
- goto error;
- }
- }
- return bytesWritten;
-
- error:
- *errorCode = errno;
- return -1;
-
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * PipeEventProc --
- *
- * 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.
- *
- * Side effects:
- * Whatever the notifier callback does.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-PipeEventProc(
- Tcl_Event *evPtr, /* Event to service. */
- int flags) /* Flags that indicate what events to
- * handle, such as TCL_FILE_EVENTS. */
-{
- PipeEvent *pipeEvPtr = (PipeEvent *)evPtr;
- PipeInfo *infoPtr;
- int mask;
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-
- if (!(flags & TCL_FILE_EVENTS)) {
- return 0;
- }
-
- /*
- * 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.
- */
-
- for (infoPtr = tsdPtr->firstPipePtr; infoPtr != NULL;
- infoPtr = infoPtr->nextPtr) {
- if (pipeEvPtr->infoPtr == infoPtr) {
- infoPtr->flags &= ~(PIPE_PENDING);
- break;
- }
- }
-
- /*
- * Remove stale events.
- */
-
- if (!infoPtr) {
- return 1;
- }
-
- /*
- * 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;
- if ((infoPtr->watchMask & TCL_WRITABLE) &&
- (WaitForSingleObject(infoPtr->writable, 0) != WAIT_TIMEOUT)) {
- mask = TCL_WRITABLE;
- }
-
- if ((infoPtr->watchMask & TCL_READABLE) && (WaitForRead(infoPtr,0) >= 0)) {
- if (infoPtr->readFlags & PIPE_EOF) {
- mask = TCL_READABLE;
- } else {
- mask |= TCL_READABLE;
- }
- }
-
- /*
- * Inform the channel of the events.
- */
-
- Tcl_NotifyChannel(infoPtr->channel, infoPtr->watchMask & mask);
- return 1;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * PipeWatchProc --
- *
- * Called by the notifier to set up to watch for events on this channel.
- *
- * Results:
- * None.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-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. */
-{
- PipeInfo **nextPtrPtr, *ptr;
- PipeInfo *infoPtr = (PipeInfo *) instanceData;
- int oldMask = infoPtr->watchMask;
- 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.
- */
-
- infoPtr->watchMask = mask & infoPtr->validMask;
- if (infoPtr->watchMask) {
- Tcl_Time blockTime = { 0, 0 };
- if (!oldMask) {
- infoPtr->nextPtr = tsdPtr->firstPipePtr;
- tsdPtr->firstPipePtr = infoPtr;
- }
- Tcl_SetMaxBlockTime(&blockTime);
- } else {
- if (oldMask) {
- /*
- * Remove the pipe from the list of watched pipes.
- */
-
- for (nextPtrPtr = &(tsdPtr->firstPipePtr), ptr = *nextPtrPtr;
- ptr != NULL;
- nextPtrPtr = &ptr->nextPtr, ptr = *nextPtrPtr) {
- if (infoPtr == ptr) {
- *nextPtrPtr = ptr->nextPtr;
- break;
- }
- }
- }
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * PipeGetHandleProc --
- *
- * 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.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-PipeGetHandleProc(
- ClientData instanceData, /* The pipe state. */
- int direction, /* TCL_READABLE or TCL_WRITABLE */
- ClientData *handlePtr) /* Where to store the handle. */
-{
- PipeInfo *infoPtr = (PipeInfo *) instanceData;
- WinFile *filePtr;
-
- if (direction == TCL_READABLE && infoPtr->readFile) {
- filePtr = (WinFile*) infoPtr->readFile;
- *handlePtr = (ClientData) filePtr->handle;
- return TCL_OK;
- }
- if (direction == TCL_WRITABLE && infoPtr->writeFile) {
- filePtr = (WinFile*) infoPtr->writeFile;
- *handlePtr = (ClientData) filePtr->handle;
- return TCL_OK;
- }
- return TCL_ERROR;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_WaitPid --
- *
- * 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.
- *
- * 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.
- *
- *----------------------------------------------------------------------
- */
-
-Tcl_Pid
-Tcl_WaitPid(
- Tcl_Pid pid,
- int *statPtr,
- int options)
-{
- ProcInfo *infoPtr = NULL, **prevPtrPtr;
- DWORD flags;
- Tcl_Pid result;
- DWORD ret, exitCode;
-
- PipeInit();
-
- /*
- * If no pid is specified, do nothing.
- */
-
- if (pid == 0) {
- *statPtr = 0;
- return 0;
- }
-
- /*
- * Find the process and cut it from the process list.
- */
-
- Tcl_MutexLock(&pipeMutex);
- prevPtrPtr = &procList;
- for (infoPtr = procList; infoPtr != NULL;
- prevPtrPtr = &infoPtr->nextPtr, infoPtr = infoPtr->nextPtr) {
- if (infoPtr->hProcess == (HANDLE) pid) {
- *prevPtrPtr = infoPtr->nextPtr;
- break;
- }
- }
- Tcl_MutexUnlock(&pipeMutex);
-
- /*
- * If the pid is not one of the processes we know about (we started it)
- * then do nothing.
- */
-
- if (infoPtr == NULL) {
- *statPtr = 0;
- return 0;
- }
-
- /*
- * Officially "wait" for it to finish. We either poll (WNOHANG) or wait
- * for an infinite amount of time.
- */
-
- if (options & WNOHANG) {
- flags = 0;
- } else {
- flags = INFINITE;
- }
- ret = WaitForSingleObject(infoPtr->hProcess, flags);
- if (ret == WAIT_TIMEOUT) {
- *statPtr = 0;
- if (options & WNOHANG) {
- /*
- * Re-insert this infoPtr back on the list.
- */
-
- Tcl_MutexLock(&pipeMutex);
- infoPtr->nextPtr = procList;
- procList = infoPtr;
- Tcl_MutexUnlock(&pipeMutex);
- return 0;
- } else {
- result = 0;
- }
- } else if (ret == WAIT_OBJECT_0) {
- GetExitCodeProcess(infoPtr->hProcess, &exitCode);
-
- /*
- * Does the exit code look like one of the exception codes?
- */
-
- 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;
-
- 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.
- */
-
- *statPtr = exitCode;
- break;
- }
- result = pid;
- } else {
- errno = ECHILD;
- *statPtr = 0xC0000000 | ECHILD;
- result = (Tcl_Pid) -1;
- }
-
- /*
- * Officially close the process handle.
- */
-
- CloseHandle(infoPtr->hProcess);
- ckfree(infoPtr);
-
- return result;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclWinAddProcess --
- *
- * Add a process to the process list so that we can use Tcl_WaitPid on
- * the process.
- *
- * Results:
- * None
- *
- * Side effects:
- * Adds the specified process handle to the process list so Tcl_WaitPid
- * knows about it.
- *
- *----------------------------------------------------------------------
- */
-
-void
-TclWinAddProcess(
- void *hProcess, /* Handle to process */
- unsigned long id) /* Global process identifier */
-{
- ProcInfo *procPtr = ckalloc(sizeof(ProcInfo));
-
- PipeInit();
-
- procPtr->hProcess = hProcess;
- procPtr->dwProcessId = id;
- Tcl_MutexLock(&pipeMutex);
- procPtr->nextPtr = procList;
- procList = procPtr;
- Tcl_MutexUnlock(&pipeMutex);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_PidObjCmd --
- *
- * 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.
- *
- * Side effects:
- * See the user documentation.
- *
- *----------------------------------------------------------------------
- */
-
- /* ARGSUSED */
-int
-Tcl_PidObjCmd(
- ClientData dummy, /* Not used. */
- Tcl_Interp *interp, /* Current interpreter. */
- int objc, /* Number of arguments. */
- Tcl_Obj *const *objv) /* Argument strings. */
-{
- Tcl_Channel chan;
- const Tcl_ChannelType *chanTypePtr;
- PipeInfo *pipePtr;
- int i;
- Tcl_Obj *resultPtr;
-
- if (objc > 2) {
- Tcl_WrongNumArgs(interp, 1, objv, "?channelId?");
- return TCL_ERROR;
- }
- if (objc == 1) {
- Tcl_SetObjResult(interp, Tcl_NewWideIntObj((unsigned) getpid()));
- } else {
- chan = Tcl_GetChannel(interp, Tcl_GetString(objv[1]),
- NULL);
- if (chan == (Tcl_Channel) NULL) {
- return TCL_ERROR;
- }
- chanTypePtr = Tcl_GetChannelType(chan);
- if (chanTypePtr != &pipeChannelType) {
- return TCL_OK;
- }
-
- pipePtr = (PipeInfo *) Tcl_GetChannelInstanceData(chan);
- resultPtr = Tcl_NewObj();
- for (i = 0; i < pipePtr->numPids; i++) {
- Tcl_ListObjAppendElement(/*interp*/ NULL, resultPtr,
- Tcl_NewWideIntObj((unsigned)
- TclpGetPid(pipePtr->pidPtr[i])));
- }
- Tcl_SetObjResult(interp, resultPtr);
- }
- return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * 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).
- *
- * 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.
- *
- * 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.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-WaitForRead(
- PipeInfo *infoPtr, /* Pipe state. */
- int blocking) /* Indicates whether call should be blocking
- * or not. */
-{
- DWORD timeout, count;
- HANDLE *handle = ((WinFile *) infoPtr->readFile)->handle;
-
- while (1) {
- /*
- * Synchronize with the reader thread.
- */
-
- /* avoid blocking if pipe-thread exited */
- timeout = (!blocking || !TclPipeThreadIsAlive(&infoPtr->readTI)
- || TclInExit() || TclInThreadExit()) ? 0 : INFINITE;
- if (WaitForSingleObject(infoPtr->readable, timeout) == WAIT_TIMEOUT) {
- /*
- * The reader thread is blocked waiting for data and the channel
- * is in non-blocking mode.
- */
-
- errno = EWOULDBLOCK;
- return -1;
- }
-
- /*
- * 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.
- */
-
- if (infoPtr->readFlags & PIPE_EOF) {
- return 1;
- }
-
- /*
- * Check to see if there is any data sitting in the pipe.
- */
-
- 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.
- */
-
- if (errno == EPIPE) {
- infoPtr->readFlags |= PIPE_EOF;
- return 1;
- }
-
- /*
- * Ignore errors if there is data in the buffer.
- */
-
- if (infoPtr->readFlags & PIPE_EXTRABYTE) {
- return 0;
- } else {
- return -1;
- }
- }
-
- /*
- * We found some data in the pipe, so it must be readable.
- */
-
- if (count > 0) {
- return 1;
- }
-
- /*
- * The pipe isn't readable, but there is some data sitting in the
- * buffer, so return immediately.
- */
-
- if (infoPtr->readFlags & PIPE_EXTRABYTE) {
- return 0;
- }
-
- /*
- * There wasn't any data available, so reset the thread and try again.
- */
-
- ResetEvent(infoPtr->readable);
- TclPipeThreadSignal(&infoPtr->readTI);
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * PipeReaderThread --
- *
- * 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().
- *
- *----------------------------------------------------------------------
- */
-
-static DWORD WINAPI
-PipeReaderThread(
- LPVOID arg)
-{
- TclPipeThreadInfo *pipeTI = (TclPipeThreadInfo *)arg;
- PipeInfo *infoPtr = NULL; /* access info only after success init/wait */
- HANDLE handle = NULL;
- DWORD count, err;
- int done = 0;
-
- while (!done) {
- /*
- * Wait for the main thread to signal before attempting to wait on the
- * pipe becoming readable.
- */
- if (!TclPipeThreadWaitForSignal(&pipeTI)) {
- /* exit */
- break;
- }
-
- if (!infoPtr) {
- infoPtr = (PipeInfo *)pipeTI->clientData;
- handle = ((WinFile *) infoPtr->readFile)->handle;
- }
-
- /*
- * 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) {
- /*
- * The error is a result of an EOF condition, so set the EOF bit
- * before signalling the main thread.
- */
-
- err = GetLastError();
- if (err == ERROR_BROKEN_PIPE) {
- infoPtr->readFlags |= PIPE_EOF;
- done = 1;
- } else if (err == ERROR_INVALID_HANDLE) {
- done = 1;
- }
- } else if (count == 0) {
- 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.
- */
-
- infoPtr->readFlags |= PIPE_EXTRABYTE;
- } else {
- err = GetLastError();
- if (err == ERROR_BROKEN_PIPE) {
- /*
- * The error is a result of an EOF condition, so set the
- * EOF bit before signalling the main thread.
- */
-
- infoPtr->readFlags |= PIPE_EOF;
- done = 1;
- } else if (err == ERROR_INVALID_HANDLE) {
- done = 1;
- }
- }
- }
-
- /*
- * 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.
- */
-
- Tcl_MutexLock(&pipeMutex);
- if (infoPtr->threadId != NULL) {
- /*
- * TIP #218. When in flight ignore the event, no one will receive
- * it anyway.
- */
-
- Tcl_ThreadAlert(infoPtr->threadId);
- }
- Tcl_MutexUnlock(&pipeMutex);
- }
-
- /*
- * If state of thread was set to stop, we can sane free info structure,
- * otherwise it is shared with main thread, so main thread will own it
- */
- TclPipeThreadExit(&pipeTI);
-
- return 0;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * PipeWriterThread --
- *
- * 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.
- *
- *----------------------------------------------------------------------
- */
-
-static DWORD WINAPI
-PipeWriterThread(
- LPVOID arg)
-{
- TclPipeThreadInfo *pipeTI = (TclPipeThreadInfo *)arg;
- PipeInfo *infoPtr = NULL; /* access info only after success init/wait */
- HANDLE handle = NULL;
- DWORD count, toWrite;
- char *buf;
- int done = 0;
-
- while (!done) {
- /*
- * Wait for the main thread to signal before attempting to write.
- */
- if (!TclPipeThreadWaitForSignal(&pipeTI)) {
- /* exit */
- break;
- }
-
- if (!infoPtr) {
- infoPtr = (PipeInfo *)pipeTI->clientData;
- handle = ((WinFile *) infoPtr->writeFile)->handle;
- }
-
- buf = infoPtr->writeBuf;
- toWrite = infoPtr->toWrite;
-
- /*
- * Loop until all of the bytes are written or an error occurs.
- */
-
- while (toWrite > 0) {
- if (WriteFile(handle, buf, toWrite, &count, NULL) == FALSE) {
- infoPtr->writeError = GetLastError();
- done = 1;
- break;
- } else {
- toWrite -= count;
- buf += count;
- }
- }
-
- /*
- * 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.
- */
-
- Tcl_MutexLock(&pipeMutex);
- if (infoPtr->threadId != NULL) {
- /*
- * TIP #218. When in flight ignore the event, no one will receive
- * it anyway.
- */
-
- Tcl_ThreadAlert(infoPtr->threadId);
- }
- Tcl_MutexUnlock(&pipeMutex);
- }
-
- /*
- * If state of thread was set to stop, we can sane free info structure,
- * otherwise it is shared with main thread, so main thread will own it.
- */
- TclPipeThreadExit(&pipeTI);
-
- return 0;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * PipeThreadActionProc --
- *
- * Insert or remove any thread local refs to this channel.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Changes thread local list of valid channels.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-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.
- */
-
- 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.
- */
-
- PipeInit();
- if (infoPtr->channel != NULL) {
- infoPtr->threadId = Tcl_GetChannelThread(infoPtr->channel);
- }
- } else {
- infoPtr->threadId = NULL;
- }
- Tcl_MutexUnlock(&pipeMutex);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclpOpenTemporaryFile --
- *
- * Creates a temporary file, possibly based on the supplied bits and
- * pieces of template supplied in the first three arguments. If the
- * fourth argument is non-NULL, it contains a Tcl_Obj to store the name
- * of the temporary file in (and it is caller's responsibility to clean
- * up). If the fourth argument is NULL, try to arrange for the temporary
- * file to go away once it is no longer needed.
- *
- * Results:
- * A read-write Tcl Channel open on the file.
- *
- *----------------------------------------------------------------------
- */
-
-Tcl_Channel
-TclpOpenTemporaryFile(
- Tcl_Obj *dirObj,
- Tcl_Obj *basenameObj,
- Tcl_Obj *extensionObj,
- Tcl_Obj *resultingNameObj)
-{
- TCHAR name[MAX_PATH];
- char *namePtr;
- HANDLE handle;
- DWORD flags = FILE_ATTRIBUTE_TEMPORARY;
- int length, counter, counter2;
- Tcl_DString buf;
-
- if (!resultingNameObj) {
- flags |= FILE_FLAG_DELETE_ON_CLOSE;
- }
-
- namePtr = (char *) name;
- length = GetTempPath(MAX_PATH, name);
- if (length == 0) {
- goto gotError;
- }
- namePtr += length * sizeof(TCHAR);
- if (basenameObj) {
- const char *string = Tcl_GetString(basenameObj);
-
- Tcl_WinUtfToTChar(string, basenameObj->length, &buf);
- memcpy(namePtr, Tcl_DStringValue(&buf), Tcl_DStringLength(&buf));
- namePtr += Tcl_DStringLength(&buf);
- Tcl_DStringFree(&buf);
- } else {
- const TCHAR *baseStr = TEXT("TCL");
- int length = 3 * sizeof(TCHAR);
-
- memcpy(namePtr, baseStr, length);
- namePtr += length;
- }
- counter = TclpGetClicks() % 65533;
- counter2 = 1024; /* Only try this many times! Prevents
- * an infinite loop. */
-
- do {
- char number[TCL_INTEGER_SPACE + 4];
-
- sprintf(number, "%d.TMP", counter);
- counter = (unsigned short) (counter + 1);
- Tcl_WinUtfToTChar(number, strlen(number), &buf);
- Tcl_DStringSetLength(&buf, Tcl_DStringLength(&buf) + 1);
- memcpy(namePtr, Tcl_DStringValue(&buf), Tcl_DStringLength(&buf) + 1);
- Tcl_DStringFree(&buf);
-
- handle = CreateFile(name,
- GENERIC_READ|GENERIC_WRITE, 0, NULL, CREATE_NEW, flags, NULL);
- } while (handle == INVALID_HANDLE_VALUE
- && --counter2 > 0
- && GetLastError() == ERROR_FILE_EXISTS);
- if (handle == INVALID_HANDLE_VALUE) {
- goto gotError;
- }
-
- if (resultingNameObj) {
- Tcl_Obj *tmpObj = TclpNativeToNormalized(name);
-
- Tcl_AppendObjToObj(resultingNameObj, tmpObj);
- TclDecrRefCount(tmpObj);
- }
-
- return Tcl_MakeFileChannel((ClientData) handle,
- TCL_READABLE|TCL_WRITABLE);
-
- gotError:
- TclWinConvertError(GetLastError());
- return NULL;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclPipeThreadCreateTI --
- *
- * Creates a thread info structure, can be owned by worker.
- *
- * Results:
- * Pointer to created TI structure.
- *
- *----------------------------------------------------------------------
- */
-
-TclPipeThreadInfo *
-TclPipeThreadCreateTI(
- TclPipeThreadInfo **pipeTIPtr,
- ClientData clientData,
- HANDLE wakeEvent)
-{
- TclPipeThreadInfo *pipeTI;
-#ifndef _PTI_USE_CKALLOC
- pipeTI = malloc(sizeof(TclPipeThreadInfo));
-#else
- pipeTI = ckalloc(sizeof(TclPipeThreadInfo));
-#endif
- pipeTI->evControl = CreateEvent(NULL, FALSE, FALSE, NULL);
- pipeTI->state = PTI_STATE_IDLE;
- pipeTI->clientData = clientData;
- pipeTI->evWakeUp = wakeEvent;
- return (*pipeTIPtr = pipeTI);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclPipeThreadWaitForSignal --
- *
- * Wait for work/stop signals inside pipe worker.
- *
- * Results:
- * 1 if signaled to work, 0 if signaled to stop.
- *
- * Side effects:
- * If this function returns 0, TI-structure pointer given via pipeTIPtr
- * may be NULL, so not accessible (can be owned by main thread).
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclPipeThreadWaitForSignal(
- TclPipeThreadInfo **pipeTIPtr)
-{
- TclPipeThreadInfo *pipeTI = *pipeTIPtr;
- LONG state;
- DWORD waitResult;
- HANDLE wakeEvent;
-
- if (!pipeTI) {
- return 0;
- }
-
- wakeEvent = pipeTI->evWakeUp;
- /*
- * Wait for the main thread to signal before attempting to do the work.
- */
-
- /* reset work state of thread (idle/waiting) */
- if ((state = InterlockedCompareExchange(&pipeTI->state,
- PTI_STATE_IDLE, PTI_STATE_WORK)) & (PTI_STATE_STOP|PTI_STATE_END)) {
- /* end of work, check the owner of structure */
- goto end;
- }
- /* entering wait */
- waitResult = WaitForSingleObject(pipeTI->evControl, INFINITE);
-
- if (waitResult != WAIT_OBJECT_0) {
-
- /*
- * The control event was not signaled, so end of work (unexpected
- * behaviour, main thread can be dead?).
- */
- goto end;
- }
-
- /* try to set work state of thread */
- if ((state = InterlockedCompareExchange(&pipeTI->state,
- PTI_STATE_WORK, PTI_STATE_IDLE)) & (PTI_STATE_STOP|PTI_STATE_END)) {
- /* end of work */
- goto end;
- }
-
- /* signaled to work */
- return 1;
-
-end:
- /* end of work, check the owner of the TI structure */
- if (state != PTI_STATE_STOP) {
- *pipeTIPtr = NULL;
- } else {
- pipeTI->evWakeUp = NULL;
- }
- if (wakeEvent) {
- SetEvent(wakeEvent);
- }
- return 0;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclPipeThreadStopSignal --
- *
- * Send stop signal to the pipe worker (without waiting).
- *
- * After calling of this function, TI-structure pointer given via pipeTIPtr
- * may be NULL.
- *
- * Results:
- * 1 if signaled (or pipe-thread is down), 0 if pipe thread still working.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclPipeThreadStopSignal(
- TclPipeThreadInfo **pipeTIPtr, HANDLE wakeEvent)
-{
- TclPipeThreadInfo *pipeTI = *pipeTIPtr;
- HANDLE evControl;
- int state;
-
- if (!pipeTI) {
- return 1;
- }
- evControl = pipeTI->evControl;
- pipeTI->evWakeUp = wakeEvent;
- switch (
- (state = InterlockedCompareExchange(&pipeTI->state,
- PTI_STATE_STOP, PTI_STATE_IDLE))
- ) {
-
- case PTI_STATE_IDLE:
-
- /* Thread was idle/waiting, notify it goes teardown */
- SetEvent(evControl);
-
- *pipeTIPtr = NULL;
-
- case PTI_STATE_DOWN:
-
- return 1;
-
- default:
- /*
- * Thread works currently, we should try to end it, own the TI structure
- * (because of possible sharing the joint structures with thread)
- */
- InterlockedExchange(&pipeTI->state, PTI_STATE_END);
- break;
- }
-
- return 0;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclPipeThreadStop --
- *
- * Send stop signal to the pipe worker and wait for thread completion.
- *
- * May be combined with TclPipeThreadStopSignal.
- *
- * After calling of this function, TI-structure pointer given via pipeTIPtr
- * is not accessible (owned by pipe worker or released here).
- *
- * Results:
- * None.
- *
- * Side effects:
- * Can terminate pipe worker (and / or stop its synchronous operations).
- *
- *----------------------------------------------------------------------
- */
-
-void
-TclPipeThreadStop(
- TclPipeThreadInfo **pipeTIPtr,
- HANDLE hThread)
-{
- TclPipeThreadInfo *pipeTI = *pipeTIPtr;
- HANDLE evControl;
- int state;
-
- if (!pipeTI) {
- return;
- }
- pipeTI = *pipeTIPtr;
- evControl = pipeTI->evControl;
- pipeTI->evWakeUp = NULL;
- /*
- * Try to sane stop the pipe worker, corresponding its current state
- */
- switch (
- (state = InterlockedCompareExchange(&pipeTI->state,
- PTI_STATE_STOP, PTI_STATE_IDLE))
- ) {
-
- case PTI_STATE_IDLE:
-
- /* Thread was idle/waiting, notify it goes teardown */
- SetEvent(evControl);
-
- /* we don't need to wait for it at all, thread frees himself (owns the TI structure) */
- pipeTI = NULL;
- break;
-
- case PTI_STATE_STOP:
- /* already stopped, thread frees himself (owns the TI structure) */
- pipeTI = NULL;
- break;
- case PTI_STATE_DOWN:
- /* Thread already down (?), do nothing */
-
- /* we don't need to wait for it, but we should free pipeTI */
- hThread = NULL;
- break;
-
- /* case PTI_STATE_WORK: */
- default:
- /*
- * Thread works currently, we should try to end it, own the TI structure
- * (because of possible sharing the joint structures with thread)
- */
- if ((state = InterlockedCompareExchange(&pipeTI->state,
- PTI_STATE_END, PTI_STATE_WORK)) == PTI_STATE_DOWN
- ) {
- /* we don't need to wait for it, but we should free pipeTI */
- hThread = NULL;
- };
- break;
- }
-
- if (pipeTI && hThread) {
- DWORD exitCode;
-
- /*
- * The thread may already have closed on its own. Check its exit
- * code.
- */
-
- GetExitCodeThread(hThread, &exitCode);
-
- if (exitCode == STILL_ACTIVE) {
-
- int inExit = (TclInExit() || TclInThreadExit());
- /*
- * Set the stop event so that if the pipe thread is blocked
- * somewhere, it may hereafter sane exit cleanly.
- */
-
- SetEvent(evControl);
-
- /*
- * Cancel all sync-IO of this thread (may be blocked there).
- */
- if (tclWinProcs.cancelSynchronousIo) {
- tclWinProcs.cancelSynchronousIo(hThread);
- }
-
- /*
- * Wait at most 20 milliseconds for the reader thread to
- * close (regarding TIP#398-fast-exit).
- */
-
- /* if we want TIP#398-fast-exit. */
- if (WaitForSingleObject(hThread, inExit ? 0 : 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
- * 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.
- *
- * 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.
- *
- * Also note that terminating threads during their initialization or teardown phase
- * may result in ntdll.dll's LoaderLock to remain locked indefinitely.
- * This causes ntdll.dll's LdrpInitializeThread() to deadlock trying to acquire LoaderLock.
- * LdrpInitializeThread() is executed within new threads to perform
- * initialization and to execute DllMain() of all loaded dlls.
- * As a result, all new threads are deadlocked in their initialization phase and never execute,
- * even though CreateThread() reports successful thread creation.
- * This results in a very weird process-wide behavior, which is extremely hard to debug.
- *
- * THREADS SHOULD NEVER BE TERMINATED. Period.
- *
- * But for now, check if thread is exiting, and if so, let it die peacefully.
- *
- * Also don't terminate if in exit (otherwise deadlocked in ntdll.dll's).
- */
-
- if ( pipeTI->state != PTI_STATE_DOWN
- && WaitForSingleObject(hThread,
- inExit ? 50 : 5000) != WAIT_OBJECT_0
- ) {
- /* BUG: this leaks memory */
- if (inExit || !TerminateThread(hThread, 0)) {
- /* in exit or terminate fails, just give thread a chance to exit */
- if (InterlockedExchange(&pipeTI->state,
- PTI_STATE_STOP) != PTI_STATE_DOWN) {
- pipeTI = NULL;
- }
- };
- }
- }
- }
- }
-
- *pipeTIPtr = NULL;
- if (pipeTI) {
- if (pipeTI->evWakeUp) {
- SetEvent(pipeTI->evWakeUp);
- }
- CloseHandle(pipeTI->evControl);
- #ifndef _PTI_USE_CKALLOC
- free(pipeTI);
- #else
- ckfree(pipeTI);
- #endif
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclPipeThreadExit --
- *
- * Clean-up for the pipe thread (removes owned TI-structure in worker).
- *
- * Should be executed on worker exit, to inform the main thread or
- * free TI-structure (if owned).
- *
- * After calling of this function, TI-structure pointer given via pipeTIPtr
- * is not accessible (owned by main thread or released here).
- *
- * Results:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-void
-TclPipeThreadExit(
- TclPipeThreadInfo **pipeTIPtr)
-{
- LONG state;
- TclPipeThreadInfo *pipeTI = *pipeTIPtr;
- /*
- * If state of thread was set to stop (exactly), we can sane free its info
- * structure, otherwise it is shared with main thread, so main thread will
- * own it.
- */
- if (!pipeTI) {
- return;
- }
- *pipeTIPtr = NULL;
- if ((state = InterlockedExchange(&pipeTI->state,
- PTI_STATE_DOWN)) == PTI_STATE_STOP) {
- CloseHandle(pipeTI->evControl);
- if (pipeTI->evWakeUp) {
- SetEvent(pipeTI->evWakeUp);
- }
- #ifndef _PTI_USE_CKALLOC
- free(pipeTI);
- #else
- ckfree(pipeTI);
- /* be sure all subsystems used are finalized */
- Tcl_FinalizeThread();
- #endif
- }
-}
-
-/*
- * Local Variables:
- * mode: c
- * c-basic-offset: 4
- * fill-column: 78
- * End:
- */
diff --git a/tcl8.6/win/tclWinPort.h b/tcl8.6/win/tclWinPort.h
deleted file mode 100644
index 29b1447..0000000
--- a/tcl8.6/win/tclWinPort.h
+++ /dev/null
@@ -1,574 +0,0 @@
-/*
- * tclWinPort.h --
- *
- * This header file handles porting issues that occur because of
- * differences between Windows and Unix. It should be the only
- * file that contains #ifdefs to handle different flavors of OS.
- *
- * Copyright (c) 1994-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.
- */
-
-#ifndef _TCLWINPORT
-#define _TCLWINPORT
-
-#if !defined(_WIN64) && defined(BUILD_tcl)
-/* See [Bug 3354324]: file mtime sets wrong time */
-# define _USE_32BIT_TIME_T
-#endif
-
-/*
- * We must specify the lower version we intend to support.
- *
- * WINVER = 0x0500 means Windows 2000 and above
- */
-
-#ifndef WINVER
-# define WINVER 0x0501
-#endif
-#ifndef _WIN32_WINNT
-# define _WIN32_WINNT 0x0501
-#endif
-
-#define WIN32_LEAN_AND_MEAN
-#include <windows.h>
-#undef WIN32_LEAN_AND_MEAN
-
-/* 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>
-#include <ws2tcpip.h>
-#ifdef HAVE_WSPIAPI_H
-# include <wspiapi.h>
-#endif
-
-#ifdef CHECK_UNICODE_CALLS
-# define _UNICODE
-# define UNICODE
-# define __TCHAR_DEFINED
- typedef float *_TCHAR;
-# define _TCHAR_DEFINED
- typedef float *TCHAR;
-#endif /* CHECK_UNICODE_CALLS */
-
-/*
- * Pull in the typedef of TCHAR for windows.
- */
-#include <tchar.h>
-#ifndef _TCHAR_DEFINED
- /* Borland seems to forget to set this. */
- typedef _TCHAR TCHAR;
-# define _TCHAR_DEFINED
-#endif
-#if defined(_MSC_VER) && defined(__STDC__)
- /* VS2005 SP1 misses this. See [Bug #3110161] */
- typedef _TCHAR TCHAR;
-#endif
-
-/*
- *---------------------------------------------------------------------------
- * The following sets of #includes and #ifdefs are required to get Tcl to
- * compile under the windows compilers.
- *---------------------------------------------------------------------------
- */
-
-#include <time.h>
-#include <wchar.h>
-#include <io.h>
-#include <errno.h>
-#include <fcntl.h>
-#include <float.h>
-#include <malloc.h>
-#include <process.h>
-#include <signal.h>
-#include <limits.h>
-
-#ifndef __GNUC__
-# define strncasecmp _strnicmp
-# define strcasecmp _stricmp
-#endif
-
-/*
- * Need to block out these includes for building extensions with MetroWerks
- * compiler for Win32.
- */
-
-#ifndef __MWERKS__
-#include <sys/stat.h>
-#include <sys/timeb.h>
-# ifdef __BORLANDC__
-# include <utime.h>
-# else
-# include <sys/utime.h>
-# endif /* __BORLANDC__ */
-#endif /* __MWERKS__ */
-
-/*
- * The following defines redefine the Windows Socket errors as
- * BSD errors so Tcl_PosixError can do the right thing.
- */
-
-#ifndef ENOTEMPTY
-# define ENOTEMPTY 41 /* Directory not empty */
-#endif
-#ifndef EREMOTE
-# define EREMOTE 66 /* The object is remote */
-#endif
-#ifndef EPFNOSUPPORT
-# define EPFNOSUPPORT 96 /* Protocol family not supported */
-#endif
-#ifndef EADDRINUSE
-# define EADDRINUSE 100 /* Address already in use */
-#endif
-#ifndef EADDRNOTAVAIL
-# define EADDRNOTAVAIL 101 /* Can't assign requested address */
-#endif
-#ifndef EAFNOSUPPORT
-# define EAFNOSUPPORT 102 /* Address family not supported */
-#endif
-#ifndef EALREADY
-# define EALREADY 103 /* Operation already in progress */
-#endif
-#ifndef EBADMSG
-# define EBADMSG 104 /* Not a data message */
-#endif
-#ifndef ECANCELED
-# define ECANCELED 105 /* Canceled */
-#endif
-#ifndef ECONNABORTED
-# define ECONNABORTED 106 /* Software caused connection abort */
-#endif
-#ifndef ECONNREFUSED
-# define ECONNREFUSED 107 /* Connection refused */
-#endif
-#ifndef ECONNRESET
-# define ECONNRESET 108 /* Connection reset by peer */
-#endif
-#ifndef EDESTADDRREQ
-# define EDESTADDRREQ 109 /* Destination address required */
-#endif
-#ifndef EHOSTUNREACH
-# define EHOSTUNREACH 110 /* No route to host */
-#endif
-#ifndef EIDRM
-# define EIDRM 111 /* Identifier removed */
-#endif
-#ifndef EINPROGRESS
-# define EINPROGRESS 112 /* Operation now in progress */
-#endif
-#ifndef EISCONN
-# define EISCONN 113 /* Socket is already connected */
-#endif
-#ifndef ELOOP
-# define ELOOP 114 /* Symbolic link loop */
-#endif
-#ifndef EMSGSIZE
-# define EMSGSIZE 115 /* Message too long */
-#endif
-#ifndef ENETDOWN
-# define ENETDOWN 116 /* Network is down */
-#endif
-#ifndef ENETRESET
-# define ENETRESET 117 /* Network dropped connection on reset */
-#endif
-#ifndef ENETUNREACH
-# define ENETUNREACH 118 /* Network is unreachable */
-#endif
-#ifndef ENOBUFS
-# define ENOBUFS 119 /* No buffer space available */
-#endif
-#ifndef ENODATA
-# define ENODATA 120 /* No data available */
-#endif
-#ifndef ENOLINK
-# define ENOLINK 121 /* Link has be severed */
-#endif
-#ifndef ENOMSG
-# define ENOMSG 122 /* No message of desired type */
-#endif
-#ifndef ENOPROTOOPT
-# define ENOPROTOOPT 123 /* Protocol not available */
-#endif
-#ifndef ENOSR
-# define ENOSR 124 /* Out of stream resources */
-#endif
-#ifndef ENOSTR
-# define ENOSTR 125 /* Not a stream device */
-#endif
-#ifndef ENOTCONN
-# define ENOTCONN 126 /* Socket is not connected */
-#endif
-#ifndef ENOTRECOVERABLE
-# define ENOTRECOVERABLE 127 /* Not recoverable */
-#endif
-#ifndef ENOTSOCK
-# define ENOTSOCK 128 /* Socket operation on non-socket */
-#endif
-#ifndef ENOTSUP
-# define ENOTSUP 129 /* Operation not supported */
-#endif
-#ifndef EOPNOTSUPP
-# define EOPNOTSUPP 130 /* Operation not supported on socket */
-#endif
-#ifndef EOTHER
-# define EOTHER 131 /* Other error */
-#endif
-#ifndef EOVERFLOW
-# define EOVERFLOW 132 /* File too big */
-#endif
-#ifndef EOWNERDEAD
-# define EOWNERDEAD 133 /* Owner dead */
-#endif
-#ifndef EPROTO
-# define EPROTO 134 /* Protocol error */
-#endif
-#ifndef EPROTONOSUPPORT
-# define EPROTONOSUPPORT 135 /* Protocol not supported */
-#endif
-#ifndef EPROTOTYPE
-# define EPROTOTYPE 136 /* Protocol wrong type for socket */
-#endif
-#ifndef ETIME
-# define ETIME 137 /* Timer expired */
-#endif
-#ifndef ETIMEDOUT
-# define ETIMEDOUT 138 /* Connection timed out */
-#endif
-#ifndef ETXTBSY
-# define ETXTBSY 139 /* Text file or pseudo-device busy */
-#endif
-#ifndef EWOULDBLOCK
-# define EWOULDBLOCK 140 /* Operation would block */
-#endif
-
-
-/* Visual Studio doesn't have these, so just choose some high numbers */
-#ifndef ESOCKTNOSUPPORT
-# define ESOCKTNOSUPPORT 240 /* Socket type not supported */
-#endif
-#ifndef ESHUTDOWN
-# define ESHUTDOWN 241 /* Can't send after socket shutdown */
-#endif
-#ifndef ETOOMANYREFS
-# define ETOOMANYREFS 242 /* Too many references: can't splice */
-#endif
-#ifndef EHOSTDOWN
-# define EHOSTDOWN 243 /* Host is down */
-#endif
-#ifndef EUSERS
-# define EUSERS 244 /* Too many users (for UFS) */
-#endif
-#ifndef EDQUOT
-# define EDQUOT 245 /* Disc quota exceeded */
-#endif
-#ifndef ESTALE
-# define ESTALE 246 /* Stale NFS file handle */
-#endif
-
-/*
- * 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.
- */
-
-#if TCL_UNION_WAIT
-# define WAIT_STATUS_TYPE union wait
-#else
-# define WAIT_STATUS_TYPE int
-#endif /* TCL_UNION_WAIT */
-
-#ifndef WIFEXITED
-# define WIFEXITED(stat) (((*((int *) &(stat))) & 0xC0000000) == 0)
-#endif
-
-#ifndef WEXITSTATUS
-# define WEXITSTATUS(stat) (*((int *) &(stat)))
-#endif
-
-#ifndef WIFSIGNALED
-# define WIFSIGNALED(stat) ((*((int *) &(stat))) & 0xC0000000)
-#endif
-
-#ifndef WTERMSIG
-# define WTERMSIG(stat) ((*((int *) &(stat))) & 0x7f)
-#endif
-
-#ifndef WIFSTOPPED
-# define WIFSTOPPED(stat) 0
-#endif
-
-#ifndef WSTOPSIG
-# define WSTOPSIG(stat) (((*((int *) &(stat))) >> 8) & 0xff)
-#endif
-
-/*
- * Define constants for waitpid() system call if they aren't defined
- * by a system header file.
- */
-
-#ifndef WNOHANG
-# define WNOHANG 1
-#endif
-#ifndef WUNTRACED
-# define WUNTRACED 2
-#endif
-
-/*
- * Define access mode constants if they aren't already defined.
- */
-
-#ifndef F_OK
-# define F_OK 00
-#endif
-#ifndef X_OK
-# define X_OK 01
-#endif
-#ifndef W_OK
-# define W_OK 02
-#endif
-#ifndef R_OK
-# define R_OK 04
-#endif
-
-/*
- * Define macros to query file type bits, if they're not already
- * defined.
- */
-
-#ifndef S_IFLNK
-# define S_IFLNK 0120000 /* Symbolic Link */
-#endif
-
-/*
- * Windows compilers do not define S_IFBLK. However, Tcl uses it in
- * GetTypeFromMode to identify blockSpecial devices based on the
- * value in the statsbuf st_mode field. We have no other way to pass this
- * from NativeStat on Windows so are forced to define it here.
- * The definition here is essentially what is seen on Linux and MingW.
- * XXX - the root problem is Tcl using Unix definitions instead of
- * abstracting the structure into a platform independent one. Sigh - perhaps
- * Tcl 9
- */
-#ifndef S_IFBLK
-# define S_IFBLK (S_IFDIR | S_IFCHR)
-#endif
-
-#ifndef S_ISREG
-# ifdef S_IFREG
-# define S_ISREG(m) (((m) & S_IFMT) == S_IFREG)
-# else
-# define S_ISREG(m) 0
-# endif
-#endif /* !S_ISREG */
-#ifndef S_ISDIR
-# ifdef S_IFDIR
-# define S_ISDIR(m) (((m) & S_IFMT) == S_IFDIR)
-# else
-# define S_ISDIR(m) 0
-# endif
-#endif /* !S_ISDIR */
-#ifndef S_ISCHR
-# ifdef S_IFCHR
-# define S_ISCHR(m) (((m) & S_IFMT) == S_IFCHR)
-# else
-# define S_ISCHR(m) 0
-# endif
-#endif /* !S_ISCHR */
-#ifndef S_ISBLK
-# ifdef S_IFBLK
-# define S_ISBLK(m) (((m) & S_IFMT) == S_IFBLK)
-# else
-# define S_ISBLK(m) 0
-# endif
-#endif /* !S_ISBLK */
-#ifndef S_ISFIFO
-# ifdef S_IFIFO
-# define S_ISFIFO(m) (((m) & S_IFMT) == S_IFIFO)
-# else
-# define S_ISFIFO(m) 0
-# endif
-#endif /* !S_ISFIFO */
-#ifndef S_ISLNK
-# ifdef S_IFLNK
-# define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK)
-# else
-# define S_ISLNK(m) 0
-# endif
-#endif /* !S_ISLNK */
-
-
-/*
- * Define MAXPATHLEN in terms of MAXPATH if available
- */
-
-#ifndef MAXPATH
-# define MAXPATH MAX_PATH
-#endif /* MAXPATH */
-
-#ifndef MAXPATHLEN
-# define MAXPATHLEN MAXPATH
-#endif /* MAXPATHLEN */
-
-/*
- * Define pid_t and uid_t if they're not already defined.
- */
-
-#if ! TCL_PID_T
-# define pid_t int
-#endif /* !TCL_PID_T */
-#if ! TCL_UID_T
-# define uid_t int
-#endif /* !TCL_UID_T */
-
-/*
- * Visual C++ has some odd names for common functions, so we need to
- * define a few macros to handle them. Also, it defines EDEADLOCK and
- * EDEADLK as the same value, which confuses Tcl_ErrnoId().
- */
-
-#if defined(_MSC_VER) || defined(__MSVCRT__)
-# define environ _environ
-# if defined(_MSC_VER) && (_MSC_VER < 1600)
-# define hypot _hypot
-# endif
-# define exception _exception
-# undef EDEADLOCK
-# if defined(_MSC_VER) && (_MSC_VER >= 1700)
-# define timezone _timezone
-# endif
-#endif /* _MSC_VER || __MSVCRT__ */
-
-/*
- * Borland's timezone and environ functions.
- */
-
-#ifdef __BORLANDC__
-# define timezone _timezone
-# 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 defined(_MSC_VER) && (_MSC_VER >= 1400)
-# pragma warning(disable:4244)
-# pragma warning(disable:4267)
-# pragma warning(disable:4996)
-#endif
-
-/*
- *---------------------------------------------------------------------------
- * 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.
- *---------------------------------------------------------------------------
- */
-
-/*
- * The default platform eol translation on Windows is TCL_TRANSLATE_CRLF:
- */
-
-#define TCL_PLATFORM_TRANSLATION TCL_TRANSLATE_CRLF
-
-/*
- * Declare dynamic loading extension macro.
- */
-
-#define TCL_SHLIB_EXT ".dll"
-
-/*
- * The following define ensures that we use the native putenv
- * implementation to modify the environment array. This keeps
- * the C level environment in synch with the system level environment.
- */
-
-#define USE_PUTENV 1
-#define USE_PUTENV_FOR_UNSET 1
-
-/*
- * Msvcrt's putenv() copies the string rather than takes ownership of it.
- */
-
-#if defined(_MSC_VER) || defined(__MSVCRT__)
-# define HAVE_PUTENV_THAT_COPIES 1
-#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.
- */
-
-#define TclpSysAlloc(size, isBin) ((void*)HeapAlloc(GetProcessHeap(), \
- (DWORD)0, (DWORD)size))
-#define TclpSysFree(ptr) (HeapFree(GetProcessHeap(), \
- (DWORD)0, (HGLOBAL)ptr))
-#define TclpSysRealloc(ptr, size) ((void*)HeapReAlloc(GetProcessHeap(), \
- (DWORD)0, (LPVOID)ptr, (DWORD)size))
-
-/* This type is not defined in the Windows headers */
-#define socklen_t int
-
-
-/*
- * 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
- * functions.
- */
-
-#define TclpExit exit
-
-#ifndef INVALID_SET_FILE_POINTER
-#define INVALID_SET_FILE_POINTER 0xFFFFFFFF
-#endif /* INVALID_SET_FILE_POINTER */
-
-#ifndef LABEL_SECURITY_INFORMATION
-# define LABEL_SECURITY_INFORMATION (0x00000010L)
-#endif
-
-#define Tcl_DirEntry void
-#define TclDIR void
-
-#endif /* _TCLWINPORT */
diff --git a/tcl8.6/win/tclWinReg.c b/tcl8.6/win/tclWinReg.c
deleted file mode 100644
index f93a553..0000000
--- a/tcl8.6/win/tclWinReg.c
+++ /dev/null
@@ -1,1546 +0,0 @@
-/*
- * 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.
- *
- * 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.
- */
-
-#undef STATIC_BUILD
-#ifndef USE_TCL_STUBS
-# define USE_TCL_STUBS
-#endif
-#include "tclInt.h"
-#ifdef _MSC_VER
-# pragma comment (lib, "advapi32.lib")
-#endif
-#include <stdlib.h>
-
-/*
- * Ensure that we can say which registry is being accessed.
- */
-
-#ifndef KEY_WOW64_64KEY
-# define KEY_WOW64_64KEY (0x0100)
-#endif
-#ifndef KEY_WOW64_32KEY
-# define KEY_WOW64_32KEY (0x0200)
-#endif
-
-/*
- * The maximum length of a sub-key name.
- */
-
-#ifndef MAX_KEY_LENGTH
-# define MAX_KEY_LENGTH 256
-#endif
-
-/*
- * The following macros convert between different endian ints.
- */
-
-#define SWAPWORD(x) MAKEWORD(HIBYTE(x), LOBYTE(x))
-#define SWAPLONG(x) MAKELONG(SWAPWORD(HIWORD(x)), SWAPWORD(LOWORD(x)))
-
-/*
- * 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.
- */
-
-static const char *const rootKeyNames[] = {
- "HKEY_LOCAL_MACHINE", "HKEY_USERS", "HKEY_CLASSES_ROOT",
- "HKEY_CURRENT_USER", "HKEY_CURRENT_CONFIG",
- "HKEY_PERFORMANCE_DATA", "HKEY_DYN_DATA", NULL
-};
-
-static const HKEY rootKeys[] = {
- HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CLASSES_ROOT, HKEY_CURRENT_USER,
- 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.
- */
-
-static const char *const typeNames[] = {
- "none", "sz", "expand_sz", "binary", "dword",
- "dword_big_endian", "link", "multi_sz", "resource_list", NULL
-};
-
-static DWORD lastType = REG_RESOURCE_LIST;
-
-/*
- * Declarations for functions defined in this file.
- */
-
-static void AppendSystemError(Tcl_Interp *interp, DWORD error);
-static int BroadcastValue(Tcl_Interp *interp, int objc,
- Tcl_Obj *const objv[]);
-static DWORD ConvertDWORD(DWORD type, DWORD value);
-static void DeleteCmd(ClientData clientData);
-static int DeleteKey(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
- REGSAM mode);
-static int DeleteValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
- Tcl_Obj *valueNameObj, REGSAM mode);
-static int GetKeyNames(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
- Tcl_Obj *patternObj, REGSAM mode);
-static int GetType(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
- Tcl_Obj *valueNameObj, REGSAM mode);
-static int GetValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
- Tcl_Obj *valueNameObj, REGSAM mode);
-static int GetValueNames(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
- Tcl_Obj *patternObj, REGSAM mode);
-static int OpenKey(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
- REGSAM mode, int flags, HKEY *keyPtr);
-static DWORD OpenSubKey(char *hostName, HKEY rootKey,
- char *keyName, REGSAM mode, int flags,
- HKEY *keyPtr);
-static int ParseKeyName(Tcl_Interp *interp, char *name,
- char **hostNamePtr, HKEY *rootKeyPtr,
- char **keyNamePtr);
-static DWORD RecursiveDeleteKey(HKEY hStartKey,
- const TCHAR * pKeyName, REGSAM mode);
-static int RegistryObjCmd(ClientData clientData,
- Tcl_Interp *interp, int objc,
- Tcl_Obj *const objv[]);
-static int SetValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
- Tcl_Obj *valueNameObj, Tcl_Obj *dataObj,
- Tcl_Obj *typeObj, REGSAM mode);
-
-static unsigned char *
-getByteArrayFromObj(
- Tcl_Obj *objPtr,
- size_t *lengthPtr
-) {
- int length;
-
- unsigned char *result = Tcl_GetByteArrayFromObj(objPtr, &length);
-#if TCL_MAJOR_VERSION > 8
- if (sizeof(TCL_HASH_TYPE) > sizeof(int)) {
- /* 64-bit and TIP #494 situation: */
- *lengthPtr = *(TCL_HASH_TYPE *) objPtr->internalRep.twoPtrValue.ptr1;
- } else
-#endif
- /* 32-bit or without TIP #494 */
- *lengthPtr = (size_t) (unsigned) length;
- return result;
-}
-
-DLLEXPORT int Registry_Init(Tcl_Interp *interp);
-DLLEXPORT int Registry_Unload(Tcl_Interp *interp, int flags);
-
-/*
- *----------------------------------------------------------------------
- *
- * Registry_Init --
- *
- * This function initializes the registry command.
- *
- * Results:
- * A standard Tcl result.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-int
-Registry_Init(
- Tcl_Interp *interp)
-{
- Tcl_Command cmd;
-
- if (Tcl_InitStubs(interp, "8.5", 0) == NULL) {
- return TCL_ERROR;
- }
-
- cmd = Tcl_CreateObjCommand(interp, "registry", RegistryObjCmd,
- interp, DeleteCmd);
- Tcl_SetAssocData(interp, REGISTRY_ASSOC_KEY, NULL, cmd);
- return Tcl_PkgProvide(interp, "registry", "1.3.3");
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * 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_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, NULL);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * RegistryObjCmd --
- *
- * This function implements the Tcl "registry" command.
- *
- * Results:
- * A standard Tcl result.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-RegistryObjCmd(
- ClientData clientData, /* Not used. */
- Tcl_Interp *interp, /* Current interpreter. */
- int objc, /* Number of arguments. */
- Tcl_Obj *const objv[]) /* Argument values. */
-{
- int n = 1;
- int index, argc;
- REGSAM mode = 0;
- const char *errString = NULL;
-
- static const char *const subcommands[] = {
- "broadcast", "delete", "get", "keys", "set", "type", "values", NULL
- };
- enum SubCmdIdx {
- BroadcastIdx, DeleteIdx, GetIdx, KeysIdx, SetIdx, TypeIdx, ValuesIdx
- };
- static const char *const modes[] = {
- "-32bit", "-64bit", NULL
- };
-
- if (objc < 2) {
- wrongArgs:
- Tcl_WrongNumArgs(interp, 1, objv, "?-32bit|-64bit? option ?arg ...?");
- return TCL_ERROR;
- }
-
- if (Tcl_GetString(objv[n])[0] == '-') {
- if (Tcl_GetIndexFromObj(interp, objv[n++], modes, "mode", 0,
- &index) != TCL_OK) {
- return TCL_ERROR;
- }
- switch (index) {
- case 0: /* -32bit */
- mode |= KEY_WOW64_32KEY;
- break;
- case 1: /* -64bit */
- mode |= KEY_WOW64_64KEY;
- break;
- }
- if (objc < 3) {
- goto wrongArgs;
- }
- }
-
- if (Tcl_GetIndexFromObj(interp, objv[n++], subcommands, "option", 0,
- &index) != TCL_OK) {
- return TCL_ERROR;
- }
-
- argc = (objc - n);
- switch (index) {
- case BroadcastIdx: /* broadcast */
- if (argc == 1 || argc == 3) {
- int res = BroadcastValue(interp, argc, objv + n);
-
- if (res != TCL_BREAK) {
- return res;
- }
- }
- errString = "keyName ?-timeout milliseconds?";
- break;
- case DeleteIdx: /* delete */
- if (argc == 1) {
- return DeleteKey(interp, objv[n], mode);
- } else if (argc == 2) {
- return DeleteValue(interp, objv[n], objv[n+1], mode);
- }
- errString = "keyName ?valueName?";
- break;
- case GetIdx: /* get */
- if (argc == 2) {
- return GetValue(interp, objv[n], objv[n+1], mode);
- }
- errString = "keyName valueName";
- break;
- case KeysIdx: /* keys */
- if (argc == 1) {
- return GetKeyNames(interp, objv[n], NULL, mode);
- } else if (argc == 2) {
- return GetKeyNames(interp, objv[n], objv[n+1], mode);
- }
- errString = "keyName ?pattern?";
- break;
- case SetIdx: /* set */
- if (argc == 1) {
- HKEY key;
-
- /*
- * Create the key and then close it immediately.
- */
-
- mode |= KEY_ALL_ACCESS;
- if (OpenKey(interp, objv[n], mode, 1, &key) != TCL_OK) {
- return TCL_ERROR;
- }
- RegCloseKey(key);
- return TCL_OK;
- } else if (argc == 3) {
- return SetValue(interp, objv[n], objv[n+1], objv[n+2], NULL,
- mode);
- } else if (argc == 4) {
- return SetValue(interp, objv[n], objv[n+1], objv[n+2], objv[n+3],
- mode);
- }
- errString = "keyName ?valueName data ?type??";
- break;
- case TypeIdx: /* type */
- if (argc == 2) {
- return GetType(interp, objv[n], objv[n+1], mode);
- }
- errString = "keyName valueName";
- break;
- case ValuesIdx: /* values */
- if (argc == 1) {
- return GetValueNames(interp, objv[n], NULL, mode);
- } else if (argc == 2) {
- return GetValueNames(interp, objv[n], objv[n+1], mode);
- }
- errString = "keyName ?pattern?";
- break;
- }
- Tcl_WrongNumArgs(interp, (mode ? 3 : 2), objv, errString);
- return TCL_ERROR;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * DeleteKey --
- *
- * This function deletes a registry key.
- *
- * Results:
- * A standard Tcl result.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-DeleteKey(
- Tcl_Interp *interp, /* Current interpreter. */
- Tcl_Obj *keyNameObj, /* Name of key to delete. */
- REGSAM mode) /* Mode flags to pass. */
-{
- char *tail, *buffer, *hostName, *keyName;
- const TCHAR *nativeTail;
- HKEY rootKey, subkey;
- DWORD result;
- Tcl_DString buf;
- REGSAM saveMode = mode;
-
- /*
- * Find the parent of the key being deleted and open it.
- */
-
- keyName = Tcl_GetString(keyNameObj);
- buffer = Tcl_Alloc(keyNameObj->length + 1);
- strcpy(buffer, keyName);
-
- if (ParseKeyName(interp, buffer, &hostName, &rootKey,
- &keyName) != TCL_OK) {
- Tcl_Free(buffer);
- return TCL_ERROR;
- }
-
- if (*keyName == '\0') {
- Tcl_SetObjResult(interp,
- Tcl_NewStringObj("bad key: cannot delete root keys", -1));
- Tcl_SetErrorCode(interp, "WIN_REG", "DEL_ROOT_KEY", NULL);
- Tcl_Free(buffer);
- return TCL_ERROR;
- }
-
- tail = strrchr(keyName, '\\');
- if (tail) {
- *tail++ = '\0';
- } else {
- tail = keyName;
- keyName = NULL;
- }
-
- mode |= KEY_ENUMERATE_SUB_KEYS | DELETE;
- result = OpenSubKey(hostName, rootKey, keyName, mode, 0, &subkey);
- if (result != ERROR_SUCCESS) {
- Tcl_Free(buffer);
- if (result == ERROR_FILE_NOT_FOUND) {
- return TCL_OK;
- }
- Tcl_SetObjResult(interp,
- Tcl_NewStringObj("unable to delete key: ", -1));
- AppendSystemError(interp, result);
- return TCL_ERROR;
- }
-
- /*
- * Now we recursively delete the key and everything below it.
- */
-
- nativeTail = Tcl_WinUtfToTChar(tail, -1, &buf);
- result = RecursiveDeleteKey(subkey, nativeTail, saveMode);
- Tcl_DStringFree(&buf);
-
- if (result != ERROR_SUCCESS && result != ERROR_FILE_NOT_FOUND) {
- Tcl_SetObjResult(interp,
- Tcl_NewStringObj("unable to delete key: ", -1));
- AppendSystemError(interp, result);
- result = TCL_ERROR;
- } else {
- result = TCL_OK;
- }
-
- RegCloseKey(subkey);
- Tcl_Free(buffer);
- return result;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * DeleteValue --
- *
- * This function deletes a value from a registry key.
- *
- * Results:
- * A standard Tcl result.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-DeleteValue(
- Tcl_Interp *interp, /* Current interpreter. */
- Tcl_Obj *keyNameObj, /* Name of key. */
- Tcl_Obj *valueNameObj, /* Name of value to delete. */
- REGSAM mode) /* Mode flags to pass. */
-{
- HKEY key;
- char *valueName;
- DWORD result;
- Tcl_DString ds;
-
- /*
- * Attempt to open the key for deletion.
- */
-
- mode |= KEY_SET_VALUE;
- if (OpenKey(interp, keyNameObj, mode, 0, &key) != TCL_OK) {
- return TCL_ERROR;
- }
-
- valueName = Tcl_GetString(valueNameObj);
- Tcl_WinUtfToTChar(valueName, valueNameObj->length, &ds);
- result = RegDeleteValue(key, (const TCHAR *)Tcl_DStringValue(&ds));
- Tcl_DStringFree(&ds);
- if (result != ERROR_SUCCESS) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "unable to delete value \"%s\" from key \"%s\": ",
- Tcl_GetString(valueNameObj), Tcl_GetString(keyNameObj)));
- AppendSystemError(interp, result);
- result = TCL_ERROR;
- } else {
- result = TCL_OK;
- }
- RegCloseKey(key);
- return result;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * 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.
- *
- * Results:
- * Returns the list of subkeys in the result object of the interpreter,
- * or an error message on failure.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-GetKeyNames(
- Tcl_Interp *interp, /* Current interpreter. */
- Tcl_Obj *keyNameObj, /* Key to enumerate. */
- Tcl_Obj *patternObj, /* Optional match pattern. */
- REGSAM mode) /* Mode flags to pass. */
-{
- const char *pattern; /* Pattern being matched against subkeys */
- HKEY key; /* Handle to the key being examined */
- TCHAR buffer[MAX_KEY_LENGTH];
- /* Buffer to hold the subkey name */
- DWORD bufSize; /* Size of the buffer */
- DWORD index; /* Position of the current subkey */
- char *name; /* Subkey name */
- Tcl_Obj *resultPtr; /* List of subkeys being accumulated */
- int result = TCL_OK; /* Return value from this command */
- Tcl_DString ds; /* Buffer to translate subkey name to UTF-8 */
-
- if (patternObj) {
- pattern = Tcl_GetString(patternObj);
- } else {
- pattern = NULL;
- }
-
- /*
- * Attempt to open the key for enumeration.
- */
-
- mode |= KEY_QUERY_VALUE | KEY_ENUMERATE_SUB_KEYS;
- if (OpenKey(interp, keyNameObj, mode, 0, &key) != TCL_OK) {
- return TCL_ERROR;
- }
-
- /*
- * Enumerate the subkeys.
- */
-
- resultPtr = Tcl_NewObj();
- for (index = 0;; ++index) {
- bufSize = MAX_KEY_LENGTH;
- result = RegEnumKeyEx(key, index, buffer, &bufSize,
- NULL, NULL, NULL, NULL);
- if (result != ERROR_SUCCESS) {
- if (result == ERROR_NO_MORE_ITEMS) {
- result = TCL_OK;
- } else {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "unable to enumerate subkeys of \"%s\": ",
- Tcl_GetString(keyNameObj)));
- AppendSystemError(interp, result);
- result = TCL_ERROR;
- }
- break;
- }
- name = Tcl_WinTCharToUtf(buffer, bufSize * sizeof(TCHAR), &ds);
- if (pattern && !Tcl_StringMatch(name, pattern)) {
- Tcl_DStringFree(&ds);
- continue;
- }
- result = Tcl_ListObjAppendElement(interp, resultPtr,
- Tcl_NewStringObj(name, Tcl_DStringLength(&ds)));
- Tcl_DStringFree(&ds);
- if (result != TCL_OK) {
- break;
- }
- }
- if (result == TCL_OK) {
- Tcl_SetObjResult(interp, resultPtr);
- } else {
- Tcl_DecrRefCount(resultPtr); /* BUGFIX: Don't leak on failure. */
- }
-
- RegCloseKey(key);
- return result;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * GetType --
- *
- * This function gets the type of a given registry value and places it in
- * the interpreter result.
- *
- * Results:
- * Returns a normal Tcl result.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-GetType(
- Tcl_Interp *interp, /* Current interpreter. */
- Tcl_Obj *keyNameObj, /* Name of key. */
- Tcl_Obj *valueNameObj, /* Name of value to get. */
- REGSAM mode) /* Mode flags to pass. */
-{
- HKEY key;
- DWORD result, type;
- Tcl_DString ds;
- const char *valueName;
- const TCHAR *nativeValue;
-
- /*
- * Attempt to open the key for reading.
- */
-
- mode |= KEY_QUERY_VALUE;
- if (OpenKey(interp, keyNameObj, mode, 0, &key) != TCL_OK) {
- return TCL_ERROR;
- }
-
- /*
- * Get the type of the value.
- */
-
- valueName = Tcl_GetString(valueNameObj);
- nativeValue = Tcl_WinUtfToTChar(valueName, valueNameObj->length, &ds);
- result = RegQueryValueEx(key, nativeValue, NULL, &type,
- NULL, NULL);
- Tcl_DStringFree(&ds);
- RegCloseKey(key);
-
- if (result != ERROR_SUCCESS) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "unable to get type of value \"%s\" from key \"%s\": ",
- Tcl_GetString(valueNameObj), Tcl_GetString(keyNameObj)));
- AppendSystemError(interp, result);
- return TCL_ERROR;
- }
-
- /*
- * 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_SetObjResult(interp, Tcl_NewIntObj((int) type));
- } else {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(typeNames[type], -1));
- }
- return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * GetValue --
- *
- * 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.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-GetValue(
- Tcl_Interp *interp, /* Current interpreter. */
- Tcl_Obj *keyNameObj, /* Name of key. */
- Tcl_Obj *valueNameObj, /* Name of value to get. */
- REGSAM mode) /* Mode flags to pass. */
-{
- HKEY key;
- const char *valueName;
- const TCHAR *nativeValue;
- DWORD result, length, type;
- Tcl_DString data, buf;
-
- /*
- * Attempt to open the key for reading.
- */
-
- mode |= KEY_QUERY_VALUE;
- if (OpenKey(interp, keyNameObj, mode, 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.
- *
- * This allows short values to be read from the registy in one call.
- * Longer values need a second call with an expanded DString.
- */
-
- Tcl_DStringInit(&data);
- Tcl_DStringSetLength(&data, TCL_DSTRING_STATIC_SIZE - 1);
- length = TCL_DSTRING_STATIC_SIZE/sizeof(TCHAR) - 1;
-
- valueName = Tcl_GetString(valueNameObj);
- nativeValue = Tcl_WinUtfToTChar(valueName, valueNameObj->length, &buf);
-
- result = RegQueryValueEx(key, nativeValue, NULL, &type,
- (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
- */
-
- length = Tcl_DStringLength(&data) * (2 / sizeof(TCHAR));
- Tcl_DStringSetLength(&data, (int) length * sizeof(TCHAR));
- result = RegQueryValueEx(key, nativeValue,
- NULL, &type, (BYTE *) Tcl_DStringValue(&data), &length);
- }
- Tcl_DStringFree(&buf);
- RegCloseKey(key);
- if (result != ERROR_SUCCESS) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "unable to get value \"%s\" from key \"%s\": ",
- Tcl_GetString(valueNameObj), Tcl_GetString(keyNameObj)));
- AppendSystemError(interp, result);
- Tcl_DStringFree(&data);
- return TCL_ERROR;
- }
-
- /*
- * 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_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.
- */
-
- while ((p < end) && *((WCHAR *) p) != 0) {
- WCHAR *wp;
-
- Tcl_WinTCharToUtf((TCHAR *) p, -1, &buf);
- Tcl_ListObjAppendElement(interp, resultPtr,
- Tcl_NewStringObj(Tcl_DStringValue(&buf),
- Tcl_DStringLength(&buf)));
- wp = (WCHAR *) p;
-
- while (*wp++ != 0) {/* empty body */}
- p = (char *) wp;
- 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_DStringResult(interp, &buf);
- } else {
- /*
- * Save binary data as a byte array.
- */
-
- Tcl_SetObjResult(interp, Tcl_NewByteArrayObj(
- (BYTE *) Tcl_DStringValue(&data), (int) length));
- }
- Tcl_DStringFree(&data);
- return result;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * 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.
- *
- * Results:
- * Returns the list of value names in the result object of the
- * interpreter, or an error message on failure.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-GetValueNames(
- Tcl_Interp *interp, /* Current interpreter. */
- Tcl_Obj *keyNameObj, /* Key to enumerate. */
- Tcl_Obj *patternObj, /* Optional match pattern. */
- REGSAM mode) /* Mode flags to pass. */
-{
- HKEY key;
- Tcl_Obj *resultPtr;
- DWORD index, size, result;
- Tcl_DString buffer, ds;
- const char *pattern, *name;
-
- /*
- * Attempt to open the key for enumeration.
- */
-
- mode |= KEY_QUERY_VALUE;
- if (OpenKey(interp, keyNameObj, mode, 0, &key) != TCL_OK) {
- return TCL_ERROR;
- }
-
- resultPtr = Tcl_NewObj();
- Tcl_DStringInit(&buffer);
- Tcl_DStringSetLength(&buffer, (int) (MAX_KEY_LENGTH * sizeof(TCHAR)));
- index = 0;
- result = TCL_OK;
-
- if (patternObj) {
- pattern = Tcl_GetString(patternObj);
- } else {
- pattern = NULL;
- }
-
- /*
- * 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.
- */
-
- size = MAX_KEY_LENGTH;
- while (RegEnumValue(key,index, (TCHAR *)Tcl_DStringValue(&buffer),
- &size, NULL, NULL, NULL, NULL) == ERROR_SUCCESS) {
- size *= sizeof(TCHAR);
-
- Tcl_WinTCharToUtf((TCHAR *) Tcl_DStringValue(&buffer), (int) size,
- &ds);
- name = Tcl_DStringValue(&ds);
- if (!pattern || Tcl_StringMatch(name, pattern)) {
- result = Tcl_ListObjAppendElement(interp, resultPtr,
- Tcl_NewStringObj(name, Tcl_DStringLength(&ds)));
- if (result != TCL_OK) {
- Tcl_DStringFree(&ds);
- break;
- }
- }
- Tcl_DStringFree(&ds);
-
- index++;
- size = MAX_KEY_LENGTH;
- }
- Tcl_SetObjResult(interp, resultPtr);
- Tcl_DStringFree(&buffer);
- RegCloseKey(key);
- return result;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * OpenKey --
- *
- * 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.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-OpenKey(
- Tcl_Interp *interp, /* Current interpreter. */
- Tcl_Obj *keyNameObj, /* Key to open. */
- REGSAM mode, /* Access mode. */
- int flags, /* 0 or REG_CREATE. */
- HKEY *keyPtr) /* Returned HKEY. */
-{
- char *keyName, *buffer, *hostName;
- HKEY rootKey;
- DWORD result;
-
- keyName = Tcl_GetString(keyNameObj);
- buffer = Tcl_Alloc(keyNameObj->length + 1);
- strcpy(buffer, keyName);
-
- result = ParseKeyName(interp, buffer, &hostName, &rootKey, &keyName);
- if (result == TCL_OK) {
- result = OpenSubKey(hostName, rootKey, keyName, mode, flags, keyPtr);
- if (result != ERROR_SUCCESS) {
- Tcl_SetObjResult(interp,
- Tcl_NewStringObj("unable to open key: ", -1));
- AppendSystemError(interp, result);
- result = TCL_ERROR;
- } else {
- result = TCL_OK;
- }
- }
-
- Tcl_Free(buffer);
- return result;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * OpenSubKey --
- *
- * 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.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-static DWORD
-OpenSubKey(
- char *hostName, /* Host to access, or NULL for local. */
- HKEY rootKey, /* Root registry key. */
- char *keyName, /* Subkey name. */
- REGSAM mode, /* Access mode. */
- int flags, /* 0 or REG_CREATE. */
- HKEY *keyPtr) /* Returned HKEY. */
-{
- DWORD result;
- Tcl_DString buf;
-
- /*
- * Attempt to open the root key on a remote host if necessary.
- */
-
- if (hostName) {
- hostName = (char *) Tcl_WinUtfToTChar(hostName, -1, &buf);
- result = RegConnectRegistry((TCHAR *)hostName, rootKey,
- &rootKey);
- Tcl_DStringFree(&buf);
- if (result != ERROR_SUCCESS) {
- return result;
- }
- }
-
- /*
- * Now open the specified key with the requested permissions. Note that
- * this key must be closed by the caller.
- */
-
- if (keyName) {
- keyName = (char *) Tcl_WinUtfToTChar(keyName, -1, &buf);
- }
- if (flags & REG_CREATE) {
- DWORD create;
-
- result = RegCreateKeyEx(rootKey, (TCHAR *)keyName, 0, NULL,
- REG_OPTION_NON_VOLATILE, mode, NULL, keyPtr, &create);
- } else if (rootKey == HKEY_PERFORMANCE_DATA) {
- /*
- * Here we fudge it for this special root key. See MSDN for more info
- * on HKEY_PERFORMANCE_DATA and the peculiarities surrounding it.
- */
-
- *keyPtr = HKEY_PERFORMANCE_DATA;
- result = ERROR_SUCCESS;
- } else {
- result = RegOpenKeyEx(rootKey, (TCHAR *)keyName, 0, mode,
- keyPtr);
- }
- if (keyName) {
- Tcl_DStringFree(&buf);
- }
-
- /*
- * Be sure to close the root key since we are done with it now.
- */
-
- if (hostName) {
- RegCloseKey(rootKey);
- }
- return result;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ParseKeyName --
- *
- * 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.
- *
- * Side effects:
- * Modifies the name string by inserting nulls.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-ParseKeyName(
- Tcl_Interp *interp, /* Current interpreter. */
- char *name,
- char **hostNamePtr,
- HKEY *rootKeyPtr,
- char **keyNamePtr)
-{
- char *rootName;
- int result, index;
- Tcl_Obj *rootObj;
-
- /*
- * Split the key into host and root portions.
- */
-
- *hostNamePtr = *keyNamePtr = rootName = NULL;
- if (name[0] == '\\') {
- if (name[1] == '\\') {
- *hostNamePtr = name;
- for (rootName = name+2; *rootName != '\0'; rootName++) {
- if (*rootName == '\\') {
- *rootName++ = '\0';
- break;
- }
- }
- }
- } else {
- rootName = name;
- }
- if (!rootName) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "bad key \"%s\": must start with a valid root", name));
- Tcl_SetErrorCode(interp, "WIN_REG", "NO_ROOT_KEY", NULL);
- return TCL_ERROR;
- }
-
- /*
- * Split the root into root and subkey portions.
- */
-
- for (*keyNamePtr = rootName; **keyNamePtr != '\0'; (*keyNamePtr)++) {
- if (**keyNamePtr == '\\') {
- **keyNamePtr = '\0';
- (*keyNamePtr)++;
- break;
- }
- }
-
- /*
- * Look for a matching root name.
- */
-
- rootObj = Tcl_NewStringObj(rootName, -1);
- result = Tcl_GetIndexFromObj(interp, rootObj, rootKeyNames, "root name",
- TCL_EXACT, &index);
- Tcl_DecrRefCount(rootObj);
- if (result != TCL_OK) {
- return TCL_ERROR;
- }
- *rootKeyPtr = rootKeys[index];
- return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * 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.
- *
- * Results:
- * Returns a Windows error code.
- *
- * Side effects:
- * Deletes all of the keys and values below the given key.
- *
- *----------------------------------------------------------------------
- */
-
-static DWORD
-RecursiveDeleteKey(
- HKEY startKey, /* Parent of key to be deleted. */
- const TCHAR *keyName, /* Name of key to be deleted in external
- * encoding, not UTF. */
- REGSAM mode) /* Mode flags to pass. */
-{
- DWORD result, size;
- Tcl_DString subkey;
- HKEY hKey;
- REGSAM saveMode = mode;
- static int checkExProc = 0;
- static FARPROC regDeleteKeyExProc = NULL;
-
- /*
- * Do not allow NULL or empty key name.
- */
-
- if (!keyName || *keyName == '\0') {
- return ERROR_BADKEY;
- }
-
- mode |= KEY_ENUMERATE_SUB_KEYS | DELETE | KEY_QUERY_VALUE;
- result = RegOpenKeyEx(startKey, keyName, 0, mode, &hKey);
- if (result != ERROR_SUCCESS) {
- return result;
- }
-
- Tcl_DStringInit(&subkey);
- Tcl_DStringSetLength(&subkey, (int) (MAX_KEY_LENGTH * sizeof(TCHAR)));
-
- mode = saveMode;
- while (result == ERROR_SUCCESS) {
- /*
- * Always get index 0 because key deletion changes ordering.
- */
-
- size = MAX_KEY_LENGTH;
- result = RegEnumKeyEx(hKey, 0, (TCHAR *)Tcl_DStringValue(&subkey),
- &size, NULL, NULL, NULL, NULL);
- if (result == ERROR_NO_MORE_ITEMS) {
- /*
- * RegDeleteKeyEx doesn't exist on non-64bit XP platforms, so we
- * can't compile with it in. We need to check for it at runtime
- * and use it if we find it.
- */
-
- if (mode && !checkExProc) {
- HMODULE handle;
-
- checkExProc = 1;
- handle = GetModuleHandle(TEXT("ADVAPI32"));
- regDeleteKeyExProc = (FARPROC)
- GetProcAddress(handle, "RegDeleteKeyExW");
- }
- if (mode && regDeleteKeyExProc) {
- result = regDeleteKeyExProc(startKey, keyName, mode, 0);
- } else {
- result = RegDeleteKey(startKey, keyName);
- }
- break;
- } else if (result == ERROR_SUCCESS) {
- result = RecursiveDeleteKey(hKey,
- (const TCHAR *) Tcl_DStringValue(&subkey), mode);
- }
- }
- Tcl_DStringFree(&subkey);
- RegCloseKey(hKey);
- return result;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * 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.
- *
- * Results:
- * Returns a normal Tcl result.
- *
- * Side effects:
- * May create new keys or values.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-SetValue(
- Tcl_Interp *interp, /* Current interpreter. */
- Tcl_Obj *keyNameObj, /* Name of key. */
- Tcl_Obj *valueNameObj, /* Name of value to set. */
- Tcl_Obj *dataObj, /* Data to be written. */
- Tcl_Obj *typeObj, /* Type of data to be written. */
- REGSAM mode) /* Mode flags to pass. */
-{
- int type;
- DWORD result;
- HKEY key;
- const char *valueName;
- Tcl_DString nameBuf;
-
- if (typeObj == NULL) {
- type = REG_SZ;
- } else if (Tcl_GetIndexFromObj(interp, typeObj, typeNames, "type",
- 0, (int *) &type) != TCL_OK) {
- if (Tcl_GetIntFromObj(NULL, typeObj, (int *) &type) != TCL_OK) {
- return TCL_ERROR;
- }
- Tcl_ResetResult(interp);
- }
- mode |= KEY_ALL_ACCESS;
- if (OpenKey(interp, keyNameObj, mode, 1, &key) != TCL_OK) {
- return TCL_ERROR;
- }
-
- valueName = Tcl_GetString(valueNameObj);
- valueName = (char *) Tcl_WinUtfToTChar(valueName, valueNameObj->length, &nameBuf);
-
- if (type == REG_DWORD || type == REG_DWORD_BIG_ENDIAN) {
- int value;
-
- if (Tcl_GetIntFromObj(interp, dataObj, &value) != TCL_OK) {
- RegCloseKey(key);
- Tcl_DStringFree(&nameBuf);
- return TCL_ERROR;
- }
-
- value = ConvertDWORD((DWORD) type, (DWORD) value);
- result = RegSetValueEx(key, (TCHAR *) valueName, 0,
- (DWORD) type, (BYTE *) &value, sizeof(DWORD));
- } else if (type == REG_MULTI_SZ) {
- Tcl_DString data, buf;
- int objc, i;
- Tcl_Obj **objv;
-
- if (Tcl_ListObjGetElements(interp, dataObj, &objc, &objv) != TCL_OK) {
- RegCloseKey(key);
- Tcl_DStringFree(&nameBuf);
- return TCL_ERROR;
- }
-
- /*
- * 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);
- for (i = 0; i < objc; i++) {
- const char *bytes = Tcl_GetString(objv[i]);
-
- Tcl_DStringAppend(&data, bytes, objv[i]->length);
-
- /*
- * Add a null character to separate this value from the next.
- */
-
- Tcl_DStringAppend(&data, "", 1); /* NUL-terminated string */
- }
-
- Tcl_WinUtfToTChar(Tcl_DStringValue(&data), Tcl_DStringLength(&data)+1,
- &buf);
- result = RegSetValueEx(key, (TCHAR *) valueName, 0,
- (DWORD) type, (BYTE *) Tcl_DStringValue(&buf),
- (DWORD) Tcl_DStringLength(&buf));
- Tcl_DStringFree(&data);
- Tcl_DStringFree(&buf);
- } else if (type == REG_SZ || type == REG_EXPAND_SZ) {
- Tcl_DString buf;
- const char *data = Tcl_GetString(dataObj);
-
- data = (char *) Tcl_WinUtfToTChar(data, dataObj->length, &buf);
-
- /*
- * Include the null in the length, padding if needed for WCHAR.
- */
-
- Tcl_DStringSetLength(&buf, Tcl_DStringLength(&buf)+1);
-
- result = RegSetValueEx(key, (TCHAR *) valueName, 0,
- (DWORD) type, (BYTE *) data, (DWORD) Tcl_DStringLength(&buf) + 1);
- Tcl_DStringFree(&buf);
- } else {
- BYTE *data;
- size_t bytelength;
-
- /*
- * Store binary data in the registry.
- */
-
- data = (BYTE *) getByteArrayFromObj(dataObj, &bytelength);
- result = RegSetValueEx(key, (TCHAR *) valueName, 0,
- (DWORD) type, data, (DWORD) bytelength);
- }
-
- Tcl_DStringFree(&nameBuf);
- RegCloseKey(key);
-
- if (result != ERROR_SUCCESS) {
- Tcl_SetObjResult(interp,
- Tcl_NewStringObj("unable to set value: ", -1));
- AppendSystemError(interp, result);
- return TCL_ERROR;
- }
- return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * BroadcastValue --
- *
- * 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.
- *
- * Side effects:
- * Will cause other programs to reload their system settings.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-BroadcastValue(
- Tcl_Interp *interp, /* Current interpreter. */
- int objc, /* Number of arguments. */
- Tcl_Obj *const objv[]) /* Argument values. */
-{
- LRESULT result;
- DWORD_PTR sendResult;
- int timeout = 3000;
- size_t len;
- const char *str;
- Tcl_Obj *objPtr;
- WCHAR *wstr;
- Tcl_DString ds;
-
- if (objc == 3) {
- str = Tcl_GetString(objv[1]);
- len = objv[1]->length;
- if ((len < 2) || (*str != '-') || strncmp(str, "-timeout", len)) {
- return TCL_BREAK;
- }
- if (Tcl_GetIntFromObj(interp, objv[2], &timeout) != TCL_OK) {
- return TCL_ERROR;
- }
- }
-
- str = Tcl_GetString(objv[0]);
- wstr = (WCHAR *) Tcl_WinUtfToTChar(str, objv[0]->length, &ds);
- if (Tcl_DStringLength(&ds) == 0) {
- wstr = NULL;
- }
-
- /*
- * Use the ignore the result.
- */
-
- result = SendMessageTimeout(HWND_BROADCAST, WM_SETTINGCHANGE,
- (WPARAM) 0, (LPARAM) wstr, SMTO_ABORTIFHUNG, (UINT) timeout, &sendResult);
- Tcl_DStringFree(&ds);
-
- objPtr = Tcl_NewObj();
- Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewWideIntObj((Tcl_WideInt) result));
- Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewWideIntObj((Tcl_WideInt) sendResult));
- Tcl_SetObjResult(interp, objPtr);
-
- return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * AppendSystemError --
- *
- * This routine formats a Windows system error message and places it into
- * the interpreter result.
- *
- * Results:
- * None.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-AppendSystemError(
- Tcl_Interp *interp, /* Current interpreter. */
- DWORD error) /* Result code from error. */
-{
- int length;
- TCHAR *tMsgPtr, **tMsgPtrPtr = &tMsgPtr;
- const char *msg;
- char id[TCL_INTEGER_SPACE], msgBuf[24 + TCL_INTEGER_SPACE];
- Tcl_DString ds;
- Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
-
- if (Tcl_IsShared(resultPtr)) {
- resultPtr = Tcl_DuplicateObj(resultPtr);
- }
- length = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM
- | FORMAT_MESSAGE_ALLOCATE_BUFFER, NULL, error,
- MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (TCHAR *) tMsgPtrPtr,
- 0, NULL);
- if (length == 0) {
- sprintf(msgBuf, "unknown error: %ld", error);
- msg = msgBuf;
- } else {
- char *msgPtr;
-
- Tcl_WinTCharToUtf(tMsgPtr, -1, &ds);
- LocalFree(tMsgPtr);
-
- msgPtr = Tcl_DStringValue(&ds);
- length = Tcl_DStringLength(&ds);
-
- /*
- * Trim the trailing CR/LF from the system message.
- */
-
- if (msgPtr[length-1] == '\n') {
- --length;
- }
- if (msgPtr[length-1] == '\r') {
- --length;
- }
- msgPtr[length] = 0;
- msg = msgPtr;
- }
-
- sprintf(id, "%ld", error);
- Tcl_SetErrorCode(interp, "WINDOWS", id, msg, NULL);
- Tcl_AppendToObj(resultPtr, msg, length);
- Tcl_SetObjResult(interp, resultPtr);
-
- if (length != 0) {
- Tcl_DStringFree(&ds);
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ConvertDWORD --
- *
- * This function determines whether a DWORD needs to be byte swapped, and
- * returns the appropriately swapped value.
- *
- * Results:
- * Returns a converted DWORD.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-static DWORD
-ConvertDWORD(
- DWORD type, /* Either REG_DWORD or REG_DWORD_BIG_ENDIAN */
- DWORD value) /* The value to be converted. */
-{
- const DWORD order = 1;
- DWORD localType;
-
- /*
- * Check to see if the low bit is in the first byte.
- */
-
- localType = (*((const char *) &order) == 1)
- ? REG_DWORD : REG_DWORD_BIG_ENDIAN;
- return (type != localType) ? (DWORD) SWAPLONG(value) : value;
-}
-
-/*
- * Local Variables:
- * mode: c
- * c-basic-offset: 4
- * fill-column: 78
- * End:
- */
diff --git a/tcl8.6/win/tclWinSerial.c b/tcl8.6/win/tclWinSerial.c
deleted file mode 100644
index fe416ff..0000000
--- a/tcl8.6/win/tclWinSerial.c
+++ /dev/null
@@ -1,2236 +0,0 @@
-/*
- * tclWinSerial.c --
- *
- * 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.
- *
- * Serial functionality implemented by Rolf.Schroedter@dlr.de
- */
-
-#include "tclWinInt.h"
-
-/*
- * The following variable is used to tell whether this module has been
- * initialized.
- */
-
-static int initialized = 0;
-
-/*
- * The serialMutex locks around access to the initialized variable, and it is
- * used to protect background threads from being terminated while they are
- * using APIs that hold locks.
- */
-
-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. */
-
-/*
- * 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)
-
-/*
- * Default time to block between checking status on the serial port.
- */
-
-#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)
-
-/*
- * This structure describes per-instance data for a serial based channel.
- */
-
-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; /* 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 */
- TclPipeThreadInfo *writeTI; /* Thread info structure of writer worker. */
- 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. */
- 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.
- */
-
- SerialInfo *firstSerialPtr;
-} ThreadSpecificData;
-
-static Tcl_ThreadDataKey dataKey;
-
-/*
- * 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. */
-} SerialEvent;
-
-/*
- * We don't use timeouts.
- */
-
-static COMMTIMEOUTS no_timeout = {
- 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 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(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
- * based IO.
- */
-
-static const Tcl_ChannelType serialChannelType = {
- "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.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Creates a new event source.
- *
- *----------------------------------------------------------------------
- */
-
-static ThreadSpecificData *
-SerialInit(void)
-{
- ThreadSpecificData *tsdPtr;
-
- /*
- * Check the initialized flag first, then check it again in the mutex.
- * This is a speed enhancement.
- */
-
- if (!initialized) {
- Tcl_MutexLock(&serialMutex);
- if (!initialized) {
- initialized = 1;
- Tcl_CreateExitHandler(ProcExitHandler, NULL);
- }
- Tcl_MutexUnlock(&serialMutex);
- }
-
- tsdPtr = (ThreadSpecificData *) TclThreadDataKeyGet(&dataKey);
- if (tsdPtr == 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.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Removes the serial event source.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-SerialExitHandler(
- 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.
- */
-
- 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.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Resets the process list.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-ProcExitHandler(
- ClientData clientData) /* Old window proc */
-{
- Tcl_MutexLock(&serialMutex);
- initialized = 0;
- Tcl_MutexUnlock(&serialMutex);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * SerialBlockTime --
- *
- * Wrapper to set Tcl's block time in msec
- *
- * Results:
- * None.
- *
- * Side effects:
- * Updates the maximum blocking time.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-SerialBlockTime(
- int msec) /* milli-seconds */
-{
- Tcl_Time blockTime;
-
- blockTime.sec = msec / 1000;
- blockTime.usec = (msec % 1000) * 1000;
- Tcl_SetMaxBlockTime(&blockTime);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * SerialGetMilliseconds --
- *
- * Get current time in milliseconds,ignoring integer overruns.
- *
- * Results:
- * The current time.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-static unsigned int
-SerialGetMilliseconds(void)
-{
- Tcl_Time time;
-
- Tcl_GetTime(&time);
-
- return (time.sec * 1000 + time.usec / 1000);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * SerialSetupProc --
- *
- * This procedure is invoked before Tcl_DoOneEvent blocks waiting for an
- * event.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Adjusts the block time if needed.
- *
- *----------------------------------------------------------------------
- */
-
-void
-SerialSetupProc(
- 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 */
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-
- if (!(flags & TCL_FILE_EVENTS)) {
- return;
- }
-
- /*
- * 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);
- }
- }
-
- if (!block) {
- SerialBlockTime(msec);
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * SerialCheckProc --
- *
- * This procedure is called by Tcl_DoOneEvent to check the serial event
- * source for events.
- *
- * Results:
- * None.
- *
- * Side effects:
- * May queue an event.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-SerialCheckProc(
- ClientData data, /* Not used. */
- int flags) /* Event flags as passed to Tcl_DoOneEvent. */
-{
- SerialInfo *infoPtr;
- SerialEvent *evPtr;
- int needEvent;
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- COMSTAT cStat;
- unsigned int time;
-
- if (!(flags & TCL_FILE_EVENTS)) {
- return;
- }
-
- /*
- * Queue events for any ready serials that don't already have events
- * 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 &&
- 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 = 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.
- *
- * Results:
- * 0 if successful, errno when failed.
- *
- * Side effects:
- * Sets the device into blocking or non-blocking mode.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-SerialBlockProc(
- ClientData instanceData, /* Instance data for channel. */
- 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.
- */
-
- if (mode == TCL_MODE_NONBLOCKING) {
- infoPtr->flags |= SERIAL_ASYNC;
- } else {
- infoPtr->flags &= ~(SERIAL_ASYNC);
- }
- return errorCode;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * SerialCloseProc --
- *
- * Closes a serial based IO channel.
- *
- * Results:
- * 0 on success, errno otherwise.
- *
- * Side effects:
- * Closes the physical channel.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-SerialCloseProc(
- ClientData instanceData, /* Pointer to SerialInfo structure. */
- Tcl_Interp *interp) /* For error reporting. */
-{
- SerialInfo *serialPtr = (SerialInfo *) instanceData;
- int errorCode, result = 0;
- SerialInfo *infoPtr, **nextPtrPtr;
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-
- errorCode = 0;
-
- if (serialPtr->validMask & TCL_READABLE) {
- PurgeComm(serialPtr->handle, PURGE_RXABORT | PURGE_RXCLEAR);
- CloseHandle(serialPtr->osRead.hEvent);
- }
- serialPtr->validMask &= ~TCL_READABLE;
-
- if (serialPtr->writeThread) {
-
- TclPipeThreadStop(&serialPtr->writeTI, serialPtr->writeThread);
-
- CloseHandle(serialPtr->osWrite.hEvent);
- CloseHandle(serialPtr->evWritable);
- CloseHandle(serialPtr->writeThread);
- serialPtr->writeThread = NULL;
-
- 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.
- */
-
- 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;
- }
- }
-
- serialPtr->watchMask &= serialPtr->validMask;
-
- /*
- * 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;
- }
- }
-
- /*
- * 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);
-
- if (errorCode == 0) {
- return result;
- }
- return errorCode;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * SerialBlockingRead --
- *
- * 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.
- *
- * Side effects:
- * Reads input from the actual channel.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-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.
- * 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;
- }
- }
- } else {
- /*
- * ReadFile completed immediately.
- */
- }
- return TRUE;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * SerialBlockingWrite --
- *
- * 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.
- *
- * Side effects:
- * Writes output to the actual channel.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-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
- */
-
- 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;
- 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;
- }
- } else {
- /*
- * WriteFile completed immediately.
- */
- }
-
- EnterCriticalSection(&infoPtr->csWrite);
- infoPtr->writeQueue += (*lpWritten - bufSize);
- LeaveCriticalSection(&infoPtr->csWrite);
-
- 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.
- *
- * Results:
- * 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.
- *
- *----------------------------------------------------------------------
- */
-
-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. */
-{
- SerialInfo *infoPtr = (SerialInfo *) instanceData;
- DWORD bytesRead = 0;
- COMSTAT cStat;
-
- *errorCode = 0;
-
- /*
- * Check if there is a CommError pending from SerialCheckProc
- */
-
- 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
- */
-
- 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 = EWOULDBLOCK;
- 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 (SerialBlockingRead(infoPtr, (LPVOID) buf, (DWORD) bufSize, &bytesRead,
- &infoPtr->osRead) == FALSE) {
- TclWinConvertError(GetLastError());
- *errorCode = errno;
- return -1;
- }
- return bytesRead;
-
- 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.
- *
- * Results:
- * 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.
- *
- *----------------------------------------------------------------------
- */
-
-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. */
-{
- SerialInfo *infoPtr = (SerialInfo *) instanceData;
- DWORD bytesWritten, timeout;
-
- *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.
- */
-
- 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;
- }
-
- 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.
- */
-
- errno = EWOULDBLOCK;
- goto error1;
- }
-
- /*
- * Check for a background error on the last write.
- */
-
- if (infoPtr->writeError) {
- 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(toWrite);
- }
- memcpy(infoPtr->writeBuf, buf, (size_t) toWrite);
- infoPtr->toWrite = toWrite;
- ResetEvent(infoPtr->evWritable);
- TclPipeThreadSignal(&infoPtr->writeTI);
- bytesWritten = (DWORD) toWrite;
-
- } else {
- /*
- * 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:
- TclWinConvertError(GetLastError());
-
- error:
- /*
- * Reset the output queue counter on error during blocking output
- */
-
- /*
- * 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.
- *
- * 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.
- *
- * Side effects:
- * 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. */
-{
- SerialEvent *serialEvPtr = (SerialEvent *)evPtr;
- SerialInfo *infoPtr;
- int mask;
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-
- if (!(flags & TCL_FILE_EVENTS)) {
- 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.
- */
-
- for (infoPtr = tsdPtr->firstSerialPtr; infoPtr != NULL;
- infoPtr = infoPtr->nextPtr) {
- if (serialEvPtr->infoPtr == infoPtr) {
- infoPtr->flags &= ~(SERIAL_PENDING);
- break;
- }
- }
-
- /*
- * Remove stale events.
- */
-
- if (!infoPtr) {
- 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.
- */
-
- mask = 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;
- }
- }
-
- /*
- * Inform the channel of the events.
- */
-
- Tcl_NotifyChannel(infoPtr->channel, infoPtr->watchMask & mask);
- return 1;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * SerialWatchProc --
- *
- * Called by the notifier to set up to watch for events on this channel.
- *
- * Results:
- * None.
- *
- * Side effects:
- * 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. */
-{
- SerialInfo **nextPtrPtr, *ptr;
- SerialInfo *infoPtr = (SerialInfo *) instanceData;
- int oldMask = infoPtr->watchMask;
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-
- /*
- * 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;
- }
- }
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * SerialGetHandleProc --
- *
- * 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.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-SerialGetHandleProc(
- 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.
- *
- * 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.
- *
- *----------------------------------------------------------------------
- */
-
-static DWORD WINAPI
-SerialWriterThread(
- LPVOID arg)
-{
- TclPipeThreadInfo *pipeTI = (TclPipeThreadInfo *)arg;
- SerialInfo *infoPtr = NULL; /* access info only after success init/wait */
- DWORD bytesWritten, toWrite;
- char *buf;
- OVERLAPPED myWrite; /* Have an own OVERLAPPED in this thread. */
-
- for (;;) {
- /*
- * Wait for the main thread to signal before attempting to write.
- */
- if (!TclPipeThreadWaitForSignal(&pipeTI)) {
- /* exit */
- break;
- }
- infoPtr = (SerialInfo *)pipeTI->clientData;
-
- 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.
- */
-
- Tcl_ThreadAlert(infoPtr->threadId);
- }
- Tcl_MutexUnlock(&serialMutex);
- }
-
- /* Worker exit, so inform the main thread or free TI-structure (if owned) */
- TclPipeThreadExit(&pipeTI);
-
- return 0;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclWinSerialOpen --
- *
- * Opens or Reopens the serial port with the OVERLAPPED FLAG set
- *
- * Results:
- * Returns the new handle, or INVALID_HANDLE_VALUE.
- * If an existing channel is specified it is closed and reopened.
- *
- * Side effects:
- * May close/reopen the original handle
- *
- *----------------------------------------------------------------------
- */
-
-HANDLE
-TclWinSerialOpen(
- HANDLE handle,
- const TCHAR *name,
- DWORD access)
-{
- SerialInit();
-
- /*
- * If an open channel is specified, close it
- */
-
- if ( handle != INVALID_HANDLE_VALUE && CloseHandle(handle) == FALSE) {
- return INVALID_HANDLE_VALUE;
- }
-
- /*
- * Multithreaded I/O needs the overlapped flag set otherwise
- * ClearCommError blocks under Windows NT/2000 until serial output is
- * finished
- */
-
- handle = CreateFile(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.
- *
- * Results:
- * Returns the new channel, or NULL.
- *
- * Side effects:
- * May open the channel
- *
- *----------------------------------------------------------------------
- */
-
-Tcl_Channel
-TclWinOpenSerialChannel(
- HANDLE handle,
- char *channelName,
- int permissions)
-{
- SerialInfo *infoPtr;
-
- SerialInit();
-
- infoPtr = ckalloc(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->lastEventTime = 0;
- 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).
- */
-
- sprintf(channelName, "file%" TCL_I_MODIFIER "x", (size_t) infoPtr);
-
- infoPtr->channel = Tcl_CreateChannel(&serialChannelType, channelName,
- infoPtr, permissions);
-
-
- SetupComm(handle, infoPtr->sysBufRead, infoPtr->sysBufWrite);
- PurgeComm(handle,
- PURGE_TXABORT | PURGE_RXABORT | PURGE_TXCLEAR | PURGE_RXCLEAR);
-
- /*
- * Default is blocking.
- */
-
- SetCommTimeouts(handle, &no_timeout);
-
- InitializeCriticalSection(&infoPtr->csWrite);
- if (permissions & TCL_READABLE) {
- 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->writeThread = CreateThread(NULL, 256, SerialWriterThread,
- TclPipeThreadCreateTI(&infoPtr->writeTI, infoPtr,
- infoPtr->evWritable), 0, NULL);
- }
-
- /*
- * Files have default translation of AUTO and ^Z eof char, which means
- * that a ^Z will be accepted as EOF when reading.
- */
-
- Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto");
- Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "\032 {}");
-
- return infoPtr->channel;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * SerialErrorStr --
- *
- * 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(
- DWORD error, /* Win32 serial error code. */
- Tcl_DString *dsPtr) /* Where to store string. */
-{
- if (error & CE_RXOVER) {
- Tcl_DStringAppendElement(dsPtr, "RXOVER");
- }
- if (error & CE_OVERRUN) {
- Tcl_DStringAppendElement(dsPtr, "OVERRUN");
- }
- if (error & CE_RXPARITY) {
- Tcl_DStringAppendElement(dsPtr, "RXPARITY");
- }
- if (error & CE_FRAME) {
- Tcl_DStringAppendElement(dsPtr, "FRAME");
- }
- if (error & CE_BREAK) {
- Tcl_DStringAppendElement(dsPtr, "BREAK");
- }
- if (error & CE_TXFULL) {
- Tcl_DStringAppendElement(dsPtr, "TXFULL");
- }
- if (error & CE_PTO) { /* PTO used to signal WRITE-TIMEOUT */
- Tcl_DStringAppendElement(dsPtr, "TIMEOUT");
- }
- 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
- *
- * Result:
- * None.
- *
- * Side effects:
- * Appends modem status flag strings to the given DString.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-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");
- Tcl_DStringAppendElement(dsPtr, "DSR");
- Tcl_DStringAppendElement(dsPtr, (status & MS_DSR_ON) ? "1" : "0");
- Tcl_DStringAppendElement(dsPtr, "RING");
- Tcl_DStringAppendElement(dsPtr, (status & MS_RING_ON) ? "1" : "0");
- Tcl_DStringAppendElement(dsPtr, "DCD");
- Tcl_DStringAppendElement(dsPtr, (status & MS_RLSD_ON) ? "1" : "0");
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * SerialSetOptionProc --
- *
- * Sets an option on a channel.
- *
- * Results:
- * 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.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-SerialSetOptionProc(
- ClientData instanceData, /* File state. */
- Tcl_Interp *interp, /* For error reporting - can be NULL. */
- const char *optionName, /* Which option to set? */
- const char *value) /* New value for option. */
-{
- SerialInfo *infoPtr;
- DCB dcb;
- BOOL result, flag;
- size_t len, vlen;
- Tcl_DString ds;
- const TCHAR *native;
- int argc;
- const char **argv;
-
- infoPtr = (SerialInfo *) instanceData;
-
- /*
- * 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)) {
- goto getStateFailed;
- }
- native = Tcl_WinUtfToTChar(value, -1, &ds);
- result = BuildCommDCB(native, &dcb);
- Tcl_DStringFree(&ds);
-
- if (result == FALSE) {
- if (interp != NULL) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "bad value \"%s\" for -mode: should be baud,parity,data,stop",
- value));
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "SERIALMODE", NULL);
- }
- return TCL_ERROR;
- }
-
- /*
- * Default settings for serial communications.
- */
-
- dcb.fBinary = TRUE;
- dcb.fErrorChar = FALSE;
- dcb.fNull = FALSE;
- dcb.fAbortOnError = FALSE;
-
- if (!SetCommState(infoPtr->handle, &dcb)) {
- goto setStateFailed;
- }
- return TCL_OK;
- }
-
- /*
- * Option -handshake none|xonxoff|rtscts|dtrdsr
- */
-
- if ((len > 1) && (strncmp(optionName, "-handshake", len) == 0)) {
- if (!GetCommState(infoPtr->handle, &dcb)) {
- goto getStateFailed;
- }
-
- /*
- * 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;
- dcb.fRtsControl = RTS_CONTROL_ENABLE;
- dcb.fTXContinueOnXoff = FALSE;
-
- /*
- * 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 (strncasecmp(value, "NONE", vlen) == 0) {
- /*
- * Leave all handshake options disabled.
- */
- } else if (strncasecmp(value, "XONXOFF", vlen) == 0) {
- dcb.fOutX = dcb.fInX = TRUE;
- } else if (strncasecmp(value, "RTSCTS", vlen) == 0) {
- dcb.fOutxCtsFlow = TRUE;
- dcb.fRtsControl = RTS_CONTROL_HANDSHAKE;
- } else if (strncasecmp(value, "DTRDSR", vlen) == 0) {
- dcb.fOutxDsrFlow = TRUE;
- dcb.fDtrControl = DTR_CONTROL_HANDSHAKE;
- } else {
- if (interp != NULL) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "bad value \"%s\" for -handshake: must be one of"
- " xonxoff, rtscts, dtrdsr or none", value));
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "HANDSHAKE", NULL);
- }
- return TCL_ERROR;
- }
-
- if (!SetCommState(infoPtr->handle, &dcb)) {
- goto setStateFailed;
- }
- return TCL_OK;
- }
-
- /*
- * Option -xchar {\x11 \x13}
- */
-
- if ((len > 1) && (strncmp(optionName, "-xchar", len) == 0)) {
- if (!GetCommState(infoPtr->handle, &dcb)) {
- goto getStateFailed;
- }
-
- if (Tcl_SplitList(interp, value, &argc, &argv) == TCL_ERROR) {
- return TCL_ERROR;
- }
- if (argc != 2) {
- badXchar:
- if (interp != NULL) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "bad value for -xchar: should be a list of"
- " two elements with each a single character", -1));
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "XCHAR", NULL);
- }
- ckfree(argv);
- return TCL_ERROR;
- }
-
- /*
- * 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(argv);
-
- if (!SetCommState(infoPtr->handle, &dcb)) {
- goto setStateFailed;
- }
- return TCL_OK;
- }
-
- /*
- * Option -ttycontrol {DTR 1 RTS 0 BREAK 0}
- */
-
- if ((len > 4) && (strncmp(optionName, "-ttycontrol", len) == 0)) {
- int i, result = TCL_OK;
-
- if (Tcl_SplitList(interp, value, &argc, &argv) == TCL_ERROR) {
- return TCL_ERROR;
- }
- if ((argc % 2) == 1) {
- if (interp != NULL) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "bad value \"%s\" for -ttycontrol: should be "
- "a list of signal,value pairs", value));
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "TTYCONTROL", NULL);
- }
- ckfree(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 (strncasecmp(argv[i], "DTR", strlen(argv[i])) == 0) {
- if (!EscapeCommFunction(infoPtr->handle,
- (DWORD) (flag ? SETDTR : CLRDTR))) {
- if (interp != NULL) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "can't set DTR signal", -1));
- Tcl_SetErrorCode(interp, "TCL", "OPERATION",
- "FCONFIGURE", "TTY_SIGNAL", NULL);
- }
- result = TCL_ERROR;
- break;
- }
- } else if (strncasecmp(argv[i], "RTS", strlen(argv[i])) == 0) {
- if (!EscapeCommFunction(infoPtr->handle,
- (DWORD) (flag ? SETRTS : CLRRTS))) {
- if (interp != NULL) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "can't set RTS signal", -1));
- Tcl_SetErrorCode(interp, "TCL", "OPERATION",
- "FCONFIGURE", "TTY_SIGNAL", NULL);
- }
- result = TCL_ERROR;
- break;
- }
- } else if (strncasecmp(argv[i], "BREAK", strlen(argv[i])) == 0) {
- if (!EscapeCommFunction(infoPtr->handle,
- (DWORD) (flag ? SETBREAK : CLRBREAK))) {
- if (interp != NULL) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "can't set BREAK signal", -1));
- Tcl_SetErrorCode(interp, "TCL", "OPERATION",
- "FCONFIGURE", "TTY_SIGNAL", NULL);
- }
- result = TCL_ERROR;
- break;
- }
- } else {
- if (interp != NULL) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "bad signal name \"%s\" for -ttycontrol: must be"
- " DTR, RTS or BREAK", argv[i]));
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "TTY_SIGNAL",
- NULL);
- }
- result = TCL_ERROR;
- break;
- }
- }
-
- ckfree(argv);
- return result;
- }
-
- /*
- * Option -sysbuffer {read_size write_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) {
- return TCL_ERROR;
- }
- if (argc == 1) {
- inSize = atoi(argv[0]);
- outSize = infoPtr->sysBufWrite;
- } else if (argc == 2) {
- inSize = atoi(argv[0]);
- outSize = atoi(argv[1]);
- }
- ckfree(argv);
-
- if ((argc < 1) || (argc > 2) || (inSize <= 0) || (outSize <= 0)) {
- if (interp != NULL) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "bad value \"%s\" for -sysbuffer: should be "
- "a list of one or two integers > 0", value));
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "SYS_BUFFER", NULL);
- }
- return TCL_ERROR;
- }
-
- if (!SetupComm(infoPtr->handle, inSize, outSize)) {
- if (interp != NULL) {
- TclWinConvertError(GetLastError());
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "can't setup comm buffers: %s",
- Tcl_PosixError(interp)));
- }
- return TCL_ERROR;
- }
- infoPtr->sysBufRead = inSize;
- infoPtr->sysBufWrite = outSize;
-
- /*
- * Adjust the handshake limits. Yes, the XonXoff limits seem to
- * influence even hardware handshake.
- */
-
- if (!GetCommState(infoPtr->handle, &dcb)) {
- goto getStateFailed;
- }
- dcb.XonLim = (WORD) (infoPtr->sysBufRead*1/2);
- dcb.XoffLim = (WORD) (infoPtr->sysBufRead*1/4);
- if (!SetCommState(infoPtr->handle, &dcb)) {
- goto setStateFailed;
- }
- return TCL_OK;
- }
-
- /*
- * Option -pollinterval msec
- */
-
- if ((len > 1) && (strncmp(optionName, "-pollinterval", len) == 0)) {
- if (Tcl_GetInt(interp, value, &(infoPtr->blockTime)) != TCL_OK) {
- return TCL_ERROR;
- }
- return TCL_OK;
- }
-
- /*
- * 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) {
- return TCL_ERROR;
- }
- tout.ReadTotalTimeoutConstant = msec;
- if (!SetCommTimeouts(infoPtr->handle, &tout)) {
- if (interp != NULL) {
- TclWinConvertError(GetLastError());
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "can't set comm timeouts: %s",
- Tcl_PosixError(interp)));
- }
- return TCL_ERROR;
- }
-
- return TCL_OK;
- }
-
- return Tcl_BadChannelOption(interp, optionName,
- "mode handshake pollinterval sysbuffer timeout ttycontrol xchar");
-
- getStateFailed:
- if (interp != NULL) {
- TclWinConvertError(GetLastError());
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "can't get comm state: %s", Tcl_PosixError(interp)));
- }
- return TCL_ERROR;
-
- setStateFailed:
- if (interp != NULL) {
- TclWinConvertError(GetLastError());
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "can't set comm state: %s", Tcl_PosixError(interp)));
- }
- return TCL_ERROR;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * 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.
- *
- * Results:
- * 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.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-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. */
-
- infoPtr = (SerialInfo *) instanceData;
-
- if (optionName == NULL) {
- len = 0;
- } else {
- len = strlen(optionName);
- }
-
- /*
- * Get option -mode
- */
-
- if (len == 0) {
- Tcl_DStringAppendElement(dsPtr, "-mode");
- }
- if (len==0 || (len>2 && (strncmp(optionName, "-mode", len) == 0))) {
- char parity;
- const char *stop;
- char buf[2 * TCL_INTEGER_SPACE + 16];
-
- if (!GetCommState(infoPtr->handle, &dcb)) {
- if (interp != NULL) {
- TclWinConvertError(GetLastError());
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "can't get comm state: %s", Tcl_PosixError(interp)));
- }
- return TCL_ERROR;
- }
-
- valid = 1;
- parity = 'n';
- if (dcb.Parity <= 4) {
- parity = "noems"[dcb.Parity];
- }
- stop = (dcb.StopBits == ONESTOPBIT) ? "1" :
- (dcb.StopBits == ONE5STOPBITS) ? "1.5" : "2";
-
- wsprintfA(buf, "%d,%c,%d,%s", dcb.BaudRate, parity,
- dcb.ByteSize, stop);
- Tcl_DStringAppendElement(dsPtr, buf);
- }
-
- /*
- * Get option -pollinterval
- */
-
- if (len == 0) {
- Tcl_DStringAppendElement(dsPtr, "-pollinterval");
- }
- if (len==0 || (len>1 && strncmp(optionName, "-pollinterval", len)==0)) {
- char buf[TCL_INTEGER_SPACE + 1];
-
- valid = 1;
- wsprintfA(buf, "%d", infoPtr->blockTime);
- Tcl_DStringAppendElement(dsPtr, buf);
- }
-
- /*
- * Get option -sysbuffer
- */
-
- if (len == 0) {
- Tcl_DStringAppendElement(dsPtr, "-sysbuffer");
- Tcl_DStringStartSublist(dsPtr);
- }
- if (len==0 || (len>1 && strncmp(optionName, "-sysbuffer", len) == 0)) {
- char buf[TCL_INTEGER_SPACE + 1];
- valid = 1;
-
- wsprintfA(buf, "%d", infoPtr->sysBufRead);
- Tcl_DStringAppendElement(dsPtr, buf);
- wsprintfA(buf, "%d", infoPtr->sysBufWrite);
- Tcl_DStringAppendElement(dsPtr, buf);
- }
- if (len == 0) {
- Tcl_DStringEndSublist(dsPtr);
- }
-
- /*
- * Get option -xchar
- */
-
- if (len == 0) {
- Tcl_DStringAppendElement(dsPtr, "-xchar");
- Tcl_DStringStartSublist(dsPtr);
- }
- if (len==0 || (len>1 && strncmp(optionName, "-xchar", len) == 0)) {
- char buf[4];
- valid = 1;
-
- if (!GetCommState(infoPtr->handle, &dcb)) {
- if (interp != NULL) {
- TclWinConvertError(GetLastError());
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "can't get comm state: %s", Tcl_PosixError(interp)));
- }
- return TCL_ERROR;
- }
- sprintf(buf, "%c", dcb.XonChar);
- Tcl_DStringAppendElement(dsPtr, buf);
- sprintf(buf, "%c", dcb.XoffChar);
- Tcl_DStringAppendElement(dsPtr, buf);
- }
- if (len == 0) {
- Tcl_DStringEndSublist(dsPtr);
- }
-
- /*
- * 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) {
- valid = 1;
- SerialErrorStr(infoPtr->lastError, dsPtr);
- }
-
- /*
- * get option -queue
- *
- * Option is readonly and returned by [fconfigure chan -queue].
- */
-
- if (len>1 && strncmp(optionName, "-queue", len)==0) {
- char buf[TCL_INTEGER_SPACE + 1];
- COMSTAT cStat;
- DWORD error;
- int inBuffered, outBuffered, count;
-
- valid = 1;
-
- /*
- * Query the pending data in Tcl's internal queues.
- */
-
- inBuffered = Tcl_InputBuffered(infoPtr->channel);
- outBuffered = Tcl_OutputBuffered(infoPtr->channel);
-
- /*
- * Query the number of bytes in our output queue:
- * 1. The bytes pending in the output thread
- * 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;
- LeaveCriticalSection(&infoPtr->csWrite);
-
- wsprintfA(buf, "%d", inBuffered + cStat.cbInQue);
- Tcl_DStringAppendElement(dsPtr, buf);
- 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].
- */
-
- if (len>4 && strncmp(optionName, "-ttystatus", len)==0) {
- DWORD status;
-
- if (!GetCommModemStatus(infoPtr->handle, &status)) {
- if (interp != NULL) {
- TclWinConvertError(GetLastError());
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "can't get tty status: %s", Tcl_PosixError(interp)));
- }
- return TCL_ERROR;
- }
- valid = 1;
- SerialModemStatusStr(status, dsPtr);
- }
-
- if (valid) {
- return TCL_OK;
- }
- return Tcl_BadChannelOption(interp, optionName,
- "mode pollinterval lasterror queue sysbuffer ttystatus xchar");
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * SerialThreadActionProc --
- *
- * Insert or remove any thread local refs to this channel.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Changes thread local list of valid channels.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-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.
- */
-
- 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.
- */
-
- 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/tcl8.6/win/tclWinSock.c b/tcl8.6/win/tclWinSock.c
deleted file mode 100644
index e2479e8..0000000
--- a/tcl8.6/win/tclWinSock.c
+++ /dev/null
@@ -1,3376 +0,0 @@
-/*
- * 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.
- *
- * -----------------------------------------------------------------------
- * The order and naming of functions in this file should minimize
- * the file diff to tclUnixSock.c.
- * -----------------------------------------------------------------------
- *
- * General information on how this module works.
- *
- * - Each Tcl-thread with its sockets maintains an internal window to receive
- * socket messages from the OS.
- *
- * - To ensure that message reception is always running this window is
- * actually owned and handled by an internal thread. This we call the
- * co-thread of Tcl's thread.
- *
- * - The whole structure is set up by InitSockets() which is called for each
- * Tcl thread. The implementation of the co-thread is in SocketThread(),
- * and the messages are handled by SocketProc(). The connection between
- * both is not directly visible, it is done through a Win32 window class.
- * This class is initialized by InitSockets() as well, and used in the
- * creation of the message receiver windows.
- *
- * - An important thing to note is that *both* thread and co-thread have
- * access to the list of sockets maintained in the private TSD data of the
- * thread. The co-thread was given access to it upon creation through the
- * new thread's client-data.
- *
- * Because of this dual access the TSD data contains an OS mutex, the
- * "socketListLock", to mediate exclusion between thread and co-thread.
- *
- * The co-thread's access is all in SocketProc(). The thread's access is
- * through SocketEventProc() (1) and the functions called by it.
- *
- * (Ad 1) This is the handler function for all queued socket events, which
- * all the OS messages are translated to through the EventSource (2)
- * driven by the OS messages.
- *
- * (Ad 2) The main functions for this are SocketSetupProc() and
- * SocketCheckProc().
- */
-
-#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.
- */
-
-#undef getservbyname
-#undef getsockopt
-#undef setsockopt
-
-/*
- * Helper macros to make parts of this file clearer. The macros do exactly
- * what they say on the tin. :-) They also only ever refer to their arguments
- * once, and so can be used without regard to side effects.
- */
-
-#define SET_BITS(var, bits) ((var) |= (bits))
-#define CLEAR_BITS(var, bits) ((var) &= ~(bits))
-
-/* "sock" + a pointer in hex + \0 */
-#define SOCK_CHAN_LENGTH (4 + sizeof(void *) * 2 + 1)
-#define SOCK_TEMPLATE "sock%p"
-
-/*
- * The following variable is used to tell whether this module has been
- * initialized. If 1, initialization of sockets was successful, if -1 then
- * socket initialization failed (WSAStartup failed).
- */
-
-static int initialized = 0;
-static const TCHAR classname[] = TEXT("TclSocket");
-TCL_DECLARE_MUTEX(socketMutex)
-
-/*
- * The following defines declare the messages used on socket windows.
- */
-
-#define SOCKET_MESSAGE WM_USER+1
-#define SOCKET_SELECT WM_USER+2
-#define SOCKET_TERMINATE WM_USER+3
-#define SELECT TRUE
-#define UNSELECT FALSE
-
-/*
- * This is needed to comply with the strict aliasing rules of GCC, but it also
- * simplifies casting between the different sockaddr types.
- */
-
-typedef union {
- struct sockaddr sa;
- struct sockaddr_in sa4;
- struct sockaddr_in6 sa6;
- struct sockaddr_storage sas;
-} address;
-
-#ifndef IN6_ARE_ADDR_EQUAL
-#define IN6_ARE_ADDR_EQUAL IN6_ADDR_EQUAL
-#endif
-
-/*
- * This structure describes per-instance state of a tcp based channel.
- */
-
-typedef struct TcpState TcpState;
-
-typedef struct TcpFdList {
- TcpState *statePtr;
- SOCKET fd;
- struct TcpFdList *next;
-} TcpFdList;
-
-struct TcpState {
- Tcl_Channel channel; /* Channel associated with this socket. */
- struct TcpFdList *sockets; /* Windows SOCKET handle. */
- int flags; /* Bit field comprised of the flags described
- * below. */
- int watchEvents; /* OR'ed combination of FD_READ, FD_WRITE,
- * FD_CLOSE, FD_ACCEPT and FD_CONNECT that
- * indicate which events are interesting. */
- volatile int readyEvents; /* OR'ed combination of FD_READ, FD_WRITE,
- * FD_CLOSE, FD_ACCEPT and FD_CONNECT that
- * indicate which events have occurred.
- * Set by notifier thread, access must be
- * protected by semaphore */
- int selectEvents; /* OR'ed combination of FD_READ, FD_WRITE,
- * FD_CLOSE, FD_ACCEPT and FD_CONNECT that
- * indicate which events are currently being
- * selected. */
- volatile int acceptEventCount;
- /* Count of the current number of FD_ACCEPTs
- * that have arrived and not yet processed.
- * Set by notifier thread, access must be
- * protected by semaphore */
- Tcl_TcpAcceptProc *acceptProc;
- /* Proc to call on accept. */
- ClientData acceptProcData; /* The data for the accept proc. */
-
- /*
- * Only needed for client sockets
- */
-
- struct addrinfo *addrlist; /* Addresses to connect to. */
- struct addrinfo *addr; /* Iterator over addrlist. */
- struct addrinfo *myaddrlist;/* Local address. */
- struct addrinfo *myaddr; /* Iterator over myaddrlist. */
- int connectError; /* Cache status of async socket. */
- int cachedBlocking; /* Cache blocking mode of async socket. */
- volatile int notifierConnectError;
- /* Async connect error set by notifier thread.
- * This error is still a windows error code.
- * Access must be protected by semaphore */
- struct TcpState *nextPtr; /* The next socket on the per-thread socket
- * list. */
-};
-
-/*
- * These bits may be ORed together into the "flags" field of a TcpState
- * structure.
- */
-
-#define TCP_NONBLOCKING (1<<0) /* Socket with non-blocking I/O */
-#define TCP_ASYNC_CONNECT (1<<1) /* Async connect in progress. */
-#define SOCKET_EOF (1<<2) /* A zero read happened on the
- * socket. */
-#define SOCKET_PENDING (1<<3) /* A message has been sent for this
- * socket */
-#define TCP_ASYNC_PENDING (1<<4) /* TcpConnect was called to
- * process an async connect. This
- * flag indicates that reentry is
- * still pending */
-#define TCP_ASYNC_FAILED (1<<5) /* An async connect finally failed */
-
-/*
- * The following structure is what is added to the Tcl event queue when a
- * socket event occurs.
- */
-
-typedef struct {
- Tcl_Event header; /* Information that is standard for all
- * events. */
- SOCKET socket; /* Socket descriptor that is ready. Used to
- * find the TcpState structure for the file
- * (can't point directly to the TcpState
- * structure because it could go away while
- * the event is queued). */
-} SocketEvent;
-
-/*
- * This defines the minimum buffersize maintained by the kernel.
- */
-
-#define TCP_BUFFER_SIZE 4096
-
-
-typedef struct {
- 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 */
- TcpState *pendingTcpState;
- /* This socket is opened but not jet in the
- * list. This value is also checked by
- * the event structure. */
- TcpState *socketList; /* Every open socket in this thread has an
- * entry on this list. */
-} ThreadSpecificData;
-
-static Tcl_ThreadDataKey dataKey;
-static WNDCLASS windowClass;
-
-/*
- * Static routines for this file:
- */
-
-static int TcpConnect(Tcl_Interp *interp,
- TcpState *state);
-static void InitSockets(void);
-static TcpState * NewSocketInfo(SOCKET socket);
-static void SocketExitHandler(ClientData clientData);
-static LRESULT CALLBACK SocketProc(HWND hwnd, UINT message, WPARAM wParam,
- LPARAM lParam);
-static int SocketsEnabled(void);
-static void TcpAccept(TcpFdList *fds, SOCKET newSocket, address addr);
-static int WaitForConnect(TcpState *statePtr, int *errorCodePtr);
-static int WaitForSocketEvent(TcpState *statePtr, int events,
- int *errorCodePtr);
-static void AddSocketInfoFd(TcpState *statePtr, SOCKET socket);
-static int FindFDInList(TcpState *statePtr, SOCKET socket);
-static DWORD WINAPI SocketThread(LPVOID arg);
-static void TcpThreadActionProc(ClientData instanceData,
- int action);
-
-static Tcl_EventCheckProc SocketCheckProc;
-static Tcl_EventProc SocketEventProc;
-static Tcl_EventSetupProc SocketSetupProc;
-static Tcl_DriverBlockModeProc TcpBlockModeProc;
-static Tcl_DriverCloseProc TcpCloseProc;
-static Tcl_DriverClose2Proc TcpClose2Proc;
-static Tcl_DriverSetOptionProc TcpSetOptionProc;
-static Tcl_DriverGetOptionProc TcpGetOptionProc;
-static Tcl_DriverInputProc TcpInputProc;
-static Tcl_DriverOutputProc TcpOutputProc;
-static Tcl_DriverWatchProc TcpWatchProc;
-static Tcl_DriverGetHandleProc TcpGetHandleProc;
-
-/*
- * This structure describes the channel type structure for TCP socket
- * based IO:
- */
-
-static const Tcl_ChannelType tcpChannelType = {
- "tcp", /* Type name. */
- TCL_CHANNEL_VERSION_5, /* v5 channel */
- TcpCloseProc, /* Close proc. */
- TcpInputProc, /* Input proc. */
- TcpOutputProc, /* Output proc. */
- NULL, /* Seek proc. */
- TcpSetOptionProc, /* Set option proc. */
- TcpGetOptionProc, /* Get option proc. */
- TcpWatchProc, /* Initialize notifier. */
- TcpGetHandleProc, /* Get OS handles out of channel. */
- TcpClose2Proc, /* Close2 proc. */
- TcpBlockModeProc, /* Set blocking or non-blocking mode.*/
- NULL, /* flush proc. */
- NULL, /* handler proc. */
- NULL, /* wide seek proc. */
- TcpThreadActionProc, /* thread action proc. */
- NULL /* truncate proc. */
-};
-
-/*
- * The following variable holds the network name of this host.
- */
-
-static TclInitProcessGlobalValueProc InitializeHostName;
-static ProcessGlobalValue hostName =
- {0, 0, NULL, NULL, InitializeHostName, NULL, NULL};
-
-/*
- * Address print debug functions
- */
-#if 0
-void printaddrinfo(struct addrinfo *ai, char *prefix)
-{
- char host[NI_MAXHOST], port[NI_MAXSERV];
- getnameinfo(ai->ai_addr, ai->ai_addrlen,
- host, sizeof(host),
- port, sizeof(port),
- NI_NUMERICHOST|NI_NUMERICSERV);
-}
-void printaddrinfolist(struct addrinfo *addrlist, char *prefix)
-{
- struct addrinfo *ai;
- for (ai = addrlist; ai != NULL; ai = ai->ai_next) {
- printaddrinfo(ai, prefix);
- }
-}
-#endif
-
-/*
- *----------------------------------------------------------------------
- *
- * InitializeHostName --
- *
- * This routine sets the process global value of the name of the local
- * host on which the process is running.
- *
- * Results:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-void
-InitializeHostName(
- char **valuePtr,
- int *lengthPtr,
- Tcl_Encoding *encodingPtr)
-{
- TCHAR tbuf[MAX_COMPUTERNAME_LENGTH + 1];
- DWORD length = MAX_COMPUTERNAME_LENGTH + 1;
- Tcl_DString ds;
-
- if (GetComputerName(tbuf, &length) != 0) {
- /*
- * Convert string from native to UTF then change to lowercase.
- */
-
- Tcl_UtfToLower(Tcl_WinTCharToUtf(tbuf, -1, &ds));
-
- } else {
- Tcl_DStringInit(&ds);
- if (TclpHasSockets(NULL) == TCL_OK) {
- /*
- * The buffer size of 256 is recommended by the MSDN page that
- * documents gethostname() as being always adequate.
- */
-
- Tcl_DString inDs;
-
- Tcl_DStringInit(&inDs);
- Tcl_DStringSetLength(&inDs, 256);
- if (gethostname(Tcl_DStringValue(&inDs),
- Tcl_DStringLength(&inDs)) == 0) {
- Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(&inDs), -1,
- &ds);
- }
- Tcl_DStringFree(&inDs);
- }
- }
-
- *encodingPtr = Tcl_GetEncoding(NULL, "utf-8");
- *lengthPtr = Tcl_DStringLength(&ds);
- *valuePtr = ckalloc((*lengthPtr) + 1);
- memcpy(*valuePtr, Tcl_DStringValue(&ds), (size_t)(*lengthPtr)+1);
- Tcl_DStringFree(&ds);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_GetHostName --
- *
- * 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.
- *
- * Side effects:
- * Caches the name to return for future calls.
- *
- *----------------------------------------------------------------------
- */
-
-const char *
-Tcl_GetHostName(void)
-{
- return Tcl_GetString(TclGetProcessGlobalValue(&hostName));
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * 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.
- *
- * Results:
- * 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.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclpHasSockets(
- Tcl_Interp *interp) /* Where to write an error message if sockets
- * are not present, or NULL if no such message
- * is to be written. */
-{
- Tcl_MutexLock(&socketMutex);
- InitSockets();
- Tcl_MutexUnlock(&socketMutex);
-
- if (SocketsEnabled()) {
- return TCL_OK;
- }
- if (interp != NULL) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "sockets are not available on this system", -1));
- }
- return TCL_ERROR;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclpFinalizeSockets --
- *
- * 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.
- *
- * Side effects:
- * Deletes the event source and destroys the socket thread.
- *
- *----------------------------------------------------------------------
- */
-
-void
-TclpFinalizeSockets(void)
-{
- ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
-
- /*
- * Careful! This is a finalizer!
- */
-
- if (tsdPtr == NULL) {
- return;
- }
-
- if (tsdPtr->socketThread != NULL) {
- if (tsdPtr->hwnd != NULL) {
- PostMessage(tsdPtr->hwnd, SOCKET_TERMINATE, 0, 0);
-
- /*
- * Wait for the thread to exit. This ensures that we are
- * completely cleaned up before we leave this function.
- */
-
- WaitForSingleObject(tsdPtr->readyEvent, INFINITE);
- tsdPtr->hwnd = NULL;
- }
- CloseHandle(tsdPtr->socketThread);
- tsdPtr->socketThread = NULL;
- }
- if (tsdPtr->readyEvent != NULL) {
- CloseHandle(tsdPtr->readyEvent);
- tsdPtr->readyEvent = NULL;
- }
- if (tsdPtr->socketListLock != NULL) {
- CloseHandle(tsdPtr->socketListLock);
- tsdPtr->socketListLock = NULL;
- }
- Tcl_DeleteEventSource(SocketSetupProc, SocketCheckProc, NULL);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TcpBlockModeProc --
- *
- * This function is invoked by the generic IO level to set blocking and
- * nonblocking mode on a TCP socket based channel.
- *
- * Results:
- * 0 if successful, errno when failed.
- *
- * Side effects:
- * Sets the device into blocking or nonblocking mode.
- *
- *----------------------------------------------------------------------
- */
-
- /* ARGSUSED */
-static int
-TcpBlockModeProc(
- ClientData instanceData, /* Socket state. */
- int mode) /* The mode to set. Can be one of
- * TCL_MODE_BLOCKING or
- * TCL_MODE_NONBLOCKING. */
-{
- TcpState *statePtr = instanceData;
-
- if (mode == TCL_MODE_NONBLOCKING) {
- statePtr->flags |= TCP_NONBLOCKING;
- } else {
- statePtr->flags &= ~(TCP_NONBLOCKING);
- }
- return 0;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * WaitForConnect --
- *
- * Check the state of an async connect process. If a connection
- * attempt terminated, process it, which may finalize it or may
- * start the next attempt. If a connect error occures, it is saved
- * in statePtr->connectError to be reported by 'fconfigure -error'.
- *
- * There are two modes of operation, defined by errorCodePtr:
- * * non-NULL: Called by explicite read/write command. block if
- * socket is blocking.
- * May return two error codes:
- * * EWOULDBLOCK: if connect is still in progress
- * * ENOTCONN: if connect failed. This would be the error
- * message of a rect or sendto syscall so this is
- * emulated here.
- * * Null: Called by a backround operation. Do not block and
- * don't return any error code.
- *
- * Results:
- * 0 if the connection has completed, -1 if still in progress
- * or there is an error.
- *
- * Side effects:
- * Processes socket events off the system queue.
- * May process asynchroneous connect.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-WaitForConnect(
- TcpState *statePtr, /* State of the socket. */
- int *errorCodePtr) /* Where to store errors?
- * A passed null-pointer activates background mode.
- */
-{
- int result;
- int oldMode;
- ThreadSpecificData *tsdPtr;
-
- /*
- * Check if an async connect failed already and error reporting is demanded,
- * return the error ENOTCONN
- */
-
- if (errorCodePtr != NULL && (statePtr->flags & TCP_ASYNC_FAILED)) {
- *errorCodePtr = ENOTCONN;
- return -1;
- }
-
- /*
- * Check if an async connect is running. If not return ok
- */
-
- if (!(statePtr->flags & TCP_ASYNC_CONNECT)) {
- return 0;
- }
-
- /*
- * Be sure to disable event servicing so we are truly modal.
- */
-
- oldMode = Tcl_SetServiceMode(TCL_SERVICE_NONE);
-
- /*
- * Loop in the blocking case until the connect signal is present
- */
-
- while (1) {
-
- /* get statePtr lock */
- tsdPtr = TclThreadDataKeyGet(&dataKey);
- WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
-
- /* Check for connect event */
- if (statePtr->readyEvents & FD_CONNECT) {
-
- /* Consume the connect event */
- statePtr->readyEvents &= ~(FD_CONNECT);
-
- /*
- * For blocking sockets and foreground processing
- * disable async connect as we continue now synchoneously
- */
- if ( errorCodePtr != NULL &&
- ! (statePtr->flags & TCP_NONBLOCKING) ) {
- CLEAR_BITS(statePtr->flags, TCP_ASYNC_CONNECT);
- }
-
- /* Free list lock */
- SetEvent(tsdPtr->socketListLock);
-
- /*
- * Continue connect.
- * If switched to synchroneous connect, the connect is terminated.
- */
- result = TcpConnect(NULL, statePtr);
-
- /* Restore event service mode */
- (void) Tcl_SetServiceMode(oldMode);
-
- /*
- * Check for Succesfull connect or async connect restart
- */
-
- if (result == TCL_OK) {
- /*
- * Check for async connect restart
- * (not possible for foreground blocking operation)
- */
- if ( statePtr->flags & TCP_ASYNC_PENDING ) {
- if (errorCodePtr != NULL) {
- *errorCodePtr = EWOULDBLOCK;
- }
- return -1;
- }
- return 0;
- }
-
- /*
- * Connect finally failed.
- * For foreground operation return ENOTCONN.
- */
-
- if (errorCodePtr != NULL) {
- *errorCodePtr = ENOTCONN;
- }
- return -1;
- }
-
- /* Free list lock */
- SetEvent(tsdPtr->socketListLock);
-
- /*
- * Background operation returns with no action as there was no connect
- * event
- */
-
- if ( errorCodePtr == NULL ) {
- return -1;
- }
-
- /*
- * A non blocking socket waiting for an asynchronous connect
- * returns directly the error EWOULDBLOCK
- */
-
- if (statePtr->flags & TCP_NONBLOCKING) {
- *errorCodePtr = EWOULDBLOCK;
- return -1;
- }
-
- /*
- * Wait until something happens.
- */
-
- WaitForSingleObject(tsdPtr->readyEvent, INFINITE);
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TcpInputProc --
- *
- * This function is invoked by the generic IO level to read input from a
- * TCP socket based channel.
- *
- * Results:
- * The number of bytes read is returned or -1 on error. An output
- * argument contains the POSIX error code on error, or zero if no error
- * occurred.
- *
- * Side effects:
- * Reads input from the input device of the channel.
- *
- *----------------------------------------------------------------------
- */
-
- /* ARGSUSED */
-static int
-TcpInputProc(
- ClientData instanceData, /* Socket state. */
- char *buf, /* Where to store data read. */
- int bufSize, /* How much space is available in the
- * buffer? */
- int *errorCodePtr) /* Where to store error code. */
-{
- TcpState *statePtr = instanceData;
- int bytesRead;
- DWORD error;
- ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
-
- *errorCodePtr = 0;
-
- /*
- * Check that WinSock is initialized; do not call it if not, to prevent
- * system crashes. This can happen at exit time if the exit handler for
- * WinSock ran before other exit handlers that want to use sockets.
- */
-
- if (!SocketsEnabled()) {
- *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.
- */
-
- if (statePtr->flags & SOCKET_EOF) {
- return 0;
- }
-
- /*
- * Check if there is an async connect running.
- * For blocking sockets terminate connect, otherwise do one step.
- * For a non blocking socket return EWOULDBLOCK if connect not terminated
- */
-
- if (WaitForConnect(statePtr, errorCodePtr) != 0) {
- return -1;
- }
-
- /*
- * 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) statePtr);
- /* single fd operation: this proc is only called for a connected socket. */
- bytesRead = recv(statePtr->sockets->fd, buf, bufSize, 0);
- statePtr->readyEvents &= ~(FD_READ);
-
- /*
- * Check for end-of-file condition or successful read.
- */
-
- if (bytesRead == 0) {
- statePtr->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 (statePtr->readyEvents & FD_CLOSE) {
- statePtr->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) {
- statePtr->flags |= SOCKET_EOF;
- bytesRead = 0;
- break;
- }
-
- /*
- * Check for error condition or underflow in non-blocking case.
- */
-
- if ((statePtr->flags & TCP_NONBLOCKING) || (error != WSAEWOULDBLOCK)) {
- TclWinConvertError(error);
- *errorCodePtr = Tcl_GetErrno();
- bytesRead = -1;
- break;
- }
-
- /*
- * In the blocking case, wait until the file becomes readable or
- * closed and try again.
- */
-
- if (!WaitForSocketEvent(statePtr, FD_READ|FD_CLOSE, errorCodePtr)) {
- bytesRead = -1;
- break;
- }
- }
-
- SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM)SELECT, (LPARAM)statePtr);
-
- return bytesRead;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TcpOutputProc --
- *
- * 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.
- *
- * Side effects:
- * Produces output on the socket.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-TcpOutputProc(
- ClientData instanceData, /* Socket state. */
- const char *buf, /* The data buffer. */
- int toWrite, /* How many bytes to write? */
- int *errorCodePtr) /* Where to store error code. */
-{
- TcpState *statePtr = instanceData;
- int written;
- DWORD error;
- ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
-
- *errorCodePtr = 0;
-
- /*
- * Check that WinSock is initialized; do not call it if not, to prevent
- * system crashes. This can happen at exit time if the exit handler for
- * WinSock ran before other exit handlers that want to use sockets.
- */
-
- if (!SocketsEnabled()) {
- *errorCodePtr = EFAULT;
- return -1;
- }
-
- /*
- * Check if there is an async connect running.
- * For blocking sockets terminate connect, otherwise do one step.
- * For a non blocking socket return EWOULDBLOCK if connect not terminated
- */
-
- if (WaitForConnect(statePtr, errorCodePtr) != 0) {
- return -1;
- }
-
- while (1) {
- SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
- (WPARAM) UNSELECT, (LPARAM) statePtr);
-
- /* single fd operation: this proc is only called for a connected socket. */
- written = send(statePtr->sockets->fd, buf, toWrite, 0);
- if (written != SOCKET_ERROR) {
- /*
- * Since Windows won't generate a new write event until we hit an
- * overflow condition, we need to force the event loop to poll
- * until the condition changes.
- */
-
- if (statePtr->watchEvents & FD_WRITE) {
- Tcl_Time blockTime = { 0, 0 };
- Tcl_SetMaxBlockTime(&blockTime);
- }
- break;
- }
-
- /*
- * Check for error condition or overflow. In the event of overflow, we
- * need to clear the FD_WRITE flag so we can detect the next writable
- * event. Note that Windows only sends a new writable event after a
- * send fails with WSAEWOULDBLOCK.
- */
-
- error = WSAGetLastError();
- if (error == WSAEWOULDBLOCK) {
- statePtr->readyEvents &= ~(FD_WRITE);
- if (statePtr->flags & TCP_NONBLOCKING) {
- *errorCodePtr = EWOULDBLOCK;
- written = -1;
- break;
- }
- } else {
- TclWinConvertError(error);
- *errorCodePtr = Tcl_GetErrno();
- written = -1;
- break;
- }
-
- /*
- * In the blocking case, wait until the file becomes writable or
- * closed and try again.
- */
-
- if (!WaitForSocketEvent(statePtr, FD_WRITE|FD_CLOSE, errorCodePtr)) {
- written = -1;
- break;
- }
- }
-
- SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM)SELECT, (LPARAM)statePtr);
-
- return written;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TcpCloseProc --
- *
- * 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.
- *
- * Side effects:
- * Closes the socket.
- *
- *----------------------------------------------------------------------
- */
-
- /* ARGSUSED */
-static int
-TcpCloseProc(
- ClientData instanceData, /* The socket to close. */
- Tcl_Interp *interp) /* Unused. */
-{
- TcpState *statePtr = 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.
- */
-
- 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.
- */
-
- while ( statePtr->sockets != NULL ) {
- TcpFdList *thisfd = statePtr->sockets;
- statePtr->sockets = thisfd->next;
-
- if (closesocket(thisfd->fd) == SOCKET_ERROR) {
- TclWinConvertError((DWORD) WSAGetLastError());
- errorCode = Tcl_GetErrno();
- }
- ckfree(thisfd);
- }
- }
-
- if (statePtr->addrlist != NULL) {
- freeaddrinfo(statePtr->addrlist);
- }
- if (statePtr->myaddrlist != NULL) {
- freeaddrinfo(statePtr->myaddrlist);
- }
-
- /*
- * Clear an eventual tsd info list pointer.
- * This may be called, if an async socket connect fails or is closed
- * between connect and thread action callback.
- */
- if (tsdPtr->pendingTcpState != NULL
- && tsdPtr->pendingTcpState == statePtr) {
-
- /* get infoPtr lock, because this concerns the notifier thread */
- WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
-
- tsdPtr->pendingTcpState = NULL;
-
- /* Free list lock */
- SetEvent(tsdPtr->socketListLock);
- }
-
- /*
- * 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(statePtr);
- return errorCode;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TcpClose2Proc --
- *
- * This function is called by the generic IO level to perform the channel
- * type specific part of a half-close: namely, a shutdown() on a socket.
- *
- * Results:
- * 0 if successful, the value of errno if failed.
- *
- * Side effects:
- * Shuts down one side of the socket.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-TcpClose2Proc(
- ClientData instanceData, /* The socket to close. */
- Tcl_Interp *interp, /* For error reporting. */
- int flags) /* Flags that indicate which side to close. */
-{
- TcpState *statePtr = instanceData;
- int errorCode = 0;
- int sd;
-
- /*
- * Shutdown the OS socket handle.
- */
-
- switch(flags) {
- case TCL_CLOSE_READ:
- sd = SD_RECEIVE;
- break;
- case TCL_CLOSE_WRITE:
- sd = SD_SEND;
- break;
- default:
- if (interp) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "socket close2proc called bidirectionally", -1));
- }
- return TCL_ERROR;
- }
-
- /* single fd operation: Tcl_OpenTcpServer() does not set TCL_READABLE or
- * TCL_WRITABLE so this should never be called for a server socket. */
- if (shutdown(statePtr->sockets->fd, sd) == SOCKET_ERROR) {
- TclWinConvertError((DWORD) WSAGetLastError());
- errorCode = Tcl_GetErrno();
- }
-
- return errorCode;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TcpSetOptionProc --
- *
- * Sets Tcp channel specific options.
- *
- * Results:
- * None, unless an error happens.
- *
- * Side effects:
- * Changes attributes of the socket at the system level.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-TcpSetOptionProc(
- ClientData instanceData, /* Socket state. */
- Tcl_Interp *interp, /* For error reporting - can be NULL. */
- const char *optionName, /* Name of the option to set. */
- const char *value) /* New value for option. */
-{
-#ifdef TCL_FEATURE_KEEPALIVE_NAGLE
- TcpState *statePtr = instanceData;
- SOCKET sock;
-#endif /*TCL_FEATURE_KEEPALIVE_NAGLE*/
-
- /*
- * 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_SetObjResult(interp, Tcl_NewStringObj(
- "winsock is not initialized", -1));
- }
- return TCL_ERROR;
- }
-
-#ifdef TCL_FEATURE_KEEPALIVE_NAGLE
- #error "TCL_FEATURE_KEEPALIVE_NAGLE not reviewed for whether to treat statePtr->sockets as single fd or list"
- sock = statePtr->sockets->fd;
-
- if (!strcasecmp(optionName, "-keepalive")) {
- BOOL val = FALSE;
- int boolVar, rtn;
-
- if (Tcl_GetBoolean(interp, value, &boolVar) != TCL_OK) {
- return TCL_ERROR;
- }
- if (boolVar) {
- val = TRUE;
- }
- rtn = setsockopt(sock, SOL_SOCKET, SO_KEEPALIVE,
- (const char *) &val, sizeof(BOOL));
- if (rtn != 0) {
- TclWinConvertError(WSAGetLastError());
- if (interp) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "couldn't set socket option: %s",
- Tcl_PosixError(interp)));
- }
- return TCL_ERROR;
- }
- return TCL_OK;
- } else if (!strcasecmp(optionName, "-nagle")) {
- BOOL val = FALSE;
- int boolVar, rtn;
-
- if (Tcl_GetBoolean(interp, value, &boolVar) != TCL_OK) {
- return TCL_ERROR;
- }
- if (!boolVar) {
- val = TRUE;
- }
- rtn = setsockopt(sock, IPPROTO_TCP, TCP_NODELAY,
- (const char *) &val, sizeof(BOOL));
- if (rtn != 0) {
- TclWinConvertError(WSAGetLastError());
- if (interp) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "couldn't set socket option: %s",
- Tcl_PosixError(interp)));
- }
- return TCL_ERROR;
- }
- return TCL_OK;
- }
-
- return Tcl_BadChannelOption(interp, optionName, "keepalive nagle");
-#else
- return Tcl_BadChannelOption(interp, optionName, "");
-#endif /*TCL_FEATURE_KEEPALIVE_NAGLE*/
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TcpGetOptionProc --
- *
- * Computes an option value for a TCP socket based channel, or a list of
- * all options and their values.
- *
- * Note: This code is based on code contributed by John Haxby.
- *
- * Results:
- * A standard Tcl result. The value of the specified option or a list of
- * all options and their values is returned in the supplied DString. Sets
- * Error message if needed.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-TcpGetOptionProc(
- ClientData instanceData, /* Socket state. */
- Tcl_Interp *interp, /* For error reporting - can be NULL. */
- const char *optionName, /* Name of the option to retrieve the value
- * for, or NULL to get all options and their
- * values. */
- Tcl_DString *dsPtr) /* Where to store the computed value;
- * initialized by caller. */
-{
- TcpState *statePtr = instanceData;
- char host[NI_MAXHOST], port[NI_MAXSERV];
- SOCKET sock;
- size_t len = 0;
- int reverseDNS = 0;
-#define SUPPRESS_RDNS_VAR "::tcl::unsupported::noReverseDNS"
-
- /*
- * 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_SetObjResult(interp, Tcl_NewStringObj(
- "winsock is not initialized", -1));
- }
- return TCL_ERROR;
- }
-
- /*
- * Go one step in async connect
- * If any error is thrown save it as backround error to report eventually below
- */
- WaitForConnect(statePtr, NULL);
-
- sock = statePtr->sockets->fd;
- if (optionName != NULL) {
- len = strlen(optionName);
- }
-
- if ((len > 1) && (optionName[1] == 'e') &&
- (strncmp(optionName, "-error", len) == 0)) {
-
- /*
- * Do not return any errors if async connect is running
- */
- if ( ! (statePtr->flags & TCP_ASYNC_PENDING) ) {
-
-
- if ( statePtr->flags & TCP_ASYNC_FAILED ) {
-
- /*
- * In case of a failed async connect, eventually report the
- * connect error only once.
- * Do not report the system error, as this comes again and again.
- */
-
- if ( statePtr->connectError != 0 ) {
- Tcl_DStringAppend(dsPtr,
- Tcl_ErrnoMsg(statePtr->connectError), -1);
- statePtr->connectError = 0;
- }
-
- } else {
-
- /*
- * Report an eventual last error of the socket system
- */
-
- int optlen;
- int ret;
- DWORD err;
-
- /*
- * Populater the err Variable with a possix error
- */
- optlen = sizeof(int);
- ret = getsockopt(sock, SOL_SOCKET, SO_ERROR,
- (char *)&err, &optlen);
- /*
- * The error was not returned directly but should be
- * taken from WSA
- */
- if (ret == SOCKET_ERROR) {
- err = WSAGetLastError();
- }
- /*
- * Return error message
- */
- if (err) {
- TclWinConvertError(err);
- Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(Tcl_GetErrno()), -1);
- }
- }
- }
- return TCL_OK;
- }
-
- if ((len > 1) && (optionName[1] == 'c') &&
- (strncmp(optionName, "-connecting", len) == 0)) {
-
- Tcl_DStringAppend(dsPtr,
- (statePtr->flags & TCP_ASYNC_PENDING)
- ? "1" : "0", -1);
- return TCL_OK;
- }
-
- if (interp != NULL && Tcl_GetVar(interp, SUPPRESS_RDNS_VAR, 0) != NULL) {
- reverseDNS = NI_NUMERICHOST;
- }
-
- if ((len == 0) || ((len > 1) && (optionName[1] == 'p') &&
- (strncmp(optionName, "-peername", len) == 0))) {
- address peername;
- socklen_t size = sizeof(peername);
-
- if ( (statePtr->flags & TCP_ASYNC_PENDING) ) {
- /*
- * In async connect output an empty string
- */
- if (len == 0) {
- Tcl_DStringAppendElement(dsPtr, "-peername");
- Tcl_DStringAppendElement(dsPtr, "");
- } else {
- return TCL_OK;
- }
- } else if ( getpeername(sock, (LPSOCKADDR) &(peername.sa), &size) == 0) {
- /*
- * Peername fetch succeeded - output list
- */
- if (len == 0) {
- Tcl_DStringAppendElement(dsPtr, "-peername");
- Tcl_DStringStartSublist(dsPtr);
- }
-
- getnameinfo(&(peername.sa), size, host, sizeof(host),
- NULL, 0, NI_NUMERICHOST);
- Tcl_DStringAppendElement(dsPtr, host);
- getnameinfo(&(peername.sa), size, host, sizeof(host),
- port, sizeof(port), reverseDNS | NI_NUMERICSERV);
- Tcl_DStringAppendElement(dsPtr, host);
- Tcl_DStringAppendElement(dsPtr, port);
- if (len == 0) {
- Tcl_DStringEndSublist(dsPtr);
- } else {
- return TCL_OK;
- }
- } else {
- /*
- * 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) {
- TclWinConvertError((DWORD) WSAGetLastError());
- if (interp) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "can't get peername: %s",
- Tcl_PosixError(interp)));
- }
- return TCL_ERROR;
- }
- }
- }
-
- if ((len == 0) || ((len > 1) && (optionName[1] == 's') &&
- (strncmp(optionName, "-sockname", len) == 0))) {
- TcpFdList *fds;
- address sockname;
- socklen_t size;
- int found = 0;
-
- if (len == 0) {
- Tcl_DStringAppendElement(dsPtr, "-sockname");
- Tcl_DStringStartSublist(dsPtr);
- }
- if ( (statePtr->flags & TCP_ASYNC_PENDING ) ) {
- /*
- * In async connect output an empty string
- */
- found = 1;
- } else {
- for (fds = statePtr->sockets; fds != NULL; fds = fds->next) {
- sock = fds->fd;
- size = sizeof(sockname);
- if (getsockname(sock, &(sockname.sa), &size) >= 0) {
- int flags = reverseDNS;
-
- found = 1;
- getnameinfo(&sockname.sa, size, host, sizeof(host),
- NULL, 0, NI_NUMERICHOST);
- Tcl_DStringAppendElement(dsPtr, host);
-
- /*
- * We don't want to resolve INADDR_ANY and sin6addr_any; they
- * can sometimes cause problems (and never have a name).
- */
- flags |= NI_NUMERICSERV;
- if (sockname.sa.sa_family == AF_INET) {
- if (sockname.sa4.sin_addr.s_addr == INADDR_ANY) {
- flags |= NI_NUMERICHOST;
- }
- } else if (sockname.sa.sa_family == AF_INET6) {
- if ((IN6_ARE_ADDR_EQUAL(&sockname.sa6.sin6_addr,
- &in6addr_any)) ||
- (IN6_IS_ADDR_V4MAPPED(&sockname.sa6.sin6_addr)
- && sockname.sa6.sin6_addr.s6_addr[12] == 0
- && sockname.sa6.sin6_addr.s6_addr[13] == 0
- && sockname.sa6.sin6_addr.s6_addr[14] == 0
- && sockname.sa6.sin6_addr.s6_addr[15] == 0)) {
- flags |= NI_NUMERICHOST;
- }
- }
- getnameinfo(&sockname.sa, size, host, sizeof(host),
- port, sizeof(port), flags);
- Tcl_DStringAppendElement(dsPtr, host);
- Tcl_DStringAppendElement(dsPtr, port);
- }
- }
- }
- if (found) {
- if (len) {
- return TCL_OK;
- }
- Tcl_DStringEndSublist(dsPtr);
- } else {
- if (interp) {
- TclWinConvertError((DWORD) WSAGetLastError());
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "can't get sockname: %s", Tcl_PosixError(interp)));
- }
- return TCL_ERROR;
- }
- }
-
-#ifdef TCL_FEATURE_KEEPALIVE_NAGLE
- if (len == 0 || !strncmp(optionName, "-keepalive", len)) {
- int optlen;
- BOOL opt = FALSE;
-
- if (len == 0) {
- Tcl_DStringAppendElement(dsPtr, "-keepalive");
- }
- optlen = sizeof(BOOL);
- getsockopt(sock, SOL_SOCKET, SO_KEEPALIVE, (char *)&opt, &optlen);
- if (opt) {
- Tcl_DStringAppendElement(dsPtr, "1");
- } else {
- Tcl_DStringAppendElement(dsPtr, "0");
- }
- 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");
- }
- optlen = sizeof(BOOL);
- getsockopt(sock, IPPROTO_TCP, TCP_NODELAY, (char *)&opt, &optlen);
- if (opt) {
- Tcl_DStringAppendElement(dsPtr, "0");
- } else {
- Tcl_DStringAppendElement(dsPtr, "1");
- }
- if (len > 0) {
- return TCL_OK;
- }
- }
-#endif /*TCL_FEATURE_KEEPALIVE_NAGLE*/
-
- if (len > 0) {
-#ifdef TCL_FEATURE_KEEPALIVE_NAGLE
- return Tcl_BadChannelOption(interp, optionName,
- "connecting peername sockname keepalive nagle");
-#else
- return Tcl_BadChannelOption(interp, optionName, "connecting peername sockname");
-#endif /*TCL_FEATURE_KEEPALIVE_NAGLE*/
- }
-
- return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TcpWatchProc --
- *
- * 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.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-TcpWatchProc(
- ClientData instanceData, /* The socket state. */
- int mask) /* Events of interest; an OR-ed combination of
- * TCL_READABLE, TCL_WRITABLE and
- * TCL_EXCEPTION. */
-{
- TcpState *statePtr = instanceData;
-
- /*
- * Update the watch events mask. Only if the socket is not a server
- * socket. [Bug 557878]
- */
-
- if (!statePtr->acceptProc) {
- statePtr->watchEvents = 0;
- if (mask & TCL_READABLE) {
- statePtr->watchEvents |= (FD_READ|FD_CLOSE);
- }
- if (mask & TCL_WRITABLE) {
- statePtr->watchEvents |= (FD_WRITE|FD_CLOSE);
- }
-
- /*
- * If there are any conditions already set, then tell the notifier to
- * poll rather than block.
- */
-
- if (statePtr->readyEvents & statePtr->watchEvents) {
- Tcl_Time blockTime = { 0, 0 };
-
- Tcl_SetMaxBlockTime(&blockTime);
- }
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TcpGetHandleProc --
- *
- * Called from Tcl_GetChannelHandle to retrieve OS handles from inside a
- * TCP socket based channel.
- *
- * Results:
- * Returns TCL_OK with the fd in handlePtr, or TCL_ERROR if there is no
- * handle for the specified direction.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
- /* ARGSUSED */
-static int
-TcpGetHandleProc(
- ClientData instanceData, /* The socket state. */
- int direction, /* Not used. */
- ClientData *handlePtr) /* Where to store the handle. */
-{
- TcpState *statePtr = instanceData;
-
- *handlePtr = INT2PTR(statePtr->sockets->fd);
- return TCL_OK;
-}
-
-
-
-/*
- *----------------------------------------------------------------------
- *
- * TcpConnect --
- *
- * This function opens a new socket in client mode.
- *
- * This might be called in 3 circumstances:
- * - By a regular socket command
- * - By the event handler to continue an asynchronously connect
- * - By a blocking socket function (gets/puts) to terminate the
- * connect synchronously
- *
- * Results:
- * TCL_OK, if the socket was successfully connected or an asynchronous
- * connection is in progress. If an error occurs, TCL_ERROR is returned
- * and an error message is left in interp.
- *
- * Side effects:
- * Opens a socket.
- *
- * Remarks:
- * A single host name may resolve to more than one IP address, e.g. for
- * an IPv4/IPv6 dual stack host. For handling asynchronously connecting
- * sockets in the background for such hosts, this function can act as a
- * coroutine. On the first call, it sets up the control variables for the
- * two nested loops over the local and remote addresses. Once the first
- * connection attempt is in progress, it sets up itself as a writable
- * event handler for that socket, and returns. When the callback occurs,
- * control is transferred to the "reenter" label, right after the initial
- * return and the loops resume as if they had never been interrupted.
- * For synchronously connecting sockets, the loops work the usual way.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-TcpConnect(
- Tcl_Interp *interp, /* For error reporting; can be NULL. */
- TcpState *statePtr)
-{
- DWORD error;
- /*
- * We are started with async connect and the connect notification
- * was not jet received
- */
- int async_connect = statePtr->flags & TCP_ASYNC_CONNECT;
- /* We were called by the event procedure and continue our loop */
- int async_callback = statePtr->flags & TCP_ASYNC_PENDING;
- ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
-
- if (async_callback) {
- goto reenter;
- }
-
- for (statePtr->addr = statePtr->addrlist; statePtr->addr != NULL;
- statePtr->addr = statePtr->addr->ai_next) {
-
- for (statePtr->myaddr = statePtr->myaddrlist; statePtr->myaddr != NULL;
- statePtr->myaddr = statePtr->myaddr->ai_next) {
-
- /*
- * No need to try combinations of local and remote addresses
- * of different families.
- */
-
- if (statePtr->myaddr->ai_family != statePtr->addr->ai_family) {
- continue;
- }
-
- /*
- * Close the socket if it is still open from the last unsuccessful
- * iteration.
- */
- if (statePtr->sockets->fd != INVALID_SOCKET) {
- closesocket(statePtr->sockets->fd);
- }
-
- /* get statePtr lock */
- WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
-
- /*
- * Reset last error from last try
- */
- statePtr->notifierConnectError = 0;
- Tcl_SetErrno(0);
-
- statePtr->sockets->fd = socket(statePtr->myaddr->ai_family, SOCK_STREAM, 0);
-
- /* Free list lock */
- SetEvent(tsdPtr->socketListLock);
-
- /* continue on socket creation error */
- if (statePtr->sockets->fd == INVALID_SOCKET) {
- TclWinConvertError((DWORD) WSAGetLastError());
- continue;
- }
-
- /*
- * Win-NT has a misfeature that sockets are inherited in child
- * processes by default. Turn off the inherit bit.
- */
-
- SetHandleInformation((HANDLE) statePtr->sockets->fd, HANDLE_FLAG_INHERIT, 0);
-
- /*
- * Set kernel space buffering
- */
-
- TclSockMinimumBuffers((void *) statePtr->sockets->fd, TCP_BUFFER_SIZE);
-
- /*
- * Try to bind to a local port.
- */
-
- if (bind(statePtr->sockets->fd, statePtr->myaddr->ai_addr,
- statePtr->myaddr->ai_addrlen) == SOCKET_ERROR) {
- TclWinConvertError((DWORD) WSAGetLastError());
- continue;
- }
- /*
- * For asynchroneous connect set the socket in nonblocking mode
- * and activate connect notification
- */
- if (async_connect) {
- TcpState *statePtr2;
- int in_socket_list = 0;
- /* get statePtr lock */
- WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
-
- /*
- * Bugfig for 336441ed59 to not ignore notifications until the
- * infoPtr is in the list.
- * Check if my statePtr is already in the tsdPtr->socketList
- * It is set after this call by TcpThreadActionProc and is set
- * on a second round.
- *
- * If not, we buffer my statePtr in the tsd memory so it is not
- * lost by the event procedure
- */
-
- for (statePtr2 = tsdPtr->socketList; statePtr2 != NULL;
- statePtr2 = statePtr2->nextPtr) {
- if (statePtr2 == statePtr) {
- in_socket_list = 1;
- break;
- }
- }
- if (!in_socket_list) {
- tsdPtr->pendingTcpState = statePtr;
- }
- /*
- * Set connect mask to connect events
- * This is activated by a SOCKET_SELECT message to the notifier
- * thread.
- */
- statePtr->selectEvents |= FD_CONNECT;
-
- /*
- * Free list lock
- */
- SetEvent(tsdPtr->socketListLock);
-
- /* activate accept notification */
- SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
- (LPARAM) statePtr);
- }
-
- /*
- * Attempt to connect to the remote socket.
- */
-
- connect(statePtr->sockets->fd, statePtr->addr->ai_addr,
- statePtr->addr->ai_addrlen);
-
- error = WSAGetLastError();
- TclWinConvertError(error);
-
- if (async_connect && error == WSAEWOULDBLOCK) {
- /*
- * Asynchroneous connect
- */
-
- /*
- * Remember that we jump back behind this next round
- */
- statePtr->flags |= TCP_ASYNC_PENDING;
- return TCL_OK;
-
- reenter:
- /*
- * Re-entry point for async connect after connect event or
- * blocking operation
- *
- * Clear the reenter flag
- */
- statePtr->flags &= ~(TCP_ASYNC_PENDING);
- /* get statePtr lock */
- WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
- /* Get signaled connect error */
- TclWinConvertError((DWORD) statePtr->notifierConnectError);
- /* Clear eventual connect flag */
- statePtr->selectEvents &= ~(FD_CONNECT);
- /* Free list lock */
- SetEvent(tsdPtr->socketListLock);
- }
-
- /*
- * Clear the tsd socket list pointer if we did not wait for
- * the FD_CONNECT asynchroneously
- */
- tsdPtr->pendingTcpState = NULL;
-
- if (Tcl_GetErrno() == 0) {
- goto out;
- }
- }
- }
-
-out:
- /*
- * Socket connected or connection failed
- */
-
- /*
- * Async connect terminated
- */
-
- CLEAR_BITS(statePtr->flags, TCP_ASYNC_CONNECT);
-
- if ( Tcl_GetErrno() == 0 ) {
- /*
- * Succesfully connected
- */
- /*
- * Set up the select mask for read/write events.
- */
- statePtr->selectEvents = FD_READ | FD_WRITE | FD_CLOSE;
-
- /*
- * Register for interest in events in the select mask. Note that this
- * automatically places the socket into non-blocking mode.
- */
-
- SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
- (LPARAM) statePtr);
- } else {
- /*
- * Connect failed
- */
-
- /*
- * For async connect schedule a writable event to report the fail.
- */
- if (async_callback) {
- /*
- * Set up the select mask for read/write events.
- */
- statePtr->selectEvents = FD_WRITE|FD_READ;
- /* get statePtr lock */
- WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
- /* Signal ready readable and writable events */
- statePtr->readyEvents |= FD_WRITE | FD_READ;
- /* Flag error to event routine */
- statePtr->flags |= TCP_ASYNC_FAILED;
- /* Save connect error to be reported by 'fconfigure -error' */
- statePtr->connectError = Tcl_GetErrno();
- /* Free list lock */
- SetEvent(tsdPtr->socketListLock);
- }
- /*
- * Error message on synchroneous connect
- */
- if (interp != NULL) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "couldn't open socket: %s", Tcl_PosixError(interp)));
- }
- return TCL_ERROR;
- }
- return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_OpenTcpClient --
- *
- * 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.
- *
- * Side effects:
- * Opens a client socket and creates a new channel.
- *
- *----------------------------------------------------------------------
- */
-
-Tcl_Channel
-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, attempt to do an asynchronous
- * connect. Otherwise we do a blocking
- * connect. */
-{
- TcpState *statePtr;
- const char *errorMsg = NULL;
- struct addrinfo *addrlist = NULL, *myaddrlist = NULL;
- char channelName[SOCK_CHAN_LENGTH];
-
- if (TclpHasSockets(interp) != TCL_OK) {
- return NULL;
- }
-
- /*
- * Check that WinSock is initialized; do not call it if not, to prevent
- * system crashes. This can happen at exit time if the exit handler for
- * WinSock ran before other exit handlers that want to use sockets.
- */
-
- if (!SocketsEnabled()) {
- return NULL;
- }
-
- /*
- * Do the name lookups for the local and remote addresses.
- */
-
- if (!TclCreateSocketAddress(interp, &addrlist, host, port, 0, &errorMsg)
- || !TclCreateSocketAddress(interp, &myaddrlist, myaddr, myport, 1,
- &errorMsg)) {
- if (addrlist != NULL) {
- freeaddrinfo(addrlist);
- }
- if (interp != NULL) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "couldn't open socket: %s", errorMsg));
- }
- return NULL;
- }
-
- statePtr = NewSocketInfo(INVALID_SOCKET);
- statePtr->addrlist = addrlist;
- statePtr->myaddrlist = myaddrlist;
- if (async) {
- statePtr->flags |= TCP_ASYNC_CONNECT;
- }
-
- /*
- * Create a new client socket and wrap it in a channel.
- */
- if (TcpConnect(interp, statePtr) != TCL_OK) {
- TcpCloseProc(statePtr, NULL);
- return NULL;
- }
-
- sprintf(channelName, SOCK_TEMPLATE, statePtr);
-
- statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
- statePtr, (TCL_READABLE | TCL_WRITABLE));
- if (TCL_ERROR == Tcl_SetChannelOption(NULL, statePtr->channel,
- "-translation", "auto crlf")) {
- Tcl_Close(NULL, statePtr->channel);
- return NULL;
- } else if (TCL_ERROR == Tcl_SetChannelOption(NULL, statePtr->channel,
- "-eofchar", "")) {
- Tcl_Close(NULL, statePtr->channel);
- return NULL;
- }
- return statePtr->channel;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_MakeTcpClientChannel --
- *
- * Creates a Tcl_Channel from an existing client TCP socket.
- *
- * Results:
- * The Tcl_Channel wrapped around the preexisting TCP socket.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-Tcl_Channel
-Tcl_MakeTcpClientChannel(
- ClientData sock) /* The socket to wrap up into a channel. */
-{
- TcpState *statePtr;
- char channelName[SOCK_CHAN_LENGTH];
- ThreadSpecificData *tsdPtr;
-
- if (TclpHasSockets(NULL) != TCL_OK) {
- return NULL;
- }
-
- tsdPtr = TclThreadDataKeyGet(&dataKey);
-
- /*
- * Set kernel space buffering and non-blocking.
- */
-
- TclSockMinimumBuffers(sock, TCP_BUFFER_SIZE);
-
- statePtr = NewSocketInfo((SOCKET) sock);
-
- /*
- * Start watching for read/write events on the socket.
- */
-
- statePtr->selectEvents = FD_READ | FD_CLOSE | FD_WRITE;
- SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM)SELECT, (LPARAM)statePtr);
-
- sprintf(channelName, SOCK_TEMPLATE, statePtr);
- statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
- statePtr, (TCL_READABLE | TCL_WRITABLE));
- Tcl_SetChannelOption(NULL, statePtr->channel, "-translation", "auto crlf");
- return statePtr->channel;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_OpenTcpServer --
- *
- * Opens a TCP server socket and creates a channel around it.
- *
- * Results:
- * The channel or NULL if failed. If an error occurred, an error message
- * is left in the interp's result if interp is not NULL.
- *
- * Side effects:
- * Opens a server socket and creates a new channel.
- *
- *----------------------------------------------------------------------
- */
-
-Tcl_Channel
-Tcl_OpenTcpServer(
- Tcl_Interp *interp, /* For error reporting - may be NULL. */
- int port, /* Port number to open. */
- const char *myHost, /* Name of local host. */
- Tcl_TcpAcceptProc *acceptProc,
- /* Callback for accepting connections from new
- * clients. */
- ClientData acceptProcData) /* Data for the callback. */
-{
- SOCKET sock = INVALID_SOCKET;
- unsigned short chosenport = 0;
- struct addrinfo *addrlist = NULL;
- struct addrinfo *addrPtr; /* Socket address to listen on. */
- TcpState *statePtr = NULL; /* The returned value. */
- char channelName[SOCK_CHAN_LENGTH];
- u_long flag = 1; /* Indicates nonblocking mode. */
- const char *errorMsg = NULL;
-
- if (TclpHasSockets(interp) != TCL_OK) {
- return NULL;
- }
-
- /*
- * Check that WinSock is initialized; do not call it if not, to prevent
- * system crashes. This can happen at exit time if the exit handler for
- * WinSock ran before other exit handlers that want to use sockets.
- */
-
- if (!SocketsEnabled()) {
- return NULL;
- }
-
- /*
- * Construct the addresses for each end of the socket.
- */
-
- if (!TclCreateSocketAddress(interp, &addrlist, myHost, port, 1, &errorMsg)) {
- goto error;
- }
-
- for (addrPtr = addrlist; addrPtr != NULL; addrPtr = addrPtr->ai_next) {
- sock = socket(addrPtr->ai_family, addrPtr->ai_socktype,
- addrPtr->ai_protocol);
- if (sock == INVALID_SOCKET) {
- TclWinConvertError((DWORD) WSAGetLastError());
- continue;
- }
-
- /*
- * Win-NT has a misfeature that sockets are inherited in child
- * processes by default. Turn off the inherit bit.
- */
-
- SetHandleInformation((HANDLE) sock, HANDLE_FLAG_INHERIT, 0);
-
- /*
- * Set kernel space buffering
- */
-
- TclSockMinimumBuffers((void *)sock, TCP_BUFFER_SIZE);
-
- /*
- * Make sure we use the same port when opening two server sockets
- * for IPv4 and IPv6.
- *
- * As sockaddr_in6 uses the same offset and size for the port
- * member as sockaddr_in, we can handle both through the IPv4 API.
- */
-
- if (port == 0 && chosenport != 0) {
- ((struct sockaddr_in *) addrPtr->ai_addr)->sin_port =
- htons(chosenport);
- }
-
- /*
- * Bind to the specified port. Note that we must not call
- * setsockopt with SO_REUSEADDR because Microsoft allows addresses
- * to be reused even if they are still in use.
- *
- * Bind should not be affected by the socket having already been
- * set into nonblocking mode. If there is trouble, this is one
- * place to look for bugs.
- */
-
- if (bind(sock, addrPtr->ai_addr, addrPtr->ai_addrlen)
- == SOCKET_ERROR) {
- TclWinConvertError((DWORD) WSAGetLastError());
- closesocket(sock);
- continue;
- }
- if (port == 0 && chosenport == 0) {
- address sockname;
- socklen_t namelen = sizeof(sockname);
-
- /*
- * Synchronize port numbers when binding to port 0 of multiple
- * addresses.
- */
-
- if (getsockname(sock, &sockname.sa, &namelen) >= 0) {
- chosenport = ntohs(sockname.sa4.sin_port);
- }
- }
-
- /*
- * Set the maximum number of pending connect requests to the max
- * value allowed on each platform (Win32 and Win32s may be
- * different, and there may be differences between TCP/IP stacks).
- */
-
- if (listen(sock, SOMAXCONN) == SOCKET_ERROR) {
- TclWinConvertError((DWORD) WSAGetLastError());
- closesocket(sock);
- continue;
- }
-
- if (statePtr == NULL) {
- /*
- * Add this socket to the global list of sockets.
- */
- statePtr = NewSocketInfo(sock);
- } else {
- AddSocketInfoFd( statePtr, sock );
- }
- }
-
-error:
- if (addrlist != NULL) {
- freeaddrinfo(addrlist);
- }
-
- if (statePtr != NULL) {
- ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
-
- statePtr->acceptProc = acceptProc;
- statePtr->acceptProcData = acceptProcData;
- sprintf(channelName, SOCK_TEMPLATE, statePtr);
- statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
- statePtr, 0);
- /*
- * Set up the select mask for connection request events.
- */
-
- statePtr->selectEvents = FD_ACCEPT;
-
- /*
- * Register for interest in events in the select mask. Note that this
- * automatically places the socket into non-blocking mode.
- */
-
- ioctlsocket(sock, (long) FIONBIO, &flag);
- SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
- (LPARAM) statePtr);
- if (Tcl_SetChannelOption(interp, statePtr->channel, "-eofchar", "")
- == TCL_ERROR) {
- Tcl_Close(NULL, statePtr->channel);
- return NULL;
- }
- return statePtr->channel;
- }
-
- if (interp != NULL) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "couldn't open socket: %s",
- (errorMsg ? errorMsg : Tcl_PosixError(interp))));
- }
-
- if (sock != INVALID_SOCKET) {
- closesocket(sock);
- }
- return NULL;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TcpAccept --
- * Accept a TCP socket connection. This is called by the event loop.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Creates a new connection socket. Calls the registered callback for the
- * connection acceptance mechanism.
- *
- *----------------------------------------------------------------------
- */
-
- /* ARGSUSED */
-static void
-TcpAccept(
- TcpFdList *fds, /* Server socket that accepted newSocket. */
- SOCKET newSocket, /* Newly accepted socket. */
- address addr) /* Address of new socket. */
-{
- TcpState *newInfoPtr;
- TcpState *statePtr = fds->statePtr;
- int len = sizeof(addr);
- char channelName[SOCK_CHAN_LENGTH];
- char host[NI_MAXHOST], port[NI_MAXSERV];
- ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
-
- /*
- * 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);
-
- /*
- * Add this socket to the global list of sockets.
- */
-
- newInfoPtr = NewSocketInfo(newSocket);
-
- /*
- * Select on read/write events and create the channel.
- */
-
- newInfoPtr->selectEvents = (FD_READ | FD_WRITE | FD_CLOSE);
- SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
- (LPARAM) newInfoPtr);
-
- sprintf(channelName, SOCK_TEMPLATE, newInfoPtr);
- newInfoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
- newInfoPtr, (TCL_READABLE | TCL_WRITABLE));
- if (Tcl_SetChannelOption(NULL, newInfoPtr->channel, "-translation",
- "auto crlf") == TCL_ERROR) {
- Tcl_Close(NULL, newInfoPtr->channel);
- return;
- }
- if (Tcl_SetChannelOption(NULL, newInfoPtr->channel, "-eofchar", "")
- == TCL_ERROR) {
- Tcl_Close(NULL, newInfoPtr->channel);
- return;
- }
-
- /*
- * Invoke the accept callback function.
- */
-
- if (statePtr->acceptProc != NULL) {
- getnameinfo(&(addr.sa), len, host, sizeof(host), port, sizeof(port),
- NI_NUMERICHOST|NI_NUMERICSERV);
- statePtr->acceptProc(statePtr->acceptProcData, newInfoPtr->channel,
- host, atoi(port));
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * InitSockets --
- *
- * Registers the event window for the socket notifier code.
- *
- * Assumes socketMutex is held.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Register a new window class and creates a
- * window for use in asynchronous socket notification.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-InitSockets(void)
-{
- DWORD id;
- ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
-
- if (!initialized) {
- initialized = 1;
- TclCreateLateExitHandler(SocketExitHandler, NULL);
-
- /*
- * 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;
- windowClass.hInstance = TclWinGetTclInstance();
- windowClass.hbrBackground = NULL;
- windowClass.lpszMenuName = NULL;
- windowClass.lpszClassName = classname;
- windowClass.lpfnWndProc = SocketProc;
- windowClass.hIcon = NULL;
- windowClass.hCursor = NULL;
-
- if (!RegisterClass(&windowClass)) {
- TclWinConvertError(GetLastError());
- goto initFailure;
- }
- }
-
- /*
- * Check for per-thread initialization.
- */
-
- if (tsdPtr != NULL) {
- return;
- }
-
- /*
- * OK, this thread has never done anything with sockets before. Construct
- * a worker thread to handle asynchronous events related to sockets
- * assigned to _this_ thread.
- */
-
- tsdPtr = TCL_TSD_INIT(&dataKey);
- tsdPtr->pendingTcpState = NULL;
- tsdPtr->socketList = NULL;
- tsdPtr->hwnd = NULL;
- tsdPtr->threadId = Tcl_GetCurrentThread();
- tsdPtr->readyEvent = CreateEvent(NULL, FALSE, FALSE, NULL);
- if (tsdPtr->readyEvent == NULL) {
- goto initFailure;
- }
- tsdPtr->socketListLock = CreateEvent(NULL, FALSE, TRUE, NULL);
- if (tsdPtr->socketListLock == NULL) {
- goto initFailure;
- }
- tsdPtr->socketThread = CreateThread(NULL, 256, SocketThread, tsdPtr, 0,
- &id);
- if (tsdPtr->socketThread == NULL) {
- goto initFailure;
- }
-
- SetThreadPriority(tsdPtr->socketThread, THREAD_PRIORITY_HIGHEST);
-
- /*
- * Wait for the thread to signal when the window has been created and if
- * it is ready to go.
- */
-
- WaitForSingleObject(tsdPtr->readyEvent, INFINITE);
-
- if (tsdPtr->hwnd == NULL) {
- goto initFailure; /* Trouble creating the window. */
- }
-
- Tcl_CreateEventSource(SocketSetupProc, SocketCheckProc, NULL);
- return;
-
- initFailure:
- TclpFinalizeSockets();
- initialized = -1;
- return;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * SocketsEnabled --
- *
- * Check that the WinSock was successfully initialized.
- *
- * Warning:
- * This check was useful in times of Windows98 where WinSock may
- * not be available. This is not the case any more.
- * This function may be removed with TCL 9.0
- *
- * Results:
- * 1 if it is.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
- /* ARGSUSED */
-static int
-SocketsEnabled(void)
-{
- int enabled;
-
- Tcl_MutexLock(&socketMutex);
- enabled = (initialized == 1);
- Tcl_MutexUnlock(&socketMutex);
- return enabled;
-}
-
-
-/*
- *----------------------------------------------------------------------
- *
- * SocketExitHandler --
- *
- * Callback invoked during exit clean up to delete the socket
- * communication window.
- *
- * Results:
- * None.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
- /* ARGSUSED */
-static void
-SocketExitHandler(
- ClientData clientData) /* Not used. */
-{
- Tcl_MutexLock(&socketMutex);
-
- /*
- * Make sure the socket event handling window is cleaned-up for, at
- * most, this thread.
- */
-
- TclpFinalizeSockets();
- UnregisterClass(classname, TclWinGetTclInstance());
- initialized = 0;
- Tcl_MutexUnlock(&socketMutex);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * SocketSetupProc --
- *
- * This function is invoked before Tcl_DoOneEvent blocks waiting for an
- * event.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Adjusts the block time if needed.
- *
- *----------------------------------------------------------------------
- */
-
-void
-SocketSetupProc(
- ClientData data, /* Not used. */
- int flags) /* Event flags as passed to Tcl_DoOneEvent. */
-{
- TcpState *statePtr;
- Tcl_Time blockTime = { 0, 0 };
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-
- if (!(flags & TCL_FILE_EVENTS)) {
- return;
- }
-
- /*
- * Check to see if there is a ready socket. If so, poll.
- */
- WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
- for (statePtr = tsdPtr->socketList; statePtr != NULL;
- statePtr = statePtr->nextPtr) {
- if (statePtr->readyEvents &
- (statePtr->watchEvents | FD_CONNECT | FD_ACCEPT)
- ) {
- Tcl_SetMaxBlockTime(&blockTime);
- break;
- }
- }
- SetEvent(tsdPtr->socketListLock);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * SocketCheckProc --
- *
- * This function is called by Tcl_DoOneEvent to check the socket event
- * source for events.
- *
- * Results:
- * None.
- *
- * Side effects:
- * May queue an event.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-SocketCheckProc(
- ClientData data, /* Not used. */
- int flags) /* Event flags as passed to Tcl_DoOneEvent. */
-{
- TcpState *statePtr;
- SocketEvent *evPtr;
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-
- 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
- * events).
- */
-
- WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
- for (statePtr = tsdPtr->socketList; statePtr != NULL;
- statePtr = statePtr->nextPtr) {
- if ((statePtr->readyEvents &
- (statePtr->watchEvents | FD_CONNECT | FD_ACCEPT))
- && !(statePtr->flags & SOCKET_PENDING)
- ) {
- statePtr->flags |= SOCKET_PENDING;
- evPtr = ckalloc(sizeof(SocketEvent));
- evPtr->header.proc = SocketEventProc;
- evPtr->socket = statePtr->sockets->fd;
- Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
- }
- }
- SetEvent(tsdPtr->socketListLock);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * SocketEventProc --
- *
- * 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.
- *
- * Side effects:
- * Whatever the channel callback functions do.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-SocketEventProc(
- Tcl_Event *evPtr, /* Event to service. */
- int flags) /* Flags that indicate what events to handle,
- * such as TCL_FILE_EVENTS. */
-{
- TcpState *statePtr;
- SocketEvent *eventPtr = (SocketEvent *) evPtr;
- int mask = 0, events;
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- TcpFdList *fds;
- SOCKET newSocket;
- address addr;
- int len;
-
- if (!(flags & TCL_FILE_EVENTS)) {
- return 0;
- }
-
- /*
- * Find the specified socket on the socket list.
- */
-
- WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
- for (statePtr = tsdPtr->socketList; statePtr != NULL;
- statePtr = statePtr->nextPtr) {
- if (statePtr->sockets->fd == eventPtr->socket) {
- break;
- }
- }
-
- /*
- * Discard events that have gone stale.
- */
-
- if (!statePtr) {
- SetEvent(tsdPtr->socketListLock);
- return 1;
- }
-
- /*
- * Clear flag that (this) event is pending
- */
-
- statePtr->flags &= ~SOCKET_PENDING;
-
- /*
- * Continue async connect if pending and ready
- */
-
- if ( statePtr->readyEvents & FD_CONNECT ) {
- if ( statePtr->flags & TCP_ASYNC_PENDING ) {
-
- /*
- * Do one step and save eventual connect error
- */
-
- SetEvent(tsdPtr->socketListLock);
- WaitForConnect(statePtr,NULL);
-
- } else {
-
- /*
- * No async connect reenter pending. Just clear event.
- */
-
- statePtr->readyEvents &= ~(FD_CONNECT);
- SetEvent(tsdPtr->socketListLock);
- }
- return 1;
- }
-
- /*
- * Handle connection requests directly.
- */
- if (statePtr->readyEvents & FD_ACCEPT) {
- for (fds = statePtr->sockets; fds != NULL; fds = fds->next) {
-
- /*
- * Accept the incoming connection request.
- */
- len = sizeof(address);
-
- newSocket = accept(fds->fd, &(addr.sa), &len);
-
- /* On Tcl server sockets with multiple OS fds we loop over the fds trying
- * an accept() on each, so we expect INVALID_SOCKET. There are also other
- * network stack conditions that can result in FD_ACCEPT but a subsequent
- * failure on accept() by the time we get around to it.
- * Access to sockets (acceptEventCount, readyEvents) in socketList
- * is still protected by the lock (prevents reintroduction of
- * SF Tcl Bug 3056775.
- */
-
- if (newSocket == INVALID_SOCKET) {
- /* int err = WSAGetLastError(); */
- continue;
- }
-
- /*
- * It is possible that more than one FD_ACCEPT has been sent, so an extra
- * count must be kept. Decrement the count, and reset the readyEvent bit
- * if the count is no longer > 0.
- */
- statePtr->acceptEventCount--;
-
- if (statePtr->acceptEventCount <= 0) {
- statePtr->readyEvents &= ~(FD_ACCEPT);
- }
-
- SetEvent(tsdPtr->socketListLock);
-
- /* Caution: TcpAccept() has the side-effect of evaluating the server
- * accept script (via AcceptCallbackProc() in tclIOCmd.c), which can
- * close the server socket and invalidate statePtr and fds.
- * If TcpAccept() accepts a socket we must return immediately and let
- * SocketCheckProc queue additional FD_ACCEPT events.
- */
- TcpAccept(fds, newSocket, addr);
- return 1;
- }
-
- /* Loop terminated with no sockets accepted; clear the ready mask so
- * we can detect the next connection request. Note that connection
- * requests are level triggered, so if there is a request already
- * pending, a new event will be generated.
- */
- statePtr->acceptEventCount = 0;
- statePtr->readyEvents &= ~(FD_ACCEPT);
-
- SetEvent(tsdPtr->socketListLock);
- return 1;
- }
-
- SetEvent(tsdPtr->socketListLock);
-
- /*
- * Mask off unwanted events and compute the read/write mask so we can
- * notify the channel.
- */
-
- events = statePtr->readyEvents & statePtr->watchEvents;
-
- if (events & FD_CLOSE) {
- /*
- * If the socket was closed and the channel is still interested in
- * read events, then we need to ensure that we keep polling for this
- * event until someone does something with the channel. Note that we
- * do this before calling Tcl_NotifyChannel so we don't have to watch
- * out for the channel being deleted out from under us. This may cause
- * a redundant trip through the event loop, but it's simpler than
- * trying to do unwind protection.
- */
-
- Tcl_Time blockTime = { 0, 0 };
-
- Tcl_SetMaxBlockTime(&blockTime);
- mask |= TCL_READABLE|TCL_WRITABLE;
- } else if (events & FD_READ) {
-
- /*
- * Throw the readable event if an async connect failed.
- */
-
- if ( statePtr->flags & TCP_ASYNC_FAILED ) {
-
- mask |= TCL_READABLE;
-
- } else {
- fd_set readFds;
- struct timeval timeout;
-
- /*
- * We must check to see if data is really available, since someone
- * could have consumed the data in the meantime. Turn off async
- * notification so select will work correctly. If the socket is
- * still readable, notify the channel driver, otherwise reset the
- * async select handler and keep waiting.
- */
-
- SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
- (WPARAM) UNSELECT, (LPARAM) statePtr);
-
- FD_ZERO(&readFds);
- FD_SET(statePtr->sockets->fd, &readFds);
- timeout.tv_usec = 0;
- timeout.tv_sec = 0;
-
- if (select(0, &readFds, NULL, NULL, &timeout) != 0) {
- mask |= TCL_READABLE;
- } else {
- statePtr->readyEvents &= ~(FD_READ);
- SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
- (WPARAM) SELECT, (LPARAM) statePtr);
- }
- }
- }
-
- /*
- * writable event
- */
-
- if (events & FD_WRITE) {
- mask |= TCL_WRITABLE;
- }
-
- /*
- * Call registered event procedures
- */
-
- if (mask) {
- Tcl_NotifyChannel(statePtr->channel, mask);
- }
- return 1;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * AddSocketInfoFd --
- *
- * This function adds a SOCKET file descriptor to the 'sockets' linked
- * list of a TcpState structure.
- *
- * Results:
- * None.
- *
- * Side effects:
- * None, except for allocation of memory.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-AddSocketInfoFd(
- TcpState *statePtr,
- SOCKET socket)
-{
- TcpFdList *fds = statePtr->sockets;
-
- if ( fds == NULL ) {
- /* Add the first FD */
- statePtr->sockets = ckalloc(sizeof(TcpFdList));
- fds = statePtr->sockets;
- } else {
- /* Find end of list and append FD */
- while ( fds->next != NULL ) {
- fds = fds->next;
- }
-
- fds->next = ckalloc(sizeof(TcpFdList));
- fds = fds->next;
- }
-
- /* Populate new FD */
- fds->fd = socket;
- fds->statePtr = statePtr;
- fds->next = NULL;
-}
-
-
-/*
- *----------------------------------------------------------------------
- *
- * NewSocketInfo --
- *
- * This function allocates and initializes a new TcpState structure.
- *
- * Results:
- * Returns a newly allocated TcpState.
- *
- * Side effects:
- * None, except for allocation of memory.
- *
- *----------------------------------------------------------------------
- */
-
-static TcpState *
-NewSocketInfo(SOCKET socket)
-{
- TcpState *statePtr = ckalloc(sizeof(TcpState));
-
- memset(statePtr, 0, sizeof(TcpState));
-
- /*
- * 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.
- */
-
- AddSocketInfoFd(statePtr, socket);
-
- return statePtr;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * WaitForSocketEvent --
- *
- * Waits until one of the specified events occurs on a socket.
- * For event FD_CONNECT use WaitForConnect.
- *
- * Results:
- * Returns 1 on success or 0 on failure, with an error code in
- * errorCodePtr.
- *
- * Side effects:
- * Processes socket events off the system queue.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-WaitForSocketEvent(
- TcpState *statePtr, /* Information about this socket. */
- int events, /* Events to look for. May be one of
- * FD_READ or FD_WRITE.
- */
- int *errorCodePtr) /* Where to store errors? */
-{
- int result = 1;
- int oldMode;
- ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
- /*
- * Be sure to disable event servicing so we are truly modal.
- */
-
- oldMode = Tcl_SetServiceMode(TCL_SERVICE_NONE);
-
- /*
- * Reset WSAAsyncSelect so we have a fresh set of events pending.
- */
-
- SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) UNSELECT,
- (LPARAM) statePtr);
- SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
- (LPARAM) statePtr);
-
- while (1) {
- int event_found;
-
- /* get statePtr lock */
- WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
-
- /* Check if event occured */
- event_found = (statePtr->readyEvents & events);
-
- /* Free list lock */
- SetEvent(tsdPtr->socketListLock);
-
- /* exit loop if event occured */
- if (event_found) {
- break;
- }
-
- /* Exit loop if event did not occur but this is a non-blocking channel */
- if (statePtr->flags & TCP_NONBLOCKING) {
- *errorCodePtr = EWOULDBLOCK;
- result = 0;
- break;
- }
-
- /*
- * Wait until something happens.
- */
-
- WaitForSingleObject(tsdPtr->readyEvent, INFINITE);
- }
-
- (void) Tcl_SetServiceMode(oldMode);
- return result;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * SocketThread --
- *
- * Helper thread used to manage the socket event handling window.
- *
- * Results:
- * 1 if unable to create socket event window, 0 otherwise.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-static DWORD WINAPI
-SocketThread(
- LPVOID arg)
-{
- MSG msg;
- ThreadSpecificData *tsdPtr = arg;
-
- /*
- * Create a dummy window receiving socket events.
- */
-
- tsdPtr->hwnd = CreateWindow(classname, classname, WS_TILED, 0, 0, 0, 0,
- NULL, NULL, windowClass.hInstance, arg);
-
- /*
- * Signalize thread creator that we are done creating the window.
- */
-
- SetEvent(tsdPtr->readyEvent);
-
- /*
- * If unable to create the window, exit this thread immediately.
- */
-
- if (tsdPtr->hwnd == NULL) {
- return 1;
- }
-
- /*
- * 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) {
- DispatchMessage(&msg);
- }
-
- /*
- * This releases waiters on thread exit in TclpFinalizeSockets()
- */
-
- SetEvent(tsdPtr->readyEvent);
-
- return msg.wParam;
-}
-
-
-/*
- *----------------------------------------------------------------------
- *
- * SocketProc --
- *
- * 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.
- *
- *----------------------------------------------------------------------
- */
-
-static LRESULT CALLBACK
-SocketProc(
- HWND hwnd,
- UINT message,
- WPARAM wParam,
- LPARAM lParam)
-{
- int event, error;
- SOCKET socket;
- TcpState *statePtr;
- int info_found = 0;
- TcpFdList *fds = NULL;
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
-#ifdef _WIN64
- GetWindowLongPtr(hwnd, GWLP_USERDATA);
-#else
- GetWindowLong(hwnd, GWL_USERDATA);
-#endif
-
- switch (message) {
- 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.
- */
-
-#ifdef _WIN64
- SetWindowLongPtr(hwnd, GWLP_USERDATA,
- (LONG_PTR) ((LPCREATESTRUCT)lParam)->lpCreateParams);
-#else
- SetWindowLong(hwnd, GWL_USERDATA,
- (LONG) ((LPCREATESTRUCT)lParam)->lpCreateParams);
-#endif
- break;
-
- case WM_DESTROY:
- PostQuitMessage(0);
- break;
-
- case SOCKET_MESSAGE:
- event = WSAGETSELECTEVENT(lParam);
- error = WSAGETSELECTERROR(lParam);
- socket = (SOCKET) wParam;
-
- WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
-
- /*
- * Find the specified socket on the socket list and update its
- * eventState flag.
- */
-
- for (statePtr = tsdPtr->socketList; statePtr != NULL;
- statePtr = statePtr->nextPtr) {
- if ( FindFDInList(statePtr,socket) ) {
- info_found = 1;
- break;
- }
- }
- /*
- * Check if there is a pending info structure not jet in the
- * list
- */
- if ( !info_found
- && tsdPtr->pendingTcpState != NULL
- && FindFDInList(tsdPtr->pendingTcpState,socket) ) {
- statePtr = tsdPtr->pendingTcpState;
- info_found = 1;
- }
- if (info_found) {
-
- /*
- * Update the socket state.
- *
- * A count of FD_ACCEPTS is stored, so if an FD_CLOSE event
- * happens, then clear the FD_ACCEPT count. Otherwise,
- * increment the count if the current event is an FD_ACCEPT.
- */
-
- if (event & FD_CLOSE) {
- statePtr->acceptEventCount = 0;
- statePtr->readyEvents &= ~(FD_WRITE|FD_ACCEPT);
- } else if (event & FD_ACCEPT) {
- statePtr->acceptEventCount++;
- }
-
- if (event & FD_CONNECT) {
- /*
- * Remember any error that occurred so we can report
- * connection failures.
- */
- if (error != ERROR_SUCCESS) {
- statePtr->notifierConnectError = error;
- }
- }
- /*
- * Inform main thread about signaled events
- */
- statePtr->readyEvents |= event;
-
- /*
- * Wake up the Main Thread.
- */
- SetEvent(tsdPtr->readyEvent);
- Tcl_ThreadAlert(tsdPtr->threadId);
- }
- SetEvent(tsdPtr->socketListLock);
- break;
-
- case SOCKET_SELECT:
- statePtr = (TcpState *) lParam;
- for (fds = statePtr->sockets; fds != NULL; fds = fds->next) {
- if (wParam == SELECT) {
- WSAAsyncSelect(fds->fd, hwnd,
- SOCKET_MESSAGE, statePtr->selectEvents);
- } else {
- /*
- * Clear the selection mask
- */
-
- WSAAsyncSelect(fds->fd, hwnd, 0, 0);
- }
- }
- break;
-
- case SOCKET_TERMINATE:
- DestroyWindow(hwnd);
- break;
- }
-
- return 0;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * FindFDInList --
- *
- * Return true, if the given file descriptior is contained in the
- * file descriptor list.
- *
- * Results:
- * true if found.
- *
- * Side effects:
- *
- *----------------------------------------------------------------------
- */
-
-static int
-FindFDInList(
- TcpState *statePtr,
- SOCKET socket)
-{
- TcpFdList *fds;
- for (fds = statePtr->sockets; fds != NULL; fds = fds->next) {
- if (fds->fd == socket) {
- return 1;
- }
- }
- return 0;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclWinGetSockOpt, et al. --
- *
- * Those functions are historically exported by the stubs table and
- * just use the original system calls now.
- *
- * Warning:
- * Those functions are depreciated and will be removed with TCL 9.0.
- *
- * Results:
- * As defined for each function.
- *
- * Side effects:
- * As defined for each function.
- *
- *----------------------------------------------------------------------
- */
-
-#undef TclWinGetSockOpt
-int
-TclWinGetSockOpt(
- SOCKET s,
- int level,
- int optname,
- char *optval,
- int *optlen)
-{
-
- return getsockopt(s, level, optname, optval, optlen);
-}
-#undef TclWinSetSockOpt
-int
-TclWinSetSockOpt(
- SOCKET s,
- int level,
- int optname,
- const char *optval,
- int optlen)
-{
- return setsockopt(s, level, optname, optval, optlen);
-}
-
-#undef TclpInetNtoa
-char *
-TclpInetNtoa(
- struct in_addr addr)
-{
- return inet_ntoa(addr);
-}
-#undef TclWinGetServByName
-struct servent *
-TclWinGetServByName(
- const char *name,
- const char *proto)
-{
- return getservbyname(name, proto);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TcpThreadActionProc --
- *
- * Insert or remove any thread local refs to this channel.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Changes thread local list of valid channels.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-TcpThreadActionProc(
- ClientData instanceData,
- int action)
-{
- ThreadSpecificData *tsdPtr;
- TcpState *statePtr = instanceData;
- int notifyCmd;
-
- if (action == TCL_CHANNEL_THREAD_INSERT) {
- /*
- * Ensure that socket subsystem is initialized in this thread, or else
- * sockets will not work.
- */
-
- Tcl_MutexLock(&socketMutex);
- InitSockets();
- Tcl_MutexUnlock(&socketMutex);
-
- tsdPtr = TCL_TSD_INIT(&dataKey);
-
- WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
- statePtr->nextPtr = tsdPtr->socketList;
- tsdPtr->socketList = statePtr;
-
- if (statePtr == tsdPtr->pendingTcpState) {
- tsdPtr->pendingTcpState = NULL;
- }
-
- SetEvent(tsdPtr->socketListLock);
-
- notifyCmd = SELECT;
- } else {
- TcpState **nextPtrPtr;
- int removed = 0;
-
- tsdPtr = TCL_TSD_INIT(&dataKey);
-
- /*
- * 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)) {
- if ((*nextPtrPtr) == statePtr) {
- (*nextPtrPtr) = statePtr->nextPtr;
- removed = 1;
- break;
- }
- }
- 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.
- */
-
- if (!removed) {
- Tcl_Panic("file info ptr not on thread channel list");
- }
-
- notifyCmd = UNSELECT;
- }
-
- /*
- * Ensure that, or stop, notifications for the socket occur in this
- * thread.
- */
-
- SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
- (WPARAM) notifyCmd, (LPARAM) statePtr);
-}
-
-/*
- * Local Variables:
- * mode: c
- * c-basic-offset: 4
- * fill-column: 78
- * tab-width: 8
- * indent-tabs-mode: nil
- * End:
- */
diff --git a/tcl8.6/win/tclWinTest.c b/tcl8.6/win/tclWinTest.c
deleted file mode 100644
index b3ad626..0000000
--- a/tcl8.6/win/tclWinTest.c
+++ /dev/null
@@ -1,663 +0,0 @@
-/*
- * 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.
- */
-
-#ifndef USE_TCL_STUBS
-# define USE_TCL_STUBS
-#endif
-#include "tclInt.h"
-
-/*
- * For TestplatformChmod on Windows
- */
-#ifdef _WIN32
-#include <aclapi.h>
-#endif
-
-/*
- * MinGW 3.4.2 does not define this.
- */
-#ifndef INHERITED_ACE
-#define INHERITED_ACE (0x10)
-#endif
-
-/*
- * Forward declarations of functions defined later in this file:
- */
-
-static int TesteventloopCmd(ClientData dummy, Tcl_Interp* interp,
- int objc, Tcl_Obj *const objv[]);
-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 objc, Tcl_Obj *const objv[]);
-
-/*
- *----------------------------------------------------------------------
- *
- * TclplatformtestInit --
- *
- * Defines commands that test platform specific functionality for Windows
- * platforms.
- *
- * Results:
- * A standard Tcl result.
- *
- * Side effects:
- * Defines new commands.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclplatformtestInit(
- Tcl_Interp *interp) /* Interpreter to add commands to. */
-{
- /*
- * Add commands for platform specific tests for Windows here.
- */
-
- Tcl_CreateObjCommand(interp, "testchmod", TestchmodCmd, NULL, NULL);
- Tcl_CreateObjCommand(interp, "testeventloop", TesteventloopCmd, NULL, NULL);
- Tcl_CreateObjCommand(interp, "testvolumetype", TestvolumetypeCmd,
- 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;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TesteventloopCmd --
- *
- * 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.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-TesteventloopCmd(
- ClientData clientData, /* Not used. */
- Tcl_Interp *interp, /* Current interpreter. */
- int objc, /* Number of arguments. */
- Tcl_Obj *const objv[]) /* Argument objects. */
-{
- static int *framePtr = NULL;/* Pointer to integer on stack frame of
- * innermost invocation of the "wait"
- * subcommand. */
-
- if (objc < 2) {
- Tcl_WrongNumArgs(interp, 1, objv, "option ...");
- return TCL_ERROR;
- }
- if (strcmp(Tcl_GetString(objv[1]), "done") == 0) {
- *framePtr = 1;
- } else if (strcmp(Tcl_GetString(objv[1]), "wait") == 0) {
- int *oldFramePtr, done;
- int oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
-
- /*
- * Save the old stack frame pointer and set up the current frame.
- */
-
- oldFramePtr = framePtr;
- framePtr = &done;
-
- /*
- * 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.
- */
-
- PostQuitMessage((int) msg.wParam);
- break;
- }
- TranslateMessage(&msg);
- DispatchMessage(&msg);
- }
- (void) Tcl_SetServiceMode(oldMode);
- framePtr = oldFramePtr;
- } else {
- Tcl_AppendResult(interp, "bad option \"", Tcl_GetString(objv[1]),
- "\": must be done or wait", NULL);
- return TCL_ERROR;
- }
- return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Testvolumetype --
- *
- * This function implements the "testvolumetype" command. It is used to
- * check the volume type (FAT, NTFS) of a volume.
- *
- * Results:
- * A standard Tcl result.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-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;
- char volType[VOL_BUF_SIZE];
- const char *path;
-
- if (objc > 2) {
- Tcl_WrongNumArgs(interp, 1, objv, "?name?");
- 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 = Tcl_GetString(objv[1]);
- } else {
- path = NULL;
- }
- 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:""), "\"", NULL);
- TclWinConvertError(GetLastError());
- return TCL_ERROR;
- }
- Tcl_AppendResult(interp, volType, NULL);
- return TCL_OK;
-#undef VOL_BUF_SIZE
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * 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.
- *
- * Usage:
- * testclock
- *
- * Parameters:
- * 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.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-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 */
- Tcl_Time tclTime; /* Tcl clock */
- FILETIME sysTime; /* System clock */
- Tcl_Obj *result; /* Result of the command */
- LARGE_INTEGER t1, t2;
- LARGE_INTEGER p1, p2;
-
- if (objc != 1) {
- Tcl_WrongNumArgs(interp, 1, objv, "");
- return TCL_ERROR;
- }
-
- QueryPerformanceCounter(&p1);
-
- 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);
-
- 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_NewWideIntObj(p1.QuadPart));
- Tcl_ListObjAppendElement(interp, result, Tcl_NewWideIntObj(p2.QuadPart));
-
- Tcl_SetObjResult(interp, result);
-
- return TCL_OK;
-}
-
-static int
-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");
- return TCL_ERROR;
- }
- if (Tcl_GetIntFromObj(interp, objv[1], &ms) != TCL_OK) {
- return TCL_ERROR;
- }
- Sleep((DWORD) ms);
- return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TestExceptionCmd --
- *
- * Causes this process to end with the named exception. Used for testing
- * Tcl_WaitPid().
- *
- * Usage:
- * testexcept <type>
- *
- * Parameters:
- * Type of exception.
- *
- * Results:
- * None, this process closes now and doesn't return.
- *
- * Side effects:
- * This Tcl process closes, hard... Bang!
- *
- *----------------------------------------------------------------------
- */
-
-static int
-TestExceptionCmd(
- ClientData dummy, /* Unused */
- Tcl_Interp* interp, /* Tcl interpreter */
- int objc, /* Argument count */
- Tcl_Obj *const objv[]) /* Argument vector */
-{
- static const char *const cmds[] = {
- "access_violation", "datatype_misalignment", "array_bounds",
- "float_denormal", "float_divbyzero", "float_inexact",
- "float_invalidop", "float_overflow", "float_stack", "float_underflow",
- "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
- };
- int cmd;
-
- if (objc != 2) {
- Tcl_WrongNumArgs(interp, 0, objv, "<type-of-exception>");
- return TCL_ERROR;
- }
- if (Tcl_GetIndexFromObj(interp, objv[1], cmds, "command", 0,
- &cmd) != TCL_OK) {
- return TCL_ERROR;
- }
-
- /*
- * Make sure the GPF dialog doesn't popup.
- */
-
- SetErrorMode(SEM_FAILCRITICALERRORS | SEM_NOGPFAULTERRORBOX);
-
- /*
- * As Tcl does not handle structured exceptions, this falls all the way
- * back up the instruction stack to the C run-time portion that called
- * main() where the process will now be terminated with this exception
- * code by the default handler the C run-time provides.
- */
-
- /* SMASH! */
- RaiseException(exceptions[cmd], EXCEPTION_NONCONTINUABLE, 0, NULL);
-
- /* NOTREACHED */
- return TCL_OK;
-}
-
-static int
-TestplatformChmod(
- const char *nativePath,
- int pmode)
-{
- 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;
-
- /*
- * References to security functions (only available on NT and later).
- */
-
- 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;
- char *userDomain = 0;
- int res = 0;
-
- /*
- * Process the chmod request.
- */
-
- attr = GetFileAttributesA(nativePath);
-
- /*
- * nativePath not found
- */
-
- if (attr == 0xffffffff) {
- res = -1;
- goto done;
- }
-
- /*
- * If nativePath is not a directory, there is no special handling.
- */
-
- if (!(attr & FILE_ATTRIBUTE_DIRECTORY)) {
- goto done;
- }
-
- /*
- * 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.
- */
-
- if (!GetFileSecurityA(nativePath, infoBits, NULL, 0, &secDescLen)) {
- DWORD secDescLen2 = 0;
-
- if (GetLastError() != ERROR_INSUFFICIENT_BUFFER) {
- goto done;
- }
-
- secDesc = ckalloc(secDescLen);
- if (!GetFileSecurityA(nativePath, infoBits,
- (PSECURITY_DESCRIPTOR) secDesc, secDescLen, &secDescLen2)
- || (secDescLen < secDescLen2)) {
- goto done;
- }
- }
-
- /*
- * Get the World SID.
- */
-
- userSid = ckalloc(GetSidLengthRequired((UCHAR) 1));
- InitializeSid(userSid, &userSidAuthority, (BYTE) 1);
- *(GetSidSubAuthority(userSid, 0)) = SECURITY_WORLD_RID;
-
- /*
- * If curAclPresent == false then curAcl and curAclDefaulted not valid.
- */
-
- if (!GetSecurityDescriptorDacl((PSECURITY_DESCRIPTOR) secDesc,
- &curAclPresent, &curAcl, &curAclDefaulted)) {
- goto done;
- }
- if (!curAclPresent || !curAcl) {
- ACLSize.AclBytesInUse = 0;
- ACLSize.AceCount = 0;
- } else if (!GetAclInformation(curAcl, &ACLSize, sizeof(ACLSize),
- AclSizeInformation)) {
- goto done;
- }
-
- /*
- * Allocate memory for the new ACL.
- */
-
- newAclSize = ACLSize.AclBytesInUse + sizeof(ACCESS_DENIED_ACE)
- + GetLengthSid(userSid) - sizeof(DWORD);
- newAcl = ckalloc(newAclSize);
-
- /*
- * Initialize the new ACL.
- */
-
- if (!InitializeAcl(newAcl, newAclSize, ACL_REVISION)) {
- goto done;
- }
-
- /*
- * Add denied to make readonly, this will be known as a "read-only tag".
- */
-
- if (set_readOnly && !AddAccessDeniedAce(newAcl, ACL_REVISION,
- readOnlyMask, userSid)) {
- goto done;
- }
-
- acl_readOnly_found = FALSE;
- for (j = 0; j < ACLSize.AceCount; j++) {
- LPVOID pACE2;
- ACE_HEADER *phACE2;
-
- if (!GetAce(curAcl, j, &pACE2)) {
- goto done;
- }
-
- 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).
- */
-
- if (phACE2->AceType == ACCESS_DENIED_ACE_TYPE) {
- ACCESS_DENIED_ACE *pACEd = (ACCESS_DENIED_ACE *) phACE2;
-
- if (pACEd->Mask == readOnlyMask
- && EqualSid(userSid, (PSID) &pACEd->SidStart)) {
- acl_readOnly_found = TRUE;
- continue;
- }
- }
-
- /*
- * Copy the current ACE from the old to the new ACL.
- */
-
- if (!AddAce(newAcl, ACL_REVISION, MAXDWORD, (PACL *) pACE2,
- ((PACE_HEADER) pACE2)->AceSize)) {
- goto done;
- }
- }
-
- /*
- * Apply the new ACL.
- */
-
- if (set_readOnly == acl_readOnly_found || SetNamedSecurityInfoA(
- (LPSTR) nativePath, SE_FILE_OBJECT, DACL_SECURITY_INFORMATION,
- NULL, NULL, newAcl, NULL) == ERROR_SUCCESS) {
- res = 0;
- }
-
- done:
- if (secDesc) {
- ckfree(secDesc);
- }
- if (newAcl) {
- ckfree(newAcl);
- }
- if (userSid) {
- ckfree(userSid);
- }
- if (userDomain) {
- ckfree(userDomain);
- }
-
- if (res != 0) {
- return res;
- }
-
- /*
- * Run normal chmod command.
- */
-
- return chmod(nativePath, 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. Otherwise, the file is
- * made read-write.
- *
- * Results:
- * A standard Tcl result.
- *
- * Side effects:
- * Changes permissions of specified files.
- *
- *---------------------------------------------------------------------------
- */
-
-static int
-TestchmodCmd(
- ClientData dummy, /* Not used. */
- Tcl_Interp *interp, /* Current interpreter. */
- int objc, /* Parameter count */
- Tcl_Obj *const * objv) /* Parameter vector */
-{
- int i, mode;
-
- if (objc < 2) {
- Tcl_WrongNumArgs(interp, 1, objv, "mode file ?file ...?");
- return TCL_ERROR;
- }
-
- if (Tcl_GetIntFromObj(interp, objv[1], &mode) != TCL_OK) {
- return TCL_ERROR;
- }
-
- for (i = 2; i < objc; i++) {
- Tcl_DString buffer;
- const char *translated;
-
- translated = Tcl_TranslateFileName(interp, Tcl_GetString(objv[i]), &buffer);
- if (translated == NULL) {
- return TCL_ERROR;
- }
- if (TestplatformChmod(translated, mode) != 0) {
- Tcl_AppendResult(interp, translated, ": ", Tcl_PosixError(interp),
- NULL);
- return TCL_ERROR;
- }
- Tcl_DStringFree(&buffer);
- }
- return TCL_OK;
-}
-
-/*
- * Local Variables:
- * mode: c
- * c-basic-offset: 4
- * fill-column: 78
- * End:
- */
diff --git a/tcl8.6/win/tclWinThrd.c b/tcl8.6/win/tclWinThrd.c
deleted file mode 100644
index 0f83526..0000000
--- a/tcl8.6/win/tclWinThrd.c
+++ /dev/null
@@ -1,1104 +0,0 @@
-/*
- * tclWinThread.c --
- *
- * This file implements the Windows-specific thread operations.
- *
- * Copyright (c) 1998 by Sun Microsystems, Inc.
- * Copyright (c) 1999 by Scriptics Corporation
- * Copyright (c) 2008 by George Peter Staplin
- *
- * See the file "license.terms" for information on usage and redistribution of
- * this file, and for a DISCLAIMER OF ALL WARRANTIES.
- */
-
-#include "tclWinInt.h"
-
-#include <float.h>
-
-/* Workaround for mingw versions which don't provide this in float.h */
-#ifndef _MCW_EM
-# define _MCW_EM 0x0008001F /* Error masks */
-# define _MCW_RC 0x00000300 /* Rounding */
-# define _MCW_PC 0x00030000 /* Precision */
-_CRTIMP unsigned int __cdecl _controlfp (unsigned int unNew, unsigned int unMask);
-#endif
-
-/*
- * 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()
-
-
-/*
- * This is the master lock used to serialize initialization and finalization
- * of Tcl as a whole.
- */
-
-static CRITICAL_SECTION initLock;
-
-/*
- * allocLock is used by Tcl's version of malloc for synchronization. For
- * obvious reasons, cannot use any dyamically allocated storage.
- */
-
-#ifdef TCL_THREADS
-
-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.
- */
-
-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.
- */
-
-/*
- * The per-thread event and queue pointers.
- */
-
-#ifdef TCL_THREADS
-
-typedef struct ThreadSpecificData {
- HANDLE condEvent; /* Per-thread condition event */
- struct ThreadSpecificData *nextPtr; /* Queue pointers */
- struct ThreadSpecificData *prevPtr;
- int flags; /* See flags below */
-} ThreadSpecificData;
-static Tcl_ThreadDataKey dataKey;
-
-#endif /* TCL_THREADS */
-
-/*
- * State bits for the thread.
- * 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.
- */
-
-typedef struct WinCondition {
- 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 */
-
-/*
- * The per thread data passed from TclpThreadCreate
- * to TclWinThreadStart.
- */
-
-typedef struct WinThread {
- LPTHREAD_START_ROUTINE lpStartAddress; /* Original startup routine */
- LPVOID lpParameter; /* Original startup data */
- unsigned int fpControl; /* Floating point control word from the
- * main thread */
-} WinThread;
-
-
-/*
- *----------------------------------------------------------------------
- *
- * TclWinThreadStart --
- *
- * This procedure is the entry point for all new threads created
- * by Tcl on Windows.
- *
- * Results:
- * Various, depending on the result of the wrapped thread start
- * routine.
- *
- * Side effects:
- * Arbitrary, since user code is executed.
- *
- *----------------------------------------------------------------------
- */
-
-static DWORD WINAPI
-TclWinThreadStart(
- LPVOID lpParameter) /* The WinThread structure pointer passed
- * from TclpThreadCreate */
-{
- WinThread *winThreadPtr = (WinThread *) lpParameter;
- LPTHREAD_START_ROUTINE lpOrigStartAddress;
- LPVOID lpOrigParameter;
-
- if (!winThreadPtr) {
- return TCL_ERROR;
- }
-
- _controlfp(winThreadPtr->fpControl, _MCW_EM | _MCW_RC | 0x03000000 /* _MCW_DN */
-#if !defined(_WIN64)
- | _MCW_PC
-#endif
- );
-
- lpOrigStartAddress = winThreadPtr->lpStartAddress;
- lpOrigParameter = winThreadPtr->lpParameter;
-
- ckfree((char *)winThreadPtr);
- return lpOrigStartAddress(lpOrigParameter);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclpThreadCreate --
- *
- * This procedure creates a new thread.
- *
- * Results:
- * TCL_OK if the thread could be created. The thread ID is returned in a
- * parameter.
- *
- * Side effects:
- * A new thread is created.
- *
- *----------------------------------------------------------------------
- */
-
-int
-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. */
-{
- WinThread *winThreadPtr; /* Per-thread startup info */
- HANDLE tHandle;
-
- winThreadPtr = (WinThread *)ckalloc(sizeof(WinThread));
- winThreadPtr->lpStartAddress = (LPTHREAD_START_ROUTINE) proc;
- winThreadPtr->lpParameter = clientData;
- winThreadPtr->fpControl = _controlfp(0, 0);
-
- 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,
- (Tcl_ThreadCreateProc*) TclWinThreadStart, winThreadPtr,
- 0, (unsigned *)idPtr);
-#else
- tHandle = CreateThread(NULL, (DWORD) stackSize,
- TclWinThreadStart, winThreadPtr, 0, (LPDWORD)idPtr);
-#endif
-
- if (tHandle == NULL) {
- LeaveCriticalSection(&joinLock);
- return TCL_ERROR;
- } else {
- if (flags & TCL_THREAD_JOINABLE) {
- TclRememberJoinableThread(*idPtr);
- }
-
- /*
- * The only purpose of this is to decrement the reference count so the
- * OS resources will be reacquired when the thread closes.
- */
-
- CloseHandle(tHandle);
- LeaveCriticalSection(&joinLock);
- return TCL_OK;
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_JoinThread --
- *
- * This procedure waits upon the exit of the specified thread.
- *
- * Results:
- * TCL_OK if the wait was successful, TCL_ERROR else.
- *
- * Side effects:
- * The result area is set to the exit code of the thread we
- * waited upon.
- *
- *----------------------------------------------------------------------
- */
-
-int
-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);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclpThreadExit --
- *
- * This procedure terminates the current thread.
- *
- * Results:
- * None.
- *
- * Side effects:
- * This procedure terminates the current thread.
- *
- *----------------------------------------------------------------------
- */
-
-void
-TclpThreadExit(
- int status)
-{
- EnterCriticalSection(&joinLock);
- TclSignalExitThread(Tcl_GetCurrentThread(), status);
- LeaveCriticalSection(&joinLock);
-
-#if defined(_MSC_VER) || defined(__MSVCRT__) || defined(__BORLANDC__)
- _endthreadex((unsigned) status);
-#else
- ExitThread((DWORD) status);
-#endif
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_GetCurrentThread --
- *
- * This procedure returns the ID of the currently running thread.
- *
- * Results:
- * A thread ID.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-Tcl_ThreadId
-Tcl_GetCurrentThread(void)
-{
- return (Tcl_ThreadId)(size_t)GetCurrentThreadId();
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * 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.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Acquire the initialization mutex.
- *
- *----------------------------------------------------------------------
- */
-
-void
-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.
- */
-
- init = 1;
- InitializeCriticalSection(&joinLock);
- InitializeCriticalSection(&initLock);
- InitializeCriticalSection(&masterLock);
- }
- EnterCriticalSection(&initLock);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclpInitUnlock
- *
- * This procedure is used to release a lock that serializes
- * initialization and finalization of Tcl.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Release the initialization mutex.
- *
- *----------------------------------------------------------------------
- */
-
-void
-TclpInitUnlock(void)
-{
- LeaveCriticalSection(&initLock);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclpMasterLock
- *
- * 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 synchronization objects.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Acquire the master mutex.
- *
- *----------------------------------------------------------------------
- */
-
-void
-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.
- */
-
- init = 1;
- InitializeCriticalSection(&joinLock);
- InitializeCriticalSection(&initLock);
- InitializeCriticalSection(&masterLock);
- }
- EnterCriticalSection(&masterLock);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclpMasterUnlock
- *
- * This procedure is used to release a lock that serializes creation and
- * deletion of synchronization objects.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Release the master mutex.
- *
- *----------------------------------------------------------------------
- */
-
-void
-TclpMasterUnlock(void)
-{
- LeaveCriticalSection(&masterLock);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * 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...
- *
- * Results:
- * A pointer to a mutex that is suitable for passing to Tcl_MutexLock and
- * Tcl_MutexUnlock.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-Tcl_Mutex *
-Tcl_GetAllocMutex(void)
-{
-#ifdef TCL_THREADS
- if (!allocOnce) {
- InitializeCriticalSection(&allocLock.crit);
- allocOnce = 1;
- }
- return &allocLockPtr;
-#else
- return NULL;
-#endif
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclpFinalizeLock
- *
- * 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.
- *
- *----------------------------------------------------------------------
- */
-
-void
-TclFinalizeLock(void)
-{
- MASTER_LOCK;
- DeleteCriticalSection(&joinLock);
-
- /*
- * Destroy the critical section that we are holding!
- */
-
- DeleteCriticalSection(&masterLock);
- init = 0;
-
-#ifdef TCL_THREADS
- if (allocOnce) {
- DeleteCriticalSection(&allocLock.crit);
- allocOnce = 0;
- }
-#endif
-
- LeaveCriticalSection(&initLock);
-
- /*
- * Destroy the critical section that we were holding.
- */
-
- DeleteCriticalSection(&initLock);
-}
-
-#ifdef TCL_THREADS
-
-/* locally used prototype */
-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.
- *
- * Results:
- * None.
- *
- * Side effects:
- * May block the current thread. The mutex is acquired when this returns.
- *
- *----------------------------------------------------------------------
- */
-
-void
-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 = ckalloc(sizeof(CRITICAL_SECTION));
- InitializeCriticalSection(csPtr);
- *mutexPtr = (Tcl_Mutex)csPtr;
- TclRememberMutex(mutexPtr);
- }
- MASTER_UNLOCK;
- }
- csPtr = *((CRITICAL_SECTION **)mutexPtr);
- EnterCriticalSection(csPtr);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_MutexUnlock --
- *
- * This procedure is invoked to unlock a mutex.
- *
- * Results:
- * None.
- *
- * Side effects:
- * The mutex is released when this returns.
- *
- *----------------------------------------------------------------------
- */
-
-void
-Tcl_MutexUnlock(
- Tcl_Mutex *mutexPtr) /* The lock */
-{
- CRITICAL_SECTION *csPtr = *((CRITICAL_SECTION **)mutexPtr);
-
- LeaveCriticalSection(csPtr);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclpFinalizeMutex --
- *
- * This procedure is invoked to clean up one mutex. This is only safe to
- * call at the end of time.
- *
- * Results:
- * None.
- *
- * Side effects:
- * The mutex list is deallocated.
- *
- *----------------------------------------------------------------------
- */
-
-void
-TclpFinalizeMutex(
- Tcl_Mutex *mutexPtr)
-{
- CRITICAL_SECTION *csPtr = *(CRITICAL_SECTION **)mutexPtr;
-
- if (csPtr != NULL) {
- DeleteCriticalSection(csPtr);
- ckfree(csPtr);
- *mutexPtr = 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.
- *
- * The mutex must be held when this procedure is called.
- *
- * Results:
- * None.
- *
- * Side effects:
- * May block the current thread. The mutex is acquired when this returns.
- * Will allocate memory for a HANDLE and initialize this the first time
- * this Tcl_Condition is used.
- *
- *----------------------------------------------------------------------
- */
-
-void
-Tcl_ConditionWait(
- Tcl_Condition *condPtr, /* Really (WinCondition **) */
- Tcl_Mutex *mutexPtr, /* Really (CRITICAL_SECTION **) */
- const Tcl_Time *timePtr) /* Timeout on waiting period */
-{
- WinCondition *winCondPtr; /* Per-condition queue head */
- CRITICAL_SECTION *csPtr; /* Caller's Mutex, after casting */
- DWORD wtime; /* Windows time value */
- int timeout; /* True if we got a timeout */
- int doExit = 0; /* True if we need to do exit setup */
- 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.
- */
-
- 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);
- tsdPtr->nextPtr = NULL;
- tsdPtr->prevPtr = NULL;
- tsdPtr->flags = WIN_THREAD_RUNNING;
- doExit = 1;
- }
- MASTER_UNLOCK;
-
- 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.
- */
-
- Tcl_CreateThreadExitHandler(FinalizeConditionEvent, tsdPtr);
- }
- }
-
- if (*condPtr == NULL) {
- MASTER_LOCK;
-
- /*
- * Initialize the per-condition queue pointers and Mutex.
- */
-
- if (*condPtr == NULL) {
- winCondPtr = ckalloc(sizeof(WinCondition));
- InitializeCriticalSection(&winCondPtr->condLock);
- winCondPtr->firstPtr = NULL;
- winCondPtr->lastPtr = NULL;
- *condPtr = (Tcl_Condition) winCondPtr;
- TclRememberCondition(condPtr);
- }
- MASTER_UNLOCK;
- }
- csPtr = *((CRITICAL_SECTION **)mutexPtr);
- winCondPtr = *((WinCondition **)condPtr);
- if (timePtr == NULL) {
- wtime = INFINITE;
- } else {
- wtime = timePtr->sec * 1000 + timePtr->usec / 1000;
- }
-
- /*
- * Queue the thread on the condition, using the per-condition lock for
- * serialization.
- */
-
- tsdPtr->flags = WIN_THREAD_BLOCKED;
- tsdPtr->nextPtr = NULL;
- EnterCriticalSection(&winCondPtr->condLock);
- tsdPtr->prevPtr = winCondPtr->lastPtr; /* A: */
- winCondPtr->lastPtr = tsdPtr;
- if (tsdPtr->prevPtr != NULL) {
- tsdPtr->prevPtr->nextPtr = tsdPtr;
- }
- if (winCondPtr->firstPtr == NULL) {
- 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.
- */
-
- LeaveCriticalSection(csPtr);
- timeout = 0;
- while (!timeout && (tsdPtr->flags & WIN_THREAD_BLOCKED)) {
- ResetEvent(tsdPtr->condEvent);
- LeaveCriticalSection(&winCondPtr->condLock);
- if (WaitForSingleObjectEx(tsdPtr->condEvent, wtime,
- TRUE) == WAIT_TIMEOUT) {
- timeout = 1;
- }
- EnterCriticalSection(&winCondPtr->condLock);
- }
-
- /*
- * 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.
- */
-
- 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;
- }
- }
-
- LeaveCriticalSection(&winCondPtr->condLock);
- EnterCriticalSection(csPtr);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_ConditionNotify --
- *
- * 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.
- *
- * Results:
- * None.
- *
- * Side effects:
- * May unblock another thread.
- *
- *----------------------------------------------------------------------
- */
-
-void
-Tcl_ConditionNotify(
- Tcl_Condition *condPtr)
-{
- WinCondition *winCondPtr;
- ThreadSpecificData *tsdPtr;
-
- if (*condPtr != NULL) {
- winCondPtr = *((WinCondition **)condPtr);
-
- if (winCondPtr == NULL) {
- return;
- }
-
- /*
- * 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);
- while (winCondPtr->firstPtr != NULL) {
- tsdPtr = winCondPtr->firstPtr;
- winCondPtr->firstPtr = tsdPtr->nextPtr;
- if (winCondPtr->lastPtr == tsdPtr) {
- winCondPtr->lastPtr = NULL;
- }
- tsdPtr->flags = WIN_THREAD_RUNNING;
- tsdPtr->nextPtr = NULL;
- tsdPtr->prevPtr = NULL; /* Not strictly necessary, see A: */
- SetEvent(tsdPtr->condEvent);
- }
- LeaveCriticalSection(&winCondPtr->condLock);
- } else {
- /*
- * No-one has used the condition variable, so there are no waiters.
- */
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * 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.
- *
- * Results:
- * None.
- *
- * Side effects:
- * The per-thread event is closed.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-FinalizeConditionEvent(
- ClientData data)
-{
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *) data;
-
- tsdPtr->flags = WIN_THREAD_UNINIT;
- CloseHandle(tsdPtr->condEvent);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclpFinalizeCondition --
- *
- * 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.
- *
- * Results:
- * None.
- *
- * Side effects:
- * The condition variable is deallocated.
- *
- *----------------------------------------------------------------------
- */
-
-void
-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.
- */
-
- if (winCondPtr != NULL) {
- DeleteCriticalSection(&winCondPtr->condLock);
- ckfree(winCondPtr);
- *condPtr = NULL;
- }
-}
-
-
-
-
-/*
- * Additions by AOL for specialized thread memory allocator.
- */
-#ifdef USE_THREAD_ALLOC
-
-Tcl_Mutex *
-TclpNewAllocMutex(void)
-{
- struct allocMutex *lockPtr;
-
- lockPtr = malloc(sizeof(struct allocMutex));
- if (lockPtr == NULL) {
- Tcl_Panic("could not allocate lock");
- }
- lockPtr->tlock = (Tcl_Mutex) &lockPtr->wlock;
- InitializeCriticalSection(&lockPtr->wlock);
- return &lockPtr->tlock;
-}
-
-void
-TclpFreeAllocMutex(
- Tcl_Mutex *mutex) /* The alloc mutex to free. */
-{
- allocMutex *lockPtr = (allocMutex *) mutex;
-
- if (!lockPtr) {
- return;
- }
- DeleteCriticalSection(&lockPtr->wlock);
- free(lockPtr);
-}
-
-void *
-TclpGetAllocCache(void)
-{
- void *result;
-
- if (!once) {
- /*
- * We need to make sure that TclpFreeAllocCache is called on each
- * thread that calls this, but only on threads that call this.
- */
-
- tlsKey = TlsAlloc();
- once = 1;
- if (tlsKey == TLS_OUT_OF_INDEXES) {
- Tcl_Panic("could not allocate thread local storage");
- }
- }
-
- result = TlsGetValue(tlsKey);
- if ((result == NULL) && (GetLastError() != NO_ERROR)) {
- Tcl_Panic("TlsGetValue failed from TclpGetAllocCache");
- }
- return result;
-}
-
-void
-TclpSetAllocCache(
- void *ptr)
-{
- BOOL success;
- success = TlsSetValue(tlsKey, ptr);
- if (!success) {
- Tcl_Panic("TlsSetValue failed from TclpSetAllocCache");
- }
-}
-
-void
-TclpFreeAllocCache(
- void *ptr)
-{
- BOOL success;
-
- if (ptr != NULL) {
- /*
- * Called by TclFinalizeThreadAlloc() and
- * TclFinalizeThreadAllocThread() during Tcl_Finalize() or
- * Tcl_FinalizeThread(). This function destroys the tsd key which
- * stores allocator caches in thread local storage.
- */
-
- TclFreeAllocCache(ptr);
- 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 */
-
-
-void *
-TclpThreadCreateKey(void)
-{
- DWORD *key;
-
- key = TclpSysAlloc(sizeof *key, 0);
- if (key == NULL) {
- Tcl_Panic("unable to allocate thread key!");
- }
-
- *key = TlsAlloc();
-
- if (*key == TLS_OUT_OF_INDEXES) {
- Tcl_Panic("unable to allocate thread-local storage");
- }
-
- return key;
-}
-
-void
-TclpThreadDeleteKey(
- void *keyPtr)
-{
- DWORD *key = keyPtr;
-
- if (!TlsFree(*key)) {
- Tcl_Panic("unable to delete key");
- }
-
- TclpSysFree(keyPtr);
-}
-
-void
-TclpThreadSetMasterTSD(
- void *tsdKeyPtr,
- void *ptr)
-{
- DWORD *key = tsdKeyPtr;
-
- if (!TlsSetValue(*key, ptr)) {
- Tcl_Panic("unable to set master TSD value");
- }
-}
-
-void *
-TclpThreadGetMasterTSD(
- void *tsdKeyPtr)
-{
- DWORD *key = tsdKeyPtr;
-
- return TlsGetValue(*key);
-}
-
-#endif /* TCL_THREADS */
-
-/*
- * Local Variables:
- * mode: c
- * c-basic-offset: 4
- * fill-column: 78
- * End:
- */
diff --git a/tcl8.6/win/tclWinTime.c b/tcl8.6/win/tclWinTime.c
deleted file mode 100644
index 2ea9e86..0000000
--- a/tcl8.6/win/tclWinTime.c
+++ /dev/null
@@ -1,1183 +0,0 @@
-/*
- * tclWinTime.c --
- *
- * 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.
- */
-
-#include "tclInt.h"
-
-#define SECSPERDAY (60L * 60L * 24L)
-#define SECSPERYEAR (SECSPERDAY * 365L)
-#define SECSPER4YEAR (SECSPERYEAR * 4L + SECSPERDAY)
-
-/*
- * Number of samples over which to estimate the performance counter.
- */
-
-#define SAMPLES 64
-
-/*
- * The following arrays contain the day of year for the last day of each
- * month, where index 1 is January.
- */
-
-static const int normalDays[] = {
- -1, 30, 58, 89, 119, 150, 180, 211, 242, 272, 303, 333, 364
-};
-
-static const int leapDays[] = {
- -1, 30, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334, 365
-};
-
-typedef struct ThreadSpecificData {
- char tzName[64]; /* Time zone name */
- struct tm tm; /* time information */
-} ThreadSpecificData;
-static Tcl_ThreadDataKey dataKey;
-
-/*
- * Data for managing high-resolution timers.
- */
-
-typedef struct TimeInfo {
- 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. */
-
- /*
- * 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.
- */
-
- ULARGE_INTEGER fileTimeLastCall;
- LARGE_INTEGER perfCounterLastCall;
- LARGE_INTEGER curCounterFreq;
-
- /*
- * Data used in developing the estimate of performance counter frequency
- */
-
- Tcl_WideUInt fileTimeSample[SAMPLES];
- /* Last 64 samples of system time. */
- Tcl_WideInt perfCounterSample[SAMPLES];
- /* Last 64 samples of performance counter. */
- int sampleNo; /* Current sample number. */
-} TimeInfo;
-
-static TimeInfo timeInfo = {
- { NULL, 0, 0, NULL, NULL, 0 },
- 0,
- 0,
- (HANDLE) NULL,
- (HANDLE) NULL,
- (HANDLE) NULL,
-#ifdef HAVE_CAST_TO_UNION
- (LARGE_INTEGER) (Tcl_WideInt) 0,
- (ULARGE_INTEGER) (DWORDLONG) 0,
- (LARGE_INTEGER) (Tcl_WideInt) 0,
- (LARGE_INTEGER) (Tcl_WideInt) 0,
-#else
- 0,
- 0,
- 0,
- 0,
-#endif
- { 0 },
- { 0 },
- 0
-};
-
-/*
- * Declarations for functions defined later in this file.
- */
-
-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.
- *
- * Results:
- * Number of seconds from the epoch.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-unsigned long
-TclpGetSeconds(void)
-{
- Tcl_Time t;
-
- tclGetTimeProcPtr(&t, tclTimeClientData); /* Tcl_GetTime inlined. */
- return t.sec;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * 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.
- *
- * Results:
- * Number of clicks from some start time.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-unsigned long
-TclpGetClicks(void)
-{
- /*
- * 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 */
-
- tclGetTimeProcPtr(&now, tclTimeClientData); /* Tcl_GetTime inlined */
-
- retval = (now.sec * 1000000) + now.usec;
- return retval;
-
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_GetTime --
- *
- * 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.
- *
- *----------------------------------------------------------------------
- */
-
-void
-Tcl_GetTime(
- Tcl_Time *timePtr) /* Location to store time information. */
-{
- 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.
- *
- *----------------------------------------------------------------------
- */
-
-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.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-NativeGetTime(
- Tcl_Time *timePtr,
- ClientData clientData)
-{
- struct _timeb t;
-
- /*
- * 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) {
- TclpInitLock();
- 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:
- * - inconsistent results among the processors on
- * multi-processor systems.
- * - 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.
- *
- * 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 !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,
- * presuming that everyone's TSC is locked to the same
- * oscillator.
- */
-
- 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)) {
- timeInfo.perfCounterAvailable = TRUE;
- } else {
- timeInfo.perfCounterAvailable = FALSE;
- }
- }
-#endif /* above code is Win32 only */
-
- /*
- * If the performance counter is available, start a thread to
- * calibrate it.
- */
-
- 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);
-
- /*
- * 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, NULL);
- }
- timeInfo.initialized = TRUE;
- }
- TclpInitUnlock();
- }
-
- if (timeInfo.perfCounterAvailable && timeInfo.curCounterFreq.QuadPart!=0) {
- /*
- * Query the performance counter and use it to calculate the current
- * time.
- */
-
- ULARGE_INTEGER fileTimeLastCall;
- LARGE_INTEGER perfCounterLastCall, curCounterFreq;
- /* Copy with current data of calibration cycle */
-
- LARGE_INTEGER curCounter;
- /* Current performance counter. */
- Tcl_WideInt curFileTime;/* Current estimated time, expressed as 100-ns
- * ticks since the Windows epoch. */
- static LARGE_INTEGER posixEpoch;
- /* Posix epoch expressed as 100-ns ticks since
- * the windows epoch. */
- Tcl_WideInt usecSincePosixEpoch;
- /* Current microseconds since Posix epoch. */
-
- posixEpoch.LowPart = 0xD53E8000;
- posixEpoch.HighPart = 0x019DB1DE;
-
- QueryPerformanceCounter(&curCounter);
-
- /*
- * Hold time section locked as short as possible
- */
- EnterCriticalSection(&timeInfo.cs);
-
- fileTimeLastCall.QuadPart = timeInfo.fileTimeLastCall.QuadPart;
- perfCounterLastCall.QuadPart = timeInfo.perfCounterLastCall.QuadPart;
- curCounterFreq.QuadPart = timeInfo.curCounterFreq.QuadPart;
-
- LeaveCriticalSection(&timeInfo.cs);
-
- /*
- * If calibration cycle occurred after we get curCounter
- */
- if (curCounter.QuadPart <= perfCounterLastCall.QuadPart) {
- usecSincePosixEpoch =
- (fileTimeLastCall.QuadPart - posixEpoch.QuadPart) / 10;
- timePtr->sec = (long) (usecSincePosixEpoch / 1000000);
- timePtr->usec = (unsigned long) (usecSincePosixEpoch % 1000000);
- return;
- }
-
- /*
- * If it appears to be more than 1.1 seconds since the last trip
- * 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 - perfCounterLastCall.QuadPart <
- 11 * curCounterFreq.QuadPart / 10
- ) {
- curFileTime = fileTimeLastCall.QuadPart +
- ((curCounter.QuadPart - perfCounterLastCall.QuadPart)
- * 10000000 / curCounterFreq.QuadPart);
-
- usecSincePosixEpoch = (curFileTime - posixEpoch.QuadPart) / 10;
- timePtr->sec = (long) (usecSincePosixEpoch / 1000000);
- timePtr->usec = (unsigned long) (usecSincePosixEpoch % 1000000);
- return;
- }
- }
-
- /*
- * High resolution timer is not available. Just use ftime.
- */
-
- _ftime(&t);
- timePtr->sec = (long)t.time;
- timePtr->usec = t.millitm * 1000;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * StopCalibration --
- *
- * Turns off the calibration thread in preparation for exiting the
- * process.
- *
- * Results:
- * 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.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-StopCalibration(
- ClientData unused) /* Client data is unused */
-{
- 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);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclpGetDate --
- *
- * This function converts between seconds and struct tm. If useGMT is
- * true, then the returned date will be in Greenwich Mean Time (GMT).
- * Otherwise, it will be in the local time zone.
- *
- * Results:
- * Returns a static tm structure.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-struct tm *
-TclpGetDate(
- const time_t *t,
- int useGMT)
-{
- struct tm *tmPtr;
- time_t time;
-
- if (!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.
- */
-
- /*
- * 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 = *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.
- */
-
- if (*t < (LONG_MAX - 2*SECSPERDAY) && *t > (LONG_MIN + 2*SECSPERDAY)) {
- tmPtr = ComputeGMT(&time);
- } else {
- tmPtr = ComputeGMT(t);
-
- tzset();
-
- /*
- * Add the bias directly to the tm structure to avoid overflow.
- * Propagate seconds overflow into minutes, hours and days.
- */
-
- time = tmPtr->tm_sec - timezone;
- tmPtr->tm_sec = (int)(time % 60);
- if (tmPtr->tm_sec < 0) {
- tmPtr->tm_sec += 60;
- time -= 60;
- }
-
- time = tmPtr->tm_min + time/60;
- tmPtr->tm_min = (int)(time % 60);
- if (tmPtr->tm_min < 0) {
- tmPtr->tm_min += 60;
- time -= 60;
- }
-
- time = tmPtr->tm_hour + time/60;
- tmPtr->tm_hour = (int)(time % 24);
- if (tmPtr->tm_hour < 0) {
- tmPtr->tm_hour += 24;
- time -= 24;
- }
-
- time /= 24;
- tmPtr->tm_mday += (int)time;
- tmPtr->tm_yday += (int)time;
- tmPtr->tm_wday = (tmPtr->tm_wday + (int)time) % 7;
- }
- } else {
- tmPtr = ComputeGMT(t);
- }
- return tmPtr;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ComputeGMT --
- *
- * This function computes GMT given the number of seconds since the epoch
- * (midnight Jan 1 1970).
- *
- * Results:
- * Returns a (per thread) statically allocated struct tm.
- *
- * Side effects:
- * Updates the values of the static struct tm.
- *
- *----------------------------------------------------------------------
- */
-
-static struct tm *
-ComputeGMT(
- const time_t *tp)
-{
- struct tm *tmPtr;
- long tmp, rem;
- int isLeap;
- const int *days;
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-
- tmPtr = &tsdPtr->tm;
-
- /*
- * Compute the 4 year span containing the specified time.
- */
-
- tmp = (long)(*tp / SECSPER4YEAR);
- rem = (long)(*tp % SECSPER4YEAR);
-
- /*
- * Correct for weird mod semantics so the remainder is always positive.
- */
-
- if (rem < 0) {
- tmp--;
- rem += SECSPER4YEAR;
- }
-
- /*
- * Compute the year after 1900 by taking the 4 year span and adjusting for
- * the remainder. This works because 2000 is a leap year, and 1900/2100
- * are out of the range.
- */
-
- tmp = (tmp * 4) + 70;
- isLeap = 0;
- if (rem >= SECSPERYEAR) { /* 1971, etc. */
- tmp++;
- rem -= SECSPERYEAR;
- if (rem >= SECSPERYEAR) { /* 1972, etc. */
- tmp++;
- rem -= SECSPERYEAR;
- if (rem >= SECSPERYEAR + SECSPERDAY) { /* 1973, etc. */
- tmp++;
- rem -= SECSPERYEAR + SECSPERDAY;
- } else {
- isLeap = 1;
- }
- }
- }
- tmPtr->tm_year = tmp;
-
- /*
- * Compute the day of year and leave the seconds in the current day in the
- * remainder.
- */
-
- tmPtr->tm_yday = rem / SECSPERDAY;
- rem %= SECSPERDAY;
-
- /*
- * Compute the time of day.
- */
-
- tmPtr->tm_hour = rem / 3600;
- rem %= 3600;
- tmPtr->tm_min = rem / 60;
- tmPtr->tm_sec = rem % 60;
-
- /*
- * Compute the month and day of month.
- */
-
- days = (isLeap) ? leapDays : normalDays;
- for (tmp = 1; days[tmp] < tmPtr->tm_yday; tmp++) {
- /* empty body */
- }
- tmPtr->tm_mon = --tmp;
- tmPtr->tm_mday = tmPtr->tm_yday - days[tmp];
-
- /*
- * Compute day of week. Epoch started on a Thursday.
- */
-
- tmPtr->tm_wday = (long)(*tp / SECSPERDAY) + 4;
- if ((*tp % SECSPERDAY) < 0) {
- tmPtr->tm_wday--;
- }
- tmPtr->tm_wday %= 7;
- if (tmPtr->tm_wday < 0) {
- tmPtr->tm_wday += 7;
- }
-
- return tmPtr;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * CalibrationThread --
- *
- * 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.
- *
- * Return value:
- * None. This thread embeds an infinite loop.
- *
- * Side effects:
- * 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.
- *
- *----------------------------------------------------------------------
- */
-
-static DWORD WINAPI
-CalibrationThread(
- LPVOID arg)
-{
- FILETIME curFileTime;
- DWORD waitResult;
-
- /*
- * Get initial system time and performance counter.
- */
-
- 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);
-
- /*
- * Wake up the calling thread. When it wakes up, it will release the
- * initialization lock.
- */
-
- SetEvent(timeInfo.readyEvent);
-
- /*
- * Run the calibration once a second.
- */
-
- while (timeInfo.perfCounterAvailable) {
- /*
- * If the exitEvent is set, break out of the loop.
- */
-
- waitResult = WaitForSingleObjectEx(timeInfo.exitEvent, 1000, FALSE);
- if (waitResult == WAIT_OBJECT_0) {
- break;
- }
- UpdateTimeEachSecond();
- }
-
- /* lint */
- return (DWORD) 0;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * UpdateTimeEachSecond --
- *
- * Callback from the waitable timer in the clock calibration thread that
- * updates system time.
- *
- * Parameters:
- * info - Pointer to the static TimeInfo structure
- *
- * Results:
- * None.
- *
- * Side effects:
- * Performs virtual time calibration discipline.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-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. */
-
- /*
- * Sample performance counter and system time.
- */
-
- QueryPerformanceCounter(&curPerfCounter);
- GetSystemTimeAsFileTime(&curSysTime);
- curFileTime.LowPart = curSysTime.dwLowDateTime;
- curFileTime.HighPart = curSysTime.dwHighDateTime;
-
- EnterCriticalSection(&timeInfo.cs);
-
- /*
- * 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;
- }
-
- /*
- * 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);
-
- /*
- * We want to adjust things so that time appears to be continuous.
- * Virtual file time, right now, is
- *
- * 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
- *
- * vt1 = 20000000 + curFileTime
- *
- * 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;
- 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.
- */
-
- tdiff = vt0 - curFileTime.QuadPart;
- 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;
- } 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);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ResetCounterSamples --
- *
- * Fills the sample arrays in 'timeInfo' with dummy values that will
- * yield the current performance counter and frequency.
- *
- * Results:
- * 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.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-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) {
- timeInfo.perfCounterSample[i] = perfCounter;
- timeInfo.fileTimeSample[i] = fileTime;
- perfCounter -= perfFreq;
- fileTime -= 10000000;
- }
- timeInfo.sampleNo = 0;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * AccumulateSample --
- *
- * 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).
- */
-
-static Tcl_WideInt
-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 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.
- */
-
- 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];
- }
-
- 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);
- 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) {
- timeInfo.sampleNo = 0;
- }
-
- return estFreq;
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclpGmtime --
- *
- * Wrapper around the 'gmtime' library function to make it thread safe.
- *
- * Results:
- * Returns a pointer to a 'struct tm' in thread-specific data.
- *
- * Side effects:
- * Invokes gmtime or gmtime_r as appropriate.
- *
- *----------------------------------------------------------------------
- */
-
-struct tm *
-TclpGmtime(
- const time_t *timePtr) /* Pointer to the number of seconds since the
- * local system's epoch */
-{
- /*
- * The MS implementation of gmtime is thread safe because it returns the
- * time in a block of thread-local storage, and Windows does not provide a
- * Posix gmtime_r function.
- */
-
- return gmtime(timePtr);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclpLocaltime --
- *
- * Wrapper around the 'localtime' library function to make it thread
- * safe.
- *
- * Results:
- * Returns a pointer to a 'struct tm' in thread-specific data.
- *
- * Side effects:
- * Invokes localtime or localtime_r as appropriate.
- *
- *----------------------------------------------------------------------
- */
-
-struct tm *
-TclpLocaltime(
- const time_t *timePtr) /* Pointer to the number of seconds since the
- * local system's epoch */
-{
- /*
- * The MS implementation of localtime is thread safe because it returns
- * the time in a block of thread-local storage, and Windows does not
- * provide a Posix localtime_r function.
- */
-
- 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/tcl8.6/win/tclooConfig.sh b/tcl8.6/win/tclooConfig.sh
deleted file mode 100644
index 2279542..0000000
--- a/tcl8.6/win/tclooConfig.sh
+++ /dev/null
@@ -1,19 +0,0 @@
-# tclooConfig.sh --
-#
-# This shell script (for sh) is generated automatically by TclOO's configure
-# script, or would be except it has no values that we substitute. It will
-# create shell variables for most of the configuration options discovered by
-# the configure script. This script is intended to be included by TEA-based
-# configure scripts for TclOO extensions so that they don't have to figure
-# this all out for themselves.
-#
-# The information in this file is specific to a single platform.
-
-# These are mostly empty because no special steps are ever needed from Tcl 8.6
-# onwards; all libraries and include files are just part of Tcl.
-TCLOO_LIB_SPEC=""
-TCLOO_STUB_LIB_SPEC=""
-TCLOO_INCLUDE_SPEC=""
-TCLOO_PRIVATE_INCLUDE_SPEC=""
-TCLOO_CFLAGS=""
-TCLOO_VERSION=1.1.0
diff --git a/tcl8.6/win/tclsh.exe.manifest.in b/tcl8.6/win/tclsh.exe.manifest.in
deleted file mode 100644
index 8b06fce..0000000
--- a/tcl8.6/win/tclsh.exe.manifest.in
+++ /dev/null
@@ -1,53 +0,0 @@
-<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
-<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0"
- xmlns:asmv3="urn:schemas-microsoft-com:asm.v3">
- <assemblyIdentity
- version="@TCL_WIN_VERSION@"
- processorArchitecture="@MACHINE@"
- name="Tcl.tclsh"
- type="win32"
- />
- <description>Tcl command line shell (tclsh)</description>
- <trustInfo xmlns="urn:schemas-microsoft-com:asm.v3">
- <security>
- <requestedPrivileges>
- <requestedExecutionLevel
- level="asInvoker"
- uiAccess="false"
- />
- </requestedPrivileges>
- </security>
- </trustInfo>
- <compatibility xmlns="urn:schemas-microsoft-com:compatibility.v1">
- <application>
- <!-- Windows 10 -->
- <supportedOS Id="{8e0f7a12-bfb3-4fe8-b9a5-48fd50a15a9a}"/>
- <!-- Windows 8.1 -->
- <supportedOS Id="{1f676c76-80e1-4239-95bb-83d0f6d0da78}"/>
- <!-- Windows 8 -->
- <supportedOS Id="{4a2f28e3-53b9-4441-ba9c-d69d4a4a6e38}"/>
- <!-- Windows 7 -->
- <supportedOS Id="{35138b9a-5d96-4fbd-8e2d-a2440225f93a}"/>
- <!-- Windows Vista -->
- <supportedOS Id="{e2011457-1546-43c5-a5fe-008deee3d3f0}"/>
- </application>
- </compatibility>
- <asmv3:application>
- <asmv3:windowsSettings
- xmlns="http://schemas.microsoft.com/SMI/2005/WindowsSettings">
- <dpiAware>true</dpiAware>
- </asmv3:windowsSettings>
- </asmv3:application>
- <dependency>
- <dependentAssembly>
- <assemblyIdentity
- type="win32"
- name="Microsoft.Windows.Common-Controls"
- version="6.0.0.0"
- processorArchitecture="@MACHINE@"
- publicKeyToken="6595b64144ccf1df"
- language="*"
- />
- </dependentAssembly>
- </dependency>
-</assembly>
diff --git a/tcl8.6/win/tclsh.ico b/tcl8.6/win/tclsh.ico
deleted file mode 100644
index e254318..0000000
--- a/tcl8.6/win/tclsh.ico
+++ /dev/null
Binary files differ
diff --git a/tcl8.6/win/tclsh.rc b/tcl8.6/win/tclsh.rc
deleted file mode 100644
index 161da50..0000000
--- a/tcl8.6/win/tclsh.rc
+++ /dev/null
@@ -1,82 +0,0 @@
-//
-// Version Resource Script
-//
-
-#include <winver.h>
-#include <tcl.h>
-
-//
-// build-up the name suffix that defines the type of build this is.
-//
-#if TCL_THREADS
-#define SUFFIX_THREADS "t"
-#else
-#define SUFFIX_THREADS ""
-#endif
-
-#if STATIC_BUILD
-#define SUFFIX_STATIC "s"
-#else
-#define SUFFIX_STATIC ""
-#endif
-
-#if DEBUG && !UNCHECKED
-#define SUFFIX_DEBUG "g"
-#else
-#define SUFFIX_DEBUG ""
-#endif
-
-#define SUFFIX SUFFIX_THREADS SUFFIX_STATIC SUFFIX_DEBUG
-
-
-LANGUAGE 0x9, 0x1 /* LANG_ENGLISH, SUBLANG_DEFAULT */
-
-VS_VERSION_INFO VERSIONINFO
- FILEVERSION TCL_MAJOR_VERSION,TCL_MINOR_VERSION,TCL_RELEASE_LEVEL,TCL_RELEASE_SERIAL
- PRODUCTVERSION TCL_MAJOR_VERSION,TCL_MINOR_VERSION,TCL_RELEASE_LEVEL,TCL_RELEASE_SERIAL
- FILEFLAGSMASK 0x3fL
-#ifdef DEBUG
- FILEFLAGS VS_FF_DEBUG
-#else
- FILEFLAGS 0x0L
-#endif
- FILEOS VOS__WINDOWS32
- FILETYPE VFT_APP
- FILESUBTYPE 0x0L
-BEGIN
- BLOCK "StringFileInfo"
- BEGIN
- BLOCK "040904b0"
- BEGIN
- VALUE "FileDescription", "Tclsh Application\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"
- VALUE "ProductName", "Tcl " TCL_VERSION " for Windows\0"
- VALUE "ProductVersion", TCL_PATCH_LEVEL
- END
- END
- BLOCK "VarFileInfo"
- BEGIN
- VALUE "Translation", 0x409, 1200
- END
-END
-
-//
-// Icon
-//
-
-tclsh ICON DISCARDABLE "tclsh.ico"
-
-//
-// This is needed for Windows 8.1 onwards.
-//
-
-#ifndef RT_MANIFEST
-#define RT_MANIFEST 24
-#endif
-#ifndef CREATEPROCESS_MANIFEST_RESOURCE_ID
-#define CREATEPROCESS_MANIFEST_RESOURCE_ID 1
-#endif
-CREATEPROCESS_MANIFEST_RESOURCE_ID RT_MANIFEST "tclsh.exe.manifest"