diff options
author | William Joye <wjoye@cfa.harvard.edu> | 2019-09-28 14:41:16 (GMT) |
---|---|---|
committer | William Joye <wjoye@cfa.harvard.edu> | 2019-09-28 14:41:16 (GMT) |
commit | 0f2071c7e4cfc72944fe2d0659ad2b31aaaaa4c7 (patch) | |
tree | da5d943c62e2a58276c3a9e503220d74cfd3cc2d /tcl8.6/win | |
parent | b1b7f616cd9f9fdf6a8c0af88e4226d0a23daac9 (diff) | |
download | blt-0f2071c7e4cfc72944fe2d0659ad2b31aaaaa4c7.zip blt-0f2071c7e4cfc72944fe2d0659ad2b31aaaaa4c7.tar.gz blt-0f2071c7e4cfc72944fe2d0659ad2b31aaaaa4c7.tar.bz2 |
upgrade tcl/tk
Diffstat (limited to 'tcl8.6/win')
43 files changed, 0 insertions, 43840 deletions
diff --git a/tcl8.6/win/Makefile.in b/tcl8.6/win/Makefile.in deleted file mode 100644 index 988a1af..0000000 --- a/tcl8.6/win/Makefile.in +++ /dev/null @@ -1,937 +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@ -runstatedir = @runstatedir@ -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 -W 2>/dev/null || 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)') -ROOT_DIR_WIN_NATIVE = $(shell cd '$(ROOT_DIR)' ; pwd -W 2>/dev/null || pwd -P) -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_EXE_FILE = tcltest${EXESUFFIX} -TEST_LIB_FILE = @LIBPREFIX@tcltest$(VER)${LIBSUFFIX} -TEST_LOAD_PRMS = 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] -TEST_LOAD_FACILITIES = package ifneeded Tcltest ${VERSION}@TCL_PATCH_LEVEL@ [list load [file normalize ${TEST_DLL_FILE}] Tcltest];\ - $(TEST_LOAD_PRMS) -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 = \ - 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_expt_d_ex.${OBJEXT} \ - bn_s_mp_get_bit.${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_set_long.${OBJEXT} \ - bn_mp_shrink.${OBJEXT} \ - bn_mp_sqr.${OBJEXT} \ - bn_mp_sqrt.${OBJEXT} \ - bn_mp_sub.${OBJEXT} \ - bn_mp_sub_d.${OBJEXT} \ - bn_mp_signed_rsh.${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 - -# Test-suite helper (can be used to test Tcl from build directory with all expected modules). -# To start from windows shell use: -# > tcltest.cmd -verbose bps -file fileName.test -# or from mingw/msys shell: -# $ ./tcltest -verbose bps -file fileName.test - -tcltest.cmd: Makefile - @echo 'Create tcltest.cmd helpers'; - @(\ - echo '@echo off'; \ - echo 'rem set LANG=en_US'; \ - echo 'set BDP=%~dp0'; \ - echo 'set OWD=%CD%'; \ - echo 'cd /d %TEMP%'; \ - echo 'rem "%BDP%\$(TCLSH)" "$(ROOT_DIR_WIN_NATIVE)/tests/all.tcl" %TESTFLAGS% -load "$(TEST_LOAD_FACILITIES)" %*'; \ - echo '"%BDP%\$(TEST_EXE_FILE)" "$(ROOT_DIR_WIN_NATIVE)/tests/all.tcl" %TESTFLAGS% -load "$(TEST_LOAD_PRMS)" %*'; \ - echo 'cd /d %OWD%'; \ - ) > tcltest.cmd; - @(\ - echo '#!/bin/sh'; \ - echo '#LANG=en_US'; \ - echo 'BDP=$$(dirname $$(readlink -f %0))'; \ - echo 'cd /tmp'; \ - echo '#"$$BDP/$(TCLSH)" "$(ROOT_DIR_WIN_NATIVE)/tests/all.tcl" $$TESTFLAGS -load "$(TEST_LOAD_FACILITIES)" "$$@"'; \ - echo '"$$BDP/$(TEST_EXE_FILE)" "$(ROOT_DIR_WIN_NATIVE)/tests/all.tcl" $$TESTFLAGS -load "$(TEST_LOAD_PRMS)" "$$@"'; \ - ) > tcltest.sh; - -tcltest.sh: tcltest.cmd - -tcltest: binaries $(TEST_EXE_FILE) $(TEST_DLL_FILE) $(CAT32) tcltest.cmd - -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) - $(COPY) tclsh.exe.manifest $(TCLSH).manifest - @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) - @$(RM) ${TCL_DLL_FILE} $(TCL_LIB_FILE) - @MAKE_DLL@ ${TCL_OBJS} tcl.$(RES) $(SHLIB_LD_LIBS) - $(COPY) tclsh.exe.manifest ${TCL_DLL_FILE}.manifest - @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) - $(COPY) tclsh.exe.manifest ${DDE_DLL_FILE}.manifest - -${REG_DLL_FILE}: ${TCL_STUB_LIB_FILE} ${REG_OBJS} - @MAKE_DLL@ ${REG_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS) - $(COPY) tclsh.exe.manifest ${REG_DLL_FILE}.manifest - -${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) - $(COPY) tclsh.exe.manifest ${TEST_DLL_FILE}.manifest - -${TEST_EXE_FILE}: ${TCL_STUB_LIB_FILE} ${TCLTEST_OBJS} tclTestMain.${OBJEXT} - @$(RM) ${TEST_EXE_FILE} - $(CC) $(CFLAGS) $(TCLTEST_OBJS) tclTestMain.$(OBJEXT) $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE) $(LIBS) \ - tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE) - $(COPY) tclsh.exe.manifest ${TEST_EXE_FILE}.manifest - -# 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 - -tclTestMain.${OBJEXT}: tclAppInit.c - $(CC) -c $(CC_SWITCHES) -DTCL_TEST -DBUILD_tcl $(EXTFLAGS) $(CC_OBJNAME) $(WIN_DIR)/tclAppInit.c - -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) - -tclWinReg.${OBJEXT}: tclWinReg.c - $(CC) -c $(CC_SWITCHES) $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME) - -tclWinDde.${OBJEXT}: tclWinDde.c - $(CC) -c $(CC_SWITCHES) $(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.1 as a Tcl Module"; - @$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/tcltest-2.5.1.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: tcltest - TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \ - ./$(TCLSH) "$(ROOT_DIR_NATIVE)/tests/all.tcl" $(TESTFLAGS) \ - -load "$(TEST_LOAD_FACILITIES)" - -# Useful target to launch a built tclsh with the proper path,... -runtest: tcltest - @TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \ - ./$(TCLSH) $(TESTFLAGS) -load "$(TEST_LOAD_FACILITIES)" $(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) $(TEST_EXE_FILE) $(TEST_DLL_FILE) tcltest.cmd tcltest.sh - $(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 e4f0a30..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 bd84dd4..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, (unsigned int)strlen(err)); - - return 0; -} diff --git a/tcl8.6/win/coffbase.txt b/tcl8.6/win/coffbase.txt deleted file mode 100644 index 5b877ae..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 beb30e2..0000000 --- a/tcl8.6/win/configure +++ /dev/null @@ -1,6320 +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-time64bit force 64-bit time_t for 32-bit build (default: off) - --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=".10" -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 x ${MAKE-make} -ac_make=`echo "" | 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 -SHELL = /bin/sh -all: - @echo '@@@%%%=$(MAKE)=@@@%%%' -_ACEOF -# GNU make sometimes prints "make[1]: Entering ...", which would confuse us. -case `${MAKE-make} -f conftest.make 2>/dev/null` in - *@@@%%%=?*=@@@%%%*) - eval ac_cv_prog_make_${ac_make}_set=yes;; - *) - eval ac_cv_prog_make_${ac_make}_set=no;; -esac -rm -f conftest.make -fi -if eval test \$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 - - -#-------------------------------------------------------------------- -# Check whether --enable-time64bit was given. -#-------------------------------------------------------------------- - -echo "$as_me:$LINENO: checking force of 64-bit time_t" >&5 -echo $ECHO_N "checking force of 64-bit time_t... $ECHO_C" >&6 -# Check whether --enable-time64bit or --disable-time64bit was given. -if test "${enable_time64bit+set}" = set; then - enableval="$enable_time64bit" - tcl_ok=$enableval -else - tcl_ok=no -fi; -echo "$as_me:$LINENO: result: \"$tcl_ok\"" >&5 -echo "${ECHO_T}\"$tcl_ok\"" >&6 -if test "$tcl_ok" = "yes"; then - CFLAGS="${CFLAGS} -D_USE_64BIT_TIME_T" -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}${LIBFLAGSUFFIX}\"" -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 cae6568..0000000 --- a/tcl8.6/win/configure.in +++ /dev/null @@ -1,479 +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=".10" -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 - -#-------------------------------------------------------------------- -# Check whether --enable-time64bit was given. -#-------------------------------------------------------------------- - -AC_MSG_CHECKING([force of 64-bit time_t]) -AC_ARG_ENABLE(time64bit, - AC_HELP_STRING([--enable-time64bit], - [force 64-bit time_t for 32-bit build (default: off)]), - [tcl_ok=$enableval], [tcl_ok=no]) -AC_MSG_RESULT("$tcl_ok") -if test "$tcl_ok" = "yes"; then - CFLAGS="${CFLAGS} -D_USE_64BIT_TIME_T" -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. -#-------------------------------------------------------------------- - -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/makefile.vc b/tcl8.6/win/makefile.vc deleted file mode 100644 index 85b1d60..0000000 --- a/tcl8.6/win/makefile.vc +++ /dev/null @@ -1,1016 +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. -# -# Basic macros and options usable on the commandline (see rules.vc for more info): -# OPTS=msvcrt,static,staticpkg,symbols,nothreads,profile,unchecked,time64bit,none -# Sets special options for the core. The default is for none. -# Any combination of the above may be used (comma separated). -# 'none' will over-ride everything to nothing. -# -# msvcrt = Affects the static option only to switch it from -# using libcmt(d) as the C runtime [by default] to -# msvcrt(d). This is useful for static embedding -# support. -# static = Builds a static library of the core instead of a -# dll. The shell will be static (and large), as well. -# staticpkg= Affects the static option only to switch -# tclshXX.exe to have the dde and reg extension linked -# inside it. -# nothreads = Turns off full multithreading support (default on). -# thrdalloc = Use the thread allocator (shared global free pool). -# symbols = Adds symbols for step debugging. -# profile = Adds profiling hooks. Map file is assumed. -# unchecked = Allows a symbols build to not use the debug -# enabled runtime (msvcrt.dll not msvcrtd.dll -# or libcmt.lib not libcmtd.lib). -# time64bit = Forces a build using 64-bit time_t for 32-bit build -# (CRT library should support this). -# -# STATS=compdbg,memdbg,none -# Sets optional memory and bytecode compiler debugging code added -# to the core. The default is for none. Any combination of the -# above may be used (comma separated). 'none' will over-ride -# everything to nothing. -# -# compdbg = Enables byte compilation logging. -# memdbg = Enables the debugging memory allocator. -# -# CHECKS=64bit,fullwarn,nodep,none -# Sets special macros for checking compatibility. -# -# 64bit = Enable 64bit portability warnings (if available) -# fullwarn = Builds with full compiler and link warnings enabled. -# Very verbose. -# nodep = Turns off compatibility macros to ensure the core -# isn't being built with deprecated functions. -# -# MACHINE=(ALPHA|AMD64|IA64|IX86) -# Set the machine type used for the compiler, linker, and -# resource compiler. This hook is needed to tell the tools -# when alternate platforms are requested. IX86 is the default -# when not specified. If the CPU environment variable has been -# set (ie: recent Platform SDK) then MACHINE is set from CPU. -# -# TMP_DIR=<path> -# OUT_DIR=<path> -# Hooks to allow the intermediate and output directories to be -# changed. $(OUT_DIR) is assumed to be -# $(BINROOT)\(Release|Debug) based on if symbols are requested. -# $(TMP_DIR) will de $(OUT_DIR)\<buildtype> by default. -# -# TESTPAT=<file> -# Reads the tests requested to be run from this file. -# -# CFG_ENCODING=encoding -# name of encoding for configuration information. Defaults -# to cp1252 -# -# 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)\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_expt_d_ex.obj \ - $(TMP_DIR)\bn_s_mp_get_bit.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_set_long.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_signed_rsh.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 -!if $(SYMBOLS) -install: install-pdbs -!endif -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): $(WIN_DIR)\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: $(WIN_DIR)\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: $(WIN_DIR)\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: $(WIN_DIR)\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: $(WIN_DIR)\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: $(WIN_DIR)\tclWinReg.c -!if $(STATIC_BUILD) - $(cc32) $(appcflags) /DSTATIC_BUILD -Fo$@ $? -!else - $(cc32) $(appcflags) /DUSE_TCL_STUBS -Fo$@ $? -!endif - - -$(TMP_DIR)\tclWinDde.obj: $(WIN_DIR)\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: $(WIN_DIR)\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) $(WIN_DIR),$$(WIN_DIR) @<< -$(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 $(WIN_DIR)\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) "$(WIN_DIR)\tclooConfig.sh" "$(LIB_INSTALL_DIR)\" - @$(CPY) "$(WIN_DIR)\rules.vc" "$(LIB_INSTALL_DIR)\nmake\" - @$(CPY) "$(WIN_DIR)\targets.vc" "$(LIB_INSTALL_DIR)\nmake\" - @$(CPY) "$(WIN_DIR)\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" - -install-pdbs: - @echo Installing debug symbols - @$(CPY) "$(OUT_DIR)\*.pdb" "$(BIN_INSTALL_DIR)\" -# "emacs font-lock highlighting fix - -#--------------------------------------------------------------------- -# 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 fac32ee..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 */ -#ifndef NDEBUG - { - 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 const 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 d64a31b..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 f951bcb..0000000 --- a/tcl8.6/win/rules.vc +++ /dev/null @@ -1,1799 +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 = 4 - -# 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 -# WIN_DIR - 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 use WINDIR because it is Windows internal environment -# variable to point to c:\windows! -WIN_DIR = $(ROOT)\win - -!ifndef RCDIR -!if exist("$(WIN_DIR)\rc") -RCDIR = $(WIN_DIR)\rc -!else -RCDIR = $(WIN_DIR) -!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 - -#--------------------------------------------------------------- -# The PLATFORM_IDENTIFY macro matches the values returned by -# the Tcl platform::identify command -!if "$(MACHINE)" == "AMD64" -PLATFORM_IDENTIFY = win32-x86_64 -!else -PLATFORM_IDENTIFY = win32-ix86 -!endif - -# The MULTIPLATFORM macro controls whether binary extensions are installed -# in platform-specific directories. Intended to be set/used by extensions. -!ifndef MULTIPLATFORM_INSTALL -MULTIPLATFORM_INSTALL = 0 -!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) -# _USE_64BIT_TIME_T - forces a build using 64-bit time_t for 32-bit build -# (CRT library should support this) -# 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) "time64bit"] -!message *** Force 64-bit time_t -_USE_64BIT_TIME_T = 1 -!endif - -# Yes, it's weird that the "symbols" option controls DEBUG and -# the "pdbs" option controls SYMBOLS. That's historical. -!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. (Not used for Tcl >= 8.7) -# 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) || $(TCL_VERSION) > 86 -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$(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"$(WIN_DIR)" -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:t=).exe -!if !exist("$(TCLSH)") -TCLSH = $(_TCLDIR)\bin\tclsh$(TCL_VERSION)t$(SUFX:t=).exe -!endif - -TCLSTUBLIB = $(_TCLDIR)\lib\tclstub$(TCL_VERSION).lib -TCLIMPLIB = $(_TCLDIR)\lib\tcl$(TCL_VERSION)$(SUFX:t=).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)t$(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:t=).exe -!if !exist($(TCLSH)) -TCLSH = $(_TCLDIR)\win\$(BUILDDIRTOP)\tclsh$(TCL_VERSION)t$(SUFX:t=).exe -!endif -TCLSTUBLIB = $(_TCLDIR)\win\$(BUILDDIRTOP)\tclstub$(TCL_VERSION).lib -TCLIMPLIB = $(_TCLDIR)\win\$(BUILDDIRTOP)\tcl$(TCL_VERSION)$(SUFX:t=).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)t$(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"$(WIN_DIR)" -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) -!if $(MULTIPLATFORM_INSTALL) -LIB_INSTALL_DIR = $(PRJ_INSTALL_DIR)\$(PLATFORM_IDENTIFY) -BIN_INSTALL_DIR = $(PRJ_INSTALL_DIR)\$(PLATFORM_IDENTIFY) -!else -LIB_INSTALL_DIR = $(PRJ_INSTALL_DIR) -BIN_INSTALL_DIR = $(PRJ_INSTALL_DIR) -!endif -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) && $(TCL_VERSION) < 87 -OPTDEFINES = $(OPTDEFINES) /DTCL_THREADS=1 -!if $(USE_THREAD_ALLOC) && $(TCL_VERSION) < 87 -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 - -!if "$(_USE_64BIT_TIME_T)" == "1" -OPTDEFINES = $(OPTDEFINES) /D_USE_64BIT_TIME_T -!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"$(WIN_DIR)" -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_nostubs = $(cflags) $(crt) $(INCLUDES) $(TCL_DEFINES) $(PRJ_DEFINES) $(OPTDEFINES) -appcflags = $(appcflags_nostubs) $(USE_STUBS_DEFS) -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) $(USE_STUBS_DEFS) - -# 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) - -!if $(MULTIPLATFORM_INSTALL) -default-pkgindex: - @echo package ifneeded $(PRJ_PACKAGE_TCLNAME) $(DOTVERSION) \ - [list load [file join $$dir $(PLATFORM_IDENTIFY) $(PRJLIBNAME)]] > $(OUT_DIR)\pkgIndex.tcl -!else -default-pkgindex: - @echo package ifneeded $(PRJ_PACKAGE_TCLNAME) $(DOTVERSION) \ - [list load [file join $$dir $(PRJLIBNAME)]] > $(OUT_DIR)\pkgIndex.tcl -!endif - -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 -!if $(SYMBOLS) -default-install: default-install-pdbs -!endif - -# Again to deal with historical brokenness, there is some confusion -# in terminlogy. For extensions, the "install-binaries" was used to -# locate target directory for *binary shared libraries* and thus -# the appropriate macro is LIB_INSTALL_DIR since BIN_INSTALL_DIR is -# for executables (exes). On the other hand the "install-libraries" -# target is for *scripts* and should have been called "install-scripts". -default-install-binaries: $(PRJLIB) - @echo Installing binaries to '$(LIB_INSTALL_DIR)' - @if not exist "$(LIB_INSTALL_DIR)" mkdir "$(LIB_INSTALL_DIR)" - @$(CPY) $(PRJLIB) "$(LIB_INSTALL_DIR)" >NUL - -# Alias for default-install-scripts -default-install-libraries: default-install-scripts - -default-install-scripts: $(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-pdbs: - @echo Installing PDBs to '$(LIB_INSTALL_DIR)' - @if not exist "$(LIB_INSTALL_DIR)" mkdir "$(LIB_INSTALL_DIR)" - @$(CPY) "$(OUT_DIR)\*.pdb" "$(LIB_INSTALL_DIR)\" - -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 $(WIN_DIR)\nmakehlp.obj, nmakehlp.exe ... - @if exist $(WIN_DIR)\nmakehlp.obj del $(WIN_DIR)\nmakehlp.obj - @if exist $(WIN_DIR)\nmakehlp.exe del $(WIN_DIR)\nmakehlp.exe - @if exist $(WIN_DIR)\nmakehlp.out del $(WIN_DIR)\nmakehlp.out - @echo Cleaning $(WIN_DIR)\nmhlp-out.txt ... - @if exist $(WIN_DIR)\nmhlp-out.txt del $(WIN_DIR)\nmhlp-out.txt - @echo Cleaning $(WIN_DIR)\_junk.pch ... - @if exist $(WIN_DIR)\_junk.pch del $(WIN_DIR)\_junk.pch - @echo Cleaning $(WIN_DIR)\vercl.x, vercl.i ... - @if exist $(WIN_DIR)\vercl.x del $(WIN_DIR)\vercl.x - @if exist $(WIN_DIR)\vercl.i del $(WIN_DIR)\vercl.i - @echo Cleaning $(WIN_DIR)\versions.vc, version.vc ... - @if exist $(WIN_DIR)\versions.vc del $(WIN_DIR)\versions.vc - @if exist $(WIN_DIR)\version.vc del $(WIN_DIR)\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) @<< -$< -<< - -{$(WIN_DIR)}.c{$(TMP_DIR)}.obj:: - $(CCPKGCMD) @<< -$< -<< - -{$(GENERICDIR)}.c{$(TMP_DIR)}.obj:: - $(CCPKGCMD) @<< -$< -<< - -{$(COMPATDIR)}.c{$(TMP_DIR)}.obj:: - $(CCPKGCMD) @<< -$< -<< - -{$(RCDIR)}.rc{$(TMP_DIR)}.res: - $(RESCMD) $< - -{$(WIN_DIR)}.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 $(TCL_VERSION) < 87 && 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 312022d..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 828508c..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 fa93b00..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 3bdccbe..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 e77fbc0..0000000 --- a/tcl8.6/win/tclWin32Dll.c +++ /dev/null @@ -1,886 +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 { - WCHAR *volumeName; /* Native wide string volume name. */ - WCHAR 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. */ -{ - (void)reserved; - - 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 WCHAR *mountPoint) -{ - MountPointMap *dlIter, *dlPtr2; - WCHAR Target[55]; /* Target of mount at mount point */ - WCHAR drive[4] = L"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 (wcscmp(dlIter->volumeName, mountPoint) == 0) { - /* - * We need to check whether this information is still valid, since - * either the user or various programs could have adjusted the - * mount points on the fly. - */ - - drive[0] = (WCHAR) dlIter->driveLetter; - - /* - * Try to read the volume mount point and see where it points. - */ - - if (GetVolumeNameForVolumeMountPointW(drive, - Target, 55) != 0) { - if (wcscmp(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 (GetVolumeNameForVolumeMountPointW(drive, - Target, 55) != 0) { - int alreadyStored = 0; - - for (dlIter = driveLetterLookup; dlIter != NULL; - dlIter = dlIter->nextPtr) { - if (wcscmp(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 (wcscmp(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 WCHAR 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. */ -{ -#if TCL_UTF_MAX > 4 - Tcl_UniChar ch = 0; - TCHAR *w, *wString; - const char *p, *end; - int oldLength; -#endif - - Tcl_DStringInit(dsPtr); - if (!string) { - return NULL; - } -#if TCL_UTF_MAX > 4 - - if (len < 0) { - len = strlen(string); - } - - /* - * Unicode string length in Tcl_UniChars will be <= UTF-8 string length in - * bytes. - */ - - oldLength = Tcl_DStringLength(dsPtr); - - Tcl_DStringSetLength(dsPtr, - oldLength + (int) ((len + 1) * sizeof(TCHAR))); - wString = (TCHAR *) (Tcl_DStringValue(dsPtr) + oldLength); - - w = wString; - p = string; - end = string + len - 4; - while (p < end) { - p += TclUtfToUniChar(p, &ch); - if (ch > 0xFFFF) { - *w++ = (WCHAR) (0xD800 + ((ch -= 0x10000) >> 10)); - *w++ = (WCHAR) (0xDC00 | (ch & 0x3FF)); - } else { - *w++ = ch; - } - } - end += 4; - while (p < end) { - if (Tcl_UtfCharComplete(p, end-p)) { - p += TclUtfToUniChar(p, &ch); - } else { - ch = UCHAR(*p++); - } - if (ch > 0xFFFF) { - *w++ = (WCHAR) (0xD800 + ((ch -= 0x10000) >> 10)); - *w++ = (WCHAR) (0xDC00 | (ch & 0x3FF)); - } else { - *w++ = ch; - } - } - *w = '\0'; - Tcl_DStringSetLength(dsPtr, - oldLength + ((char *) w - (char *) wString)); - - return wString; -#else - return (TCHAR *)Tcl_UtfToUniCharDString(string, len, dsPtr); -#endif -} - -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. */ -{ -#if TCL_UTF_MAX > 4 - const WCHAR *w, *wEnd; - char *p, *result; - int oldLength, blen = 1; -#endif - - Tcl_DStringInit(dsPtr); - if (!string) { - return NULL; - } - if (len < 0) { - len = wcslen((WCHAR *)string); - } else { - len /= 2; - } -#if TCL_UTF_MAX > 4 - oldLength = Tcl_DStringLength(dsPtr); - Tcl_DStringSetLength(dsPtr, oldLength + (len + 1) * 4); - result = Tcl_DStringValue(dsPtr) + oldLength; - - p = result; - wEnd = (WCHAR *)string + len; - for (w = (WCHAR *)string; w < wEnd; ) { - if (!blen && ((*w & 0xFC00) != 0xDC00)) { - /* Special case for handling high surrogates. */ - p += Tcl_UniCharToUtf(-1, p); - } - blen = Tcl_UniCharToUtf(*w, p); - p += blen; - if ((*w >= 0xD800) && (blen < 3)) { - /* Indication that high surrogate is handled */ - blen = 0; - } - w++; - } - if (!blen) { - /* Special case for handling high surrogates. */ - p += Tcl_UniCharToUtf(-1, p); - } - Tcl_DStringSetLength(dsPtr, oldLength + (p - result)); - - return result; -#else - return Tcl_UniCharToUtfDString((Tcl_UniChar *)string, len, dsPtr); -#endif -} - -/* - *------------------------------------------------------------------------ - * - * 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 209b860..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 WCHAR *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 WCHAR *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 = GetFileAttributesW(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 = CreateFileW(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 WCHAR *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 173fe9e..0000000 --- a/tcl8.6/win/tclWinConsole.c +++ /dev/null @@ -1,1421 +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 ReadConsoleW, that takes and returns number of bytes - * instead of number of WCHARS. - * - *---------------------------------------------------------------------- - */ - -static BOOL -ReadConsoleBytes( - HANDLE hConsole, - LPVOID lpBuffer, - DWORD nbytes, - LPDWORD nbytesread) -{ - DWORD ntchars; - BOOL result; - - /* - * 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 = ReadConsoleW(hConsole, lpBuffer, nbytes / sizeof(WCHAR), &ntchars, - NULL); - } while (result && ntchars == 0 && GetLastError() == ERROR_OPERATION_ABORTED); - if (nbytesread != NULL) { - *nbytesread = ntchars * sizeof(WCHAR); - } - return result; -} - -static BOOL -WriteConsoleBytes( - HANDLE hConsole, - const void *lpBuffer, - DWORD nbytes, - LPDWORD nbyteswritten) -{ - DWORD ntchars; - BOOL result; - - result = WriteConsoleW(hConsole, lpBuffer, nbytes / sizeof(WCHAR), &ntchars, - NULL); - if (nbyteswritten != NULL) { - *nbyteswritten = ntchars * sizeof(WCHAR); - } - 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 (PeekConsoleInputW(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 = CreateEventW(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 = CreateEventW(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 {}"); - Tcl_SetChannelOption(NULL, infoPtr->channel, "-encoding", "unicode"); - 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 6fa9cc2..0000000 --- a/tcl8.6/win/tclWinDde.c +++ /dev/null @@ -1,1981 +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. */ - WCHAR *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 L"TclEval" -#define TCL_DDE_EXECUTE_RESULT L"$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(void *clientData); -static int DdeGetServicesList(Tcl_Interp *interp, - const WCHAR *serviceName, const WCHAR *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(void *clientData); -static Tcl_Obj * ExecuteRemoteObject(RegisteredInterp *riPtr, - Tcl_Obj *ddeObjectPtr); -static int MakeDdeConnection(Tcl_Interp *interp, - const WCHAR *name, HCONV *ddeConvPtr); -static void SetDdeError(Tcl_Interp *interp); -static int DdeObjCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); - -#if (TCL_MAJOR_VERSION < 9) && (TCL_MINOR_VERSION < 7) -# if TCL_UTF_MAX > 3 -# define Tcl_WCharToUtfDString(a,b,c) Tcl_WinTCharToUtf(a,(b)*sizeof(WCHAR),c) -# define Tcl_UtfToWCharDString(a,b,c) Tcl_WinUtfToTChar(a,b,c) -# else -# define Tcl_WCharToUtfDString Tcl_UniCharToUtfDString -# define Tcl_UtfToWCharDString Tcl_UtfToUniCharDString -# endif -#endif - -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; -} - -#ifdef __cplusplus -extern "C" { -#endif -DLLEXPORT int Dde_Init(Tcl_Interp *interp); -DLLEXPORT int Dde_SafeInit(Tcl_Interp *interp); -#ifdef __cplusplus -} -#endif - -/* - *---------------------------------------------------------------------- - * - * 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.5-", 0)) { - return TCL_ERROR; - } - - Tcl_CreateObjCommand(interp, "dde", DdeObjCmd, NULL, NULL); - Tcl_CreateExitHandler(DdeExitProc, NULL); - return Tcl_PkgProvideEx(interp, TCL_DDE_PACKAGE_NAME, TCL_DDE_VERSION, NULL); -} - -/* - *---------------------------------------------------------------------- - * - * 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 (DdeInitializeW(&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 = DdeCreateStringHandleW(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 WCHAR * -DdeSetServerName( - Tcl_Interp *interp, - const WCHAR *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 WCHAR *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 L""; - } - - /* - * 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_DStringInit(&dString); - OutputDebugStringW(Tcl_UtfToWCharDString(Tcl_GetString(Tcl_GetObjResult(interp)), -1, &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, wcslen(name) * sizeof(WCHAR)); - Tcl_DStringAppend(&dString, (char *)L" #", 2 * sizeof(WCHAR)); - offset = Tcl_DStringLength(&dString); - Tcl_DStringSetLength(&dString, offset + sizeof(WCHAR) * TCL_INTEGER_SPACE); - actualName = (WCHAR *) Tcl_DStringValue(&dString); - } - _snwprintf((WCHAR *) (Tcl_DStringValue(&dString) + offset), - TCL_INTEGER_SPACE, L"%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_DStringInit(&ds); - Tcl_UtfToWCharDString(Tcl_GetString(namePtr), -1, &ds); - if (wcscmp(actualName, (WCHAR *)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 = (WCHAR *) Tcl_Alloc((wcslen(actualName) + 1) * sizeof(WCHAR)); - riPtr->nextPtr = tsdPtr->interpListPtr; - riPtr->handlerPtr = handlerPtr; - if (riPtr->handlerPtr != NULL) { - Tcl_IncrRefCount(riPtr->handlerPtr); - } - tsdPtr->interpListPtr = riPtr; - wcscpy(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( - void *clientData) /* The interp we are deleting. */ -{ - 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 unused1, DWORD unused2) - /* Transaction-dependent data. */ -{ - Tcl_DString dString; - size_t len; - DWORD dlen; - WCHAR *utilString; - Tcl_Obj *ddeObjectPtr; - HDDEDATA ddeReturn = NULL; - RegisteredInterp *riPtr; - Conversation *convPtr, *prevConvPtr; - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - (void)unused1; - (void)unused2; - - switch(uType) { - case XTYP_CONNECT: - /* - * Dde is trying to initialize a conversation with us. Check and make - * sure we have a valid topic. - */ - - len = DdeQueryStringW(ddeInstance, ddeTopic, NULL, 0, CP_WINUNICODE); - Tcl_DStringInit(&dString); - Tcl_DStringSetLength(&dString, (len + 1) * sizeof(WCHAR) - 1); - utilString = (WCHAR *) Tcl_DStringValue(&dString); - DdeQueryStringW(ddeInstance, ddeTopic, utilString, (DWORD) len + 1, - CP_WINUNICODE); - - for (riPtr = tsdPtr->interpListPtr; riPtr != NULL; - riPtr = riPtr->nextPtr) { - if (_wcsicmp(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 = DdeQueryStringW(ddeInstance, ddeTopic, NULL, 0, CP_WINUNICODE); - Tcl_DStringInit(&dString); - Tcl_DStringSetLength(&dString, (len + 1) * sizeof(WCHAR) - 1); - utilString = (WCHAR *) Tcl_DStringValue(&dString); - DdeQueryStringW(ddeInstance, ddeTopic, utilString, (DWORD) len + 1, - CP_WINUNICODE); - for (riPtr = tsdPtr->interpListPtr; riPtr != NULL; - riPtr = riPtr->nextPtr) { - if (_wcsicmp(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 = DdeQueryStringW(ddeInstance, ddeItem, NULL, 0, CP_WINUNICODE); - Tcl_DStringInit(&dString); - Tcl_DStringInit(&dsBuf); - Tcl_DStringSetLength(&dString, (len + 1) * sizeof(WCHAR) - 1); - utilString = (WCHAR *) Tcl_DStringValue(&dString); - DdeQueryStringW(ddeInstance, ddeItem, utilString, (DWORD) len + 1, - CP_WINUNICODE); - if (_wcsicmp(utilString, TCL_DDE_EXECUTE_RESULT) == 0) { - returnString = - Tcl_GetString(convPtr->returnPackagePtr); - len = convPtr->returnPackagePtr->length; - if (uFmt != CF_TEXT) { - Tcl_DStringInit(&dsBuf); - Tcl_UtfToWCharDString(returnString, len, &dsBuf); - returnString = Tcl_DStringValue(&dsBuf); - len = Tcl_DStringLength(&dsBuf) + sizeof(WCHAR) - 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_DStringInit(&ds); - Tcl_WCharToUtfDString(utilString, wcslen(utilString), &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_DStringInit(&dsBuf); - Tcl_UtfToWCharDString(returnString, len, &dsBuf); - returnString = Tcl_DStringValue(&dsBuf); - len = Tcl_DStringLength(&dsBuf) + sizeof(WCHAR) - 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 = DdeQueryStringW(ddeInstance, ddeItem, NULL, 0, CP_WINUNICODE); - Tcl_DStringSetLength(&dString, (len + 1) * sizeof(WCHAR) - 1); - utilString = (WCHAR *) Tcl_DStringValue(&dString); - DdeQueryStringW(ddeInstance, ddeItem, utilString, (DWORD) len + 1, - CP_WINUNICODE); - Tcl_DStringInit(&ds); - Tcl_WCharToUtfDString(utilString, wcslen(utilString), &ds); - utilString = (WCHAR *) DdeAccessData(hData, &len2); - len = len2; - if (uFmt != CF_TEXT) { - Tcl_DStringInit(&ds2); - Tcl_WCharToUtfDString(utilString, wcslen(utilString), &ds2); - utilString = (WCHAR *) 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 = (WCHAR *) 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_DStringInit(&dsBuf); - Tcl_WCharToUtfDString(utilString, (dlen>>1) - 1, &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 = DdeCreateStringHandleW(ddeInstance, - TCL_DDE_SERVICE_NAME, CP_WINUNICODE); - returnPtr[i].hszTopic = DdeCreateStringHandleW(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( - void *dummy) /* Not used. */ -{ - (void)dummy; - 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 WCHAR *name, /* The connection to use. */ - HCONV *ddeConvPtr) -{ - HSZ ddeTopic, ddeService; - HCONV ddeConv; - - ddeService = DdeCreateStringHandleW(ddeInstance, TCL_DDE_SERVICE_NAME, CP_WINUNICODE); - ddeTopic = DdeCreateStringHandleW(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_DStringInit(&dString); - Tcl_WCharToUtfDString(name, wcslen(name), &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) -{ - WNDCLASSEXW wc; - static const WCHAR *szDdeClientClassName = L"TclEval client class"; - static const WCHAR *szDdeClientWindowName = L"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. - */ - - RegisterClassExW(&wc); - es->hwnd = CreateWindowExW(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 - SetWindowLongPtrW(hwnd, GWLP_USERDATA, (LONG_PTR) es); -#else - SetWindowLongW(hwnd, GWL_USERDATA, (LONG) es); -#endif - return (LRESULT) 0L; - } - case WM_DDE_ACK: - return DdeServicesOnAck(hwnd, wParam, lParam); - default: - return DefWindowProcW(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; - WCHAR sz[255]; - Tcl_DString dString; - -#ifdef _WIN64 - es = (DdeEnumServices *) GetWindowLongPtrW(hwnd, GWLP_USERDATA); -#else - es = (DdeEnumServices *) GetWindowLongW(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); - - GlobalGetAtomNameW(service, sz, 255); - Tcl_DStringInit(&dString); - Tcl_WCharToUtfDString(sz, wcslen(sz), &dString); - Tcl_ListObjAppendElement(NULL, matchPtr, Tcl_NewStringObj(Tcl_DStringValue(&dString), -1)); - Tcl_DStringFree(&dString); - GlobalGetAtomNameW(topic, sz, 255); - Tcl_DStringInit(&dString); - Tcl_WCharToUtfDString(sz, wcslen(sz), &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. - */ - - PostMessageW(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; - - SendMessageTimeoutW(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 WCHAR *serviceName, - const WCHAR *topicName) -{ - DdeEnumServices es; - - es.interp = interp; - es.result = TCL_OK; - es.service = (serviceName == NULL) - ? (ATOM)0 : GlobalAddAtomW(serviceName); - es.topic = (topicName == NULL) ? (ATOM)0 : GlobalAddAtomW(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( - void *dummy, /* Not used. */ - 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 WCHAR *serviceName = NULL, *topicName = NULL; - const char *string; - DWORD ddeResult; - Tcl_Obj *objPtr, *handlerPtr = NULL; - Tcl_DString serviceBuf, topicBuf, itemBuf; - (void)dummy; - - /* - * 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_DStringInit(&serviceBuf); - Tcl_UtfToWCharDString(src, length, &serviceBuf); - serviceName = (WCHAR *) Tcl_DStringValue(&serviceBuf); - length = Tcl_DStringLength(&serviceBuf) / sizeof(WCHAR); - } else { - length = 0; - } - - if (length == 0) { - serviceName = NULL; - } else if ((index != DDE_SERVERNAME) && (index != DDE_EVAL)) { - ddeService = DdeCreateStringHandleW(ddeInstance, serviceName, - CP_WINUNICODE); - } - - if ((index != DDE_SERVERNAME) && (index != DDE_EVAL)) { - const char *src = Tcl_GetString(objv[firstArg + 1]); - - length = objv[firstArg + 1]->length; - Tcl_DStringInit(&topicBuf); - topicName = Tcl_UtfToWCharDString(src, length, &topicBuf); - length = Tcl_DStringLength(&topicBuf) / sizeof(WCHAR); - if (length == 0) { - topicName = NULL; - } else { - ddeTopic = DdeCreateStringHandleW(ddeInstance, topicName, - CP_WINUNICODE); - } - } - - switch ((enum DdeSubcommands) index) { - case DDE_SERVERNAME: - serviceName = DdeSetServerName(interp, serviceName, flags, - handlerPtr); - if (serviceName != NULL) { - Tcl_DString dsBuf; - - Tcl_DStringInit(&dsBuf); - Tcl_WCharToUtfDString(serviceName, wcslen(serviceName), &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; - Tcl_DStringInit(&dsBuf); - dataString = - Tcl_UtfToWCharDString(src, dataLength, &dsBuf); - dataLength = Tcl_DStringLength(&dsBuf) + sizeof(WCHAR); - } - - 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 WCHAR *itemString; - const char *src; - - src = Tcl_GetString(objv[firstArg + 2]); - length = objv[firstArg + 2]->length; - Tcl_DStringInit(&itemBuf); - itemString = Tcl_UtfToWCharDString(src, length, &itemBuf); - length = Tcl_DStringLength(&itemBuf) / sizeof(WCHAR); - - 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 = DdeCreateStringHandleW(ddeInstance, 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; - WCHAR *dataString = (WCHAR *) DdeAccessData(ddeData, &tmp); - - if (flags & DDE_FLAG_BINARY) { - returnObjPtr = - Tcl_NewByteArrayObj((BYTE *) dataString, tmp); - } else { - Tcl_DString dsBuf; - - if ((tmp >= sizeof(WCHAR)) - && !dataString[tmp / sizeof(WCHAR) - 1]) { - tmp -= sizeof(WCHAR); - } - Tcl_DStringInit(&dsBuf); - Tcl_WCharToUtfDString(dataString, tmp>>1, &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 WCHAR *itemString; - BYTE *dataString; - const char *src; - - src = Tcl_GetString(objv[firstArg + 2]); - length = objv[firstArg + 2]->length; - Tcl_DStringInit(&itemBuf); - itemString = Tcl_UtfToWCharDString(src, length, &itemBuf); - length = Tcl_DStringLength(&itemBuf) / sizeof(WCHAR); - 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; - Tcl_DStringInit(&dsBuf); - dataString = (BYTE *) - Tcl_UtfToWCharDString(data, length, &dsBuf); - length = Tcl_DStringLength(&dsBuf) + sizeof(WCHAR); - } - - hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL); - DdeFreeStringHandle(ddeInstance, ddeService); - DdeFreeStringHandle(ddeInstance, ddeTopic); - - if (hConv == NULL) { - SetDdeError(interp); - result = TCL_ERROR; - } else { - ddeItem = DdeCreateStringHandleW(ddeInstance, 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 (_wcsicmp(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_DStringInit(&dsBuf); - Tcl_UtfToWCharDString(string, length, &dsBuf); - string = Tcl_DStringValue(&dsBuf); - length = Tcl_DStringLength(&dsBuf) + sizeof(WCHAR); - 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 = DdeCreateStringHandleW(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; - WCHAR *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 = (WCHAR *) Tcl_Alloc(length); - DdeGetData(ddeData, (BYTE *) ddeDataString, (DWORD) length, 0); - if (length > sizeof(WCHAR)) { - length -= sizeof(WCHAR); - } - Tcl_DStringInit(&dsBuf); - Tcl_WCharToUtfDString(ddeDataString, length>>1, &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 9df9d82..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 WCHAR *srcPtr, const WCHAR *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 WCHAR *srcPtr, const WCHAR *dstPtr); -static int DoCreateDirectory(const WCHAR *pathPtr); -static int DoRemoveJustDirectory(const WCHAR *nativeSrc, - int ignoreError, Tcl_DString *errorPtr); -static int DoRemoveDirectory(Tcl_DString *pathPtr, int recursive, - Tcl_DString *errorPtr); -static int DoRenameFile(const WCHAR *nativeSrc, - const WCHAR *dstPtr); -static int TraversalCopy(const WCHAR *srcPtr, const WCHAR *dstPtr, - int type, Tcl_DString *errorPtr); -static int TraversalDelete(const WCHAR *srcPtr, - const WCHAR *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 WCHAR *nativeSrc, /* Pathname of file or dir to be renamed - * (native). */ - const WCHAR *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 MoveFileW 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 MoveFileW 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 - * MoveFileW. - */ - - "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 MoveFileW(nativeSrc, nativeDst) - */ - - "pushl %%ebx" "\n\t" - "pushl %%ecx" "\n\t" - "movl %[moveFileW], %%eax" "\n\t" - "call *%%eax" "\n\t" - - /* - * Come here on normal exit. Recover the TCLEXCEPTION_REGISTRATION and - * put the status return from MoveFileW 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), - [moveFileW] "r" (MoveFileW) - : - "%eax", "%ebx", "%ecx", "%edx", "memory" - ); - if (registration.status != FALSE) { - retval = TCL_OK; - } -#else -#ifndef HAVE_NO_SEH - __try { -#endif - if ((*MoveFileW)(nativeSrc, nativeDst) != FALSE) { - retval = TCL_OK; - } -#ifndef HAVE_NO_SEH - } __except (EXCEPTION_EXECUTE_HANDLER) {} -#endif -#endif - - if (retval != -1) { - return retval; - } - - TclWinConvertError(GetLastError()); - - srcAttr = GetFileAttributesW(nativeSrc); - dstAttr = GetFileAttributesW(nativeDst); - if (srcAttr == 0xffffffff) { - if (GetFullPathNameW(nativeSrc, 0, NULL, - NULL) >= MAX_PATH) { - errno = ENAMETOOLONG; - return TCL_ERROR; - } - srcAttr = 0; - } - if (dstAttr == 0xffffffff) { - if (GetFullPathNameW(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) { - WCHAR *nativeSrcRest, *nativeDstRest; - const char **srcArgv, **dstArgv; - int size, srcArgc, dstArgc; - WCHAR nativeSrcPath[MAX_PATH]; - WCHAR nativeDstPath[MAX_PATH]; - Tcl_DString srcString, dstString; - const char *src, *dst; - - size = GetFullPathNameW(nativeSrc, MAX_PATH, - nativeSrcPath, &nativeSrcRest); - if ((size == 0) || (size > MAX_PATH)) { - return TCL_ERROR; - } - size = GetFullPathNameW(nativeDst, MAX_PATH, - nativeDstPath, &nativeDstRest); - if ((size == 0) || (size > MAX_PATH)) { - return TCL_ERROR; - } - CharLowerW(nativeSrcPath); - CharLowerW(nativeDstPath); - - src = Tcl_WinTCharToUtf((TCHAR *)nativeSrcPath, -1, &srcString); - dst = Tcl_WinTCharToUtf((TCHAR *)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 MoveFileW 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 (MoveFileW(nativeSrc, - nativeDst) != FALSE) { - return TCL_OK; - } - - /* - * Some new error has occurred. Don't know what it could - * be, but report this one. - */ - - TclWinConvertError(GetLastError()); - CreateDirectoryW(nativeDst, NULL); - SetFileAttributesW(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. - */ - - WCHAR *nativeRest, *nativeTmp, *nativePrefix; - int result, size; - WCHAR tempBuf[MAX_PATH]; - - size = GetFullPathNameW(nativeDst, MAX_PATH, - tempBuf, &nativeRest); - if ((size == 0) || (size > MAX_PATH) || (nativeRest == NULL)) { - return TCL_ERROR; - } - nativeTmp = (WCHAR *) tempBuf; - nativeRest[0] = L'\0'; - - result = TCL_ERROR; - nativePrefix = (WCHAR *) L"tclr"; - if (GetTempFileNameW(nativeTmp, nativePrefix, - 0, tempBuf) != 0) { - /* - * Strictly speaking, need the following DeleteFile and - * MoveFileW to be joined as an atomic operation so no - * other app comes along in the meantime and creates the - * same temp file. - */ - - nativeTmp = tempBuf; - DeleteFileW(nativeTmp); - if (MoveFileW(nativeDst, nativeTmp) != FALSE) { - if (MoveFileW(nativeSrc, nativeDst) != FALSE) { - SetFileAttributesW(nativeTmp, FILE_ATTRIBUTE_NORMAL); - DeleteFileW(nativeTmp); - return TCL_OK; - } else { - DeleteFileW(nativeDst); - MoveFileW(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 WCHAR *nativeSrc, /* Pathname of file to be copied (native). */ - const WCHAR *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 CopyFileW(nativeSrc, nativeDst, 0) - */ - - "movl %[copyFileW], %%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), - [copyFileW] "r" (CopyFileW) - : - "%eax", "%ebx", "%ecx", "%edx", "memory" - ); - if (registration.status != FALSE) { - retval = TCL_OK; - } -#else -#ifndef HAVE_NO_SEH - __try { -#endif - if (CopyFileW(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 = GetFileAttributesW(nativeSrc); - dstAttr = GetFileAttributesW(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) { - SetFileAttributesW(nativeDst, - dstAttr & ~((DWORD)FILE_ATTRIBUTE_READONLY)); - if (CopyFileW(nativeSrc, nativeDst, - 0) != FALSE) { - return TCL_OK; - } - - /* - * Still can't copy onto dst. Return that error, and restore - * attributes of dst. - */ - - TclWinConvertError(GetLastError()); - SetFileAttributesW(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 WCHAR *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 (DeleteFileW(path) != FALSE) { - return TCL_OK; - } - TclWinConvertError(GetLastError()); - - if (Tcl_GetErrno() == EACCES) { - attr = GetFileAttributesW(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 = SetFileAttributesW(path, - attr & ~((DWORD) FILE_ATTRIBUTE_READONLY)); - - if ((res != 0) && - (DeleteFileW(path) != FALSE)) { - return TCL_OK; - } - TclWinConvertError(GetLastError()); - if (res != 0) { - SetFileAttributesW(path, attr); - } - } - } - } else if (Tcl_GetErrno() == ENOENT) { - attr = GetFileAttributesW(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 WCHAR *nativePath) /* Pathname of directory to create (native). */ -{ - if (CreateDirectoryW(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 WCHAR *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 = GetFileAttributesW(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 (RemoveDirectoryW(nativePath) != FALSE) { - return TCL_OK; - } - } - - TclWinConvertError(GetLastError()); - - if (Tcl_GetErrno() == EACCES) { - attr = GetFileAttributesW(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 (SetFileAttributesW(nativePath, - attr) == FALSE) { - goto end; - } - if (RemoveDirectoryW(nativePath) != FALSE) { - return TCL_OK; - } - TclWinConvertError(GetLastError()); - SetFileAttributesW(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((TCHAR *)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 WCHAR *)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; - WCHAR *nativeSource, *nativeTarget, *nativeErrfile; - int result, found, sourceLen, targetLen = 0, oldSourceLen, oldTargetLen; - HANDLE handle; - WIN32_FIND_DATAW data; - - nativeErrfile = NULL; - result = TCL_OK; - oldTargetLen = 0; /* lint. */ - - nativeSource = (WCHAR *) Tcl_DStringValue(sourcePtr); - nativeTarget = (WCHAR *) - (targetPtr == NULL ? NULL : Tcl_DStringValue(targetPtr)); - - oldSourceLen = Tcl_DStringLength(sourcePtr); - sourceAttr = GetFileAttributesW(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 *) L"\\*.*", 4 * sizeof(WCHAR) + 1); - Tcl_DStringSetLength(sourcePtr, Tcl_DStringLength(sourcePtr) - 1); - - nativeSource = (WCHAR *) Tcl_DStringValue(sourcePtr); - handle = FindFirstFileW(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(WCHAR); - Tcl_DStringAppend(sourcePtr, (char *) L"\\", sizeof(WCHAR) + 1); - Tcl_DStringSetLength(sourcePtr, sourceLen); - if (targetPtr != NULL) { - oldTargetLen = Tcl_DStringLength(targetPtr); - - targetLen = oldTargetLen; - targetLen += sizeof(WCHAR); - Tcl_DStringAppend(targetPtr, (char *) L"\\", sizeof(WCHAR) + 1); - Tcl_DStringSetLength(targetPtr, targetLen); - } - - found = 1; - for (; found; found = FindNextFileW(handle, &data)) { - WCHAR *nativeName; - size_t len; - - WCHAR *wp = data.cFileName; - if (*wp == '.') { - wp++; - if (*wp == '.') { - wp++; - } - if (*wp == '\0') { - continue; - } - } - nativeName = (WCHAR *) data.cFileName; - len = wcslen(data.cFileName) * sizeof(WCHAR); - - /* - * 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 WCHAR *)Tcl_DStringValue(sourcePtr), - (const WCHAR *)(targetPtr == NULL ? NULL : Tcl_DStringValue(targetPtr)), - DOTREE_POSTD, errorPtr); - } - - end: - if (nativeErrfile != NULL) { - TclWinConvertError(GetLastError()); - if (errorPtr != NULL) { - Tcl_WinTCharToUtf((TCHAR *)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 WCHAR *nativeSrc, /* Source pathname to copy. */ - const WCHAR *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 = GetFileAttributesW(nativeSrc); - - if (SetFileAttributesW(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((TCHAR *)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 WCHAR *nativeSrc, /* Source pathname to delete. */ - const WCHAR *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((TCHAR *)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 WCHAR *nativeName; - int attr; - - nativeName = Tcl_FSGetNativePath(fileName); - result = GetFileAttributesW(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 WCHAR *nativeName; - const char *tempString; - int tempLen; - WIN32_FIND_DATAW 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 = (WCHAR *)Tcl_WinUtfToTChar(tempString, tempLen, &ds); - Tcl_DecrRefCount(tempPath); - handle = FindFirstFileW(nativeName, &data); - if (handle == INVALID_HANDLE_VALUE) { - /* - * FindFirstFileW() 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 = GetFileAttributesW(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 = (WCHAR *) 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((TCHAR *)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 WCHAR *nativeName; - - nativeName = Tcl_FSGetNativePath(fileName); - fileAttributes = old = GetFileAttributesW(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) - && !SetFileAttributesW(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) { - /* - * GetVolumeInformationW() will detect 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 GetVolumeInformationW() 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 100644 index 20cd6d4..0000000 --- a/tcl8.6/win/tclWinFile.c +++ /dev/null @@ -1,3347 +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 WCHAR *path, int mode); -static int NativeDev(const WCHAR *path); -static int NativeStat(const WCHAR *path, Tcl_StatBuf *statPtr, - int checkLinks); -static unsigned short NativeStatMode(DWORD attr, int checkLinks, - int isExec); -static int NativeIsExec(const WCHAR *path); -static int NativeReadReparse(const WCHAR *LinkDirectory, - REPARSE_DATA_BUFFER *buffer, DWORD desiredAccess); -static int NativeWriteReparse(const WCHAR *LinkDirectory, - REPARSE_DATA_BUFFER *buffer); -static int NativeMatchType(int isDrive, DWORD attr, - const WCHAR *nativeName, Tcl_GlobTypeData *types); -static int WinIsDrive(const char *name, int nameLen); -static int WinIsReserved(const char *path); -static Tcl_Obj * WinReadLink(const WCHAR *LinkSource); -static Tcl_Obj * WinReadLinkDirectory(const WCHAR *LinkDirectory); -static int WinLink(const WCHAR *LinkSource, - const WCHAR *LinkTarget, int linkAction); -static int WinSymLinkDirectory(const WCHAR *LinkDirectory, - const WCHAR *LinkTarget); -MODULE_SCOPE TCL_NORETURN void tclWinDebugPanic(const char *format, ...); - -/* - *-------------------------------------------------------------------- - * - * WinLink -- - * - * Make a link from source to target. - * - *-------------------------------------------------------------------- - */ - -static int -WinLink( - const WCHAR *linkSourcePath, - const WCHAR *linkTargetPath, - int linkAction) -{ - WCHAR tempFileName[MAX_PATH]; - WCHAR *tempFilePart; - DWORD attr; - - /* - * Get the full path referenced by the target. - */ - - if (!GetFullPathNameW(linkTargetPath, MAX_PATH, tempFileName, - &tempFilePart)) { - /* - * Invalid file. - */ - - TclWinConvertError(GetLastError()); - return -1; - } - - /* - * Make sure source file doesn't exist. - */ - - attr = GetFileAttributesW(linkSourcePath); - if (attr != INVALID_FILE_ATTRIBUTES) { - Tcl_SetErrno(EEXIST); - return -1; - } - - /* - * Get the full path referenced by the source file/directory. - */ - - if (!GetFullPathNameW(linkSourcePath, MAX_PATH, tempFileName, - &tempFilePart)) { - /* - * Invalid file. - */ - - TclWinConvertError(GetLastError()); - return -1; - } - - /* - * Check the target. - */ - - attr = GetFileAttributesW(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 (CreateHardLinkW(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 WCHAR *linkSourcePath) -{ - WCHAR tempFileName[MAX_PATH]; - WCHAR *tempFilePart; - DWORD attr; - - /* - * Get the full path referenced by the target. - */ - - if (!GetFullPathNameW(linkSourcePath, MAX_PATH, tempFileName, - &tempFilePart)) { - /* - * Invalid file. - */ - - TclWinConvertError(GetLastError()); - return NULL; - } - - /* - * Make sure source file does exist. - */ - - attr = GetFileAttributesW(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 WCHAR *linkDirPath, - const WCHAR *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 WCHAR *linkOrigPath, /* Existing junction - reparse point */ - const WCHAR *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 WCHAR *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 = CreateFileW(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) { - RemoveDirectoryW(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 WCHAR *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 = GetFileAttributesW(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; -#if 1 - 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((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 WCHAR *linkDirPath, /* The junction to read */ - REPARSE_DATA_BUFFER *buffer,/* Pointer to buffer. Cannot be NULL */ - DWORD desiredAccess) -{ - HANDLE hFile; - DWORD returnedLength; - - hFile = CreateFileW(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 WCHAR *linkDirPath, - REPARSE_DATA_BUFFER *buffer) -{ - HANDLE hFile; - DWORD returnedLength; - - /* - * Create the directory - it must not already exist. - */ - - if (CreateDirectoryW(linkDirPath, NULL) == 0) { - /* - * Error creating directory. - */ - - TclWinConvertError(GetLastError()); - return -1; - } - hFile = CreateFileW(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); - RemoveDirectoryW(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); - } - - GetModuleFileNameW(NULL, wName, MAX_PATH); - 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 WCHAR *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 (GetFileAttributesExW(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_DATAW 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 = GetFileAttributesW(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 = (WCHAR *)Tcl_WinUtfToTChar(dirName, -1, &ds); - if ((types == NULL) || (types->type != TCL_GLOB_TYPE_DIR)) { - handle = FindFirstFileW(native, &data); - } else { - /* - * We can be more efficient, for pure directory requests. - */ - - handle = FindFirstFileExW(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((TCHAR *)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 (FindNextFileW(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 WCHAR *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 - */ - - ptr = TclpGetUserName(&ds); - if (ptr != 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 exist; 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 WCHAR *nativePath, /* Path of file to access, native encoding. */ - int mode) /* Permission setting. */ -{ - DWORD attr; - - attr = GetFileAttributesW(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 = CreateFileW(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. - */ - -#if 1 - { - 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; - GetFileSecurityW(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 GetFileSecurityW() for real. - */ - - if (!GetFileSecurityW(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 WCHAR *path) -{ - size_t len = wcslen(path); - - if (len < 5) { - return 0; - } - - if (path[len-4] != '.') { - return 0; - } - - path += len-3; - if ((wcsicmp(path, L"exe") == 0) - || (wcsicmp(path, L"com") == 0) - || (wcsicmp(path, L"cmd") == 0) - || (wcsicmp(path, L"cmd") == 0) - || (wcsicmp(path, L"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 WCHAR *nativePath; - - nativePath = Tcl_FSGetNativePath(pathPtr); - - if (!nativePath) { - return -1; - } - result = SetCurrentDirectoryW(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. */ -{ - WCHAR buffer[MAX_PATH]; - char *p; - WCHAR *native; - - if (GetCurrentDirectoryW(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 WCHAR *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 = CreateFileW(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 (GetFileAttributesExW(nativePath, - GetFileExInfoStandard, &data) != TRUE) { - HANDLE hFind; - WIN32_FIND_DATAW ffd; - DWORD lasterror = GetLastError(); - - if (lasterror != ERROR_SHARING_VIOLATION) { - TclWinConvertError(lasterror); - return -1; - } - hFind = FindFirstFileW(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 WCHAR *nativePath) /* Full path of file to stat */ -{ - int dev; - Tcl_DString ds; - WCHAR nativeFullPath[MAX_PATH]; - WCHAR *nativePart; - const char *fullPath; - - GetFullPathNameW(nativePath, MAX_PATH, nativeFullPath, &nativePart); - fullPath = Tcl_WinTCharToUtf((TCHAR *)nativeFullPath, -1, &ds); - - if ((fullPath[0] == '\\') && (fullPath[1] == '\\')) { - const char *p; - DWORD dw; - const WCHAR *nativeVol; - Tcl_DString volString; - - p = strchr(fullPath + 2, '\\'); - p = strchr(p + 1, '\\'); - if (p == NULL) { - /* - * Add terminating backslash to fullpath or GetVolumeInformationW() - * won't work. - */ - - fullPath = TclDStringAppendLiteral(&ds, "\\"); - p = fullPath + Tcl_DStringLength(&ds); - } else { - p++; - } - nativeVol = (WCHAR *)Tcl_WinUtfToTChar(fullPath, p - fullPath, &volString); - dw = (DWORD) -1; - GetVolumeInformationW(nativeVol, NULL, 0, &dw, NULL, NULL, NULL, 0); - - /* - * GetFullPathNameW() turns special devices like "NUL" into "\\.\NUL", - * but GetVolumeInformationW() 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) -{ - WCHAR buffer[MAX_PATH]; - - if (GetCurrentDirectoryW(MAX_PATH, buffer) == 0) { - TclWinConvertError(GetLastError()); - return NULL; - } - - if (clientData != NULL) { - if (wcscmp((const WCHAR *) 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 WCHAR *LinkTarget; - const WCHAR *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 WCHAR *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; - WCHAR 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 = GetVolumeInformationW(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 = GetVolumeInformationW(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((TCHAR *)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 WCHAR *nativePath = (WCHAR *)Tcl_WinUtfToTChar(path, - currentPathEndPosition - path, &ds); - - if (GetFileAttributesExW(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(WCHAR)), - (int)(dotLen * sizeof(WCHAR))); - } 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 WCHAR *nativePath = - Tcl_WinUtfToTChar(path, lastValidPathEnd - path, &ds); - DWORD wpathlen = GetLongPathNameProc(nativePath, - (WCHAR *) 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((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((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(WCHAR) * (wcslen((const WCHAR *) 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 WCHAR *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 = GetFileAttributesW(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 = CreateFileW(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 WCHAR *native; - PSID ownerSid = NULL; - PSECURITY_DESCRIPTOR secd = NULL; - HANDLE token; - LPBYTE buf = NULL; - DWORD bufsz; - int owned = 0; - - native = Tcl_FSGetNativePath(pathPtr); - - if (GetNamedSecurityInfoW((LPWSTR) 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 cb13b20..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> - -/* - * GetUserNameW() 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-dependent 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 = GetModuleHandleW(L"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 lstrcmpiA() 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) { - WCHAR szUserName[UNLEN+1]; - DWORD cchUserNameLen = UNLEN; - - if (!GetUserNameW(szUserName, &cchUserNameLen)) { - return NULL; - } - cchUserNameLen--; - cchUserNameLen *= sizeof(WCHAR); - Tcl_WinTCharToUtf((TCHAR *)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 = GetModuleHandleW(L"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); - } - -#ifndef NDEBUG - /* - * The existence of the "debug" element of the tcl_platform array - * indicates that this particular Tcl shell has been compiled with debug - * information. Using "info exists tcl_platform(debug)" a Tcl script can - * direct the interpreter to load debug versions of DLLs with the load - * command. - */ - - 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 ed99ad0..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 WCHAR *mountPoint); -MODULE_SCOPE void TclWinEncodingsCleanup(); -MODULE_SCOPE void TclWinInit(HINSTANCE hInst); -MODULE_SCOPE TclFile TclWinMakeFile(HANDLE handle); -MODULE_SCOPE Tcl_Channel TclWinOpenConsoleChannel(HANDLE handle, - char *channelName, int permissions); -MODULE_SCOPE Tcl_Channel TclWinOpenFileChannel(HANDLE handle, char *channelName, - int permissions, int appendMode); -MODULE_SCOPE Tcl_Channel TclWinOpenSerialChannel(HANDLE handle, - char *channelName, int permissions); -MODULE_SCOPE HANDLE TclWinSerialOpen(HANDLE handle, const WCHAR *name, - DWORD access); -MODULE_SCOPE int TclWinSymLinkCopyDirectory(const WCHAR *LinkOriginal, - const WCHAR *LinkCopy); -MODULE_SCOPE int TclWinSymLinkDelete(const WCHAR *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 89adcc3..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 WCHAR *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 = LoadLibraryExW(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 = (WCHAR *)Tcl_WinUtfToTChar(Tcl_GetString(pathPtr), -1, &ds); - hInstance = LoadLibraryExW(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 2542476..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 WCHAR classname[] = L"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); - WNDCLASSW windowClass; - - /* - * Register Notifier window class if this is the first thread to use - * this module. - */ - - Tcl_MutexLock(¬ifierMutex); - if (notifierCount == 0) { - windowClass.style = 0; - windowClass.cbClsExtra = 0; - windowClass.cbWndExtra = 0; - windowClass.hInstance = TclWinGetTclInstance(); - windowClass.hbrBackground = NULL; - windowClass.lpszMenuName = NULL; - windowClass.lpszClassName = classname; - windowClass.lpfnWndProc = NotifierProc; - windowClass.hIcon = NULL; - windowClass.hCursor = NULL; - - if (!RegisterClassW(&windowClass)) { - Tcl_Panic("Unable to register TclNotifier window class"); - } - } - notifierCount++; - Tcl_MutexUnlock(¬ifierMutex); - - tsdPtr->pending = 0; - tsdPtr->timerActive = 0; - - InitializeCriticalSection(&tsdPtr->crit); - - tsdPtr->hwnd = NULL; - tsdPtr->thread = GetCurrentThreadId(); - tsdPtr->event = CreateEventW(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(¬ifierMutex); - notifierCount--; - if (notifierCount == 0) { - UnregisterClassW(classname, TclWinGetTclInstance()); - } - Tcl_MutexUnlock(¬ifierMutex); - } -} - -/* - *---------------------------------------------------------------------- - * - * 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) { - PostMessageW(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 = CreateWindowW(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 DefWindowProcW(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 (!PeekMessageW(&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 (PeekMessageW(&msg, NULL, 0, 0, PM_NOREMOVE)) { - /* - * Retrieve and dispatch the first message. - */ - - result = GetMessageW(&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); - DispatchMessageW(&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 6120358..0000000 --- a/tcl8.6/win/tclWinPipe.c +++ /dev/null @@ -1,3727 +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(WCHAR 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( - WCHAR name[MAX_PATH]) /* Buffer in which name for temporary file - * gets stored. */ -{ - const WCHAR *prefix = L"TCL"; - if (GetTempPathW(MAX_PATH, name) != 0) { - if (GetTempFileNameW(name, prefix, 0, name) != 0) { - return 1; - } - } - name[0] = '.'; - name[1] = '\0'; - return GetTempFileNameW(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 WCHAR *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 = (WCHAR *)Tcl_WinUtfToTChar(path, -1, &ds); - - /* - * If the file is not being created, use the existing file attributes. - */ - - flags = 0; - if (!(mode & O_CREAT)) { - flags = GetFileAttributesW(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 = CreateFileW(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. */ -{ - WCHAR name[MAX_PATH]; - const char *native; - Tcl_DString dstring; - HANDLE handle; - - if (TempFileName(name) == 0) { - return NULL; - } - - handle = CreateFileW(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); - DeleteFileW(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) -{ - WCHAR 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 (WCHAR). */ - STARTUPINFOW 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 = CreateFileW(L"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 = CreateFileW(L"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 (CreateProcessW(NULL, (WCHAR *) 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 = CreateFileW(L"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; - WCHAR *rest; - char *ext; - char buf[2]; - DWORD attr, read; - IMAGE_DOS_HEADER header; - Tcl_DString nameBuf, ds; - const WCHAR *nativeName; - WCHAR 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 SearchPathW() 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, SearchPathW 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 = (WCHAR *)Tcl_WinUtfToTChar(Tcl_DStringValue(&nameBuf), - Tcl_DStringLength(&nameBuf), &ds); - found = SearchPathW(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 = GetFileAttributesW(nativeFullPath); - if ((attr == 0xffffffff) || (attr & FILE_ATTRIBUTE_DIRECTORY)) { - continue; - } - strcpy(fullName, Tcl_WinTCharToUtf((TCHAR *)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 = CreateFileW(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. - */ - - GetShortPathNameW(nativeFullPath, nativeFullPath, MAX_PATH); - strcpy(fullName, Tcl_WinTCharToUtf((TCHAR *)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 position. - */ - - 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 position). - */ - - 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 (WCHAR). */ -{ - const char *arg, *start, *special, *bspos; - int quote = 0, i; - Tcl_DString ds; - static const char specMetaChars[] = "&|^<>!()%"; - /* Characters to enclose in quotes if unpaired - * quote flag set. */ - static const char specMetaChars2[] = "%"; - /* Character to enclose in quotes in any case - * (regardless of unpaired-flag). */ - /* - * 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 { - for (start = arg; - *start != '\0' && - (quote & (CL_ESCAPE|CL_QUOTE)) != (CL_ESCAPE|CL_QUOTE); - start++) { - if (*start & 0x80) { - continue; - } - if (TclIsSpaceProc(*start)) { - 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 position) - */ - - special = BuildCmdLineBypassBS(special, &bspos); - if (*special == '\0') { - break; - } - } - /* ["] */ - if (*special == '"') { - /* - * Invert the unpaired flag - observe unpaired quotes - */ - - quote ^= CL_UNPAIRED; - - /* - * 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 position (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 = CreateEventW(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 = CreateEventW(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) -{ - WCHAR 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 = GetTempPathW(MAX_PATH, name); - if (length == 0) { - goto gotError; - } - namePtr += length * sizeof(WCHAR); - 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 WCHAR *baseStr = L"TCL"; - int length = 3 * sizeof(WCHAR); - - 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 = CreateFileW(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 /* !_PTI_USE_CKALLOC */ - pipeTI->evControl = CreateEventW(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) - */ - - state = InterlockedCompareExchange(&pipeTI->state, PTI_STATE_IDLE, - PTI_STATE_WORK); - if (state & (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 - */ - - state = InterlockedCompareExchange(&pipeTI->state, PTI_STATE_WORK, - PTI_STATE_IDLE); - if (state & (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; - state = InterlockedCompareExchange(&pipeTI->state, PTI_STATE_STOP, - PTI_STATE_IDLE); - switch (state) { - case PTI_STATE_IDLE: - /* - * Thread was idle/waiting, notify it goes teardown - */ - - SetEvent(evControl); - *pipeTIPtr = NULL; - /* FALLTHRU */ - 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 - */ - - state = InterlockedCompareExchange(&pipeTI->state, PTI_STATE_STOP, - PTI_STATE_IDLE); - switch (state) { - 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) - */ - - state = InterlockedCompareExchange(&pipeTI->state, PTI_STATE_END, - PTI_STATE_WORK); - if (state == 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 /* !_PTI_USE_CKALLOC */ - } -} - -/* - *---------------------------------------------------------------------- - * - * 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; - state = InterlockedExchange(&pipeTI->state, PTI_STATE_DOWN); - if (state == 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 /* !_PTI_USE_CKALLOC */ - } -} - -/* - * 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 337d88d..0000000 --- a/tcl8.6/win/tclWinPort.h +++ /dev/null @@ -1,577 +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(__MINGW_USE_VC2005_COMPAT) -/* See [Bug 3354324]: file mtime sets wrong time */ -# define __MINGW_USE_VC2005_COMPAT -#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) -# pragma warning(disable:4244) -# if _MSC_VER >= 1400 -# pragma warning(disable:4267) -# pragma warning(disable:4996) -# endif -#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 068e5d7..0000000 --- a/tcl8.6/win/tclWinReg.c +++ /dev/null @@ -1,1577 +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(void *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 WCHAR * pKeyName, REGSAM mode); -static int RegistryObjCmd(void *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); - -#if (TCL_MAJOR_VERSION < 9) && (TCL_MINOR_VERSION < 7) -# if TCL_UTF_MAX > 3 -# define Tcl_WCharToUtfDString(a,b,c) Tcl_WinTCharToUtf(a,(b)*sizeof(WCHAR),c) -# define Tcl_UtfToWCharDString(a,b,c) Tcl_WinUtfToTChar(a,b,c) -# else -# define Tcl_WCharToUtfDString Tcl_UniCharToUtfDString -# define Tcl_UtfToWCharDString Tcl_UtfToUniCharDString -# endif -#endif - -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; -} - -#ifdef __cplusplus -extern "C" { -#endif -DLLEXPORT int Registry_Init(Tcl_Interp *interp); -DLLEXPORT int Registry_Unload(Tcl_Interp *interp, int flags); -#ifdef __cplusplus -} -#endif - -/* - *---------------------------------------------------------------------- - * - * 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_PkgProvideEx(interp, "registry", "1.3.3", NULL); -} - -/* - *---------------------------------------------------------------------- - * - * 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]; - (void)flags; - - /* - * Unregister the registry package. There is no Tcl_PkgForget() - */ - - objv[0] = Tcl_NewStringObj("package", -1); - objv[1] = Tcl_NewStringObj("forget", -1); - objv[2] = Tcl_NewStringObj("registry", -1); - Tcl_EvalObjv(interp, 3, objv, TCL_EVAL_GLOBAL); - - /* - * Delete the originally registered command. - */ - - cmd = (Tcl_Command)Tcl_GetAssocData(interp, REGISTRY_ASSOC_KEY, NULL); - if (cmd != NULL) { - Tcl_DeleteCommandFromToken(interp, cmd); - } - - return TCL_OK; -} - -/* - *---------------------------------------------------------------------- - * - * DeleteCmd -- - * - * Cleanup the interp command token so that unloading doesn't try to - * re-delete the command (which will crash). - * - * Results: - * None. - * - * Side effects: - * The unload command will not attempt to delete this command. - * - *---------------------------------------------------------------------- - */ - -static void -DeleteCmd( - void *clientData) -{ - Tcl_Interp *interp = (Tcl_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( - void *dummy, /* 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 - }; - (void)dummy; - - 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 WCHAR *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. - */ - - Tcl_DStringInit(&buf); - nativeTail = Tcl_UtfToWCharDString(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_DStringInit(&ds); - Tcl_UtfToWCharDString(valueName, valueNameObj->length, &ds); - result = RegDeleteValueW(key, (const WCHAR *)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 */ - WCHAR 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 = RegEnumKeyExW(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; - } - Tcl_DStringInit(&ds); - name = Tcl_WCharToUtfDString(buffer, bufSize, &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 WCHAR *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); - Tcl_DStringInit(&ds); - nativeValue = Tcl_UtfToWCharDString(valueName, valueNameObj->length, &ds); - result = RegQueryValueExW(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 WCHAR *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(WCHAR) - 1; - - valueName = Tcl_GetString(valueNameObj); - Tcl_DStringInit(&buf); - nativeValue = Tcl_UtfToWCharDString(valueName, valueNameObj->length, &buf); - - result = RegQueryValueExW(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(WCHAR)); - Tcl_DStringSetLength(&data, (int) length * sizeof(WCHAR)); - result = RegQueryValueExW(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 = (WCHAR *) p; - - Tcl_DStringInit(&buf); - Tcl_WCharToUtfDString(wp, wcslen(wp), &buf); - Tcl_ListObjAppendElement(interp, resultPtr, - Tcl_NewStringObj(Tcl_DStringValue(&buf), - Tcl_DStringLength(&buf))); - - while (*wp++ != 0) {/* empty body */} - p = (char *) wp; - Tcl_DStringFree(&buf); - } - Tcl_SetObjResult(interp, resultPtr); - } else if ((type == REG_SZ) || (type == REG_EXPAND_SZ)) { - WCHAR *wp = (WCHAR *) Tcl_DStringValue(&data); - Tcl_DStringInit(&buf); - Tcl_WCharToUtfDString((const WCHAR *)Tcl_DStringValue(&data), wcslen(wp), &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(WCHAR))); - 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 (RegEnumValueW(key,index, (WCHAR *)Tcl_DStringValue(&buffer), - &size, NULL, NULL, NULL, NULL) == ERROR_SUCCESS) { - - Tcl_DStringInit(&ds); - Tcl_WCharToUtfDString((const WCHAR *)Tcl_DStringValue(&buffer), 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) { - Tcl_DStringInit(&buf); - hostName = (char *) Tcl_UtfToWCharDString(hostName, -1, &buf); - result = RegConnectRegistryW((WCHAR *)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) { - Tcl_DStringInit(&buf); - keyName = (char *) Tcl_UtfToWCharDString(keyName, -1, &buf); - } - if (flags & REG_CREATE) { - DWORD create; - - result = RegCreateKeyExW(rootKey, (WCHAR *)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 = RegOpenKeyExW(rootKey, (WCHAR *)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 WCHAR *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 LSTATUS (* regDeleteKeyExProc) (HKEY, LPCWSTR, REGSAM, DWORD) = (LSTATUS (*) (HKEY, LPCWSTR, REGSAM, DWORD)) 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 = RegOpenKeyExW(startKey, keyName, 0, mode, &hKey); - if (result != ERROR_SUCCESS) { - return result; - } - - Tcl_DStringInit(&subkey); - Tcl_DStringSetLength(&subkey, (int) (MAX_KEY_LENGTH * sizeof(WCHAR))); - - mode = saveMode; - while (result == ERROR_SUCCESS) { - /* - * Always get index 0 because key deletion changes ordering. - */ - - size = MAX_KEY_LENGTH; - result = RegEnumKeyExW(hKey, 0, (WCHAR *)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 = GetModuleHandleW(L"ADVAPI32"); - regDeleteKeyExProc = (LSTATUS (*) (HKEY, LPCWSTR, REGSAM, DWORD)) - GetProcAddress(handle, "RegDeleteKeyExW"); - } - if (mode && regDeleteKeyExProc) { - result = regDeleteKeyExProc(startKey, keyName, mode, 0); - } else { - result = RegDeleteKeyW(startKey, keyName); - } - break; - } else if (result == ERROR_SUCCESS) { - result = RecursiveDeleteKey(hKey, - (const WCHAR *) 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); - Tcl_DStringInit(&nameBuf); - valueName = (char *) Tcl_UtfToWCharDString(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 = RegSetValueExW(key, (WCHAR *) 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_DStringInit(&buf); - Tcl_UtfToWCharDString(Tcl_DStringValue(&data), Tcl_DStringLength(&data)+1, - &buf); - result = RegSetValueExW(key, (WCHAR *) 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); - - Tcl_DStringInit(&buf); - data = (char *) Tcl_UtfToWCharDString(data, dataObj->length, &buf); - - /* - * Include the null in the length, padding if needed for WCHAR. - */ - - Tcl_DStringSetLength(&buf, Tcl_DStringLength(&buf)+1); - - result = RegSetValueExW(key, (WCHAR *) 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 = RegSetValueExW(key, (WCHAR *) 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]); - Tcl_DStringInit(&ds); - wstr = Tcl_UtfToWCharDString(str, objv[0]->length, &ds); - if (Tcl_DStringLength(&ds) == 0) { - wstr = NULL; - } - - /* - * Use the ignore the result. - */ - - result = SendMessageTimeoutW(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; - WCHAR *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 = FormatMessageW(FORMAT_MESSAGE_FROM_SYSTEM - | FORMAT_MESSAGE_ALLOCATE_BUFFER, NULL, error, - MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (WCHAR *) tMsgPtrPtr, - 0, NULL); - if (length == 0) { - sprintf(msgBuf, "unknown error: %ld", error); - msg = msgBuf; - } else { - char *msgPtr; - - Tcl_DStringInit(&ds); - Tcl_WCharToUtfDString(tMsgPtr, wcslen(tMsgPtr), &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 4f7c0be..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 = CreateEventW(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 WCHAR *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 = CreateFileW(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 = CreateEventW(NULL, TRUE, FALSE, NULL); - } - if (permissions & TCL_WRITABLE) { - /* - * Initially the channel is writable and the writeThread is idle. - */ - - infoPtr->osWrite.hEvent = CreateEventW(NULL, TRUE, FALSE, NULL); - infoPtr->evWritable = CreateEventW(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 WCHAR *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 = (const WCHAR *)Tcl_WinUtfToTChar(value, -1, &ds); - result = BuildCommDCBW(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 a397a30..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 WCHAR classname[] = L"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 WNDCLASSW 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) -{ - WCHAR wbuf[MAX_COMPUTERNAME_LENGTH + 1]; - DWORD length = MAX_COMPUTERNAME_LENGTH + 1; - Tcl_DString ds; - - if (GetComputerNameW(wbuf, &length) != 0) { - /* - * Convert string from native to UTF then change to lowercase. - */ - - Tcl_UtfToLower(Tcl_WinTCharToUtf((TCHAR *)wbuf, -1, &ds)); - - } else { - Tcl_DStringInit(&ds); - if (TclpHasSockets(NULL) == TCL_OK) { - /* - * The buffer size of 256 is recommended by the MSDN page that - * documents gethostname() as being always adequate. - */ - - Tcl_DString inDs; - - Tcl_DStringInit(&inDs); - Tcl_DStringSetLength(&inDs, 256); - if (gethostname(Tcl_DStringValue(&inDs), - Tcl_DStringLength(&inDs)) == 0) { - Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(&inDs), -1, - &ds); - } - Tcl_DStringFree(&inDs); - } - } - - *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) { - PostMessageW(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) { - SendMessageW(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; - } - } - - SendMessageW(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) { - SendMessageW(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; - } - } - - SendMessageW(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 */ - SendMessageW(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. - */ - - SendMessageW(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; - SendMessageW(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); - SendMessageW(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); - SendMessageW(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 (!RegisterClassW(&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 = CreateEventW(NULL, FALSE, FALSE, NULL); - if (tsdPtr->readyEvent == NULL) { - goto initFailure; - } - tsdPtr->socketListLock = CreateEventW(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(); - UnregisterClassW(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. - */ - - SendMessageW(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); - SendMessageW(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. - */ - - SendMessageW(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) UNSELECT, - (LPARAM) statePtr); - SendMessageW(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 = CreateWindowW(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 - * PostMessageW(SOCKET_TERMINATE) in TclpFinalizeSockets(). - */ - - while (GetMessageW(&msg, NULL, 0, 0) > 0) { - DispatchMessageW(&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 - GetWindowLongPtrW(hwnd, GWLP_USERDATA); -#else - GetWindowLongW(hwnd, GWL_USERDATA); -#endif - - switch (message) { - default: - return DefWindowProcW(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 - SetWindowLongPtrW(hwnd, GWLP_USERDATA, - (LONG_PTR) ((LPCREATESTRUCT)lParam)->lpCreateParams); -#else - SetWindowLongW(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. - */ - - SendMessageW(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 dd4d5ec..0000000 --- a/tcl8.6/win/tclWinTest.c +++ /dev/null @@ -1,695 +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 int TestSizeCmd(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); - Tcl_CreateObjCommand(interp, "testsize", TestSizeCmd, 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 (!GetMessageW(&msg, NULL, 0, 0)) { - /* - * The application is exiting, so repost the quit message and - * start unwinding. - */ - - PostQuitMessage((int) msg.wParam); - break; - } - TranslateMessage(&msg); - DispatchMessageW(&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; -} - -static int -TestSizeCmd( - ClientData clientData, /* Unused */ - Tcl_Interp* interp, /* Tcl interpreter */ - int objc, /* Parameter count */ - Tcl_Obj *const * objv) /* Parameter vector */ -{ - if (objc != 2) { - goto syntax; - } - if (strcmp(Tcl_GetString(objv[1]), "time_t") == 0) { - Tcl_SetObjResult(interp, Tcl_NewWideIntObj(sizeof(time_t))); - return TCL_OK; - } - if (strcmp(Tcl_GetString(objv[1]), "st_mtime") == 0) { - Tcl_StatBuf *statPtr; - Tcl_SetObjResult(interp, Tcl_NewWideIntObj(sizeof(statPtr->st_mtime))); - return TCL_OK; - } - -syntax: - Tcl_WrongNumArgs(interp, 1, objv, "time_t|st_mtime"); - return TCL_ERROR; -} - -/* - *---------------------------------------------------------------------- - * - * 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; - /* don't reset change permissions mask (WRITE_DAC, allow test-cases restore it to cleanup) */ - 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. Note PROTECTED_DACL_SECURITY_INFORMATION can be used - * to remove inherited ACL (we need to overwrite the default ACL's in this case) - */ - - if (set_readOnly == acl_readOnly_found || SetNamedSecurityInfoA( - (LPSTR) nativePath, SE_FILE_OBJECT, - DACL_SECURITY_INFORMATION /*| PROTECTED_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 5316075..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 = CreateEventW(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 33d87a7..0000000 --- a/tcl8.6/win/tclWinTime.c +++ /dev/null @@ -1,1467 +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. */ - DWORD calibrationInterv; /* Calibration interval in seconds (start 1 sec) */ - 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; - LARGE_INTEGER posixEpoch; /* Posix epoch expressed as 100-ns ticks since - * the windows epoch. */ - - /* - * 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, - 1, - (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, - (LARGE_INTEGER) (Tcl_WideInt) 0, -#else - {0, 0}, - {0, 0}, - {0, 0}, - {0, 0}, - {0, 0}, -#endif - { 0 }, - { 0 }, - 0 -}; - -/* - * Scale to convert wide click values from the TclpGetWideClicks native - * resolution to microsecond resolution and back. - */ -static struct { - int initialized; /* 1 if initialized, 0 otherwise */ - int perfCounter; /* 1 if performance counter usable for wide clicks */ - double microsecsScale; /* Denominator scale between clock / microsecs */ -} wideClick = {0, 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 Tcl_WideInt NativeGetMicroseconds(void); -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_WideInt usecSincePosixEpoch; - - /* Try to use high resolution timer */ - if ( tclGetTimeProcPtr == NativeGetTime - && (usecSincePosixEpoch = NativeGetMicroseconds()) - ) { - return usecSincePosixEpoch / 1000000; - } else { - 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 dependent. - * - * Results: - * Number of clicks from some start time. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -unsigned long -TclpGetClicks(void) -{ - Tcl_WideInt usecSincePosixEpoch; - - /* Try to use high resolution timer */ - if ( tclGetTimeProcPtr == NativeGetTime - && (usecSincePosixEpoch = NativeGetMicroseconds()) - ) { - return (unsigned long)usecSincePosixEpoch; - } else { - /* - * 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 */ - - tclGetTimeProcPtr(&now, tclTimeClientData); /* Tcl_GetTime inlined */ - return (unsigned long)(now.sec * 1000000) + now.usec; - } -} - -/* - *---------------------------------------------------------------------- - * - * TclpGetWideClicks -- - * - * This procedure returns a WideInt value that represents the highest - * resolution clock in microseconds available on the system. - * - * Results: - * Number of microseconds (from some start time). - * - * Side effects: - * This should be used for time-delta resp. for measurement purposes - * only, because on some platforms can return microseconds from some - * start time (not from the epoch). - * - *---------------------------------------------------------------------- - */ - -Tcl_WideInt -TclpGetWideClicks(void) -{ - LARGE_INTEGER curCounter; - - if (!wideClick.initialized) { - LARGE_INTEGER perfCounterFreq; - - /* - * The frequency of the performance counter is fixed at system boot and - * is consistent across all processors. Therefore, the frequency need - * only be queried upon application initialization. - */ - if (QueryPerformanceFrequency(&perfCounterFreq)) { - wideClick.perfCounter = 1; - wideClick.microsecsScale = 1000000.0 / perfCounterFreq.QuadPart; - } else { - /* fallback using microseconds */ - wideClick.perfCounter = 0; - wideClick.microsecsScale = 1; - } - - wideClick.initialized = 1; - } - if (wideClick.perfCounter) { - if (QueryPerformanceCounter(&curCounter)) { - return (Tcl_WideInt)curCounter.QuadPart; - } - /* fallback using microseconds */ - wideClick.perfCounter = 0; - wideClick.microsecsScale = 1; - return TclpGetMicroseconds(); - } else { - return TclpGetMicroseconds(); - } -} - -/* - *---------------------------------------------------------------------- - * - * TclpWideClickInMicrosec -- - * - * This procedure return scale to convert wide click values from the - * TclpGetWideClicks native resolution to microsecond resolution - * and back. - * - * Results: - * 1 click in microseconds as double. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -double -TclpWideClickInMicrosec(void) -{ - if (!wideClick.initialized) { - (void)TclpGetWideClicks(); /* initialize */ - } - return wideClick.microsecsScale; -} - -/* - *---------------------------------------------------------------------- - * - * TclpGetMicroseconds -- - * - * This procedure returns a WideInt value that represents the highest - * resolution clock in microseconds available on the system. - * - * Results: - * Number of microseconds (from the epoch). - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -Tcl_WideInt -TclpGetMicroseconds(void) -{ - Tcl_WideInt usecSincePosixEpoch; - - /* Try to use high resolution timer */ - if ( tclGetTimeProcPtr == NativeGetTime - && (usecSincePosixEpoch = NativeGetMicroseconds()) - ) { - return usecSincePosixEpoch; - } else { - /* - * Use the Tcl_GetTime abstraction to get the time in microseconds, as - * nearly as we can, and return it. - */ - - Tcl_Time now; - - tclGetTimeProcPtr(&now, tclTimeClientData); /* Tcl_GetTime inlined */ - return (((Tcl_WideInt)now.sec) * 1000000) + now.usec; - } -} - -/* - *---------------------------------------------------------------------- - * - * 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. */ -{ - Tcl_WideInt usecSincePosixEpoch; - - /* Try to use high resolution timer */ - if ( tclGetTimeProcPtr == NativeGetTime - && (usecSincePosixEpoch = NativeGetMicroseconds()) - ) { - timePtr->sec = (long) (usecSincePosixEpoch / 1000000); - timePtr->usec = (unsigned long) (usecSincePosixEpoch % 1000000); - } else { - 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. - */ -} - -/* - *---------------------------------------------------------------------- - * - * NativeGetMicroseconds -- - * - * Gets the current system time in microseconds since the beginning - * of the epoch: 00:00 UCT, January 1, 1970. - * - * Results: - * Returns the wide integer with number of microseconds from the epoch, or - * 0 if high resolution timer is not available. - * - * 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 inline Tcl_WideInt -NativeCalc100NsTicks( - ULONGLONG fileTimeLastCall, - LONGLONG perfCounterLastCall, - LONGLONG curCounterFreq, - LONGLONG curCounter -) { - return fileTimeLastCall + - ((curCounter - perfCounterLastCall) * 10000000 / curCounterFreq); -} - -static Tcl_WideInt -NativeGetMicroseconds(void) -{ - /* - * 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.posixEpoch.LowPart = 0xD53E8000; - timeInfo.posixEpoch.HighPart = 0x019DB1DE; - - 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 = CreateEventW(NULL, FALSE, FALSE, NULL); - timeInfo.exitEvent = CreateEventW(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. - */ - - ULONGLONG fileTimeLastCall; - LONGLONG perfCounterLastCall, curCounterFreq; - /* Copy with current data of calibration cycle */ - - LARGE_INTEGER curCounter; - /* Current performance counter. */ - - QueryPerformanceCounter(&curCounter); - - /* - * Hold time section locked as short as possible - */ - EnterCriticalSection(&timeInfo.cs); - - fileTimeLastCall = timeInfo.fileTimeLastCall.QuadPart; - perfCounterLastCall = timeInfo.perfCounterLastCall.QuadPart; - curCounterFreq = timeInfo.curCounterFreq.QuadPart; - - LeaveCriticalSection(&timeInfo.cs); - - /* - * If calibration cycle occurred after we get curCounter - */ - if (curCounter.QuadPart <= perfCounterLastCall) { - /* Calibrated file-time is saved from posix in 100-ns ticks */ - return fileTimeLastCall / 10; - } - - /* - * 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 < - 11 * curCounterFreq * timeInfo.calibrationInterv / 10 - ) { - /* Calibrated file-time is saved from posix in 100-ns ticks */ - return NativeCalc100NsTicks(fileTimeLastCall, - perfCounterLastCall, curCounterFreq, curCounter.QuadPart) / 10; - } - } - - /* - * High resolution timer is not available. - */ - return 0; -} - -/* - *---------------------------------------------------------------------- - * - * 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: - * See NativeGetMicroseconds for more information. - * - *---------------------------------------------------------------------- - */ - -static void -NativeGetTime( - Tcl_Time *timePtr, - ClientData clientData) -{ - Tcl_WideInt usecSincePosixEpoch; - - /* - * Try to use high resolution timer. - */ - if ( (usecSincePosixEpoch = NativeGetMicroseconds()) ) { - timePtr->sec = (long) (usecSincePosixEpoch / 1000000); - timePtr->usec = (unsigned long) (usecSincePosixEpoch % 1000000); - } else { - /* - * High resolution timer is not available. Just use ftime. - */ - - struct _timeb t; - - _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. - * - *---------------------------------------------------------------------- - */ - -void TclWinResetTimerResolution(void); - -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 defined(_WIN64) || (defined(_USE_64BIT_TIME_T) || (defined(_MSC_VER) && _MSC_VER < 1400)) -# define t2 *t /* no need to cripple time to 32-bit */ -#else - time_t t2 = *(__time32_t *)t; -#endif - - if (!useGMT) { -#if defined(_MSC_VER) && (_MSC_VER >= 1900) -# undef timezone /* prevent conflict with timezone() function */ - long timezone = 0; -#endif - - 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 (t2 >= LOCALTIME_VALIDITY_BOUNDARY) { - return TclpLocaltime(&t2); - } - -#if defined(_MSC_VER) && (_MSC_VER >= 1900) - _get_timezone(&timezone); -#endif - - time = t2 - 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 (t2 < (LONG_MAX - 2*SECSPERDAY) && t2 > (LONG_MIN + 2*SECSPERDAY)) { - tmPtr = ComputeGMT(&time); - } else { - tmPtr = ComputeGMT(&t2); - - 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(&t2); - } - 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; - /* Calibrated file-time will be saved from posix in 100-ns ticks */ - timeInfo.fileTimeLastCall.QuadPart -= timeInfo.posixEpoch.QuadPart; - - 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. */ - static LARGE_INTEGER lastFileTime; /* File time of the previous calibration */ - 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 (from posix epoch). - */ - - GetSystemTimeAsFileTime(&curSysTime); - curFileTime.LowPart = curSysTime.dwLowDateTime; - curFileTime.HighPart = curSysTime.dwHighDateTime; - curFileTime.QuadPart -= timeInfo.posixEpoch.QuadPart; - /* If calibration still not needed (check for possible time switch) */ - if ( curFileTime.QuadPart > lastFileTime.QuadPart - && curFileTime.QuadPart < lastFileTime.QuadPart + - (timeInfo.calibrationInterv * 10000000) - ) { - /* again in next one second */ - return; - } - QueryPerformanceCounter(&curPerfCounter); - - lastFileTime.QuadPart = curFileTime.QuadPart; - - /* - * 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){ - 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 = NativeCalc100NsTicks(timeInfo.fileTimeLastCall.QuadPart, - timeInfo.perfCounterLastCall.QuadPart, timeInfo.curCounterFreq.QuadPart, - curPerfCounter.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) { - /* jump to current system time, use curent estimated frequency */ - vt0 = curFileTime.QuadPart; - } else { - /* calculate new frequency and estimate drift to the next second */ - vt1 = 20000000 + curFileTime.QuadPart; - driftFreq = (estFreq * 20000000 / (vt1 - vt0)); - /* - * Avoid too large drifts (only half of the current difference), - * that allows also be more accurate (aspire to the smallest tdiff), - * so then we can prolong calibration interval by tdiff < 100000 - */ - driftFreq = timeInfo.curCounterFreq.QuadPart + - (driftFreq - timeInfo.curCounterFreq.QuadPart) / 2; - - /* - * Average between estimated, 2 current and 5 drifted frequencies, - * (do the soft drifting as possible) - */ - estFreq = (estFreq + 2 * timeInfo.curCounterFreq.QuadPart + 5 * driftFreq) / 8; - } - - /* Avoid too large discrepancy from nominal frequency */ - if (estFreq > 1003*timeInfo.nominalFreq.QuadPart/1000) { - estFreq = 1003*timeInfo.nominalFreq.QuadPart/1000; - vt0 = curFileTime.QuadPart; - } else if (estFreq < 997*timeInfo.nominalFreq.QuadPart/1000) { - estFreq = 997*timeInfo.nominalFreq.QuadPart/1000; - vt0 = curFileTime.QuadPart; - } else if (vt0 != curFileTime.QuadPart) { - /* - * Be sure the clock ticks never backwards (avoid it by negative drifting) - * just compare native time (in 100-ns) before and hereafter using - * new calibrated values) and do a small adjustment (short time freeze) - */ - LARGE_INTEGER newPerfCounter; - Tcl_WideInt nt0, nt1; - - QueryPerformanceCounter(&newPerfCounter); - nt0 = NativeCalc100NsTicks(timeInfo.fileTimeLastCall.QuadPart, - timeInfo.perfCounterLastCall.QuadPart, timeInfo.curCounterFreq.QuadPart, - newPerfCounter.QuadPart); - nt1 = NativeCalc100NsTicks(vt0, - curPerfCounter.QuadPart, estFreq, - newPerfCounter.QuadPart); - if (nt0 > nt1) { /* drifted backwards, try to compensate with new base */ - /* first adjust with a micro jump (short frozen time is acceptable) */ - vt0 += nt0 - nt1; - /* if drift unavoidable (e. g. we had a time switch), then reset it */ - vt1 = vt0 - curFileTime.QuadPart; - if (vt1 > 10000000 || vt1 < -10000000) { - /* larger jump resp. shift relative new file-time */ - vt0 = curFileTime.QuadPart; - } - } - } - - /* In lock commit new values to timeInfo (hold lock as short as possible) */ - EnterCriticalSection(&timeInfo.cs); - - /* grow calibration interval up to 10 seconds (if still precise enough) */ - if (tdiff < -100000 || tdiff > 100000) { - /* too long drift - reset calibration interval to 1000 second */ - timeInfo.calibrationInterv = 1; - } else if (timeInfo.calibrationInterv < 10) { - timeInfo.calibrationInterv++; - } - - timeInfo.fileTimeLastCall.QuadPart = vt0; - timeInfo.curCounterFreq.QuadPart = estFreq; - 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. - */ - -#if defined(_WIN64) || defined(_USE_64BIT_TIME_T) || (defined(_MSC_VER) && _MSC_VER < 1400) - return gmtime(timePtr); -#else - return _gmtime32((CONST __time32_t *)timePtr); -#endif -} - -/* - *---------------------------------------------------------------------- - * - * 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. - */ - -#if defined(_WIN64) || defined(_USE_64BIT_TIME_T) || (defined(_MSC_VER) && _MSC_VER < 1400) - return localtime(timePtr); -#else - return _localtime32((CONST __time32_t *)timePtr); -#endif -} - -/* - *---------------------------------------------------------------------- - * - * 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 Binary files differdeleted file mode 100644 index e254318..0000000 --- a/tcl8.6/win/tclsh.ico +++ /dev/null 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" |