diff options
Diffstat (limited to 'win')
50 files changed, 13617 insertions, 18960 deletions
diff --git a/win/Makefile.in b/win/Makefile.in index e103ef2..ada9448 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -23,7 +23,6 @@ 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 @@ -49,9 +48,6 @@ LIB_INSTALL_DIR = $(INSTALL_ROOT)$(libdir) # Path name to use when installing library scripts. SCRIPT_INSTALL_DIR = $(INSTALL_ROOT)$(TCL_LIBRARY) -# Path name to use when installing Tcl modules. -MODULE_INSTALL_DIR = $(SCRIPT_INSTALL_DIR)/../tcl8 - # Directory in which to install the include file tcl.h: INCLUDE_INSTALL_DIR = $(INSTALL_ROOT)$(includedir) @@ -70,6 +66,9 @@ 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@ @@ -82,12 +81,7 @@ CFLAGS_OPTIMIZE = @CFLAGS_OPTIMIZE@ #CFLAGS = $(CFLAGS_DEBUG) #CFLAGS = $(CFLAGS_OPTIMIZE) #CFLAGS = $(CFLAGS_DEBUG) $(CFLAGS_OPTIMIZE) -CFLAGS = @CFLAGS@ @CFLAGS_DEFAULT@ -DMP_FIXED_CUTOFFS -D__USE_MINGW_ANSI_STDIO=0 - -# To compile without backward compatibility and deprecated code uncomment the -# following -NO_DEPRECATED_FLAGS = -#NO_DEPRECATED_FLAGS = -DTCL_NO_DEPRECATED +CFLAGS = @CFLAGS@ @CFLAGS_DEFAULT@ # To enable compilation debugging reverse the comment characters on one of the # following lines. @@ -95,17 +89,15 @@ COMPILE_DEBUG_FLAGS = #COMPILE_DEBUG_FLAGS = -DTCL_COMPILE_DEBUG #COMPILE_DEBUG_FLAGS = -DTCL_COMPILE_DEBUG -DTCL_COMPILE_STATS +# Special compiler flags to use when building man2tcl on Windows. +MAN2TCLFLAGS = @MAN2TCLFLAGS@ + SRC_DIR = @srcdir@ ROOT_DIR = @srcdir@/.. -TOP_DIR = $(shell cd @srcdir@/..; pwd -W 2>/dev/null || pwd -P) -BUILD_DIR = @builddir@ -GENERIC_DIR = $(TOP_DIR)/generic -WIN_DIR = $(TOP_DIR)/win -COMPAT_DIR = $(TOP_DIR)/compat -PKGS_DIR = $(TOP_DIR)/pkgs -ZLIB_DIR = $(COMPAT_DIR)/zlib -MINIZIP_DIR = $(ZLIB_DIR)/contrib/minizip -TOMMATH_DIR = $(TOP_DIR)/libtommath +GENERIC_DIR = @srcdir@/../generic +TOMMATH_DIR = @srcdir@/../libtommath +WIN_DIR = @srcdir@ +COMPAT_DIR = @srcdir@/../compat # Converts a POSIX path to a Windows native path. CYGPATH = @CYGPATH@ @@ -116,16 +108,18 @@ 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)') -SCRIPT_INSTALL_DIR_NATIVE = $(shell $(CYGPATH) '$(SCRIPT_INSTALL_DIR)') -INCLUDE_INSTALL_DIR_NATIVE = $(shell $(CYGPATH) '$(INCLUDE_INSTALL_DIR)') -MAN_INSTALL_DIR_NATIVE = $(shell $(CYGPATH) '$(MAN_INSTALL_DIR)') -ROOT_DIR_WIN_NATIVE = $(shell cd '$(ROOT_DIR)' ; pwd -W 2>/dev/null || pwd -P) -ZLIB_DIR_NATIVE = $(shell $(CYGPATH) '$(ZLIB_DIR)') -MINIZIP_DIR_NATIVE = $(shell $(CYGPATH) '$(MINIZIP_DIR)') -TOMMATH_DIR_NATIVE = $(shell $(CYGPATH) '$(TOMMATH_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) +LIBRARY_DIR = $(shell $(CYGPATH) '$(LIBRARY_DIR1)') DLLSUFFIX = @DLLSUFFIX@ LIBSUFFIX = @LIBSUFFIX@ EXESUFFIX = @EXESUFFIX@ @@ -137,49 +131,41 @@ 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_ZIP_FILE = @TCL_ZIP_FILE@ -TCL_VFS_PATH = libtcl.vfs/tcl_library -TCL_VFS_ROOT = libtcl.vfs - - 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)${DLLSUFFIX}${LIBSUFFIX} -REG_DLL_FILE = tclregistry$(REGVER)${DLLSUFFIX} -REG_LIB_FILE = @LIBPREFIX@tclregistry$(REGVER)${DLLSUFFIX}${LIBSUFFIX} -TEST_DLL_FILE = tcltest$(VER)${DLLSUFFIX} -TEST_EXE_FILE = tcltest${EXESUFFIX} -TEST_LIB_FILE = @LIBPREFIX@tcltest$(VER)${DLLSUFFIX}${LIBSUFFIX} -TEST_LOAD_PRMS = lappend ::auto_path {$(ROOT_DIR_WIN_NATIVE)/tests};\ - package ifneeded dde 1.4.5 [list load ${DDE_DLL_FILE}];\ - package ifneeded registry 1.3.7 [list load ${REG_DLL_FILE}] -TEST_LOAD_FACILITIES = package ifneeded tcl::test ${VERSION}@TCL_PATCH_LEVEL@ [list load ${TEST_DLL_FILE} Tcltest];\ - $(TEST_LOAD_PRMS) -ZLIB_DLL_FILE = zlib1.dll -TOMMATH_DLL_FILE = libtommath.dll - -SHARED_LIBRARIES = $(TCL_DLL_FILE) @ZLIB_DLL_FILE@ @TOMMATH_DLL_FILE@ -STATIC_LIBRARIES = $(TCL_LIB_FILE) +DDE_LIB_FILE = tcldde$(DDEVER)${LIBSUFFIX} +REG_DLL_FILE = tclreg$(REGVER)${DLLSUFFIX} +REG_LIB_FILE = tclreg$(REGVER)${LIBSUFFIX} +PIPE_DLL_FILE = tclpip$(VER)${DLLSUFFIX} + +SHARED_LIBRARIES = $(TCL_DLL_FILE) $(TCL_STUB_LIB_FILE) \ + $(DDE_DLL_FILE) $(REG_DLL_FILE) $(PIPE_DLL_FILE) +STATIC_LIBRARIES = $(TCL_LIB_FILE) $(REG_LIB_FILE) $(DDE_LIB_FILE) + +# To compile without backward compatibility and deprecated code +# uncomment the following +NO_DEPRECATED_FLAGS = +#NO_DEPRECATED_FLAGS = -DTCL_NO_DEPRECATED + +# TCL_EXE is the name of a tclsh executable that is available *BEFORE* running +# make for the first time. Certain build targets (make genstubs) need it to be +# available on the PATH. This executable should *NOT* be required just to do a +# normal build although it can be required to run make dist. +TCL_EXE = tclsh TCLSH = tclsh$(VER)${EXESUFFIX} -WINE = @WINE@ +TCLTEST = tcltest${EXEEXT} CAT32 = cat32$(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@ +MAN2TCL = man2tcl$(EXEEXT) @SET_MAKE@ # Setting the VPATH variable to a list of paths will cause the Makefile to # look into these paths when resolving .c to .obj dependencies. -VPATH = $(GENERIC_DIR):$(WIN_DIR):$(COMPAT_DIR):$(ZLIB_DIR):$(TOMMATH_DIR) +VPATH = $(GENERIC_DIR):$(TOMMATH_DIR):$(WIN_DIR):$(COMPAT_DIR) AR = @AR@ RANLIB = @RANLIB@ @@ -197,84 +183,37 @@ EXEEXT = @EXEEXT@ OBJEXT = @OBJEXT@ STLIB_LD = @STLIB_LD@ SHLIB_LD = @SHLIB_LD@ -SHLIB_LD_LIBS = @SHLIB_LD_LIBS@ +SHLIB_LD_LIBS = @SHLIB_LD_LIBS@ $(LIBS) SHLIB_CFLAGS = @SHLIB_CFLAGS@ SHLIB_SUFFIX = @SHLIB_SUFFIX@ -LIBS = @LIBS@ $(shell $(CYGPATH) '@ZLIB_LIBS@') $(shell $(CYGPATH) '@TOMMATH_LIBS@') +LIBS = @LIBS@ RMDIR = rm -rf MKDIR = mkdir -p SHELL = @SHELL@ RM = rm -f COPY = cp -LN = ln - -### -# Tip 430 - ZipFS Modifications -### - -TCL_ZIP_FILE = @TCL_ZIP_FILE@ -TCL_VFS_PATH = libtcl.vfs/tcl_library -TCL_VFS_ROOT = libtcl.vfs - -HOST_CC = @CC_FOR_BUILD@ -HOST_EXEEXT = @EXEEXT_FOR_BUILD@ -HOST_OBJEXT = @OBJEXT_FOR_BUILD@ -ZIPFS_BUILD = @ZIPFS_BUILD@ -NATIVE_ZIP = @ZIP_PROG@ -ZIP_PROG_OPTIONS = @ZIP_PROG_OPTIONS@ -ZIP_PROG_VFSSEARCH = @ZIP_PROG_VFSSEARCH@ -SHARED_BUILD = @SHARED_BUILD@ -INSTALL_MSGS = @INSTALL_MSGS@ -INSTALL_LIBRARIES = @INSTALL_LIBRARIES@ -# Fully qualify library path so that `make test` -# does not depend on the current directory. -# Only define these if not embedding the library -ifeq ($(ZIPFS_BUILD), 0) -LIBRARY_DIR1 = $(shell cd '$(ROOT_DIR_NATIVE)/library' ; pwd -P) -LIBRARY_DIR = $(shell $(CYGPATH) '$(LIBRARY_DIR1)') -endif - -# Minizip -MINIZIP_OBJS = \ - adler32.$(HOST_OBJEXT) \ - compress.$(HOST_OBJEXT) \ - crc32.$(HOST_OBJEXT) \ - deflate.$(HOST_OBJEXT) \ - infback.$(HOST_OBJEXT) \ - inffast.$(HOST_OBJEXT) \ - inflate.$(HOST_OBJEXT) \ - inftrees.$(HOST_OBJEXT) \ - ioapi.$(HOST_OBJEXT) \ - iowin32.$(HOST_OBJEXT) \ - trees.$(HOST_OBJEXT) \ - uncompr.$(HOST_OBJEXT) \ - zip.$(HOST_OBJEXT) \ - zutil.$(HOST_OBJEXT) \ - minizip.$(HOST_OBJEXT) - -ZIP_INSTALL_OBJS = @ZIP_INSTALL_OBJS@ - -CC_SWITCHES = -I"${BUILD_DIR}" -I"${GENERIC_DIR_NATIVE}" -I"${TOMMATH_DIR_NATIVE}" \ --I"${ZLIB_DIR_NATIVE}" -I"${WIN_DIR_NATIVE}" \ -${CFLAGS} ${CFLAGS_WARNING} ${SHLIB_CFLAGS} -DMP_PREC=4 \ -${AC_FLAGS} ${COMPILE_DEBUG_FLAGS} ${NO_DEPRECATED_FLAGS} +CC_SWITCHES = ${CFLAGS} ${CFLAGS_WARNING} ${TCL_SHLIB_CFLAGS} \ +-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 = -I"${GENERIC_DIR_NATIVE}" -I"${TOMMATH_DIR_NATIVE}" \ --I"${ZLIB_DIR_NATIVE}" -I"${WIN_DIR_NATIVE}" \ -${CFLAGS} ${CFLAGS_WARNING} ${SHLIB_CFLAGS} -DMP_PREC=4 \ -${AC_FLAGS} ${COMPILE_DEBUG_FLAGS} +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) + tclWinTest.$(OBJEXT) \ + testMain.$(OBJEXT) GENERIC_OBJS = \ regcomp.$(OBJEXT) \ @@ -282,8 +221,6 @@ GENERIC_OBJS = \ regfree.$(OBJEXT) \ regerror.$(OBJEXT) \ tclAlloc.$(OBJEXT) \ - tclArithSeries.$(OBJEXT) \ - tclAssembly.$(OBJEXT) \ tclAsync.$(OBJEXT) \ tclBasic.$(OBJEXT) \ tclBinary.$(OBJEXT) \ @@ -293,16 +230,12 @@ GENERIC_OBJS = \ tclCmdIL.$(OBJEXT) \ tclCmdMZ.$(OBJEXT) \ tclCompCmds.$(OBJEXT) \ - tclCompCmdsGR.$(OBJEXT) \ - tclCompCmdsSZ.$(OBJEXT) \ tclCompExpr.$(OBJEXT) \ tclCompile.$(OBJEXT) \ tclConfig.$(OBJEXT) \ tclDate.$(OBJEXT) \ tclDictObj.$(OBJEXT) \ - tclDisassemble.$(OBJEXT) \ tclEncoding.$(OBJEXT) \ - tclEnsemble.$(OBJEXT) \ tclEnv.$(OBJEXT) \ tclEvent.$(OBJEXT) \ tclExecute.$(OBJEXT) \ @@ -317,26 +250,16 @@ GENERIC_OBJS = \ tclIOCmd.$(OBJEXT) \ tclIOGT.$(OBJEXT) \ tclIORChan.$(OBJEXT) \ - tclIORTrans.$(OBJEXT) \ tclIOSock.$(OBJEXT) \ tclIOUtil.$(OBJEXT) \ tclLink.$(OBJEXT) \ tclLiteral.$(OBJEXT) \ tclListObj.$(OBJEXT) \ tclLoad.$(OBJEXT) \ - tclMainW.$(OBJEXT) \ tclMain.$(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) \ @@ -346,7 +269,6 @@ GENERIC_OBJS = \ tclPosixStr.$(OBJEXT) \ tclPreserve.$(OBJEXT) \ tclProc.$(OBJEXT) \ - tclProcess.$(OBJEXT) \ tclRegexp.$(OBJEXT) \ tclResolve.$(OBJEXT) \ tclResult.$(OBJEXT) \ @@ -354,6 +276,7 @@ GENERIC_OBJS = \ tclStringObj.$(OBJEXT) \ tclStrToD.$(OBJEXT) \ tclStubInit.$(OBJEXT) \ + tclStubLib.$(OBJEXT) \ tclThread.$(OBJEXT) \ tclThreadAlloc.$(OBJEXT) \ tclThreadJoin.$(OBJEXT) \ @@ -363,11 +286,13 @@ GENERIC_OBJS = \ tclTrace.$(OBJEXT) \ tclUtf.$(OBJEXT) \ tclUtil.$(OBJEXT) \ - tclVar.$(OBJEXT) \ - tclZipfs.$(OBJEXT) \ - tclZlib.$(OBJEXT) + tclVar.$(OBJEXT) TOMMATH_OBJS = \ + bncore.${OBJEXT} \ + bn_reverse.${OBJEXT} \ + bn_fast_s_mp_mul_digs.${OBJEXT} \ + bn_fast_s_mp_sqr.${OBJEXT} \ bn_mp_add.${OBJEXT} \ bn_mp_add_d.${OBJEXT} \ bn_mp_and.${OBJEXT} \ @@ -386,16 +311,16 @@ TOMMATH_OBJS = \ bn_mp_div_2d.${OBJEXT} \ bn_mp_div_3.${OBJEXT} \ bn_mp_exch.${OBJEXT} \ - bn_mp_expt_u32.${OBJEXT} \ - bn_mp_get_mag_u64.${OBJEXT} \ + bn_mp_expt_d.${OBJEXT} \ bn_mp_grow.${OBJEXT} \ bn_mp_init.${OBJEXT} \ bn_mp_init_copy.${OBJEXT} \ - bn_mp_init_i64.${OBJEXT} \ bn_mp_init_multi.${OBJEXT} \ bn_mp_init_set.${OBJEXT} \ + bn_mp_init_set_int.${OBJEXT} \ bn_mp_init_size.${OBJEXT} \ - bn_mp_init_u64.${OBJEXT} \ + bn_mp_karatsuba_mul.${OBJEXT} \ + bn_mp_karatsuba_sqr.$(OBJEXT) \ bn_mp_lshd.${OBJEXT} \ bn_mp_mod.${OBJEXT} \ bn_mp_mod_2d.${OBJEXT} \ @@ -405,38 +330,29 @@ TOMMATH_OBJS = \ bn_mp_mul_d.${OBJEXT} \ bn_mp_neg.${OBJEXT} \ bn_mp_or.${OBJEXT} \ - bn_mp_pack.${OBJEXT} \ - bn_mp_pack_count.${OBJEXT} \ bn_mp_radix_size.${OBJEXT} \ bn_mp_radix_smap.${OBJEXT} \ bn_mp_read_radix.${OBJEXT} \ bn_mp_rshd.${OBJEXT} \ - bn_mp_set_i64.${OBJEXT} \ - bn_mp_set_u64.${OBJEXT} \ + bn_mp_set.${OBJEXT} \ + bn_mp_set_int.${OBJEXT} \ bn_mp_shrink.${OBJEXT} \ bn_mp_sqr.${OBJEXT} \ bn_mp_sqrt.${OBJEXT} \ bn_mp_sub.${OBJEXT} \ bn_mp_sub_d.${OBJEXT} \ - bn_mp_signed_rsh.${OBJEXT} \ - bn_mp_to_ubin.${OBJEXT} \ - bn_mp_to_radix.${OBJEXT} \ - bn_mp_ubin_size.${OBJEXT} \ - bn_mp_unpack.${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_balance_mul.$(OBJEXT) \ - bn_s_mp_karatsuba_mul.${OBJEXT} \ - bn_s_mp_karatsuba_sqr.$(OBJEXT) \ bn_s_mp_mul_digs.${OBJEXT} \ - bn_s_mp_mul_digs_fast.${OBJEXT} \ - bn_s_mp_reverse.${OBJEXT} \ - bn_s_mp_sqr_fast.${OBJEXT} \ bn_s_mp_sqr.${OBJEXT} \ - bn_s_mp_sub.${OBJEXT} \ - bn_s_mp_toom_mul.${OBJEXT} \ - bn_s_mp_toom_sqr.${OBJEXT} + bn_s_mp_sub.${OBJEXT} WIN_OBJS = \ @@ -455,108 +371,52 @@ WIN_OBJS = \ tclWinThrd.$(OBJEXT) \ tclWinTime.$(OBJEXT) +PIPE_OBJS = stub16.$(OBJEXT) + DDE_OBJS = tclWinDde.$(OBJEXT) REG_OBJS = tclWinReg.$(OBJEXT) -STUB_OBJS = \ - tclStubLib.$(OBJEXT) \ - tclTomMathStubLib.$(OBJEXT) \ - tclOOStubLib.$(OBJEXT) \ - tclWinPanic.$(OBJEXT) +STUB_OBJS = tclStubLib.$(OBJEXT) TCLSH_OBJS = tclAppInit.$(OBJEXT) -ZLIB_OBJS = \ - adler32.$(OBJEXT) \ - compress.$(OBJEXT) \ - crc32.$(OBJEXT) \ - deflate.$(OBJEXT) \ - infback.$(OBJEXT) \ - inffast.$(OBJEXT) \ - inflate.$(OBJEXT) \ - inftrees.$(OBJEXT) \ - trees.$(OBJEXT) \ - uncompr.$(OBJEXT) \ - zutil.$(OBJEXT) - -TCL_OBJS = ${GENERIC_OBJS} ${WIN_OBJS} @ZLIB_OBJS@ @TOMMATH_OBJS@ +TCL_OBJS = ${GENERIC_OBJS} $(TOMMATH_OBJS) ${WIN_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 ${TCL_ZIP_FILE} $(TCLSH) +all: binaries libraries doc -winextensions: ${DDE_DLL_FILE} ${REG_DLL_FILE} +tcltest: $(TCLTEST) + +binaries: @LIBRARIES@ $(TCLSH) libraries: doc: -tclzipfile: ${TCL_ZIP_FILE} - -${TCL_ZIP_FILE}: ${ZIP_INSTALL_OBJS} ${DDE_DLL_FILE} ${REG_DLL_FILE} - @rm -rf ${TCL_VFS_ROOT} - @mkdir -p ${TCL_VFS_PATH} - @echo "creating ${TCL_VFS_PATH} (prepare compression)" - @( \ - $(COPY) -a $(TOP_DIR)/library/* ${TCL_VFS_PATH}; \ - $(COPY) -a ${TCL_VFS_PATH}/manifest.txt ${TCL_VFS_PATH}/pkgIndex.tcl; \ - $(COPY) ${DDE_DLL_FILE} ${TCL_VFS_PATH}/dde; \ - $(COPY) ${REG_DLL_FILE} ${TCL_VFS_PATH}/registry; \ - ) - (zip=`(realpath '${NATIVE_ZIP}' || readlink -m '${NATIVE_ZIP}') 2>/dev/null || \ - (echo '${NATIVE_ZIP}' | sed "s?^\./?$$(pwd)/?")`; \ - cd ${TCL_VFS_ROOT} && \ - $$zip ${ZIP_PROG_OPTIONS} ../${TCL_ZIP_FILE} ${ZIP_PROG_VFSSEARCH} >/dev/null && \ - echo "${TCL_ZIP_FILE} successful created with $$zip" && \ - cd ..) - -$(TCLSH): $(TCLSH_OBJS) @LIBRARIES@ $(TCL_STUB_LIB_FILE) tclsh.$(RES) ${TCL_ZIP_FILE} - $(CC) $(CFLAGS) $(TCLSH_OBJS) $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE) $(LIBS) \ - tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE) - $(COPY) tclsh.exe.manifest $(TCLSH).manifest +winhelp: $(ROOT_DIR)/tools/man2help.tcl $(MAN2TCL) + TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \ + ./$(TCLSH) "$(ROOT_DIR_NATIVE)"/tools/man2help.tcl tcl "$(VER)" $(TCL_DOCS) + hcw /c /e tcl.hpj + +winextensions: ${DDE_DLL_FILE} ${REG_DLL_FILE} + +$(MAN2TCL): $(ROOT_DIR)/tools/man2tcl.c + $(CC) $(CFLAGS_OPTIMIZE) $(MAN2TCLFLAGS) -o $(MAN2TCL) "$(ROOT_DIR_NATIVE)"/tools/man2tcl.c + +$(TCLSH): $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE) $(TCLSH_OBJS) tclsh.$(RES) + $(CC) $(CFLAGS) $(TCLSH_OBJS) $(TCL_LIB_FILE) $(LIBS) \ + tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE) + @VC_MANIFEST_EMBED_EXE@ + +$(TCLTEST): $(TCL_LIB_FILE) $(TCLTEST_OBJS) $(CAT32) tclsh.$(RES) + $(CC) $(CFLAGS) $(TCLTEST_OBJS) $(TCL_LIB_FILE) $(LIBS) \ + tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE) @VC_MANIFEST_EMBED_EXE@ - @if test "${ZIPFS_BUILD}" = "2" ; then \ - cat ${TCL_ZIP_FILE} >> ${TCLSH}; \ - ${NATIVE_ZIP} -A ${TCLSH} \ - || echo 'ignore zip-error by adjust sfx process (not executable?)'; \ - fi cat32.$(OBJEXT): cat.c - $(CC) -c $(CC_SWITCHES) -DUNICODE -D_UNICODE @DEPARG@ $(CC_OBJNAME) + $(CC) -c $(CC_SWITCHES) @DEPARG@ $(CC_OBJNAME) $(CAT32): cat32.$(OBJEXT) $(CC) $(CFLAGS) cat32.$(OBJEXT) $(CC_EXENAME) $(LIBS) $(LDFLAGS_CONSOLE) @@ -564,69 +424,42 @@ $(CAT32): cat32.$(OBJEXT) # The following targets are configured by autoconf to generate either a shared # library or static library -${TCL_STUB_LIB_FILE}: ${STUB_OBJS} ${DDE_OBJS} ${REG_OBJS} +${TCL_STUB_LIB_FILE}: ${STUB_OBJS} @$(RM) ${TCL_STUB_LIB_FILE} - @MAKE_STUB_LIB@ ${STUB_OBJS} ${DDE_OBJS} ${REG_OBJS} + @MAKE_STUB_LIB@ ${STUB_OBJS} @POST_MAKE_LIB@ -${TCL_DLL_FILE}: ${TCL_OBJS} tcl.$(RES) @ZLIB_DLL_FILE@ @TOMMATH_DLL_FILE@ ${TCL_ZIP_FILE} - @$(RM) ${TCL_DLL_FILE} $(TCL_LIB_FILE) +${TCL_DLL_FILE}: ${TCL_OBJS} tcl.$(RES) + @$(RM) ${TCL_DLL_FILE} @MAKE_DLL@ ${TCL_OBJS} tcl.$(RES) $(SHLIB_LD_LIBS) - $(COPY) tclsh.exe.manifest ${TCL_DLL_FILE}.manifest @VC_MANIFEST_EMBED_DLL@ - @if test "${ZIPFS_BUILD}" = "1" ; then \ - cat ${TCL_ZIP_FILE} >> ${TCL_DLL_FILE}; \ - ${NATIVE_ZIP} -A ${TCL_DLL_FILE} \ - || echo 'ignore zip-error by adjust sfx process (not executable?)'; \ - fi -${TCL_LIB_FILE}: ${TCL_OBJS} tclWinPanic.$(OBJEXT) ${DDE_OBJS} ${REG_OBJS} +${TCL_LIB_FILE}: ${TCL_OBJS} @$(RM) ${TCL_LIB_FILE} - @MAKE_LIB@ ${TCL_OBJS} tclWinPanic.$(OBJEXT) ${DDE_OBJS} ${REG_OBJS} + @MAKE_LIB@ ${TCL_OBJS} @POST_MAKE_LIB@ -${DDE_DLL_FILE}: ${TCL_STUB_LIB_FILE} ${DDE_OBJS} +${DDE_DLL_FILE}: ${DDE_OBJS} ${TCL_STUB_LIB_FILE} + @$(RM) ${DDE_DLL_FILE} @MAKE_DLL@ ${DDE_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS) - $(COPY) tclsh.exe.manifest ${DDE_DLL_FILE}.manifest -${REG_DLL_FILE}: ${TCL_STUB_LIB_FILE} ${REG_OBJS} +${DDE_LIB_FILE}: ${DDE_OBJS} ${TCL_LIB_FILE} + @$(RM) ${DDE_LIB_FILE} + @MAKE_LIB@ ${DDE_OBJS} ${TCL_LIB_FILE} + +${REG_DLL_FILE}: ${REG_OBJS} ${TCL_STUB_LIB_FILE} + @$(RM) ${REG_DLL_FILE} @MAKE_DLL@ ${REG_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS) - $(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 +${REG_LIB_FILE}: ${REG_OBJS} ${TCL_LIB_FILE} + @$(RM) ${REG_LIB_FILE} + @MAKE_LIB@ ${REG_OBJS} ${TCL_LIB_FILE} -${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 prebuilt zlib1.dll -${ZLIB_DLL_FILE}: ${TCL_STUB_LIB_FILE} - @if test "@ZLIB_LIBS@set" = "${ZLIB_DIR_NATIVE}/win64-arm/zdll.libset" ; then \ - $(COPY) $(ZLIB_DIR)/win64-arm/${ZLIB_DLL_FILE} ${ZLIB_DLL_FILE}; \ - elif test "@ZLIB_LIBS@set" = "${ZLIB_DIR_NATIVE}/win64-arm/libz.dll.aset" ; then \ - $(COPY) $(ZLIB_DIR)/win64-arm/${ZLIB_DLL_FILE} ${ZLIB_DLL_FILE}; \ - elif test "@ZLIB_LIBS@set" = "${ZLIB_DIR_NATIVE}/win32/zdll.libset" ; then \ - $(COPY) $(ZLIB_DIR)/win32/${ZLIB_DLL_FILE} ${ZLIB_DLL_FILE}; \ - else \ - $(COPY) $(ZLIB_DIR)/win64/${ZLIB_DLL_FILE} ${ZLIB_DLL_FILE}; \ - fi; - -# use pre-built libtommath.dll -${TOMMATH_DLL_FILE}: ${TCL_STUB_LIB_FILE} - @if test "@TOMMATH_LIBS@set" = "${TOMMATH_DIR_NATIVE}/win64-arm/tommath.libset" ; then \ - $(COPY) $(TOMMATH_DIR)/win64-arm/${TOMMATH_DLL_FILE} ${TOMMATH_DLL_FILE}; \ - elif test "@TOMMATH_LIBS@set" = "${TOMMATH_DIR_NATIVE}/win64-arm/libtommath.dll.aset" ; then \ - $(COPY) $(TOMMATH_DIR)/win64-arm/${TOMMATH_DLL_FILE} ${TOMMATH_DLL_FILE}; \ - elif test "@TOMMATH_LIBS@set" = "${TOMMATH_DIR_NATIVE}/win32/tommath.libset" ; then \ - $(COPY) $(TOMMATH_DIR)/win32/${TOMMATH_DLL_FILE} ${TOMMATH_DLL_FILE}; \ - else \ - $(COPY) $(TOMMATH_DIR)/win64/${TOMMATH_DLL_FILE} ${TOMMATH_DLL_FILE}; \ - fi; +# PIPE_DLL_FILE is actually an executable, don't build it like a DLL. + +${PIPE_DLL_FILE}: ${PIPE_OBJS} + @$(RM) ${PIPE_DLL_FILE} + @MAKE_EXE@ $(CFLAGS) ${PIPE_OBJS} $(LIBS) $(LDFLAGS_CONSOLE) # Add the object extension to the implicit rules. By default .obj is not # automatically added. @@ -637,32 +470,35 @@ ${TOMMATH_DLL_FILE}: ${TCL_STUB_LIB_FILE} # Special case object targets -tclTestMain.${OBJEXT}: tclAppInit.c - $(CC) -c $(CC_SWITCHES) -DTCL_TEST -DUNICODE -D_UNICODE $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME) - tclWinInit.${OBJEXT}: tclWinInit.c $(CC) -c $(CC_SWITCHES) -DBUILD_tcl $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME) tclWinPipe.${OBJEXT}: tclWinPipe.c - $(CC) -c $(CC_SWITCHES) -DBUILD_tcl $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME) + $(CC) -c $(CC_SWITCHES) -DBUILD_tcl -DTCL_PIPE_DLL=\"$(PIPE_DLL_FILE)\" \ + $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME) -tclWinReg.${OBJEXT}: tclWinReg.c - $(CC) -c $(CC_SWITCHES) $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME) +testMain.${OBJEXT}: tclAppInit.c + $(CC) -c $(CC_SWITCHES) -DTCL_TEST @DEPARG@ $(CC_OBJNAME) -tclWinDde.${OBJEXT}: tclWinDde.c - $(CC) -c $(CC_SWITCHES) $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME) +tclTest.${OBJEXT}: tclTest.c + $(CC) -c $(CC_SWITCHES) @DEPARG@ $(CC_OBJNAME) -tclAppInit.${OBJEXT}: tclAppInit.c - $(CC) -c $(CC_SWITCHES) $(EXTFLAGS) -DUNICODE -D_UNICODE @DEPARG@ $(CC_OBJNAME) +tclTestObj.${OBJEXT}: tclTestObj.c + $(CC) -c $(CC_SWITCHES) @DEPARG@ $(CC_OBJNAME) -tclMainW.${OBJEXT}: tclMain.c - $(CC) -c $(CC_SWITCHES) -DBUILD_tcl -DUNICODE -D_UNICODE @DEPARG@ $(CC_OBJNAME) +tclWinTest.${OBJEXT}: tclWinTest.c + $(CC) -c $(CC_SWITCHES) @DEPARG@ $(CC_OBJNAME) -# TIP #430, ZipFS Support -tclZipfs.${OBJEXT}: $(GENERIC_DIR)/tclZipfs.c - $(CC) -c $(CC_SWITCHES) -DBUILD_tcl \ - $(ZLIB_INCLUDE) -I$(MINIZIP_DIR_NATIVE) @DEPARG@ $(CC_OBJNAME) +tclAppInit.${OBJEXT} : tclAppInit.c + $(CC) -c $(CC_SWITCHES) @DEPARG@ $(CC_OBJNAME) +# The following objects should be built using the stub interfaces + +tclWinReg.${OBJEXT} : tclWinReg.c + $(CC) -c $(CC_SWITCHES) -DUSE_TCL_STUBS @DEPARG@ $(CC_OBJNAME) + +tclWinDde.${OBJEXT} : tclWinDde.c + $(CC) -c $(CC_SWITCHES) -DUSE_TCL_STUBS @DEPARG@ $(CC_OBJNAME) # TIP #59, embedding of configuration information into the binary library. # @@ -674,52 +510,27 @@ tclZipfs.${OBJEXT}: $(GENERIC_DIR)/tclZipfs.c 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_NATIVE)\"" \ + -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)\"" \ - -DCFG_RUNTIME_DLLFILE="\"$(TCL_DLL_FILE)\"" \ + -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) -tclEvent.${OBJEXT}: tclEvent.c tclUuid.h - -tclTest.${OBJEXT}: tclTest.c tclUuid.h - -$(TOP_DIR)/manifest.uuid: - printf "git-" >$(TOP_DIR)/manifest.uuid - (cd $(TOP_DIR); git rev-parse HEAD >>$(TOP_DIR)/manifest.uuid || \ - (printf "svn-r" >$(TOP_DIR)/manifest.uuid ; \ - svn info --show-item last-changed-revision >>$(TOP_DIR)/manifest.uuid) || \ - printf "unknown" >$(TOP_DIR)/manifest.uuid) - -tclUuid.h: $(TOP_DIR)/manifest.uuid - echo "#define TCL_VERSION_UUID \\" >$@ - cat $(TOP_DIR)/manifest.uuid >>$@ - echo "" >>$@ - # 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 @CFLAGS_NOLTO@ @DEPARG@ $(CC_OBJNAME) - -tclTomMathStubLib.${OBJEXT}: tclTomMathStubLib.c - $(CC) -c $(CC_SWITCHES) @CFLAGS_NOLTO@ @DEPARG@ $(CC_OBJNAME) - -tclOOStubLib.${OBJEXT}: tclOOStubLib.c - $(CC) -c $(CC_SWITCHES) @CFLAGS_NOLTO@ @DEPARG@ $(CC_OBJNAME) - -tclWinPanic.${OBJEXT}: tclWinPanic.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 @@ -728,59 +539,6 @@ tclWinPanic.${OBJEXT}: tclWinPanic.c .rc.$(RES): $(RC) @RC_OUT@ $@ @RC_TYPE@ @RC_DEFINES@ @RC_INCLUDE@ "$(GENERIC_DIR_NATIVE)" @RC_INCLUDE@ "$(WIN_DIR_NATIVE)" @DEPARG@ - - -#-------------------------------------------------------------------------- -# Minizip implementation -#-------------------------------------------------------------------------- -adler32.$(HOST_OBJEXT): - $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/adler32.c - -compress.$(HOST_OBJEXT): - $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/compress.c - -crc32.$(HOST_OBJEXT): - $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/crc32.c - -deflate.$(HOST_OBJEXT): - $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/deflate.c - -ioapi.$(HOST_OBJEXT): - $(HOST_CC) -o $@ -I$(ZLIB_DIR) -I$(ZLIB_DIR)/contrib/minizip -c $(ZLIB_DIR)/contrib/minizip/ioapi.c - -iowin32.$(HOST_OBJEXT): - $(HOST_CC) -o $@ -I$(ZLIB_DIR) -I$(ZLIB_DIR)/contrib/minizip -c $(ZLIB_DIR)/contrib/minizip/iowin32.c - -infback.$(HOST_OBJEXT): - $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/infback.c - -inffast.$(HOST_OBJEXT): - $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/inffast.c - -inflate.$(HOST_OBJEXT): - $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/inflate.c - -inftrees.$(HOST_OBJEXT): - $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/inftrees.c - -trees.$(HOST_OBJEXT): - $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/trees.c - -uncompr.$(HOST_OBJEXT): - $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/uncompr.c - -zip.$(HOST_OBJEXT): - $(HOST_CC) -o $@ -I$(ZLIB_DIR) -I$(ZLIB_DIR)/contrib/minizip -c $(ZLIB_DIR)/contrib/minizip/zip.c - -zutil.$(HOST_OBJEXT): - $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/zutil.c - -minizip.$(HOST_OBJEXT): - $(HOST_CC) -o $@ -I$(ZLIB_DIR) -I$(ZLIB_DIR)/contrib/minizip -c $(ZLIB_DIR)/contrib/minizip/minizip.c - -minizip${HOST_EXEEXT}: $(MINIZIP_OBJS) - $(HOST_CC) -o $@ $(MINIZIP_OBJS) - # 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 @@ -793,42 +551,42 @@ gendate: --no-lines \ $(GENERIC_DIR)/tclGetDate.y -INSTALL_BASE_TARGETS = install-binaries $(INSTALL_LIBRARIES) $(INSTALL_MSGS) $(INSTALL_TZDATA) -INSTALL_DOC_TARGETS = install-doc -INSTALL_PACKAGE_TARGETS = install-packages -INSTALL_DEV_TARGETS = install-headers -INSTALL_EXTRA_TARGETS = -INSTALL_TARGETS = $(INSTALL_BASE_TARGETS) $(INSTALL_DOC_TARGETS) $(INSTALL_DEV_TARGETS) \ - $(INSTALL_PACKAGE_TARGETS) $(INSTALL_EXTRA_TARGETS) +# 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: $(INSTALL_TARGETS) +install: all install-binaries install-libraries install-doc install-binaries: binaries - @for i in "$(LIB_INSTALL_DIR)" "$(BIN_INSTALL_DIR)"; \ + @for i in "$(LIB_INSTALL_DIR)" "$(BIN_INSTALL_DIR)" ; \ do \ - if [ ! -d "$$i" ] ; then \ + if [ ! -d $$i ] ; then \ echo "Making directory $$i"; \ - $(MKDIR) "$$i"; \ - chmod 755 "$$i"; \ + $(MKDIR) $$i; \ + chmod 755 $$i; \ else true; \ fi; \ done; - @for i in dde${DDEDOTVER} registry${REGDOTVER}; \ + @for i in dde$(DDEDOTVER) reg$(REGDOTVER); \ do \ - if [ ! -d "$(LIB_INSTALL_DIR)/$$i" ] ; then \ + if [ ! -d $(LIB_INSTALL_DIR)/$$i ] ; then \ echo "Making directory $(LIB_INSTALL_DIR)/$$i"; \ - $(MKDIR) "$(LIB_INSTALL_DIR)/$$i"; \ + $(MKDIR) $(LIB_INSTALL_DIR)/$$i; \ else true; \ fi; \ done; - @for i in $(TCL_DLL_FILE) $(ZLIB_DLL_FILE) $(TOMMATH_DLL_FILE) $(TCLSH); \ + @for i in $(TCL_DLL_FILE) $(TCLSH) $(PIPE_DLL_FILE); \ do \ if [ -f $$i ]; then \ echo "Installing $$i to $(BIN_INSTALL_DIR)/"; \ $(COPY) $$i "$(BIN_INSTALL_DIR)"; \ fi; \ done - @for i in tclConfig.sh tclooConfig.sh $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE) @ZLIB_LIBS@ @TOMMATH_LIBS@; \ + @for i in tclConfig.sh $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE); \ do \ if [ -f $$i ]; then \ echo "Installing $$i to $(LIB_INSTALL_DIR)/"; \ @@ -837,74 +595,76 @@ install-binaries: binaries done @if [ -f $(DDE_DLL_FILE) ]; then \ echo Installing $(DDE_DLL_FILE); \ - $(COPY) $(DDE_DLL_FILE) "$(LIB_INSTALL_DIR)/dde${DDEDOTVER}"; \ + $(COPY) $(DDE_DLL_FILE) $(LIB_INSTALL_DIR)/dde$(DDEDOTVER); \ $(COPY) $(ROOT_DIR)/library/dde/pkgIndex.tcl \ - "$(LIB_INSTALL_DIR)/dde${DDEDOTVER}"; \ + $(LIB_INSTALL_DIR)/dde$(DDEDOTVER); \ fi @if [ -f $(DDE_LIB_FILE) ]; then \ echo Installing $(DDE_LIB_FILE); \ - $(COPY) $(DDE_LIB_FILE) "$(LIB_INSTALL_DIR)/dde${DDEDOTVER}"; \ + $(COPY) $(DDE_LIB_FILE) $(LIB_INSTALL_DIR)/dde$(DDEDOTVER); \ fi @if [ -f $(REG_DLL_FILE) ]; then \ echo Installing $(REG_DLL_FILE); \ - $(COPY) $(REG_DLL_FILE) "$(LIB_INSTALL_DIR)/registry${REGDOTVER}"; \ - $(COPY) $(ROOT_DIR)/library/registry/pkgIndex.tcl \ - "$(LIB_INSTALL_DIR)/registry${REGDOTVER}"; \ + $(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)/registry${REGDOTVER}"; \ + $(COPY) $(REG_LIB_FILE) $(LIB_INSTALL_DIR)/reg$(REGDOTVER); \ fi install-libraries: libraries install-tzdata install-msgs - @for i in "$(prefix)/lib" "$(INCLUDE_INSTALL_DIR)" \ - "$(SCRIPT_INSTALL_DIR)" "$(MODULE_INSTALL_DIR)"; \ + @for i in $(prefix)/lib $(INCLUDE_INSTALL_DIR) \ + $(SCRIPT_INSTALL_DIR); \ do \ - if [ ! -d "$$i" ] ; then \ + if [ ! -d $$i ] ; then \ echo "Making directory $$i"; \ - $(MKDIR) "$$i"; \ + $(MKDIR) $$i; \ else true; \ fi; \ done; - @for i in opt0.4 cookiejar0.2 encoding; \ + @for i in http1.0 opt0.4 encoding ../tcl8 ../tcl8/8.4 ../tcl8/8.4/platform ../tcl8/8.5; \ do \ - if [ ! -d "$(SCRIPT_INSTALL_DIR)/$$i" ] ; then \ + if [ ! -d $(SCRIPT_INSTALL_DIR)/$$i ] ; then \ echo "Making directory $(SCRIPT_INSTALL_DIR)/$$i"; \ - $(MKDIR) "$(SCRIPT_INSTALL_DIR)/$$i"; \ + $(MKDIR) $(SCRIPT_INSTALL_DIR)/$$i; \ else true; \ fi; \ done; - @for i in 8.4 8.4/platform 8.5 8.6 8.7; \ + @echo "Installing header files"; + @for i in "$(GENERIC_DIR)/tcl.h" "$(GENERIC_DIR)/tclDecls.h" \ + "$(GENERIC_DIR)/tclPlatDecls.h" \ + "$(GENERIC_DIR)/tclTomMath.h" \ + "$(GENERIC_DIR)/tclTomMathDecls.h"; \ do \ - if [ ! -d "$(MODULE_INSTALL_DIR)/$$i" ] ; then \ - echo "Making directory $(MODULE_INSTALL_DIR)/$$i"; \ - $(MKDIR) "$(MODULE_INSTALL_DIR)/$$i"; \ - else true; \ - fi; \ + $(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 \ + @for i in $(ROOT_DIR)/library/*.tcl $(ROOT_DIR)/library/tclIndex; \ + do \ $(COPY) "$$i" "$(SCRIPT_INSTALL_DIR)"; \ done; - @echo "Installing package cookiejar 0.2" - @for j in $(ROOT_DIR)/library/cookiejar/*.tcl \ - $(ROOT_DIR)/library/cookiejar/*.gz; do \ - $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/cookiejar0.2"; \ + @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.10b2 as a Tcl Module"; - @$(COPY) $(ROOT_DIR)/library/http/http.tcl "$(MODULE_INSTALL_DIR)/8.6/http-2.10b2.tm"; - @echo "Installing package opt 0.4.7"; - @for j in $(ROOT_DIR)/library/opt/*.tcl; do \ + @echo "Installing package http 2.7.13 as a Tcl Module"; + @$(COPY) $(ROOT_DIR)/library/http/http.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/http-2.7.13.tm; + @echo "Installing library opt0.4 directory"; + @for j in $(ROOT_DIR)/library/opt/*.tcl; \ + do \ $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/opt0.4"; \ done; - @echo "Installing package msgcat 1.7.1 as a Tcl Module"; - @$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl "$(MODULE_INSTALL_DIR)/8.7/msgcat-1.7.1.tm"; - @echo "Installing package tcltest 2.5.8 as a Tcl Module"; - @$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl "$(MODULE_INSTALL_DIR)/8.5/tcltest-2.5.8.tm"; - @echo "Installing package platform 1.0.19 as a Tcl Module"; - @$(COPY) $(ROOT_DIR)/library/platform/platform.tcl "$(MODULE_INSTALL_DIR)/8.4/platform-1.0.19.tm"; + @echo "Installing package msgcat 1.5.2 as a Tcl Module"; + @$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/msgcat-1.5.2.tm; + @echo "Installing package tcltest 2.3.8 as a Tcl Module"; + @$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/tcltest-2.3.8.tm; + @echo "Installing package platform 1.0.14 as a Tcl Module"; + @$(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 "$(MODULE_INSTALL_DIR)/8.4/platform/shell-1.1.4.tm"; + @$(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"; \ @@ -912,37 +672,18 @@ install-libraries: libraries install-tzdata install-msgs install-tzdata: @echo "Installing time zone data" - @$(TCL_EXE) "$(ROOT_DIR)/tools/installData.tcl" \ - "$(ROOT_DIR)/library/tzdata" "$(SCRIPT_INSTALL_DIR_NATIVE)/tzdata" + @TCL_LIBRARY="${LIBRARY_DIR}"; export TCL_LIBRARY; \ + ./$(TCLSH) "$(ROOT_DIR)/tools/installData.tcl" \ + "$(ROOT_DIR)/library/tzdata" "$(SCRIPT_INSTALL_DIR)/tzdata" install-msgs: @echo "Installing message catalogs" - $(TCL_EXE) "$(ROOT_DIR)/tools/installData.tcl" \ - "$(ROOT_DIR)/library/msgs" "$(SCRIPT_INSTALL_DIR_NATIVE)/msgs" + @TCL_LIBRARY="${LIBRARY_DIR}"; export TCL_LIBRARY; \ + ./$(TCLSH) "$(ROOT_DIR)/tools/installData.tcl" \ + "$(ROOT_DIR)/library/msgs" "$(SCRIPT_INSTALL_DIR)/msgs" install-doc: doc -install-headers: - @for i in "$(INCLUDE_INSTALL_DIR)"; \ - do \ - if [ ! -d "$$i" ] ; then \ - echo "Making directory $$i"; \ - $(MKDIR) "$$i"; \ - chmod 755 "$$i"; \ - else true; \ - fi; \ - done; - @echo "Installing header files to $(INCLUDE_INSTALL_DIR)/"; - @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 \ - $(TOMMATH_DIR)/tommath.h ; \ - do \ - $(COPY) $$i "$(INCLUDE_INSTALL_DIR)"; \ - done; - # Optional target to install private headers install-private-headers: libraries @for i in $(PRIVATE_INCLUDE_INSTALL_DIR); \ @@ -956,7 +697,6 @@ install-private-headers: libraries @echo "Installing private header files"; @for i in "$(GENERIC_DIR)/tclInt.h" "$(GENERIC_DIR)/tclIntDecls.h" \ "$(GENERIC_DIR)/tclIntPlatDecls.h" "$(GENERIC_DIR)/tclPort.h" \ - "$(GENERIC_DIR)/tclOOInt.h" "$(GENERIC_DIR)/tclOOIntDecls.h" \ "$(WIN_DIR)/tclWinPort.h" ; \ do \ $(COPY) "$$i" "$(PRIVATE_INCLUDE_INSTALL_DIR)"; \ @@ -966,23 +706,23 @@ install-private-headers: libraries # tcltest, i.e.: # % make test TESTFLAGS="-verbose bps -file fileName.test" -test: test-tcl test-packages - -test-tcl: tcltest +test: binaries $(TCLTEST) TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \ - $(WINE) ./$(TCLSH) "$(ROOT_DIR_NATIVE)/tests/all.tcl" $(TESTFLAGS) \ - -load "$(TEST_LOAD_FACILITIES)" + ./$(TCLTEST) "$(ROOT_DIR_NATIVE)/tests/all.tcl" $(TESTFLAGS) \ + -load "package ifneeded dde 1.3.3 [list load [file normalize ${DDE_DLL_FILE}] dde]; \ + package ifneeded registry 1.2.2 [list load [file normalize ${REG_DLL_FILE}] registry]" | ./$(CAT32) -# Useful target to launch a built tclsh with the proper path,... -runtest: tcltest +# Useful target to launch a built tcltest with the proper path,... +runtest: binaries $(TCLTEST) @TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \ - $(WINE) ./$(TCLSH) $(TESTFLAGS) -load "$(TEST_LOAD_FACILITIES)" $(SCRIPT) + ./$(TCLTEST) $(TESTFLAGS) -load "package ifneeded dde 1.3.3 [list load [file normalize ${DDE_DLL_FILE}] dde]; \ + package ifneeded registry 1.2.2 [list load [file normalize ${REG_DLL_FILE}] registry]" $(SCRIPT) # This target can be used to run tclsh from the build directory via # `make shell SCRIPT=foo.tcl` shell: binaries @TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \ - $(WINE) ./$(TCLSH) -encoding utf-8 $(SCRIPT) + ./$(TCLSH) $(SCRIPT) # This target can be used to run tclsh inside either gdb or insight gdb: binaries @@ -996,96 +736,16 @@ Makefile: $(SRC_DIR)/Makefile.in ./config.status cleanhelp: - $(RM) *.hlp *.cnt *.GID + $(RM) *.hlp *.cnt *.GID *.rtf man2tcl.exe -clean: cleanhelp clean-packages +clean: cleanhelp $(RM) *.lib *.a *.exp *.dll *.$(RES) *.${OBJEXT} *~ \#* TAGS a.out - $(RM) $(TCLSH) $(CAT32) $(TEST_EXE_FILE) $(TEST_DLL_FILE) tcltest.cmd tcltest.sh - $(RM) *.pch *.ilk *.pdb *.zip - $(RM) minizip${HOST_EXEEXT} *.${HOST_OBJEXT} - $(RMDIR) *.vfs + $(RM) $(TCLSH) $(TCLTEST) $(CAT32) + $(RM) *.pch *.ilk *.pdb -distclean: distclean-packages clean +distclean: clean $(RM) Makefile config.status config.cache config.log tclConfig.sh \ - config.status.lineno tclsh.exe.manifest tclUuid.h - -# -# 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; ) \ - 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) + tcl.hpj config.status.lineno # # Regenerate the stubs files. @@ -1101,29 +761,8 @@ genstubs: $(TCL_EXE) "$(ROOT_DIR_NATIVE)/tools/genStubs.tcl" \ "$(GENERIC_DIR_NATIVE)" \ "$(GENERIC_DIR_NATIVE)/tcl.decls" \ - "$(GENERIC_DIR_NATIVE)/tclInt.decls" \ + "$(GENERIC_DIR_NATIVE)/tclInt.decls" \ "$(GENERIC_DIR_NATIVE)/tclTomMath.decls" - $(TCL_EXE) "$(ROOT_DIR_NATIVE)/tools/genStubs.tcl" \ - "$(GENERIC_DIR_NATIVE)" \ - "$(GENERIC_DIR_NATIVE)/tclOO.decls" - -# -# This target creates the HTML folder for Tcl & Tk and places it in -# DISTDIR/html. It uses the tcltk-man2html.tcl tool from the Tcl group's tool -# workspace. It depends on the Tcl & Tk being in directories called tcl8.* & -# tk8.* up two directories from the TOOL_DIR. -# - -TOOL_DIR=$(ROOT_DIR)/tools -HTML_INSTALL_DIR=$(ROOT_DIR)/html -html: - $(MAKE) shell SCRIPT="$(TOOL_DIR)/tcltk-man2html.tcl --htmldir=$(HTML_INSTALL_DIR) --srcdir=$(ROOT_DIR)/.. $(BUILD_HTML_FLAGS)" - -html-tcl: $(TCLSH) - $(MAKE) shell SCRIPT="$(TOOL_DIR)/tcltk-man2html.tcl --htmldir=$(HTML_INSTALL_DIR) --srcdir=$(ROOT_DIR)/.. $(BUILD_HTML_FLAGS) --tcl" - -html-tk: $(TCLSH) - $(MAKE) shell SCRIPT="$(TOOL_DIR)/tcltk-man2html.tcl --htmldir=$(HTML_INSTALL_DIR) --srcdir=$(ROOT_DIR)/.. $(BUILD_HTML_FLAGS) --tk" # # The list of all the targets that do not correspond to real files. This stops @@ -1136,6 +775,5 @@ html-tk: $(TCLSH) .PHONY: gdb depend cleanhelp clean distclean packages install-packages .PHONY: test-packages clean-packages distclean-packages genstubs html .PHONY: html-tcl html-tk -.PHONY: tclzipfile # DO NOT DELETE THIS LINE -- make depend depends on it. @@ -1,4 +1,4 @@ -Tcl 8.7 for Windows +Tcl 8.5 for Windows 1. Introduction --------------- @@ -9,43 +9,43 @@ that are specific to Microsoft Windows. The information in this file is maintained on the web at: - https://www.tcl-lang.org/doc/howto/compile.html#win + 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.7 Source Distribution (plus any patches) + Tcl 8.5 Source Distribution (plus any patches) and - Visual Studio 2015 or newer + Visual C++ 6 or newer or - Linux + MinGW-w64 [https://www.mingw-w64.org/] + Linux + MinGW-w64 [http://mingw-w64.sourceforge.net/] (win32 or win64) or - Cygwin + MinGW-w64 [https://cygwin.com/install.html] + Cygwin + MinGW-w64 [http://cygwin.com/install.html] (win32 or win64) or - Darwin + MinGW-w64 [https://www.mingw-w64.org/] + Darwin + MinGW-w64 [http://mingw-w64.sourceforge.net/] (win32 or win64) or - Msys + MinGW-w64 [https://www.mingw-w64.org/] + Msys + MinGW-w64 [http://mingw-w64.sourceforge.net/] (win32 or win64) or - LLVM MinGW [https://github.com/mstorsjo/llvm-mingw/] - (win32 or win64, IX86, AMD64 or ARM64) + Msys + MinGW [http://www.mingw.org/download.shtml] + (win32 only) In practice, this release is built with Visual C++ 6.0 and the TEA @@ -67,9 +67,8 @@ 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 (or --enable-64bit=arm64) option. Make sure that -the x86_64-w64-mingw32 (or aarch64-w64-mingw32) compiler is present. -For Cygwin the x86_64 compiler can be found in the +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 @@ -80,13 +79,11 @@ 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 tclsh87.exe, you must ensure that tcl87.dll, -libtommath.dll and zlib1.dll are on your path, in the system -directory, or in the directory containing tclsh87.exe. +Note that in order to run tclsh85.exe, you must ensure that tcl85.dll is +on your path, in the system directory, or in the directory containing +tclsh85.exe. -Note: Tcl no longer provides support for systems earlier than Windows 7. -You will also need the Windows Universal C runtime (UCRT): - [https://support.microsoft.com/en-us/topic/update-for-universal-c-runtime-in-windows-c0514201-7fe6-95a3-b0a5-287930f3560c] +Note: Tcl no longer provides support for Win32s. 3. Test suite ------------- @@ -96,7 +93,7 @@ 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: - https://core.tcl-lang.org/tcl/reportlist + 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/win/buildall.vc.bat b/win/buildall.vc.bat index 941f27e..1a0f36d 100755..100644 --- a/win/buildall.vc.bat +++ b/win/buildall.vc.bat @@ -38,9 +38,7 @@ if defined WINDOWSSDKDIR (goto :startBuilding) :: might not be correct. You should call it yourself prior to running
:: this batchfile.
::
-REM call "C:\Program Files\Microsoft Developer Studio\vc98\bin\vcvars32.bat"
-set "VSCMD_START_DIR=%CD%"
-call "C:\Program Files (x86)\Microsoft Visual Studio\2017\Community\Common7\Tools\VsDevCmd.bat"
+call "C:\Program Files\Microsoft Developer Studio\vc98\bin\vcvars32.bat"
if errorlevel 1 (goto no_vcvars)
:startBuilding
@@ -61,15 +59,15 @@ if "%INSTALLDIR%" == "" set INSTALLDIR=C:\Program Files\Tcl :: Build the normal stuff along with the help file.
::
-set OPTS=none
-if not %SYMBOLS%.==. set OPTS=symbols
-nmake -nologo -f makefile.vc release htmlhelp OPTS=%OPTS% %1
+set OPTS=threads
+if not %SYMBOLS%.==. set OPTS=symbols,threads
+nmake -nologo -f makefile.vc release winhelp OPTS=%OPTS% %1
if errorlevel 1 goto error
:: Build the static core and shell.
::
-set OPTS=static
-if not %SYMBOLS%.==. set OPTS=symbols,static
+set OPTS=static,msvcrt,threads
+if not %SYMBOLS%.==. set OPTS=symbols,static,msvcrt,threads
nmake -nologo -f makefile.vc shell OPTS=%OPTS% %1
if errorlevel 1 goto error
@@ -9,33 +9,26 @@ * of this file, and for a DISCLAIMER OF ALL WARRANTIES. */ -#ifdef TCL_BROKEN_MAINARGS -/* On mingw32 and cygwin this doesn't work */ -# undef UNICODE -# undef _UNICODE -#endif - #include <stdio.h> #include <io.h> #include <string.h> -#include <tchar.h> int -_tmain(void) +main(void) { char buf[1024]; int n; const char *err; while (1) { - n = _read(0, buf, sizeof(buf)); + n = read(0, buf, sizeof(buf)); if (n <= 0) { break; } - _write(1, buf, n); + write(1, buf, n); } err = (sizeof(int) == 2) ? "stderr16" : "stderr32"; - _write(2, err, (unsigned int)strlen(err)); + write(2, err, strlen(err)); return 0; } diff --git a/win/coffbase.txt b/win/coffbase.txt new file mode 100644 index 0000000..0ebe18a --- /dev/null +++ b/win/coffbase.txt @@ -0,0 +1,42 @@ +;
+; 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
+;
+; insert new packages here
+;
+snack 0x1E000000 0x00400000
+sound 0x1E400000 0x00400000
+snackogg 0x1E800000 0x00200000
diff --git a/win/configure b/win/configure index 94e04f5..090feaa 100755 --- a/win/configure +++ b/win/configure @@ -1,469 +1,81 @@ #! /bin/sh # Guess values for system-dependent variables and create Makefiles. -# Generated by GNU Autoconf 2.72 for tcl 8.7. -# -# -# Copyright (C) 1992-1996, 1998-2017, 2020-2023 Free Software Foundation, -# Inc. -# +# Generated by GNU Autoconf 2.59. # +# Copyright (C) 2003 Free Software Foundation, Inc. # This configure script is free software; the Free Software Foundation # gives unlimited permission to copy, distribute and modify it. -## -------------------- ## -## M4sh Initialization. ## -## -------------------- ## +## --------------------- ## +## M4sh Initialization. ## +## --------------------- ## -# Be more Bourne compatible -DUALCASE=1; export DUALCASE # for MKS sh -if test ${ZSH_VERSION+y} && (emulate sh) >/dev/null 2>&1 -then : +# Be Bourne compatible +if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then emulate sh NULLCMD=: - # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which + # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' - setopt NO_GLOB_SUBST -else case e in #( - e) case `(set -o) 2>/dev/null` in #( - *posix*) : - set -o posix ;; #( - *) : - ;; -esac ;; -esac +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 -# Reset variables that may have inherited troublesome values from -# the environment. - -# IFS needs to be set, to space, tab, and newline, in precisely that order. -# (If _AS_PATH_WALK were called with IFS unset, it would have the -# side effect of setting IFS to empty, thus disabling word splitting.) -# Quoting is to prevent editors from complaining about space-tab. -as_nl=' -' -export as_nl -IFS=" "" $as_nl" - +# Work around bugs in pre-3.0 UWIN ksh. +$as_unset ENV MAIL MAILPATH PS1='$ ' PS2='> ' PS4='+ ' -# Ensure predictable behavior from utilities with locale-dependent output. -LC_ALL=C -export LC_ALL -LANGUAGE=C -export LANGUAGE - -# We cannot yet rely on "unset" to work, but we need these variables -# to be unset--not just set to an empty or harmless value--now, to -# avoid bugs in old shells (e.g. pre-3.0 UWIN ksh). This construct -# also avoids known problems related to "unset" and subshell syntax -# in other old shells (e.g. bash 2.01 and pdksh 5.2.14). -for as_var in BASH_ENV ENV MAIL MAILPATH CDPATH -do eval test \${$as_var+y} \ - && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || : -done - -# Ensure that fds 0, 1, and 2 are open. -if (exec 3>&0) 2>/dev/null; then :; else exec 0</dev/null; fi -if (exec 3>&1) 2>/dev/null; then :; else exec 1>/dev/null; fi -if (exec 3>&2) ; then :; else exec 2>/dev/null; fi - -# The user is always right. -if ${PATH_SEPARATOR+false} :; then - PATH_SEPARATOR=: - (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && { - (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 || - PATH_SEPARATOR=';' - } -fi - - -# Find who we are. Look in the path if we contain no directory separator. -as_myself= -case $0 in #(( - *[\\/]* ) as_myself=$0 ;; - *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - case $as_dir in #((( - '') as_dir=./ ;; - */) ;; - *) as_dir=$as_dir/ ;; - esac - test -r "$as_dir$0" && as_myself=$as_dir$0 && break - done -IFS=$as_save_IFS - - ;; -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 - printf "%s\n" "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 - exit 1 -fi - - -# Use a proper internal environment variable to ensure we don't fall - # into an infinite loop, continuously re-executing ourselves. - if test x"${_as_can_reexec}" != xno && test "x$CONFIG_SHELL" != x; then - _as_can_reexec=no; export _as_can_reexec; - # We cannot yet assume a decent shell, so we have to provide a -# neutralization value for shells without unset; and this also -# works around shells that cannot unset nonexistent variables. -# Preserve -v and -x to the replacement shell. -BASH_ENV=/dev/null -ENV=/dev/null -(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV -case $- in # (((( - *v*x* | *x*v* ) as_opts=-vx ;; - *v* ) as_opts=-v ;; - *x* ) as_opts=-x ;; - * ) as_opts= ;; -esac -exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"} -# Admittedly, this is quite paranoid, since all the known shells bail -# out after a failed 'exec'. -printf "%s\n" "$0: could not re-execute with $CONFIG_SHELL" >&2 -exit 255 - fi - # We don't want this to propagate to other subprocesses. - { _as_can_reexec=; unset _as_can_reexec;} -if test "x$CONFIG_SHELL" = x; then - as_bourne_compatible="if test \${ZSH_VERSION+y} && (emulate sh) >/dev/null 2>&1 -then : - emulate sh - NULLCMD=: - # Pre-4.2 versions of Zsh do word splitting on \${1+\"\$@\"}, which - # is contrary to our usage. Disable this feature. - alias -g '\${1+\"\$@\"}'='\"\$@\"' - setopt NO_GLOB_SUBST -else case e in #( - e) case \`(set -o) 2>/dev/null\` in #( - *posix*) : - set -o posix ;; #( - *) : - ;; -esac ;; -esac -fi -" - as_required="as_fn_return () { (exit \$1); } -as_fn_success () { as_fn_return 0; } -as_fn_failure () { as_fn_return 1; } -as_fn_ret_success () { return 0; } -as_fn_ret_failure () { return 1; } - -exitcode=0 -as_fn_success || { exitcode=1; echo as_fn_success failed.; } -as_fn_failure && { exitcode=1; echo as_fn_failure succeeded.; } -as_fn_ret_success || { exitcode=1; echo as_fn_ret_success failed.; } -as_fn_ret_failure && { exitcode=1; echo as_fn_ret_failure succeeded.; } -if ( set x; as_fn_ret_success y && test x = \"\$1\" ) -then : - -else case e in #( - e) exitcode=1; echo positional parameters were not saved. ;; -esac -fi -test x\$exitcode = x0 || exit 1 -blah=\$(echo \$(echo blah)) -test x\"\$blah\" = xblah || exit 1 -test -x / || exit 1" - as_suggested=" as_lineno_1=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_1a=\$LINENO - as_lineno_2=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_2a=\$LINENO - eval 'test \"x\$as_lineno_1'\$as_run'\" != \"x\$as_lineno_2'\$as_run'\" && - test \"x\`expr \$as_lineno_1'\$as_run' + 1\`\" = \"x\$as_lineno_2'\$as_run'\"' || exit 1 -test \$(( 1 + 1 )) = 2 || exit 1" - if (eval "$as_required") 2>/dev/null -then : - as_have_required=yes -else case e in #( - e) as_have_required=no ;; -esac -fi - if test x$as_have_required = xyes && (eval "$as_suggested") 2>/dev/null -then : - -else case e in #( - e) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -as_found=false -for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH +# 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 - IFS=$as_save_IFS - case $as_dir in #((( - '') as_dir=./ ;; - */) ;; - *) as_dir=$as_dir/ ;; - esac - as_found=: - case $as_dir in #( - /*) - for as_base in sh bash ksh sh5; do - # Try only shells that exist, to save several forks. - as_shell=$as_dir$as_base - if { test -f "$as_shell" || test -f "$as_shell.exe"; } && - as_run=a "$as_shell" -c "$as_bourne_compatible""$as_required" 2>/dev/null -then : - CONFIG_SHELL=$as_shell as_have_required=yes - if as_run=a "$as_shell" -c "$as_bourne_compatible""$as_suggested" 2>/dev/null -then : - break 2 -fi -fi - done;; - esac - as_found=false -done -IFS=$as_save_IFS -if $as_found -then : - -else case e in #( - e) if { test -f "$SHELL" || test -f "$SHELL.exe"; } && - as_run=a "$SHELL" -c "$as_bourne_compatible""$as_required" 2>/dev/null -then : - CONFIG_SHELL=$SHELL as_have_required=yes -fi ;; -esac -fi - - - if test "x$CONFIG_SHELL" != x -then : - export CONFIG_SHELL - # We cannot yet assume a decent shell, so we have to provide a -# neutralization value for shells without unset; and this also -# works around shells that cannot unset nonexistent variables. -# Preserve -v and -x to the replacement shell. -BASH_ENV=/dev/null -ENV=/dev/null -(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV -case $- in # (((( - *v*x* | *x*v* ) as_opts=-vx ;; - *v* ) as_opts=-v ;; - *x* ) as_opts=-x ;; - * ) as_opts= ;; -esac -exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"} -# Admittedly, this is quite paranoid, since all the known shells bail -# out after a failed 'exec'. -printf "%s\n" "$0: could not re-execute with $CONFIG_SHELL" >&2 -exit 255 -fi - - if test x$as_have_required = xno -then : - printf "%s\n" "$0: This script requires a shell more modern than all" - printf "%s\n" "$0: the shells that I found on your system." - if test ${ZSH_VERSION+y} ; then - printf "%s\n" "$0: In particular, zsh $ZSH_VERSION has bugs and should" - printf "%s\n" "$0: be upgraded to zsh 4.3.4 or later." + if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then + eval $as_var=C; export $as_var else - printf "%s\n" "$0: Please tell bug-autoconf@gnu.org about your system, -$0: including any error possibly output before this -$0: message. Then install a modern shell, or manually run -$0: the script under such a shell if you do have one." - fi - exit 1 -fi ;; -esac -fi -fi -SHELL=${CONFIG_SHELL-/bin/sh} -export SHELL -# Unset more variables known to interfere with behavior of common tools. -CLICOLOR_FORCE= GREP_OPTIONS= -unset CLICOLOR_FORCE GREP_OPTIONS - -## --------------------- ## -## M4sh Shell Functions. ## -## --------------------- ## -# as_fn_unset VAR -# --------------- -# Portably unset VAR. -as_fn_unset () -{ - { eval $1=; unset $1;} -} -as_unset=as_fn_unset - - -# as_fn_set_status STATUS -# ----------------------- -# Set $? to STATUS, without forking. -as_fn_set_status () -{ - return $1 -} # as_fn_set_status - -# as_fn_exit STATUS -# ----------------- -# Exit the shell with STATUS, even in a "trap 0" or "set -e" context. -as_fn_exit () -{ - set +e - as_fn_set_status $1 - exit $1 -} # as_fn_exit - -# as_fn_mkdir_p -# ------------- -# Create "$as_dir" as a directory, including parents if necessary. -as_fn_mkdir_p () -{ - - case $as_dir in #( - -*) as_dir=./$as_dir;; - esac - test -d "$as_dir" || eval $as_mkdir_p || { - as_dirs= - while :; do - case $as_dir in #( - *\'*) as_qdir=`printf "%s\n" "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'( - *) as_qdir=$as_dir;; - esac - as_dirs="'$as_qdir' $as_dirs" - as_dir=`$as_dirname -- "$as_dir" || -$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ - X"$as_dir" : 'X\(//\)[^/]' \| \ - X"$as_dir" : 'X\(//\)$' \| \ - X"$as_dir" : 'X\(/\)' \| . 2>/dev/null || -printf "%s\n" X"$as_dir" | - sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ - s//\1/ - q - } - /^X\(\/\/\)[^/].*/{ - s//\1/ - q - } - /^X\(\/\/\)$/{ - s//\1/ - q - } - /^X\(\/\).*/{ - s//\1/ - q - } - s/.*/./; q'` - test -d "$as_dir" && break - done - test -z "$as_dirs" || eval "mkdir $as_dirs" - } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir" - - -} # as_fn_mkdir_p - -# as_fn_executable_p FILE -# ----------------------- -# Test if FILE is an executable regular file. -as_fn_executable_p () -{ - test -f "$1" && test -x "$1" -} # as_fn_executable_p -# as_fn_append VAR VALUE -# ---------------------- -# Append the text in VALUE to the end of the definition contained in VAR. Take -# advantage of any shell optimizations that allow amortized linear growth over -# repeated appends, instead of the typical quadratic growth present in naive -# implementations. -if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null -then : - eval 'as_fn_append () - { - eval $1+=\$2 - }' -else case e in #( - e) as_fn_append () - { - eval $1=\$$1\$2 - } ;; -esac -fi # as_fn_append - -# as_fn_arith ARG... -# ------------------ -# Perform arithmetic evaluation on the ARGs, and store the result in the -# global $as_val. Take advantage of shells that can avoid forks. The arguments -# must be portable across $(()) and expr. -if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null -then : - eval 'as_fn_arith () - { - as_val=$(( $* )) - }' -else case e in #( - e) as_fn_arith () - { - as_val=`expr "$@" || test $? -eq 1` - } ;; -esac -fi # as_fn_arith - - -# as_fn_error STATUS ERROR [LINENO LOG_FD] -# ---------------------------------------- -# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are -# provided, also output the error to LOG_FD, referencing LINENO. Then exit the -# script with STATUS, using 1 if that was 0. -as_fn_error () -{ - as_status=$1; test $as_status -eq 0 && as_status=1 - if test "$4"; then - as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack - printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: $2" >&$4 + $as_unset $as_var fi - printf "%s\n" "$as_me: error: $2" >&2 - as_fn_exit $as_status -} # as_fn_error +done -if expr a : '\(a\)' >/dev/null 2>&1 && - test "X`expr 00001 : '.*\(...\)'`" = X001; then +# 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 +if (basename /) >/dev/null 2>&1 && test "X`basename / 2>&1`" = "X/"; then as_basename=basename else as_basename=false fi -if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then - as_dirname=dirname -else - as_dirname=false -fi -as_me=`$as_basename -- "$0" || +# Name of the executable. +as_me=`$as_basename "$0" || $as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ X"$0" : 'X\(//\)$' \| \ - X"$0" : 'X\(/\)' \| . 2>/dev/null || -printf "%s\n" X/"$0" | - sed '/^.*\/\([^/][^/]*\)\/*$/{ - s//\1/ - q - } - /^X\/\(\/\/\)$/{ - s//\1/ - q - } - /^X\/\(\/\).*/{ - s//\1/ - q - } - s/.*/./; q'` + 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' @@ -471,356 +83,238 @@ 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_1a=$LINENO - as_lineno_2=$LINENO as_lineno_2a=$LINENO - eval 'test "x$as_lineno_1'$as_run'" != "x$as_lineno_2'$as_run'" && - test "x`expr $as_lineno_1'$as_run' + 1`" = "x$as_lineno_2'$as_run'"' || { - # Blame Lee E. McMahon (1931-1989) for sed's syntax. :-) - sed -n ' - p - /[$]LINENO/= - ' <$as_myself | + 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 ' - t clear - :clear - s/[$]LINENO.*/&-/ - t lineno - b - :lineno N - :loop - s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/ + s,$,-, + : loop + s,^\(['$as_cr_digits']*\)\(.*\)[$]LINENO\([^'$as_cr_alnum'_]\),\1\2\1\3, t loop - s/-\n.*// + s,-$,, + s,^['$as_cr_digits']*\n,, ' >$as_me.lineno && - chmod +x "$as_me.lineno" || - { printf "%s\n" "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2; as_fn_exit 1; } + chmod +x $as_me.lineno || + { echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2 + { (exit 1); exit 1; }; } - # If we had to re-execute with $CONFIG_SHELL, we're ensured to have - # already done that, so ensure we don't try to do so again and fall - # in an infinite loop. This has already happened in practice. - _as_can_reexec=no; export _as_can_reexec # 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 sensitive to this). - . "./$as_me.lineno" + # original and so on. Autoconf is especially sensible to this). + . ./$as_me.lineno # Exit status is that of the last command. exit } -# Determine whether it's possible to make 'echo' print without a newline. -# These variables are no longer used directly by Autoconf, but are AC_SUBSTed -# for compatibility with existing Makefiles. -ECHO_C= ECHO_N= ECHO_T= -case `echo -n x` in #((((( --n*) - case `echo 'xy\c'` in - *c*) ECHO_T=' ';; # ECHO_T is single tab character. - xy) ECHO_C='\c';; - *) echo `echo ksh88 bug on AIX 6.1` > /dev/null - ECHO_T=' ';; - esac;; -*) - ECHO_N='-n';; +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 -# For backward compatibility with old third-party macros, we provide -# the shell variables $as_echo and $as_echo_n. New code should use -# AS_ECHO(["message"]) and AS_ECHO_N(["message"]), respectively. -as_echo='printf %s\n' -as_echo_n='printf %s' - -rm -f conf$$ conf$$.exe conf$$.file -if test -d conf$$.dir; then - rm -f conf$$.dir/conf$$.file +if expr a : '\(a\)' >/dev/null 2>&1; then + as_expr=expr else - rm -f conf$$.dir - mkdir conf$$.dir 2>/dev/null + as_expr=false fi -if (echo >conf$$.file) 2>/dev/null; then - if ln -s conf$$.file conf$$ 2>/dev/null; then - as_ln_s='ln -s' - # ... but there are two gotchas: - # 1) On MSYS, both 'ln -s file dir' and 'ln file dir' fail. - # 2) DJGPP < 2.04 has no symlinks; 'ln -s' creates a wrapper executable. - # In both cases, we have to default to 'cp -pR'. - ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || - as_ln_s='cp -pR' - elif ln conf$$.file conf$$ 2>/dev/null; then - as_ln_s=ln + +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='cp -pR' + as_ln_s='ln -s' fi +elif ln conf$$.file conf$$ 2>/dev/null; then + as_ln_s=ln else - as_ln_s='cp -pR' + as_ln_s='cp -p' fi -rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file -rmdir conf$$.dir 2>/dev/null +rm -f conf$$ conf$$.exe conf$$.file if mkdir -p . 2>/dev/null; then - as_mkdir_p='mkdir -p "$as_dir"' + as_mkdir_p=: else test -d ./-p && rmdir ./-p as_mkdir_p=false fi -as_test_x='test -x' -as_executable_p=as_fn_executable_p +as_executable_p="test -f" # Sed expression to map a string onto a valid CPP name. -as_sed_cpp="y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g" -as_tr_cpp="eval sed '$as_sed_cpp'" # deprecated +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_sed_sh="y%*+%pp%;s%[^_$as_cr_alnum]%_%g" -as_tr_sh="eval sed '$as_sed_sh'" # deprecated +as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" -test -n "$DJDIR" || exec 7<&0 </dev/null -exec 6>&1 +# 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, old GNU/Linux) returns a bogus exit status, +# 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_clean_files= ac_config_libobj_dir=. -LIBOBJS= 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='tcl' -PACKAGE_TARNAME='tcl' -PACKAGE_VERSION='8.7' -PACKAGE_STRING='tcl 8.7' -PACKAGE_BUGREPORT='' -PACKAGE_URL='' +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 <stddef.h> -#ifdef HAVE_STDIO_H -# include <stdio.h> +#include <stdio.h> +#if HAVE_SYS_TYPES_H +# include <sys/types.h> +#endif +#if HAVE_SYS_STAT_H +# include <sys/stat.h> #endif -#ifdef HAVE_STDLIB_H +#if STDC_HEADERS # include <stdlib.h> +# include <stddef.h> +#else +# if HAVE_STDLIB_H +# include <stdlib.h> +# endif #endif -#ifdef HAVE_STRING_H +#if HAVE_STRING_H +# if !STDC_HEADERS && HAVE_MEMORY_H +# include <memory.h> +# endif # include <string.h> #endif -#ifdef HAVE_INTTYPES_H -# include <inttypes.h> -#endif -#ifdef HAVE_STDINT_H -# include <stdint.h> -#endif -#ifdef HAVE_STRINGS_H +#if HAVE_STRINGS_H # include <strings.h> #endif -#ifdef HAVE_SYS_TYPES_H -# include <sys/types.h> -#endif -#ifdef HAVE_SYS_STAT_H -# include <sys/stat.h> +#if HAVE_INTTYPES_H +# include <inttypes.h> +#else +# if HAVE_STDINT_H +# include <stdint.h> +# endif #endif -#ifdef HAVE_UNISTD_H +#if HAVE_UNISTD_H # include <unistd.h> #endif" -ac_header_c_list= -ac_subst_vars='LTLIBOBJS -LIBOBJS -RES -RC_DEFINES -RC_DEFINE -RC_INCLUDE -RC_TYPE -RC_OUT -TCL_REG_MINOR_VERSION -TCL_REG_MAJOR_VERSION -TCL_REG_VERSION -TCL_DDE_MINOR_VERSION -TCL_DDE_MAJOR_VERSION -TCL_DDE_VERSION -TCL_PACKAGE_PATH -TCL_EXP_FILE -TCL_BUILD_EXP_FILE -TCL_LD_SEARCH_FLAGS -TCL_CC_SEARCH_FLAGS -TCL_BUILD_LIB_SPEC -MAKE_EXE -MAKE_DLL -POST_MAKE_LIB -MAKE_STUB_LIB -MAKE_LIB -LIBRARIES -EXESUFFIX -LIBSUFFIX -LIBPREFIX -DLLSUFFIX -LIBS_GUI -TCL_SHARED_BUILD -SHLIB_SUFFIX -SHLIB_CFLAGS -SHLIB_LD_LIBS -SHLIB_LD -STLIB_LD -LDFLAGS_WINDOW -LDFLAGS_CONSOLE -LDFLAGS_OPTIMIZE -LDFLAGS_DEBUG -CC_EXENAME -CC_OBJNAME -DEPARG -EXTRA_CFLAGS -CFG_TCL_UNSHARED_LIB_SUFFIX -CFG_TCL_SHARED_LIB_SUFFIX -TCL_BIN_DIR -TCL_SRC_DIR -TCL_DLL_FILE -TCL_BUILD_STUB_LIB_PATH -TCL_BUILD_STUB_LIB_SPEC -TCL_INCLUDE_SPEC -TCL_STUB_LIB_PATH -TCL_STUB_LIB_SPEC -TCL_STUB_LIB_FLAG -TCL_STUB_LIB_FILE -TCL_LIB_SPEC -TCL_IMPORT_LIB_FLAG -TCL_IMPORT_LIB_FILE -TCL_STATIC_LIB_FLAG -TCL_STATIC_LIB_FILE -TCL_LIB_FLAG -TCL_LIB_FILE -TCL_EXE -PKG_CFG_ARGS -TCL_PATCH_LEVEL -TCL_MINOR_VERSION -TCL_MAJOR_VERSION -TCL_VERSION -MACHINE -TCL_WIN_VERSION -VC_MANIFEST_EMBED_EXE -VC_MANIFEST_EMBED_DLL -CPP -LDFLAGS_DEFAULT -CFLAGS_DEFAULT -INSTALL_MSGS -INSTALL_LIBRARIES -TCL_ZIP_FILE -ZIPFS_BUILD -ZIP_INSTALL_OBJS -ZIP_PROG_VFSSEARCH -ZIP_PROG_OPTIONS -ZIP_PROG -TCLSH_PROG -EXEEXT_FOR_BUILD -CC_FOR_BUILD -TCL_TOMMATH_LIB_NAME -TCL_ZLIB_LIB_NAME -TOMMATH_OBJS -ZLIB_OBJS -TOMMATH_LIBS -ZLIB_LIBS -TOMMATH_DLL_FILE -ZLIB_DLL_FILE -CFLAGS_NOLTO -CFLAGS_WARNING -CFLAGS_OPTIMIZE -CFLAGS_DEBUG -DL_LIBS -WINE -CYGPATH -SHARED_BUILD -SET_MAKE -RC -RANLIB -AR -OBJEXT -EXEEXT -ac_ct_CC -CPPFLAGS -LDFLAGS -CFLAGS -CC -target_alias -host_alias -build_alias -LIBS -ECHO_T -ECHO_N -ECHO_C -DEFS -mandir -localedir -libdir -psdir -pdfdir -dvidir -htmldir -infodir -docdir -oldincludedir -includedir -runstatedir -localstatedir -sharedstatedir -sysconfdir -datadir -datarootdir -libexecdir -sbindir -bindir -program_transform_name -prefix -exec_prefix -PACKAGE_URL -PACKAGE_BUGREPORT -PACKAGE_STRING -PACKAGE_VERSION -PACKAGE_TARNAME -PACKAGE_NAME -PATH_SEPARATOR -SHELL -OBJEXT_FOR_BUILD' +ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT CPP EGREP AR ac_ct_AR RANLIB ac_ct_RANLIB RC ac_ct_RC SET_MAKE TCL_THREADS CYGPATH CELIB_DIR DL_LIBS CFLAGS_DEBUG CFLAGS_OPTIMIZE CFLAGS_WARNING CFLAGS_DEFAULT LDFLAGS_DEFAULT VC_MANIFEST_EMBED_DLL VC_MANIFEST_EMBED_EXE TCL_WIN_VERSION MACHINE TCL_VERSION TCL_MAJOR_VERSION TCL_MINOR_VERSION TCL_PATCH_LEVEL TCL_LIB_FILE TCL_LIB_FLAG TCL_LIB_SPEC TCL_STUB_LIB_FILE TCL_STUB_LIB_FLAG TCL_STUB_LIB_SPEC TCL_STUB_LIB_PATH TCL_INCLUDE_SPEC TCL_BUILD_STUB_LIB_SPEC TCL_BUILD_STUB_LIB_PATH TCL_DLL_FILE TCL_SRC_DIR TCL_BIN_DIR TCL_DBGX CFG_TCL_SHARED_LIB_SUFFIX CFG_TCL_UNSHARED_LIB_SUFFIX CFG_TCL_EXPORT_FILE_SUFFIX EXTRA_CFLAGS DEPARG CC_OBJNAME CC_EXENAME LDFLAGS_DEBUG LDFLAGS_OPTIMIZE LDFLAGS_CONSOLE LDFLAGS_WINDOW STLIB_LD SHLIB_LD SHLIB_LD_LIBS SHLIB_CFLAGS SHLIB_SUFFIX TCL_SHARED_BUILD LIBS_GUI DLLSUFFIX LIBPREFIX LIBSUFFIX EXESUFFIX LIBRARIES MAKE_LIB MAKE_STUB_LIB POST_MAKE_LIB MAKE_DLL MAKE_EXE TCL_BUILD_LIB_SPEC TCL_LD_SEARCH_FLAGS TCL_NEEDS_EXP_FILE TCL_BUILD_EXP_FILE TCL_EXP_FILE TCL_LIB_VERSIONS_OK TCL_PACKAGE_PATH TCL_DDE_VERSION TCL_DDE_MAJOR_VERSION TCL_DDE_MINOR_VERSION TCL_REG_VERSION TCL_REG_MAJOR_VERSION TCL_REG_MINOR_VERSION RC_OUT RC_TYPE RC_INCLUDE RC_DEFINE RC_DEFINES RES LIBOBJS LTLIBOBJS' ac_subst_files='' -ac_user_opts=' -enable_option_checking -with_encoding -enable_shared -enable_time64bit -enable_64bit -enable_zipfs -enable_symbols -enable_embedded_manifest -' - ac_precious_vars='build_alias -host_alias -target_alias -CC -CFLAGS -LDFLAGS -LIBS -CPPFLAGS -CPP' - # Initialize some variables set by options. ac_init_help= ac_init_version=false -ac_unrecognized_opts= -ac_unrecognized_sep= # The variables have the same names as the options, with # dashes changed to underlines. cache_file=/dev/null @@ -843,48 +337,34 @@ x_libraries=NONE # 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. -# (The list follows the same order as the GNU Coding Standards.) bindir='${exec_prefix}/bin' sbindir='${exec_prefix}/sbin' libexecdir='${exec_prefix}/libexec' -datarootdir='${prefix}/share' -datadir='${datarootdir}' +datadir='${prefix}/share' sysconfdir='${prefix}/etc' sharedstatedir='${prefix}/com' localstatedir='${prefix}/var' -runstatedir='${localstatedir}/run' +libdir='${exec_prefix}/lib' includedir='${prefix}/include' oldincludedir='/usr/include' -docdir='${datarootdir}/doc/${PACKAGE_TARNAME}' -infodir='${datarootdir}/info' -htmldir='${docdir}' -dvidir='${docdir}' -pdfdir='${docdir}' -psdir='${docdir}' -libdir='${exec_prefix}/lib' -localedir='${datarootdir}/locale' -mandir='${datarootdir}/man' +infodir='${prefix}/info' +mandir='${prefix}/man' ac_prev= -ac_dashdash= for ac_option do # If the previous option needs an argument, assign it. if test -n "$ac_prev"; then - eval $ac_prev=\$ac_option + eval "$ac_prev=\$ac_option" ac_prev= continue fi - case $ac_option in - *=?*) ac_optarg=`expr "X$ac_option" : '[^=]*=\(.*\)'` ;; - *=) ac_optarg= ;; - *) ac_optarg=yes ;; - esac + ac_optarg=`expr "x$ac_option" : 'x[^=]*=\(.*\)'` + + # Accept the important Cygnus configure options, so we can diagnose typos. - case $ac_dashdash$ac_option in - --) - ac_dashdash=yes ;; + case $ac_option in -bindir | --bindir | --bindi | --bind | --bin | --bi) ac_prev=bindir ;; @@ -906,59 +386,33 @@ do --config-cache | -C) cache_file=config.cache ;; - -datadir | --datadir | --datadi | --datad) + -datadir | --datadir | --datadi | --datad | --data | --dat | --da) ac_prev=datadir ;; - -datadir=* | --datadir=* | --datadi=* | --datad=*) + -datadir=* | --datadir=* | --datadi=* | --datad=* | --data=* | --dat=* \ + | --da=*) datadir=$ac_optarg ;; - -datarootdir | --datarootdir | --datarootdi | --datarootd | --dataroot \ - | --dataroo | --dataro | --datar) - ac_prev=datarootdir ;; - -datarootdir=* | --datarootdir=* | --datarootdi=* | --datarootd=* \ - | --dataroot=* | --dataroo=* | --dataro=* | --datar=*) - datarootdir=$ac_optarg ;; - -disable-* | --disable-*) - ac_useropt=`expr "x$ac_option" : 'x-*disable-\(.*\)'` + ac_feature=`expr "x$ac_option" : 'x-*disable-\(.*\)'` # Reject names that are not valid shell variable names. - expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && - as_fn_error $? "invalid feature name: '$ac_useropt'" - ac_useropt_orig=$ac_useropt - ac_useropt=`printf "%s\n" "$ac_useropt" | sed 's/[-+.]/_/g'` - case $ac_user_opts in - *" -"enable_$ac_useropt" -"*) ;; - *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--disable-$ac_useropt_orig" - ac_unrecognized_sep=', ';; - esac - eval enable_$ac_useropt=no ;; - - -docdir | --docdir | --docdi | --doc | --do) - ac_prev=docdir ;; - -docdir=* | --docdir=* | --docdi=* | --doc=* | --do=*) - docdir=$ac_optarg ;; - - -dvidir | --dvidir | --dvidi | --dvid | --dvi | --dv) - ac_prev=dvidir ;; - -dvidir=* | --dvidir=* | --dvidi=* | --dvid=* | --dvi=* | --dv=*) - dvidir=$ac_optarg ;; + 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_useropt=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'` + ac_feature=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'` # Reject names that are not valid shell variable names. - expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && - as_fn_error $? "invalid feature name: '$ac_useropt'" - ac_useropt_orig=$ac_useropt - ac_useropt=`printf "%s\n" "$ac_useropt" | sed 's/[-+.]/_/g'` - case $ac_user_opts in - *" -"enable_$ac_useropt" -"*) ;; - *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--enable-$ac_useropt_orig" - ac_unrecognized_sep=', ';; + 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_useropt=\$ac_optarg ;; + eval "enable_$ac_feature='$ac_optarg'" ;; -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \ | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \ @@ -985,12 +439,6 @@ do -host=* | --host=* | --hos=* | --ho=*) host_alias=$ac_optarg ;; - -htmldir | --htmldir | --htmldi | --htmld | --html | --htm | --ht) - ac_prev=htmldir ;; - -htmldir=* | --htmldir=* | --htmldi=* | --htmld=* | --html=* | --htm=* \ - | --ht=*) - htmldir=$ac_optarg ;; - -includedir | --includedir | --includedi | --included | --include \ | --includ | --inclu | --incl | --inc) ac_prev=includedir ;; @@ -1015,16 +463,13 @@ do | --libexe=* | --libex=* | --libe=*) libexecdir=$ac_optarg ;; - -localedir | --localedir | --localedi | --localed | --locale) - ac_prev=localedir ;; - -localedir=* | --localedir=* | --localedi=* | --localed=* | --locale=*) - localedir=$ac_optarg ;; - -localstatedir | --localstatedir | --localstatedi | --localstated \ - | --localstate | --localstat | --localsta | --localst | --locals) + | --localstate | --localstat | --localsta | --localst \ + | --locals | --local | --loca | --loc | --lo) ac_prev=localstatedir ;; -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \ - | --localstate=* | --localstat=* | --localsta=* | --localst=* | --locals=*) + | --localstate=* | --localstat=* | --localsta=* | --localst=* \ + | --locals=* | --local=* | --loca=* | --loc=* | --lo=*) localstatedir=$ac_optarg ;; -mandir | --mandir | --mandi | --mand | --man | --ma | --m) @@ -1089,29 +534,10 @@ do | --progr-tra=* | --program-tr=* | --program-t=*) program_transform_name=$ac_optarg ;; - -pdfdir | --pdfdir | --pdfdi | --pdfd | --pdf | --pd) - ac_prev=pdfdir ;; - -pdfdir=* | --pdfdir=* | --pdfdi=* | --pdfd=* | --pdf=* | --pd=*) - pdfdir=$ac_optarg ;; - - -psdir | --psdir | --psdi | --psd | --ps) - ac_prev=psdir ;; - -psdir=* | --psdir=* | --psdi=* | --psd=* | --ps=*) - psdir=$ac_optarg ;; - -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil) silent=yes ;; - -runstatedir | --runstatedir | --runstatedi | --runstated \ - | --runstate | --runstat | --runsta | --runst | --runs \ - | --run | --ru | --r) - ac_prev=runstatedir ;; - -runstatedir=* | --runstatedir=* | --runstatedi=* | --runstated=* \ - | --runstate=* | --runstat=* | --runsta=* | --runst=* | --runs=* \ - | --run=* | --ru=* | --r=*) - runstatedir=$ac_optarg ;; - -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb) ac_prev=sbindir ;; -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \ @@ -1158,36 +584,26 @@ do ac_init_version=: ;; -with-* | --with-*) - ac_useropt=`expr "x$ac_option" : 'x-*with-\([^=]*\)'` + ac_package=`expr "x$ac_option" : 'x-*with-\([^=]*\)'` # Reject names that are not valid shell variable names. - expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && - as_fn_error $? "invalid package name: '$ac_useropt'" - ac_useropt_orig=$ac_useropt - ac_useropt=`printf "%s\n" "$ac_useropt" | sed 's/[-+.]/_/g'` - case $ac_user_opts in - *" -"with_$ac_useropt" -"*) ;; - *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--with-$ac_useropt_orig" - ac_unrecognized_sep=', ';; + 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_useropt=\$ac_optarg ;; + eval "with_$ac_package='$ac_optarg'" ;; -without-* | --without-*) - ac_useropt=`expr "x$ac_option" : 'x-*without-\(.*\)'` + ac_package=`expr "x$ac_option" : 'x-*without-\(.*\)'` # Reject names that are not valid shell variable names. - expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && - as_fn_error $? "invalid package name: '$ac_useropt'" - ac_useropt_orig=$ac_useropt - ac_useropt=`printf "%s\n" "$ac_useropt" | sed 's/[-+.]/_/g'` - case $ac_user_opts in - *" -"with_$ac_useropt" -"*) ;; - *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--without-$ac_useropt_orig" - ac_unrecognized_sep=', ';; - esac - eval with_$ac_useropt=no ;; + expr "x$ac_package" : ".*[^-_$as_cr_alnum]" >/dev/null && + { echo "$as_me: error: invalid package name: $ac_package" >&2 + { (exit 1); exit 1; }; } + ac_package=`echo $ac_package | sed 's/-/_/g'` + eval "with_$ac_package=no" ;; --x) # Obsolete; use --with-x. @@ -1207,26 +623,27 @@ do | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*) x_libraries=$ac_optarg ;; - -*) as_fn_error $? "unrecognized option: '$ac_option' -Try '$0 --help' for more information" + -*) { 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. - case $ac_envvar in #( - '' | [0-9]* | *[!_$as_cr_alnum]* ) - as_fn_error $? "invalid variable name: '$ac_envvar'" ;; - esac - eval $ac_envvar=\$ac_optarg + 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. - printf "%s\n" "$as_me: WARNING: you should use --build, --host, --target" >&2 + echo "$as_me: WARNING: you should use --build, --host, --target" >&2 expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null && - printf "%s\n" "$as_me: WARNING: invalid host type: $ac_option" >&2 - : "${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option}" + echo "$as_me: WARNING: invalid host type: $ac_option" >&2 + : ${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option} ;; esac @@ -1234,39 +651,34 @@ done if test -n "$ac_prev"; then ac_option=--`echo $ac_prev | sed 's/_/-/g'` - as_fn_error $? "missing argument to $ac_option" + { echo "$as_me: error: missing argument to $ac_option" >&2 + { (exit 1); exit 1; }; } fi -if test -n "$ac_unrecognized_opts"; then - case $enable_option_checking in - no) ;; - fatal) as_fn_error $? "unrecognized options: $ac_unrecognized_opts" ;; - *) printf "%s\n" "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2 ;; - esac -fi - -# Check all directory arguments for consistency. -for ac_var in exec_prefix prefix bindir sbindir libexecdir datarootdir \ - datadir sysconfdir sharedstatedir localstatedir includedir \ - oldincludedir docdir infodir htmldir dvidir pdfdir psdir \ - libdir localedir mandir runstatedir +# Be sure to have absolute paths. +for ac_var in exec_prefix prefix do - eval ac_val=\$$ac_var - # Remove trailing slashes. + eval ac_val=$`echo $ac_var` case $ac_val in - */ ) - ac_val=`expr "X$ac_val" : 'X\(.*[^/]\)' \| "X$ac_val" : 'X\(.*\)'` - eval $ac_var=\$ac_val;; + [\\/$]* | ?:[\\/]* | NONE | '' ) ;; + *) { echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2 + { (exit 1); exit 1; }; };; esac - # Be sure to have absolute directory names. +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 - [\\/$]* | ?:[\\/]* ) continue;; - NONE | '' ) case $ac_var in *prefix ) continue;; esac;; + [\\/$]* | ?:[\\/]* ) ;; + *) { echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2 + { (exit 1); exit 1; }; };; esac - as_fn_error $? "expected an absolute directory name for --$ac_var: $ac_val" done -# There might be people who depend on the old broken behavior: '$host' +# 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 @@ -1277,6 +689,8 @@ target=$target_alias 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 @@ -1288,72 +702,74 @@ test -n "$host_alias" && ac_tool_prefix=$host_alias- test "$silent" = yes && exec 6>/dev/null -ac_pwd=`pwd` && test -n "$ac_pwd" && -ac_ls_di=`ls -di .` && -ac_pwd_ls_di=`cd "$ac_pwd" && ls -di .` || - as_fn_error $? "working directory cannot be determined" -test "X$ac_ls_di" = "X$ac_pwd_ls_di" || - as_fn_error $? "pwd does not report name of working directory" - - # 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 the parent directory. - ac_confdir=`$as_dirname -- "$as_myself" || -$as_expr X"$as_myself" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ - X"$as_myself" : 'X\(//\)[^/]' \| \ - X"$as_myself" : 'X\(//\)$' \| \ - X"$as_myself" : 'X\(/\)' \| . 2>/dev/null || -printf "%s\n" X"$as_myself" | - sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ - s//\1/ - q - } - /^X\(\/\/\)[^/].*/{ - s//\1/ - q - } - /^X\(\/\/\)$/{ - s//\1/ - q - } - /^X\(\/\).*/{ - s//\1/ - q - } - s/.*/./; q'` + # 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 + if test ! -r $srcdir/$ac_unique_file; then srcdir=.. fi else ac_srcdir_defaulted=no fi -if test ! -r "$srcdir/$ac_unique_file"; then - test "$ac_srcdir_defaulted" = yes && srcdir="$ac_confdir or .." - as_fn_error $? "cannot find sources ($ac_unique_file) in $srcdir" -fi -ac_msg="sources are in $srcdir, but 'cd $srcdir' does not work" -ac_abs_confdir=`( - cd "$srcdir" && test -r "./$ac_unique_file" || as_fn_error $? "$ac_msg" - pwd)` -# When building in place, set srcdir=. -if test "$ac_abs_confdir" = "$ac_pwd"; then - srcdir=. -fi -# Remove unnecessary trailing slashes from srcdir. -# Double slashes in file names in object file debugging info -# mess up M-x gdb in Emacs. -case $srcdir in -*/) srcdir=`expr "X$srcdir" : 'X\(.*[^/]\)' \| "X$srcdir" : 'X\(.*\)'`;; -esac -for ac_var in $ac_precious_vars; do - eval ac_env_${ac_var}_set=\${${ac_var}+set} - eval ac_env_${ac_var}_value=\$${ac_var} - eval ac_cv_env_${ac_var}_set=\${${ac_var}+set} - eval ac_cv_env_${ac_var}_value=\$${ac_var} -done +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. @@ -1362,7 +778,7 @@ 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 tcl 8.7 to adapt to many kinds of systems. +\`configure' configures this package to adapt to many kinds of systems. Usage: $0 [OPTION]... [VAR=VALUE]... @@ -1376,46 +792,41 @@ Configuration: --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 + -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' + -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 '..'] + --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] + [$ac_default_prefix] --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX - [PREFIX] + [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'. +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] - --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] - --runstatedir=DIR modifiable per-process data [LOCALSTATEDIR/run] - --libdir=DIR object code libraries [EPREFIX/lib] - --includedir=DIR C header files [PREFIX/include] - --oldincludedir=DIR C header files for non-gcc [/usr/include] - --datarootdir=DIR read-only arch.-independent data root [PREFIX/share] - --datadir=DIR read-only architecture-independent data [DATAROOTDIR] - --infodir=DIR info documentation [DATAROOTDIR/info] - --localedir=DIR locale-dependent data [DATAROOTDIR/locale] - --mandir=DIR man documentation [DATAROOTDIR/man] - --docdir=DIR documentation root [DATAROOTDIR/doc/tcl] - --htmldir=DIR html documentation [DOCDIR] - --dvidir=DIR dvi documentation [DOCDIR] - --pdfdir=DIR pdf documentation [DOCDIR] - --psdir=DIR ps documentation [DOCDIR] + --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 @@ -1423,19 +834,16 @@ _ACEOF fi if test -n "$ac_init_help"; then - case $ac_init_help in - short | recursive ) echo "Configuration of tcl 8.7:";; - esac + cat <<\_ACEOF Optional Features: - --disable-option-checking ignore unrecognized --enable/--with options --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no) --enable-FEATURE[=ARG] include FEATURE [ARG=yes] + --enable-threads build with threads (default: off) --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-zipfs build with Zipfs support (default: on) + --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) @@ -1444,301 +852,133 @@ 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> - LIBS libraries to pass to the linker, e.g. -l<library> - CPPFLAGS (Objective) C/C++ preprocessor flags, e.g. -I<include dir> if - you have headers in a nonstandard directory <include 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 +Use these variables to override the choices made by `configure' or to help it to find libraries and programs with nonstandard names/locations. -Report bugs to the package provider. _ACEOF -ac_status=$? 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" || - { cd "$srcdir" && ac_pwd=`pwd` && srcdir=. && test -d "$ac_dir"; } || - continue + test -d $ac_dir || continue ac_builddir=. -case "$ac_dir" in -.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; -*) - ac_dir_suffix=/`printf "%s\n" "$ac_dir" | sed 's|^\.[\\/]||'` - # A ".." for each directory in $ac_dir_suffix. - ac_top_builddir_sub=`printf "%s\n" "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'` - case $ac_top_builddir_sub in - "") ac_top_builddir_sub=. ac_top_build_prefix= ;; - *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; - esac ;; -esac -ac_abs_top_builddir=$ac_pwd -ac_abs_builddir=$ac_pwd$ac_dir_suffix -# for backward compatibility: -ac_top_builddir=$ac_top_build_prefix +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 - .) # We are building in place. + .) # No --srcdir option. We are building in place. ac_srcdir=. - ac_top_srcdir=$ac_top_builddir_sub - ac_abs_top_srcdir=$ac_pwd ;; - [\\/]* | ?:[\\/]* ) # Absolute name. + 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 - ac_abs_top_srcdir=$srcdir ;; - *) # Relative name. - ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix - ac_top_srcdir=$ac_top_build_prefix$srcdir - ac_abs_top_srcdir=$ac_pwd/$srcdir ;; + 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 -ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix - - cd "$ac_dir" || { ac_status=$?; continue; } - # Check for configure.gnu first; this name is used for a wrapper for - # Metaconfig's "Configure" on case-insensitive file systems. - 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 +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 - printf "%s\n" "$as_me: WARNING: no configuration information is in $ac_dir" >&2 - fi || ac_status=$? - cd "$ac_pwd" || { ac_status=$?; break; } + echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2 + fi + cd $ac_popdir done fi -test -n "$ac_init_help" && exit $ac_status +test -n "$ac_init_help" && exit 0 if $ac_init_version; then cat <<\_ACEOF -tcl configure 8.7 -generated by GNU Autoconf 2.72 -Copyright (C) 2023 Free Software Foundation, Inc. +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 -fi - -## ------------------------ ## -## Autoconf initialization. ## -## ------------------------ ## - -# ac_fn_c_try_compile LINENO -# -------------------------- -# Try to compile conftest.$ac_ext, and return whether this succeeded. -ac_fn_c_try_compile () -{ - as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack - rm -f conftest.$ac_objext conftest.beam - if { { ac_try="$ac_compile" -case "(($ac_try" in - *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; - *) ac_try_echo=$ac_try;; -esac -eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" -printf "%s\n" "$ac_try_echo"; } >&5 - (eval "$ac_compile") 2>conftest.err - ac_status=$? - if test -s conftest.err; then - grep -v '^ *+' conftest.err >conftest.er1 - cat conftest.er1 >&5 - mv -f conftest.er1 conftest.err - fi - printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; } && { - test -z "$ac_c_werror_flag" || - test ! -s conftest.err - } && test -s conftest.$ac_objext -then : - ac_retval=0 -else case e in #( - e) printf "%s\n" "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - - ac_retval=1 ;; -esac + exit 0 fi - eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno - as_fn_set_status $ac_retval - -} # ac_fn_c_try_compile - -# ac_fn_c_check_header_compile LINENO HEADER VAR INCLUDES -# ------------------------------------------------------- -# Tests whether HEADER exists and can be compiled using the include files in -# INCLUDES, setting the cache variable VAR accordingly. -ac_fn_c_check_header_compile () -{ - as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 -printf %s "checking for $2... " >&6; } -if eval test \${$3+y} -then : - printf %s "(cached) " >&6 -else case e in #( - e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -$4 -#include <$2> -_ACEOF -if ac_fn_c_try_compile "$LINENO" -then : - eval "$3=yes" -else case e in #( - e) eval "$3=no" ;; -esac -fi -rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ;; -esac -fi -eval ac_res=\$$3 - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 -printf "%s\n" "$ac_res" >&6; } - eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno - -} # ac_fn_c_check_header_compile - -# ac_fn_c_check_type LINENO TYPE VAR INCLUDES -# ------------------------------------------- -# Tests whether TYPE exists after having included INCLUDES, setting cache -# variable VAR accordingly. -ac_fn_c_check_type () -{ - as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 -printf %s "checking for $2... " >&6; } -if eval test \${$3+y} -then : - printf %s "(cached) " >&6 -else case e in #( - e) eval "$3=no" - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -$4 -int -main (void) -{ -if (sizeof ($2)) - return 0; - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO" -then : - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -$4 -int -main (void) -{ -if (sizeof (($2))) - return 0; - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO" -then : - -else case e in #( - e) eval "$3=yes" ;; -esac -fi -rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext -fi -rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ;; -esac -fi -eval ac_res=\$$3 - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 -printf "%s\n" "$ac_res" >&6; } - eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno - -} # ac_fn_c_check_type - -# ac_fn_c_try_cpp LINENO -# ---------------------- -# Try to preprocess conftest.$ac_ext, and return whether this succeeded. -ac_fn_c_try_cpp () -{ - as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack - if { { ac_try="$ac_cpp conftest.$ac_ext" -case "(($ac_try" in - *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; - *) ac_try_echo=$ac_try;; -esac -eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" -printf "%s\n" "$ac_try_echo"; } >&5 - (eval "$ac_cpp conftest.$ac_ext") 2>conftest.err - ac_status=$? - if test -s conftest.err; then - grep -v '^ *+' conftest.err >conftest.er1 - cat conftest.er1 >&5 - mv -f conftest.er1 conftest.err - fi - printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; } > conftest.i && { - test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" || - test ! -s conftest.err - } -then : - ac_retval=0 -else case e in #( - e) printf "%s\n" "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - - ac_retval=1 ;; -esac -fi - eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno - as_fn_set_status $ac_retval - -} # ac_fn_c_try_cpp -ac_configure_args_raw= -for ac_arg -do - case $ac_arg in - *\'*) - ac_arg=`printf "%s\n" "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;; - esac - as_fn_append ac_configure_args_raw " '$ac_arg'" -done - -case $ac_configure_args_raw in - *$as_nl*) - ac_safe_unquote= ;; - *) - ac_unsafe_z='|&;<>()$`\\"*?[ '' ' # This string ends in space, tab. - ac_unsafe_a="$ac_unsafe_z#~" - ac_safe_unquote="s/ '\\([^$ac_unsafe_a][^$ac_unsafe_z]*\\)'/ \\1/g" - ac_configure_args_raw=` printf "%s\n" "$ac_configure_args_raw" | sed "$ac_safe_unquote"`;; -esac - -cat >config.log <<_ACEOF +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 tcl $as_me 8.7, which was -generated by GNU Autoconf 2.72. Invocation command line was +It was created by $as_me, which was +generated by GNU Autoconf 2.59. Invocation command line was - $ $0$ac_configure_args_raw + $ $0 $@ _ACEOF -exec 5>>config.log { cat <<_ASUNAME ## --------- ## @@ -1757,7 +997,7 @@ uname -v = `(uname -v) 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` -/usr/bin/hostinfo = `(/usr/bin/hostinfo) 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` @@ -1768,14 +1008,9 @@ as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS - case $as_dir in #((( - '') as_dir=./ ;; - */) ;; - *) as_dir=$as_dir/ ;; - esac - printf "%s\n" "PATH: $as_dir" - done -IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + echo "PATH: $as_dir" +done } >&5 @@ -1797,6 +1032,7 @@ _ACEOF ac_configure_args= ac_configure_args0= ac_configure_args1= +ac_sep= ac_must_keep_next=false for ac_pass in 1 2 do @@ -1807,13 +1043,13 @@ do -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil) continue ;; - *\'*) - ac_arg=`printf "%s\n" "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;; + *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?\"\']*) + ac_arg=`echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;; esac case $ac_pass in - 1) as_fn_append ac_configure_args0 " '$ac_arg'" ;; + 1) ac_configure_args0="$ac_configure_args0 '$ac_arg'" ;; 2) - as_fn_append ac_configure_args1 " '$ac_arg'" + 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 @@ -1829,575 +1065,217 @@ do -* ) ac_must_keep_next=true ;; esac fi - as_fn_append ac_configure_args " '$ac_arg'" + ac_configure_args="$ac_configure_args$ac_sep'$ac_arg'" + # Get rid of the leading space. + ac_sep=" " ;; esac done done -{ ac_configure_args0=; unset ac_configure_args0;} -{ ac_configure_args1=; unset ac_configure_args1;} +$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: Use '\'' to represent an apostrophe within the trap. -# WARNING: Do not start the trap code with a newline, due to a FreeBSD 4.0 bug. +# 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=$? - # Sanitize IFS. - IFS=" "" $as_nl" # Save into config.log some information that might help in debugging. { echo - printf "%s\n" "## ---------------- ## + cat <<\_ASBOX +## ---------------- ## ## Cache variables. ## -## ---------------- ##" +## ---------------- ## +_ASBOX echo # The following way of writing the cache mishandles newlines in values, -( - for ac_var in `(set) 2>&1 | sed -n '\''s/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'\''`; do - eval ac_val=\$$ac_var - case $ac_val in #( - *${as_nl}*) - case $ac_var in #( - *_cv_*) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5 -printf "%s\n" "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;; - esac - case $ac_var in #( - _ | IFS | as_nl) ;; #( - BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #( - *) { eval $ac_var=; unset $ac_var;} ;; - esac ;; - esac - done +{ (set) 2>&1 | - case $as_nl`(ac_space='\'' '\''; set) 2>&1` in #( - *${as_nl}ac_space=\ *) + 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" - ;; #( + "s/'"'"'/'"'"'\\\\'"'"''"'"'/g; + s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='"'"'\\2'"'"'/p" + ;; *) - sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" + sed -n \ + "s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1=\\2/p" ;; - esac | - sort -) + esac; +} echo - printf "%s\n" "## ----------------- ## + cat <<\_ASBOX +## ----------------- ## ## Output variables. ## -## ----------------- ##" +## ----------------- ## +_ASBOX echo for ac_var in $ac_subst_vars do - eval ac_val=\$$ac_var - case $ac_val in - *\'\''*) ac_val=`printf "%s\n" "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; - esac - printf "%s\n" "$ac_var='\''$ac_val'\''" + eval ac_val=$`echo $ac_var` + echo "$ac_var='"'"'$ac_val'"'"'" done | sort echo if test -n "$ac_subst_files"; then - printf "%s\n" "## ------------------- ## -## File substitutions. ## -## ------------------- ##" + cat <<\_ASBOX +## ------------- ## +## Output files. ## +## ------------- ## +_ASBOX echo for ac_var in $ac_subst_files do - eval ac_val=\$$ac_var - case $ac_val in - *\'\''*) ac_val=`printf "%s\n" "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; - esac - printf "%s\n" "$ac_var='\''$ac_val'\''" + eval ac_val=$`echo $ac_var` + echo "$ac_var='"'"'$ac_val'"'"'" done | sort echo fi if test -s confdefs.h; then - printf "%s\n" "## ----------- ## + cat <<\_ASBOX +## ----------- ## ## confdefs.h. ## -## ----------- ##" +## ----------- ## +_ASBOX echo - cat confdefs.h + sed "/^$/d" confdefs.h | sort echo fi test "$ac_signal" != 0 && - printf "%s\n" "$as_me: caught signal $ac_signal" - printf "%s\n" "$as_me: exit $exit_status" + echo "$as_me: caught signal $ac_signal" + echo "$as_me: exit $exit_status" } >&5 - rm -f core *.core core.conftest.* && - rm -f -r conftest* confdefs* conf$$* $ac_clean_files && + rm -f core *.core && + rm -rf conftest* confdefs* conf$$* $ac_clean_files && exit $exit_status -' 0 + ' 0 for ac_signal in 1 2 13 15; do - trap 'ac_signal='$ac_signal'; as_fn_exit 1' $ac_signal + 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 -f -r conftest* confdefs.h - -printf "%s\n" "/* confdefs.h */" > confdefs.h +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. -printf "%s\n" "#define PACKAGE_NAME \"$PACKAGE_NAME\"" >>confdefs.h +cat >>confdefs.h <<_ACEOF +#define PACKAGE_NAME "$PACKAGE_NAME" +_ACEOF + + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_TARNAME "$PACKAGE_TARNAME" +_ACEOF + -printf "%s\n" "#define PACKAGE_TARNAME \"$PACKAGE_TARNAME\"" >>confdefs.h +cat >>confdefs.h <<_ACEOF +#define PACKAGE_VERSION "$PACKAGE_VERSION" +_ACEOF -printf "%s\n" "#define PACKAGE_VERSION \"$PACKAGE_VERSION\"" >>confdefs.h -printf "%s\n" "#define PACKAGE_STRING \"$PACKAGE_STRING\"" >>confdefs.h +cat >>confdefs.h <<_ACEOF +#define PACKAGE_STRING "$PACKAGE_STRING" +_ACEOF -printf "%s\n" "#define PACKAGE_BUGREPORT \"$PACKAGE_BUGREPORT\"" >>confdefs.h -printf "%s\n" "#define PACKAGE_URL \"$PACKAGE_URL\"" >>confdefs.h +cat >>confdefs.h <<_ACEOF +#define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT" +_ACEOF # Let the site file select an alternate cache file if it wants to. -# Prefer an explicitly selected file to automatically selected ones. -if test -n "$CONFIG_SITE"; then - ac_site_files="$CONFIG_SITE" -elif test "x$prefix" != xNONE; then - ac_site_files="$prefix/share/config.site $prefix/etc/config.site" -else - ac_site_files="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site" +# 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 $ac_site_files -do - case $ac_site_file in #( - */*) : - ;; #( - *) : - ac_site_file=./$ac_site_file ;; -esac - if test -f "$ac_site_file" && test -r "$ac_site_file"; then - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: loading site script $ac_site_file" >&5 -printf "%s\n" "$as_me: loading site script $ac_site_file" >&6;} +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" \ - || { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in '$ac_pwd':" >&5 -printf "%s\n" "$as_me: error: in '$ac_pwd':" >&2;} -as_fn_error $? "failed to load site script $ac_site_file -See 'config.log' for more details" "$LINENO" 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. DJGPP emulates it as a regular file. - if test /dev/null != "$cache_file" && test -f "$cache_file"; then - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: loading cache $cache_file" >&5 -printf "%s\n" "$as_me: loading cache $cache_file" >&6;} + # 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";; + [\\/]* | ?:[\\/]* ) . $cache_file;; + *) . ./$cache_file;; esac fi else - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: creating cache $cache_file" >&5 -printf "%s\n" "$as_me: creating cache $cache_file" >&6;} + { echo "$as_me:$LINENO: creating cache $cache_file" >&5 +echo "$as_me: creating cache $cache_file" >&6;} >$cache_file fi -# Test code for whether the C compiler supports C89 (global declarations) -ac_c_conftest_c89_globals=' -/* Does the compiler advertise C89 conformance? - Do not test the value of __STDC__, because some compilers set it to 0 - while being otherwise adequately conformant. */ -#if !defined __STDC__ -# error "Compiler does not advertise C89 conformance" -#endif - -#include <stddef.h> -#include <stdarg.h> -struct stat; -/* Most of the following tests are stolen from RCS 5.7 src/conf.sh. */ -struct buf { int x; }; -struct buf * (*rcsopen) (struct buf *, struct stat *, int); -static char *e (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; -} - -/* C89 style stringification. */ -#define noexpand_stringify(a) #a -const char *stringified = noexpand_stringify(arbitrary+token=sequence); - -/* C89 style token pasting. Exercises some of the corner cases that - e.g. old MSVC gets wrong, but not very hard. */ -#define noexpand_concat(a,b) a##b -#define expand_concat(a,b) noexpand_concat(a,b) -extern int vA; -extern int vbee; -#define aye A -#define bee B -int *pvA = &expand_concat(v,aye); -int *pvbee = &noexpand_concat(v,bee); - -/* 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 do not provoke an error unfortunately, instead are silently treated - as an "x". The following induces an error, until -std is added to get - proper ANSI mode. Curiously \x00 != x always comes out true, for an - array size at least. It is necessary to write \x00 == 0 to get something - that is true only with -std. */ -int osf4_cc_array ['\''\x00'\'' == 0 ? 1 : -1]; - -/* IBM C 6 for AIX is almost-ANSI by default, but it replaces macro parameters - inside strings and character constants. */ -#define FOO(x) '\''x'\'' -int xlc6_cc_array[FOO(a) == '\''x'\'' ? 1 : -1]; - -int test (int i, double x); -struct s1 {int (*f) (int a);}; -struct s2 {int (*f) (double a);}; -int pairnames (int, char **, int *(*)(struct buf *, struct stat *, int), - int, int);' - -# Test code for whether the C compiler supports C89 (body of main). -ac_c_conftest_c89_main=' -ok |= (argc == 0 || f (e, argv, 0) != argv[0] || f (e, argv, 1) != argv[1]); -' - -# Test code for whether the C compiler supports C99 (global declarations) -ac_c_conftest_c99_globals=' -/* Does the compiler advertise C99 conformance? */ -#if !defined __STDC_VERSION__ || __STDC_VERSION__ < 199901L -# error "Compiler does not advertise C99 conformance" -#endif - -// See if C++-style comments work. - -#include <stdbool.h> -extern int puts (const char *); -extern int printf (const char *, ...); -extern int dprintf (int, const char *, ...); -extern void *malloc (size_t); -extern void free (void *); - -// Check varargs macros. These examples are taken from C99 6.10.3.5. -// dprintf is used instead of fprintf to avoid needing to declare -// FILE and stderr. -#define debug(...) dprintf (2, __VA_ARGS__) -#define showlist(...) puts (#__VA_ARGS__) -#define report(test,...) ((test) ? puts (#test) : printf (__VA_ARGS__)) -static void -test_varargs_macros (void) -{ - int x = 1234; - int y = 5678; - debug ("Flag"); - debug ("X = %d\n", x); - showlist (The first, second, and third items.); - report (x>y, "x is %d but y is %d", x, y); -} - -// Check long long types. -#define BIG64 18446744073709551615ull -#define BIG32 4294967295ul -#define BIG_OK (BIG64 / BIG32 == 4294967297ull && BIG64 % BIG32 == 0) -#if !BIG_OK - #error "your preprocessor is broken" -#endif -#if BIG_OK -#else - #error "your preprocessor is broken" -#endif -static long long int bignum = -9223372036854775807LL; -static unsigned long long int ubignum = BIG64; - -struct incomplete_array -{ - int datasize; - double data[]; -}; - -struct named_init { - int number; - const wchar_t *name; - double average; -}; - -typedef const char *ccp; - -static inline int -test_restrict (ccp restrict text) -{ - // Iterate through items via the restricted pointer. - // Also check for declarations in for loops. - for (unsigned int i = 0; *(text+i) != '\''\0'\''; ++i) - continue; - return 0; -} - -// Check varargs and va_copy. -static bool -test_varargs (const char *format, ...) -{ - va_list args; - va_start (args, format); - va_list args_copy; - va_copy (args_copy, args); - - const char *str = ""; - int number = 0; - float fnumber = 0; - - while (*format) - { - switch (*format++) - { - case '\''s'\'': // string - str = va_arg (args_copy, const char *); - break; - case '\''d'\'': // int - number = va_arg (args_copy, int); - break; - case '\''f'\'': // float - fnumber = va_arg (args_copy, double); - break; - default: - break; - } - } - va_end (args_copy); - va_end (args); - - return *str && number && fnumber; -} -' - -# Test code for whether the C compiler supports C99 (body of main). -ac_c_conftest_c99_main=' - // Check bool. - _Bool success = false; - success |= (argc != 0); - - // Check restrict. - if (test_restrict ("String literal") == 0) - success = true; - char *restrict newvar = "Another string"; - - // Check varargs. - success &= test_varargs ("s, d'\'' f .", "string", 65, 34.234); - test_varargs_macros (); - - // Check flexible array members. - struct incomplete_array *ia = - malloc (sizeof (struct incomplete_array) + (sizeof (double) * 10)); - ia->datasize = 10; - for (int i = 0; i < ia->datasize; ++i) - ia->data[i] = i * 1.234; - // Work around memory leak warnings. - free (ia); - - // Check named initializers. - struct named_init ni = { - .number = 34, - .name = L"Test wide string", - .average = 543.34343, - }; - - ni.number = 58; - - int dynamic_array[ni.number]; - dynamic_array[0] = argv[0][0]; - dynamic_array[ni.number - 1] = 543; - - // work around unused variable warnings - ok |= (!success || bignum == 0LL || ubignum == 0uLL || newvar[0] == '\''x'\'' - || dynamic_array[ni.number - 1] != 543); -' - -# Test code for whether the C compiler supports C11 (global declarations) -ac_c_conftest_c11_globals=' -/* Does the compiler advertise C11 conformance? */ -#if !defined __STDC_VERSION__ || __STDC_VERSION__ < 201112L -# error "Compiler does not advertise C11 conformance" -#endif - -// Check _Alignas. -char _Alignas (double) aligned_as_double; -char _Alignas (0) no_special_alignment; -extern char aligned_as_int; -char _Alignas (0) _Alignas (int) aligned_as_int; - -// Check _Alignof. -enum -{ - int_alignment = _Alignof (int), - int_array_alignment = _Alignof (int[100]), - char_alignment = _Alignof (char) -}; -_Static_assert (0 < -_Alignof (int), "_Alignof is signed"); - -// Check _Noreturn. -int _Noreturn does_not_return (void) { for (;;) continue; } - -// Check _Static_assert. -struct test_static_assert -{ - int x; - _Static_assert (sizeof (int) <= sizeof (long int), - "_Static_assert does not work in struct"); - long int y; -}; - -// Check UTF-8 literals. -#define u8 syntax error! -char const utf8_literal[] = u8"happens to be ASCII" "another string"; - -// Check duplicate typedefs. -typedef long *long_ptr; -typedef long int *long_ptr; -typedef long_ptr long_ptr; - -// Anonymous structures and unions -- taken from C11 6.7.2.1 Example 1. -struct anonymous -{ - union { - struct { int i; int j; }; - struct { int k; long int l; } w; - }; - int m; -} v1; -' - -# Test code for whether the C compiler supports C11 (body of main). -ac_c_conftest_c11_main=' - _Static_assert ((offsetof (struct anonymous, i) - == offsetof (struct anonymous, w.k)), - "Anonymous union alignment botch"); - v1.i = 2; - v1.w.k = 5; - ok |= v1.i != 5; -' - -# Test code for whether the C compiler supports C11 (complete). -ac_c_conftest_c11_program="${ac_c_conftest_c89_globals} -${ac_c_conftest_c99_globals} -${ac_c_conftest_c11_globals} - -int -main (int argc, char **argv) -{ - int ok = 0; - ${ac_c_conftest_c89_main} - ${ac_c_conftest_c99_main} - ${ac_c_conftest_c11_main} - return ok; -} -" - -# Test code for whether the C compiler supports C99 (complete). -ac_c_conftest_c99_program="${ac_c_conftest_c89_globals} -${ac_c_conftest_c99_globals} - -int -main (int argc, char **argv) -{ - int ok = 0; - ${ac_c_conftest_c89_main} - ${ac_c_conftest_c99_main} - return ok; -} -" - -# Test code for whether the C compiler supports C89 (complete). -ac_c_conftest_c89_program="${ac_c_conftest_c89_globals} - -int -main (int argc, char **argv) -{ - int ok = 0; - ${ac_c_conftest_c89_main} - return ok; -} -" - -as_fn_append ac_header_c_list " stdio.h stdio_h HAVE_STDIO_H" -as_fn_append ac_header_c_list " stdlib.h stdlib_h HAVE_STDLIB_H" -as_fn_append ac_header_c_list " string.h string_h HAVE_STRING_H" -as_fn_append ac_header_c_list " inttypes.h inttypes_h HAVE_INTTYPES_H" -as_fn_append ac_header_c_list " stdint.h stdint_h HAVE_STDINT_H" -as_fn_append ac_header_c_list " strings.h strings_h HAVE_STRINGS_H" -as_fn_append ac_header_c_list " sys/stat.h sys_stat_h HAVE_SYS_STAT_H" -as_fn_append ac_header_c_list " sys/types.h sys_types_h HAVE_SYS_TYPES_H" -as_fn_append ac_header_c_list " unistd.h unistd_h HAVE_UNISTD_H" # Check that the precious variables saved in the cache have kept the same # value. ac_cache_corrupted=false -for ac_var in $ac_precious_vars; do +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 + 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,) - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: '$ac_var' was set to '$ac_old_val' in the previous run" >&5 -printf "%s\n" "$as_me: error: '$ac_var' was set to '$ac_old_val' in the previous run" >&2;} + { 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) - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: '$ac_var' was not set in the previous run" >&5 -printf "%s\n" "$as_me: error: '$ac_var' was not set in the previous run" >&2;} + { 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 - # differences in whitespace do not lead to failure. - ac_old_val_w=`echo x $ac_old_val` - ac_new_val_w=`echo x $ac_new_val` - if test "$ac_old_val_w" != "$ac_new_val_w"; then - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: '$ac_var' has changed since the previous run:" >&5 -printf "%s\n" "$as_me: error: '$ac_var' has changed since the previous run:" >&2;} - ac_cache_corrupted=: - else - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: warning: ignoring whitespace changes in '$ac_var' since the previous run:" >&5 -printf "%s\n" "$as_me: warning: ignoring whitespace changes in '$ac_var' since the previous run:" >&2;} - eval $ac_var=\$ac_old_val - fi - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: former value: '$ac_old_val'" >&5 -printf "%s\n" "$as_me: former value: '$ac_old_val'" >&2;} - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: current value: '$ac_new_val'" >&5 -printf "%s\n" "$as_me: current value: '$ac_new_val'" >&2;} + { 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=`printf "%s\n" "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;; + *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?\"\']*) + 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. - *) as_fn_append ac_configure_args " '$ac_arg'" ;; + *) ac_configure_args="$ac_configure_args '$ac_arg'" ;; esac fi done if $ac_cache_corrupted; then - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in '$ac_pwd':" >&5 -printf "%s\n" "$as_me: error: in '$ac_pwd':" >&2;} - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: changes in the environment can compromise the build" >&5 -printf "%s\n" "$as_me: error: changes in the environment can compromise the build" >&2;} - as_fn_error $? "run '${MAKE-make} distclean' and/or 'rm $cache_file' - and start over" "$LINENO" 5 + { 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 -## -------------------- ## -## Main body of script. ## -## -------------------- ## ac_ext=c ac_cpp='$CPP $CPPFLAGS' @@ -2409,34 +1287,43 @@ 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.7 +TCL_VERSION=8.5 TCL_MAJOR_VERSION=8 -TCL_MINOR_VERSION=7 -TCL_PATCH_LEVEL="b1" +TCL_MINOR_VERSION=5 +TCL_PATCH_LEVEL=".18" VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION -TCL_DDE_VERSION=1.4 +TCL_DDE_VERSION=1.3 TCL_DDE_MAJOR_VERSION=1 -TCL_DDE_MINOR_VERSION=4 +TCL_DDE_MINOR_VERSION=3 DDEVER=$TCL_DDE_MAJOR_VERSION$TCL_DDE_MINOR_VERSION -TCL_REG_VERSION=1.3 +TCL_REG_VERSION=1.2 TCL_REG_MAJOR_VERSION=1 -TCL_REG_MINOR_VERSION=3 +TCL_REG_MINOR_VERSION=2 REGVER=$TCL_REG_MAJOR_VERSION$TCL_REG_MINOR_VERSION -PKG_CFG_ARGS=$@ - -#------------------------------------------------------------------------ -# Empty slate for bundled packages, to avoid stale configuration -#------------------------------------------------------------------------ -rm -Rf pkgs - #------------------------------------------------------------------------ # Handle the --prefix=... option #------------------------------------------------------------------------ @@ -2460,15 +1347,6 @@ 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' @@ -2477,164 +1355,172 @@ 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 -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -printf %s "checking for $ac_word... " >&6; } -if test ${ac_cv_prog_CC+y} -then : - printf %s "(cached) " >&6 -else case e in #( - e) if test -n "$CC"; then +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 - case $as_dir in #((( - '') as_dir=./ ;; - */) ;; - *) as_dir=$as_dir/ ;; - esac - for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then + 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" - printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 + echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done - done -IFS=$as_save_IFS +done -fi ;; -esac +fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 -printf "%s\n" "$CC" >&6; } + echo "$as_me:$LINENO: result: $CC" >&5 +echo "${ECHO_T}$CC" >&6 else - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 -printf "%s\n" "no" >&6; } + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 fi - fi if test -z "$ac_cv_prog_CC"; then ac_ct_CC=$CC # Extract the first word of "gcc", so it can be a program name with args. set dummy gcc; ac_word=$2 -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -printf %s "checking for $ac_word... " >&6; } -if test ${ac_cv_prog_ac_ct_CC+y} -then : - printf %s "(cached) " >&6 -else case e in #( - e) if test -n "$ac_ct_CC"; then +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 - case $as_dir in #((( - '') as_dir=./ ;; - */) ;; - *) as_dir=$as_dir/ ;; - esac - for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then + 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" - printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 + echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done - done -IFS=$as_save_IFS +done -fi ;; -esac +fi fi ac_ct_CC=$ac_cv_prog_ac_ct_CC if test -n "$ac_ct_CC"; then - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5 -printf "%s\n" "$ac_ct_CC" >&6; } + echo "$as_me:$LINENO: result: $ac_ct_CC" >&5 +echo "${ECHO_T}$ac_ct_CC" >&6 else - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 -printf "%s\n" "no" >&6; } + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 fi - if test "x$ac_ct_CC" = x; then - CC="" - else - case $cross_compiling:$ac_tool_warned in -yes:) -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 -printf "%s\n" "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} -ac_tool_warned=yes ;; -esac - CC=$ac_ct_CC - 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. + 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 -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -printf %s "checking for $ac_word... " >&6; } -if test ${ac_cv_prog_CC+y} -then : - printf %s "(cached) " >&6 -else case e in #( - e) if test -n "$CC"; then +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 - case $as_dir in #((( - '') as_dir=./ ;; - */) ;; - *) as_dir=$as_dir/ ;; - esac - for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then + 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" - printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 + echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done - done -IFS=$as_save_IFS +done -fi ;; -esac +fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 -printf "%s\n" "$CC" >&6; } + echo "$as_me:$LINENO: result: $CC" >&5 +echo "${ECHO_T}$CC" >&6 else - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 -printf "%s\n" "no" >&6; } + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 fi - +fi +if test -z "$ac_cv_prog_CC"; then + ac_ct_CC=$CC + # Extract the first word of "cc", so it can be a program name with args. +set dummy cc; ac_word=$2 +echo "$as_me:$LINENO: checking for $ac_word" >&5 +echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 +if test "${ac_cv_prog_ac_ct_CC+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + if test -n "$ac_ct_CC"; then + ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_CC="cc" + echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 fi +done +done + +fi +fi +ac_ct_CC=$ac_cv_prog_ac_ct_CC +if test -n "$ac_ct_CC"; then + echo "$as_me:$LINENO: result: $ac_ct_CC" >&5 +echo "${ECHO_T}$ac_ct_CC" >&6 +else + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 +fi + + CC=$ac_ct_CC +else + CC="$ac_cv_prog_CC" +fi + fi if test -z "$CC"; then # Extract the first word of "cc", so it can be a program name with args. set dummy cc; ac_word=$2 -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -printf %s "checking for $ac_word... " >&6; } -if test ${ac_cv_prog_CC+y} -then : - printf %s "(cached) " >&6 -else case e in #( - e) if test -n "$CC"; then +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 @@ -2642,24 +1528,19 @@ as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS - case $as_dir in #((( - '') as_dir=./ ;; - */) ;; - *) as_dir=$as_dir/ ;; - esac - for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then - if test "$as_dir$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then + 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" - printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 + echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done - done -IFS=$as_save_IFS +done if test $ac_prog_rejected = yes; then # We found a bogon in the path, so make sure we never use it. @@ -2670,280 +1551,146 @@ if test $ac_prog_rejected = yes; then # 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+' '}$@" + ac_cv_prog_CC="$as_dir/$ac_word${1+' '}$@" fi fi -fi ;; -esac +fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 -printf "%s\n" "$CC" >&6; } + echo "$as_me:$LINENO: result: $CC" >&5 +echo "${ECHO_T}$CC" >&6 else - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 -printf "%s\n" "no" >&6; } + 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.exe + 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 -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -printf %s "checking for $ac_word... " >&6; } -if test ${ac_cv_prog_CC+y} -then : - printf %s "(cached) " >&6 -else case e in #( - e) if test -n "$CC"; then +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 - case $as_dir in #((( - '') as_dir=./ ;; - */) ;; - *) as_dir=$as_dir/ ;; - esac - for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then + 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" - printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 + echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done - done -IFS=$as_save_IFS +done -fi ;; -esac +fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 -printf "%s\n" "$CC" >&6; } + echo "$as_me:$LINENO: result: $CC" >&5 +echo "${ECHO_T}$CC" >&6 else - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 -printf "%s\n" "no" >&6; } + 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.exe + 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 -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -printf %s "checking for $ac_word... " >&6; } -if test ${ac_cv_prog_ac_ct_CC+y} -then : - printf %s "(cached) " >&6 -else case e in #( - e) if test -n "$ac_ct_CC"; then +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 - case $as_dir in #((( - '') as_dir=./ ;; - */) ;; - *) as_dir=$as_dir/ ;; - esac - for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then + 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" - printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 + echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done - done -IFS=$as_save_IFS +done -fi ;; -esac +fi fi ac_ct_CC=$ac_cv_prog_ac_ct_CC if test -n "$ac_ct_CC"; then - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5 -printf "%s\n" "$ac_ct_CC" >&6; } + echo "$as_me:$LINENO: result: $ac_ct_CC" >&5 +echo "${ECHO_T}$ac_ct_CC" >&6 else - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 -printf "%s\n" "no" >&6; } + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 fi - test -n "$ac_ct_CC" && break done - if test "x$ac_ct_CC" = x; then - CC="" - else - case $cross_compiling:$ac_tool_warned in -yes:) -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 -printf "%s\n" "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} -ac_tool_warned=yes ;; -esac - CC=$ac_ct_CC - fi -fi - -fi -if test -z "$CC"; then - if test -n "$ac_tool_prefix"; then - # Extract the first word of "${ac_tool_prefix}clang", so it can be a program name with args. -set dummy ${ac_tool_prefix}clang; ac_word=$2 -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -printf %s "checking for $ac_word... " >&6; } -if test ${ac_cv_prog_CC+y} -then : - printf %s "(cached) " >&6 -else case e in #( - e) 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 - case $as_dir in #((( - '') as_dir=./ ;; - */) ;; - *) as_dir=$as_dir/ ;; - esac - for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then - ac_cv_prog_CC="${ac_tool_prefix}clang" - printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 - break 2 - fi -done - done -IFS=$as_save_IFS - -fi ;; -esac -fi -CC=$ac_cv_prog_CC -if test -n "$CC"; then - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 -printf "%s\n" "$CC" >&6; } -else - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 -printf "%s\n" "no" >&6; } -fi - - -fi -if test -z "$ac_cv_prog_CC"; then - ac_ct_CC=$CC - # Extract the first word of "clang", so it can be a program name with args. -set dummy clang; ac_word=$2 -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -printf %s "checking for $ac_word... " >&6; } -if test ${ac_cv_prog_ac_ct_CC+y} -then : - printf %s "(cached) " >&6 -else case e in #( - e) 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 - case $as_dir in #((( - '') as_dir=./ ;; - */) ;; - *) as_dir=$as_dir/ ;; - esac - for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then - ac_cv_prog_ac_ct_CC="clang" - printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 - break 2 - fi -done - done -IFS=$as_save_IFS - -fi ;; -esac -fi -ac_ct_CC=$ac_cv_prog_ac_ct_CC -if test -n "$ac_ct_CC"; then - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5 -printf "%s\n" "$ac_ct_CC" >&6; } -else - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 -printf "%s\n" "no" >&6; } -fi - - if test "x$ac_ct_CC" = x; then - CC="" - else - case $cross_compiling:$ac_tool_warned in -yes:) -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 -printf "%s\n" "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} -ac_tool_warned=yes ;; -esac - CC=$ac_ct_CC - fi -else - CC="$ac_cv_prog_CC" + CC=$ac_ct_CC fi fi -test -z "$CC" && { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in '$ac_pwd':" >&5 -printf "%s\n" "$as_me: error: in '$ac_pwd':" >&2;} -as_fn_error $? "no acceptable C compiler found in \$PATH -See 'config.log' for more details" "$LINENO" 5; } +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. -printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for C compiler version" >&5 -set X $ac_compile -ac_compiler=$2 -for ac_option in --version -v -V -qversion -version; do - { { ac_try="$ac_compiler $ac_option >&5" -case "(($ac_try" in - *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; - *) ac_try_echo=$ac_try;; -esac -eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" -printf "%s\n" "$ac_try_echo"; } >&5 - (eval "$ac_compiler $ac_option >&5") 2>conftest.err +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=$? - if test -s conftest.err; then - sed '10a\ -... rest of stderr output deleted ... - 10q' conftest.err >conftest.er1 - cat conftest.er1 >&5 - fi - rm -f conftest.er1 conftest.err - printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; } -done + 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 confdefs.h - <<_ACEOF >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. */ int -main (void) +main () { ; @@ -2951,213 +1698,155 @@ main (void) } _ACEOF ac_clean_files_save=$ac_clean_files -ac_clean_files="$ac_clean_files a.out a.out.dSYM a.exe b.out" +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. -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether the C compiler works" >&5 -printf %s "checking whether the C compiler works... " >&6; } -ac_link_default=`printf "%s\n" "$ac_link" | sed 's/ -o *conftest[^ ]*//'` - -# The possible output files: -ac_files="a.out conftest.exe conftest a.exe a_out.exe b.out conftest.*" - -ac_rmfiles= -for ac_file in $ac_files -do - case $ac_file in - *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;; - * ) ac_rmfiles="$ac_rmfiles $ac_file";; - esac -done -rm -f $ac_rmfiles - -if { { ac_try="$ac_link_default" -case "(($ac_try" in - *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; - *) ac_try_echo=$ac_try;; -esac -eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" -printf "%s\n" "$ac_try_echo"; } >&5 - (eval "$ac_link_default") 2>&5 +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=$? - printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; } -then : - # Autoconf-2.13 could set the ac_cv_exeext variable to 'no'. -# So ignore a value of 'no', otherwise this would lead to 'EXEEXT = no' -# in a Makefile. We should not override ac_cv_exeext if it was cached, -# so that the user can short-circuit this test for compilers unknown to -# Autoconf. -for ac_file in $ac_files '' + 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 | *.map | *.inf | *.dSYM | *.o | *.obj ) + *.$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;; *.* ) - if test ${ac_cv_exeext+y} && test "$ac_cv_exeext" != no; - then :; else - ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` - fi - # We set ac_cv_exeext here because the later test for it is not - # safe: cross compilers may not add the suffix if given an '-o' - # argument, so we may need to know it at that point already. - # Even if this section looks crufty: it has the advantage of - # actually working. + 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 -test "$ac_cv_exeext" = no && ac_cv_exeext= - -else case e in #( - e) ac_file='' ;; -esac -fi -if test -z "$ac_file" -then : - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 -printf "%s\n" "no" >&6; } -printf "%s\n" "$as_me: failed program was:" >&5 +else + echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 -{ { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in '$ac_pwd':" >&5 -printf "%s\n" "$as_me: error: in '$ac_pwd':" >&2;} -as_fn_error 77 "C compiler cannot create executables -See 'config.log' for more details" "$LINENO" 5; } -else case e in #( - e) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 -printf "%s\n" "yes" >&6; } ;; -esac +{ { 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 -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for C compiler default output file name" >&5 -printf %s "checking for C compiler default output file name... " >&6; } -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_file" >&5 -printf "%s\n" "$ac_file" >&6; } + 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 -r a.out a.out.dSYM a.exe conftest$ac_cv_exeext b.out +rm -f a.out a.exe conftest$ac_cv_exeext b.out ac_clean_files=$ac_clean_files_save -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for suffix of executables" >&5 -printf %s "checking for suffix of executables... " >&6; } -if { { ac_try="$ac_link" -case "(($ac_try" in - *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; - *) ac_try_echo=$ac_try;; -esac -eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" -printf "%s\n" "$ac_try_echo"; } >&5 - (eval "$ac_link") 2>&5 +# 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=$? - printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; } -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'. + 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 | *.map | *.inf | *.dSYM | *.o | *.obj ) ;; + *.$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 case e in #( - e) { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in '$ac_pwd':" >&5 -printf "%s\n" "$as_me: error: in '$ac_pwd':" >&2;} -as_fn_error $? "cannot compute suffix of executables: cannot compile and link -See 'config.log' for more details" "$LINENO" 5; } ;; -esac +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 conftest$ac_cv_exeext -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_exeext" >&5 -printf "%s\n" "$ac_cv_exeext" >&6; } + +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 -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include <stdio.h> -int -main (void) -{ -FILE *f = fopen ("conftest.out", "w"); - if (!f) - return 1; - return ferror (f) || fclose (f) != 0; - - ; - return 0; -} +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 -ac_clean_files="$ac_clean_files conftest.out" -# Check that the compiler produces executables we can run. If not, either -# the compiler is broken, or we cross compile. -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether we are cross compiling" >&5 -printf %s "checking whether we are cross compiling... " >&6; } -if test "$cross_compiling" != yes; then - { { ac_try="$ac_link" -case "(($ac_try" in - *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; - *) ac_try_echo=$ac_try;; -esac -eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" -printf "%s\n" "$ac_try_echo"; } >&5 - (eval "$ac_link") 2>&5 - ac_status=$? - printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; } - if { ac_try='./conftest$ac_cv_exeext' - { { case "(($ac_try" in - *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; - *) ac_try_echo=$ac_try;; -esac -eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" -printf "%s\n" "$ac_try_echo"; } >&5 - (eval "$ac_try") 2>&5 - ac_status=$? - printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; }; }; then - cross_compiling=no - else - if test "$cross_compiling" = maybe; then - cross_compiling=yes - else - { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in '$ac_pwd':" >&5 -printf "%s\n" "$as_me: error: in '$ac_pwd':" >&2;} -as_fn_error 77 "cannot run C compiled programs. -If you meant to cross compile, use '--host'. -See 'config.log' for more details" "$LINENO" 5; } - fi - fi -fi -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $cross_compiling" >&5 -printf "%s\n" "$cross_compiling" >&6; } - -rm -f conftest.$ac_ext conftest$ac_cv_exeext \ - conftest.o conftest.obj conftest.out -ac_clean_files=$ac_clean_files_save -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for suffix of object files" >&5 -printf %s "checking for suffix of object files... " >&6; } -if test ${ac_cv_objext+y} -then : - printf %s "(cached) " >&6 -else case e in #( - e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int -main (void) +main () { ; @@ -3165,54 +1854,49 @@ main (void) } _ACEOF rm -f conftest.o conftest.obj -if { { ac_try="$ac_compile" -case "(($ac_try" in - *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; - *) ac_try_echo=$ac_try;; -esac -eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" -printf "%s\n" "$ac_try_echo"; } >&5 - (eval "$ac_compile") 2>&5 +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>&5 ac_status=$? - printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; } -then : - for ac_file in conftest.o conftest.obj conftest.*; do - test -f "$ac_file" || continue; + 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 | *.map | *.inf | *.dSYM ) ;; + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg ) ;; *) ac_cv_objext=`expr "$ac_file" : '.*\.\(.*\)'` break;; esac done -else case e in #( - e) printf "%s\n" "$as_me: failed program was:" >&5 +else + echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 -{ { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in '$ac_pwd':" >&5 -printf "%s\n" "$as_me: error: in '$ac_pwd':" >&2;} -as_fn_error $? "cannot compute suffix of object files: cannot compile -See 'config.log' for more details" "$LINENO" 5; } ;; -esac +{ { 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 ;; -esac + +rm -f conftest.$ac_cv_objext conftest.$ac_ext fi -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_objext" >&5 -printf "%s\n" "$ac_cv_objext" >&6; } +echo "$as_me:$LINENO: result: $ac_cv_objext" >&5 +echo "${ECHO_T}$ac_cv_objext" >&6 OBJEXT=$ac_cv_objext ac_objext=$OBJEXT -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether the compiler supports GNU C" >&5 -printf %s "checking whether the compiler supports GNU C... " >&6; } -if test ${ac_cv_c_compiler_gnu+y} -then : - printf %s "(cached) " >&6 -else case e in #( - e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext +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 (void) +main () { #ifndef __GNUC__ choke me @@ -3222,100 +1906,99 @@ main (void) return 0; } _ACEOF -if ac_fn_c_try_compile "$LINENO" -then : +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 case e in #( - e) ac_compiler_gnu=no ;; -esac +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_compiler_gnu=no fi -rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext ac_cv_c_compiler_gnu=$ac_compiler_gnu - ;; -esac -fi -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_compiler_gnu" >&5 -printf "%s\n" "$ac_cv_c_compiler_gnu" >&6; } -ac_compiler_gnu=$ac_cv_c_compiler_gnu -if test $ac_compiler_gnu = yes; then - GCC=yes -else - GCC= fi -ac_test_CFLAGS=${CFLAGS+y} +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 -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether $CC accepts -g" >&5 -printf %s "checking whether $CC accepts -g... " >&6; } -if test ${ac_cv_prog_cc_g+y} -then : - printf %s "(cached) " >&6 -else case e in #( - e) ac_save_c_werror_flag=$ac_c_werror_flag - ac_c_werror_flag=yes - ac_cv_prog_cc_g=no - CFLAGS="-g" - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -int -main (void) -{ - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO" -then : - ac_cv_prog_cc_g=yes -else case e in #( - e) CFLAGS="" - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -int -main (void) -{ - - ; - return 0; -} +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 -if ac_fn_c_try_compile "$LINENO" -then : - -else case e in #( - e) ac_c_werror_flag=$ac_save_c_werror_flag - CFLAGS="-g" - cat confdefs.h - <<_ACEOF >conftest.$ac_ext +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int -main (void) +main () { ; return 0; } _ACEOF -if ac_fn_c_try_compile "$LINENO" -then : +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 core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ;; -esac -fi -rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ;; -esac -fi -rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext - ac_c_werror_flag=$ac_save_c_werror_flag ;; -esac +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_g" >&5 -printf "%s\n" "$ac_cv_prog_cc_g" >&6; } -if test $ac_test_CFLAGS; then +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 @@ -3330,155 +2013,264 @@ else CFLAGS= fi fi -ac_prog_cc_stdc=no -if test x$ac_prog_cc_stdc = xno -then : - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $CC option to enable C11 features" >&5 -printf %s "checking for $CC option to enable C11 features... " >&6; } -if test ${ac_cv_prog_cc_c11+y} -then : - printf %s "(cached) " >&6 -else case e in #( - e) ac_cv_prog_cc_c11=no +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 confdefs.h - <<_ACEOF >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_c_conftest_c11_program +#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 -for ac_arg in '' -std=gnu11 +# 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" - if ac_fn_c_try_compile "$LINENO" -then : - ac_cv_prog_cc_c11=$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 core conftest.err conftest.$ac_objext conftest.beam - test "x$ac_cv_prog_cc_c11" != "xno" && break +rm -f conftest.err conftest.$ac_objext done -rm -f conftest.$ac_ext -CC=$ac_save_CC ;; -esac -fi +rm -f conftest.$ac_ext conftest.$ac_objext +CC=$ac_save_CC -if test "x$ac_cv_prog_cc_c11" = xno -then : - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 -printf "%s\n" "unsupported" >&6; } -else case e in #( - e) if test "x$ac_cv_prog_cc_c11" = x -then : - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 -printf "%s\n" "none needed" >&6; } -else case e in #( - e) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c11" >&5 -printf "%s\n" "$ac_cv_prog_cc_c11" >&6; } - CC="$CC $ac_cv_prog_cc_c11" ;; -esac fi - ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c11 - ac_prog_cc_stdc=c11 ;; + +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 -fi -fi -if test x$ac_prog_cc_stdc = xno -then : - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $CC option to enable C99 features" >&5 -printf %s "checking for $CC option to enable C99 features... " >&6; } -if test ${ac_cv_prog_cc_c99+y} -then : - printf %s "(cached) " >&6 -else case e in #( - e) ac_cv_prog_cc_c99=no -ac_save_CC=$CC -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -$ac_c_conftest_c99_program + +# 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 -for ac_arg in '' -std=gnu99 -std=c99 -c99 -qlanglvl=extc1x -qlanglvl=extc99 -AC99 -D_STDC_C99= +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 - CC="$ac_save_CC $ac_arg" - if ac_fn_c_try_compile "$LINENO" -then : - ac_cv_prog_cc_c99=$ac_arg -fi -rm -f core conftest.err conftest.$ac_objext conftest.beam - test "x$ac_cv_prog_cc_c99" != "xno" && break -done -rm -f conftest.$ac_ext -CC=$ac_save_CC ;; -esac -fi + 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 -if test "x$ac_cv_prog_cc_c99" = xno -then : - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 -printf "%s\n" "unsupported" >&6; } -else case e in #( - e) if test "x$ac_cv_prog_cc_c99" = x -then : - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 -printf "%s\n" "none needed" >&6; } -else case e in #( - e) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c99" >&5 -printf "%s\n" "$ac_cv_prog_cc_c99" >&6; } - CC="$CC $ac_cv_prog_cc_c99" ;; -esac -fi - ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c99 - ac_prog_cc_stdc=c99 ;; -esac -fi +continue fi -if test x$ac_prog_cc_stdc = xno -then : - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $CC option to enable C89 features" >&5 -printf %s "checking for $CC option to enable C89 features... " >&6; } -if test ${ac_cv_prog_cc_c89+y} -then : - printf %s "(cached) " >&6 -else case e in #( - e) ac_cv_prog_cc_c89=no -ac_save_CC=$CC -cat confdefs.h - <<_ACEOF >conftest.$ac_ext +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_c_conftest_c89_program +$ac_declaration +int +main () +{ +exit (42); + ; + return 0; +} _ACEOF -for ac_arg in '' -qlanglvl=extc89 -qlanglvl=ansi -std -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__" -do - CC="$ac_save_CC $ac_arg" - if ac_fn_c_try_compile "$LINENO" -then : - ac_cv_prog_cc_c89=$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 + break +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + fi -rm -f core conftest.err conftest.$ac_objext conftest.beam - test "x$ac_cv_prog_cc_c89" != "xno" && break +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext done -rm -f conftest.$ac_ext -CC=$ac_save_CC ;; -esac +rm -f conftest* +if test -n "$ac_declaration"; then + echo '#ifdef __cplusplus' >>confdefs.h + echo $ac_declaration >>confdefs.h + echo '#endif' >>confdefs.h fi -if test "x$ac_cv_prog_cc_c89" = xno -then : - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 -printf "%s\n" "unsupported" >&6; } -else case e in #( - e) if test "x$ac_cv_prog_cc_c89" = x -then : - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 -printf "%s\n" "none needed" >&6; } -else case e in #( - e) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c89" >&5 -printf "%s\n" "$ac_cv_prog_cc_c89" >&6; } - CC="$CC $ac_cv_prog_cc_c89" ;; -esac -fi - ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c89 - ac_prog_cc_stdc=c89 ;; -esac -fi -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' @@ -3486,35 +2278,61 @@ ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $ ac_compiler_gnu=$ac_cv_c_compiler_gnu -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for inline" >&5 -printf %s "checking for inline... " >&6; } -if test ${ac_cv_c_inline+y} -then : - printf %s "(cached) " >&6 -else case e in #( - e) ac_cv_c_inline=no +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 confdefs.h - <<_ACEOF >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. */ #ifndef __cplusplus typedef int foo_t; -static $ac_kw foo_t static_foo (void) {return 0; } -$ac_kw foo_t foo (void) {return 0; } +static $ac_kw foo_t static_foo () {return 0; } +$ac_kw foo_t foo () {return 0; } #endif _ACEOF -if ac_fn_c_try_compile "$LINENO" -then : - ac_cv_c_inline=$ac_kw +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 core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext - test "$ac_cv_c_inline" != no && break +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext done - ;; -esac + fi -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_inline" >&5 -printf "%s\n" "$ac_cv_c_inline" >&6; } +echo "$as_me:$LINENO: result: $ac_cv_c_inline" >&5 +echo "${ECHO_T}$ac_cv_c_inline" >&6 + case $ac_cv_c_inline in inline | yes) ;; @@ -3531,107 +2349,498 @@ _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 -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -printf %s "checking for $ac_word... " >&6; } -if test ${ac_cv_prog_AR+y} -then : - printf %s "(cached) " >&6 -else case e in #( - e) if test -n "$AR"; then +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 - case $as_dir in #((( - '') as_dir=./ ;; - */) ;; - *) as_dir=$as_dir/ ;; - esac - for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then + 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" - printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 + echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done - done -IFS=$as_save_IFS +done -fi ;; -esac +fi fi AR=$ac_cv_prog_AR if test -n "$AR"; then - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $AR" >&5 -printf "%s\n" "$AR" >&6; } + echo "$as_me:$LINENO: result: $AR" >&5 +echo "${ECHO_T}$AR" >&6 else - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 -printf "%s\n" "no" >&6; } + 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 -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -printf %s "checking for $ac_word... " >&6; } -if test ${ac_cv_prog_ac_ct_AR+y} -then : - printf %s "(cached) " >&6 -else case e in #( - e) if test -n "$ac_ct_AR"; then +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 - case $as_dir in #((( - '') as_dir=./ ;; - */) ;; - *) as_dir=$as_dir/ ;; - esac - for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then + 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" - printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 + echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done - done -IFS=$as_save_IFS +done -fi ;; -esac +fi fi ac_ct_AR=$ac_cv_prog_ac_ct_AR if test -n "$ac_ct_AR"; then - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_ct_AR" >&5 -printf "%s\n" "$ac_ct_AR" >&6; } + echo "$as_me:$LINENO: result: $ac_ct_AR" >&5 +echo "${ECHO_T}$ac_ct_AR" >&6 else - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 -printf "%s\n" "no" >&6; } + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 fi - if test "x$ac_ct_AR" = x; then - AR="" - else - case $cross_compiling:$ac_tool_warned in -yes:) -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 -printf "%s\n" "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} -ac_tool_warned=yes ;; -esac - AR=$ac_ct_AR - fi + AR=$ac_ct_AR else AR="$ac_cv_prog_AR" fi @@ -3639,103 +2848,78 @@ 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 -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -printf %s "checking for $ac_word... " >&6; } -if test ${ac_cv_prog_RANLIB+y} -then : - printf %s "(cached) " >&6 -else case e in #( - e) if test -n "$RANLIB"; then +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 - case $as_dir in #((( - '') as_dir=./ ;; - */) ;; - *) as_dir=$as_dir/ ;; - esac - for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then + 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" - printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 + echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done - done -IFS=$as_save_IFS +done -fi ;; -esac +fi fi RANLIB=$ac_cv_prog_RANLIB if test -n "$RANLIB"; then - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $RANLIB" >&5 -printf "%s\n" "$RANLIB" >&6; } + echo "$as_me:$LINENO: result: $RANLIB" >&5 +echo "${ECHO_T}$RANLIB" >&6 else - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 -printf "%s\n" "no" >&6; } + 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 -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -printf %s "checking for $ac_word... " >&6; } -if test ${ac_cv_prog_ac_ct_RANLIB+y} -then : - printf %s "(cached) " >&6 -else case e in #( - e) if test -n "$ac_ct_RANLIB"; then +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 - case $as_dir in #((( - '') as_dir=./ ;; - */) ;; - *) as_dir=$as_dir/ ;; - esac - for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then + 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" - printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 + echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done - done -IFS=$as_save_IFS +done -fi ;; -esac +fi fi ac_ct_RANLIB=$ac_cv_prog_ac_ct_RANLIB if test -n "$ac_ct_RANLIB"; then - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_ct_RANLIB" >&5 -printf "%s\n" "$ac_ct_RANLIB" >&6; } + echo "$as_me:$LINENO: result: $ac_ct_RANLIB" >&5 +echo "${ECHO_T}$ac_ct_RANLIB" >&6 else - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 -printf "%s\n" "no" >&6; } + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 fi - if test "x$ac_ct_RANLIB" = x; then - RANLIB="" - else - case $cross_compiling:$ac_tool_warned in -yes:) -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 -printf "%s\n" "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} -ac_tool_warned=yes ;; -esac - RANLIB=$ac_ct_RANLIB - fi + RANLIB=$ac_ct_RANLIB else RANLIB="$ac_cv_prog_RANLIB" fi @@ -3743,103 +2927,78 @@ 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 -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -printf %s "checking for $ac_word... " >&6; } -if test ${ac_cv_prog_RC+y} -then : - printf %s "(cached) " >&6 -else case e in #( - e) if test -n "$RC"; then +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 - case $as_dir in #((( - '') as_dir=./ ;; - */) ;; - *) as_dir=$as_dir/ ;; - esac - for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then + 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" - printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 + echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done - done -IFS=$as_save_IFS +done -fi ;; -esac +fi fi RC=$ac_cv_prog_RC if test -n "$RC"; then - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $RC" >&5 -printf "%s\n" "$RC" >&6; } + echo "$as_me:$LINENO: result: $RC" >&5 +echo "${ECHO_T}$RC" >&6 else - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 -printf "%s\n" "no" >&6; } + 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 -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -printf %s "checking for $ac_word... " >&6; } -if test ${ac_cv_prog_ac_ct_RC+y} -then : - printf %s "(cached) " >&6 -else case e in #( - e) if test -n "$ac_ct_RC"; then +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 - case $as_dir in #((( - '') as_dir=./ ;; - */) ;; - *) as_dir=$as_dir/ ;; - esac - for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then + 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" - printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 + echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done - done -IFS=$as_save_IFS +done -fi ;; -esac +fi fi ac_ct_RC=$ac_cv_prog_ac_ct_RC if test -n "$ac_ct_RC"; then - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_ct_RC" >&5 -printf "%s\n" "$ac_ct_RC" >&6; } + echo "$as_me:$LINENO: result: $ac_ct_RC" >&5 +echo "${ECHO_T}$ac_ct_RC" >&6 else - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 -printf "%s\n" "no" >&6; } + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 fi - if test "x$ac_ct_RC" = x; then - RC="" - else - case $cross_compiling:$ac_tool_warned in -yes:) -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 -printf "%s\n" "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} -ac_tool_warned=yes ;; -esac - RC=$ac_ct_RC - fi + RC=$ac_ct_RC else RC="$ac_cv_prog_RC" fi @@ -3849,36 +3008,32 @@ fi # Checks to see if the make program sets the $MAKE variable. #-------------------------------------------------------------------- -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether ${MAKE-make} sets \$(MAKE)" >&5 -printf %s "checking whether ${MAKE-make} sets \$(MAKE)... " >&6; } -set x ${MAKE-make} -ac_make=`printf "%s\n" "$2" | sed 's/+/p/g; s/[^a-zA-Z0-9_]/_/g'` -if eval test \${ac_cv_prog_make_${ac_make}_set+y} -then : - printf %s "(cached) " >&6 -else case e in #( - e) cat >conftest.make <<\_ACEOF -SHELL = /bin/sh +echo "$as_me:$LINENO: checking whether ${MAKE-make} sets \$(MAKE)" >&5 +echo $ECHO_N "checking whether ${MAKE-make} sets \$(MAKE)... $ECHO_C" >&6 +set dummy ${MAKE-make}; ac_make=`echo "$2" | sed 'y,:./+-,___p_,'` +if eval "test \"\${ac_cv_prog_make_${ac_make}_set+set}\" = set"; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + cat >conftest.make <<\_ACEOF all: - @echo '@@@%%%=$(MAKE)=@@@%%%' + @echo 'ac_maketemp="$(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 ;; -esac +# GNU make sometimes prints "make[1]: Entering...", which would confuse us. +eval `${MAKE-make} -f conftest.make 2>/dev/null | grep temp=` +if test -n "$ac_maketemp"; then + eval ac_cv_prog_make_${ac_make}_set=yes +else + eval ac_cv_prog_make_${ac_make}_set=no fi -if eval test \$ac_cv_prog_make_${ac_make}_set = yes; then - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 -printf "%s\n" "yes" >&6; } +rm -f conftest.make +fi +if eval "test \"`echo '$ac_cv_prog_make_'${ac_make}_set`\" = yes"; then + echo "$as_me:$LINENO: result: yes" >&5 +echo "${ECHO_T}yes" >&6 SET_MAKE= else - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 -printf "%s\n" "no" >&6; } + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 SET_MAKE="MAKE=${MAKE-make}" fi @@ -3890,24 +3045,65 @@ fi +#-------------------------------------------------------------------- +# 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=no +fi; + + if test "$tcl_ok" = "yes"; then + echo "$as_me:$LINENO: result: yes" >&5 +echo "${ECHO_T}yes" >&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 (default)" >&5 +echo "${ECHO_T}no (default)" >&6 + fi + + + #------------------------------------------------------------------------ # Embedded configuration information, encoding to use for the values, TIP #59 #------------------------------------------------------------------------ -# Check whether --with-encoding was given. -if test ${with_encoding+y} -then : - withval=$with_encoding; with_tcencoding=${withval} -fi - +# 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 - printf "%s\n" "#define TCL_CFGVAL_ENCODING \"${with_tcencoding}\"" >>confdefs.h + cat >>confdefs.h <<_ACEOF +#define TCL_CFGVAL_ENCODING "${with_tcencoding}" +_ACEOF else - printf "%s\n" "#define TCL_CFGVAL_ENCODING \"utf-8\"" >>confdefs.h + # Default encoding on windows is not "iso8859-1" + cat >>confdefs.h <<\_ACEOF +#define TCL_CFGVAL_ENCODING "cp1252" +_ACEOF fi @@ -3918,74 +3114,46 @@ fi #-------------------------------------------------------------------- - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking how to build libraries" >&5 -printf %s "checking how to build libraries... " >&6; } - # Check whether --enable-shared was given. -if test ${enable_shared+y} -then : - enableval=$enable_shared; tcl_ok=$enableval -else case e in #( - e) tcl_ok=yes ;; -esac -fi + 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 - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: shared" >&5 -printf "%s\n" "shared" >&6; } + echo "$as_me:$LINENO: result: shared" >&5 +echo "${ECHO_T}shared" >&6 SHARED_BUILD=1 else - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: static" >&5 -printf "%s\n" "static" >&6; } + echo "$as_me:$LINENO: result: static" >&5 +echo "${ECHO_T}static" >&6 SHARED_BUILD=0 -printf "%s\n" "#define STATIC_BUILD 1" >>confdefs.h +cat >>confdefs.h <<\_ACEOF +#define STATIC_BUILD 1 +_ACEOF fi - -#-------------------------------------------------------------------- -# Check whether --enable-time64bit was given. -#-------------------------------------------------------------------- - -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking force of 64-bit time_t" >&5 -printf %s "checking force of 64-bit time_t... " >&6; } -# Check whether --enable-time64bit was given. -if test ${enable_time64bit+y} -then : - enableval=$enable_time64bit; tcl_ok=$enableval -else case e in #( - e) tcl_ok=no ;; -esac -fi - -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: \"$tcl_ok\"" >&5 -printf "%s\n" "\"$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. #-------------------------------------------------------------------- -ac_header= ac_cache= -for ac_item in $ac_header_c_list -do - if test $ac_cache; then - ac_fn_c_check_header_compile "$LINENO" $ac_header ac_cv_header_$ac_cache "$ac_includes_default" - if eval test \"x\$ac_cv_header_$ac_cache\" = xyes; then - printf "%s\n" "#define $ac_item 1" >> confdefs.h - fi - ac_header= ac_cache= - elif test $ac_header; then - ac_cache=$ac_item - else - ac_header=$ac_item - fi -done +# On IRIX 5.3, sys/types and inttypes.h are conflicting. @@ -3994,185 +3162,230 @@ done -if test $ac_cv_header_stdlib_h = yes && test $ac_cv_header_string_h = yes -then : -printf "%s\n" "#define STDC_HEADERS 1" >>confdefs.h +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? - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking if 64bit support is requested" >&5 -printf %s "checking if 64bit support is requested... " >&6; } - # Check whether --enable-64bit was given. -if test ${enable_64bit+y} -then : - enableval=$enable_64bit; do64bit=$enableval -else case e in #( - e) do64bit=no ;; -esac -fi - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $do64bit" >&5 -printf "%s\n" "$do64bit" >&6; } - # Set some defaults (may get changed below) - EXTRA_CFLAGS="" + # Step 0: Enable 64 bit support? -printf "%s\n" "#define MODULE_SCOPE extern" >>confdefs.h + 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="" # Extract the first word of "cygpath", so it can be a program name with args. set dummy cygpath; ac_word=$2 -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -printf %s "checking for $ac_word... " >&6; } -if test ${ac_cv_prog_CYGPATH+y} -then : - printf %s "(cached) " >&6 -else case e in #( - e) if test -n "$CYGPATH"; then +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 - case $as_dir in #((( - '') as_dir=./ ;; - */) ;; - *) as_dir=$as_dir/ ;; - esac - for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then + 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" - printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 + echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done - done -IFS=$as_save_IFS +done test -z "$ac_cv_prog_CYGPATH" && ac_cv_prog_CYGPATH="echo" -fi ;; -esac +fi fi CYGPATH=$ac_cv_prog_CYGPATH if test -n "$CYGPATH"; then - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CYGPATH" >&5 -printf "%s\n" "$CYGPATH" >&6; } -else - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 -printf "%s\n" "no" >&6; } -fi - - - # Extract the first word of "wine", so it can be a program name with args. -set dummy wine; ac_word=$2 -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -printf %s "checking for $ac_word... " >&6; } -if test ${ac_cv_prog_WINE+y} -then : - printf %s "(cached) " >&6 -else case e in #( - e) if test -n "$WINE"; then - ac_cv_prog_WINE="$WINE" # Let the user override the test. -else -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - case $as_dir in #((( - '') as_dir=./ ;; - */) ;; - *) as_dir=$as_dir/ ;; - esac - for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then - ac_cv_prog_WINE="wine" - printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 - break 2 - fi -done - done -IFS=$as_save_IFS - -fi ;; -esac -fi -WINE=$ac_cv_prog_WINE -if test -n "$WINE"; then - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $WINE" >&5 -printf "%s\n" "$WINE" >&6; } + echo "$as_me:$LINENO: result: $CYGPATH" >&5 +echo "${ECHO_T}$CYGPATH" >&6 else - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 -printf "%s\n" "no" >&6; } + 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|arm64|ia64. + # which requires x86|amd64|ia64. MACHINE="X86" if test "$GCC" = "yes"; then - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for cross-compile version of gcc" >&5 -printf %s "checking for cross-compile version of gcc... " >&6; } -if test ${ac_cv_cross+y} -then : - printf %s "(cached) " >&6 -else case e in #( - e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext + 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 + #ifndef __WIN32__ #error cross-compiler #endif int -main (void) +main () { ; return 0; } _ACEOF -if ac_fn_c_try_compile "$LINENO" -then : +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 case e in #( - e) ac_cv_cross=yes ;; -esac +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_cv_cross=yes fi -rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext - ;; -esac +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext + fi -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_cross" >&5 -printf "%s\n" "$ac_cv_cross" >&6; } +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-${CC}" + 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" ;; - arm64|aarch64) - CC="aarch64-w64-mingw32-${CC}" - LD="aarch64-w64-mingw32-ld" - AR="aarch64-w64-mingw32-ar" - RANLIB="aarch64-w64-mingw32-ranlib" - RC="aarch64-w64-mingw32-windres" - ;; *) - CC="i686-w64-mingw32-${CC}" + CC="i686-w64-mingw32-gcc" LD="i686-w64-mingw32-ld" AR="i686-w64-mingw32-ar" RANLIB="i686-w64-mingw32-ranlib" @@ -4195,20 +3408,20 @@ printf "%s\n" "$ac_cv_cross" >&6; } echo "101 \"name\"" >> $conftest echo "END" >> $conftest - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for Windows native path bug in windres" >&5 -printf %s "checking for Windows native path bug in windres... " >&6; } + 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\":${as_lineno-$LINENO}: \"$ac_try\""; } >&5 + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? - printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; }; } ; then - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 -printf "%s\n" "no" >&6; } + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } ; then + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 else - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 -printf "%s\n" "yes" >&6; } + echo "$as_me:$LINENO: result: yes" >&5 +echo "${ECHO_T}yes" >&6 CYGPATH=echo fi conftest= @@ -4226,254 +3439,79 @@ printf "%s\n" "yes" >&6; } if test "${GCC}" = "yes" ; then extra_cflags="-pipe" extra_ldflags="-pipe -static-libgcc" - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for mingw32 version of gcc" >&5 -printf %s "checking for mingw32 version of gcc... " >&6; } -if test ${ac_cv_win32+y} -then : - printf %s "(cached) " >&6 -else case e in #( - e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext + 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 + #ifdef __WIN32__ #error win32 #endif int -main (void) +main () { ; return 0; } _ACEOF -if ac_fn_c_try_compile "$LINENO" -then : - ac_cv_win32=no -else case e in #( - e) ac_cv_win32=yes ;; -esac -fi -rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext - ;; -esac -fi -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_win32" >&5 -printf "%s\n" "$ac_cv_win32" >&6; } - if test "$ac_cv_win32" != "yes"; then - as_fn_error $? "${CC} cannot produce win32 executables." "$LINENO" 5 - fi - if test "$do64bit" != "arm64"; then - extra_cflags="$extra_cflags -DHAVE_CPUID=1" - fi - - hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -mwindows -municode -Dmain=xxmain" - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for working -municode linker flag" >&5 -printf %s "checking for working -municode linker flag... " >&6; } -if test ${ac_cv_municode+y} -then : - printf %s "(cached) " >&6 -else case e in #( - e) -# ac_fn_c_try_link LINENO -# ----------------------- -# Try to link conftest.$ac_ext, and return whether this succeeded. -ac_fn_c_try_link () -{ - as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack - rm -f conftest.$ac_objext conftest.beam conftest$ac_exeext - if { { ac_try="$ac_link" -case "(($ac_try" in - *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; - *) ac_try_echo=$ac_try;; -esac -eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" -printf "%s\n" "$ac_try_echo"; } >&5 - (eval "$ac_link") 2>conftest.err +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 ac_status=$? - if test -s conftest.err; then - grep -v '^ *+' conftest.err >conftest.er1 - cat conftest.er1 >&5 - mv -f conftest.er1 conftest.err - fi - printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; } && { - test -z "$ac_c_werror_flag" || - test ! -s conftest.err - } && test -s conftest$ac_exeext && { - test "$cross_compiling" = yes || - test -x conftest$ac_exeext - } -then : - ac_retval=0 -else case e in #( - e) printf "%s\n" "$as_me: failed program was:" >&5 + 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_retval=1 ;; -esac -fi - # Delete the IPA/IPO (Inter Procedural Analysis/Optimization) information - # created by the PGI compiler (conftest_ipa8_conftest.oo), as it would - # interfere with the next link command; also delete a directory that is - # left behind by Apple's compiler. We do this before executing the actions. - rm -rf conftest.dSYM conftest_ipa8_conftest.oo - eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno - as_fn_set_status $ac_retval - -} # ac_fn_c_try_link -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - - #include <windows.h> - int APIENTRY wWinMain(HINSTANCE a, HINSTANCE b, LPWSTR c, int d) {return 0;} - -int -main (void) -{ - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO" -then : - ac_cv_municode=yes -else case e in #( - e) ac_cv_municode=no ;; -esac -fi -rm -f core conftest.err conftest.$ac_objext conftest.beam \ - conftest$ac_exeext conftest.$ac_ext - ;; -esac -fi -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_municode" >&5 -printf "%s\n" "$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 - hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -fno-lto" - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for working -fno-lto" >&5 -printf %s "checking for working -fno-lto... " >&6; } -if test ${ac_cv_nolto+y} -then : - printf %s "(cached) " >&6 -else case e in #( - e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -int -main (void) -{ - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO" -then : - ac_cv_nolto=yes -else case e in #( - e) ac_cv_nolto=no ;; -esac -fi -rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext - ;; -esac +ac_cv_win32=yes fi -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_nolto" >&5 -printf "%s\n" "$ac_cv_nolto" >&6; } - CFLAGS=$hold_cflags - if test "$ac_cv_nolto" = "yes" ; then - CFLAGS_NOLTO="-fno-lto" - else - CFLAGS_NOLTO="" - fi - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking if the compiler understands -finput-charset" >&5 -printf %s "checking if the compiler understands -finput-charset... " >&6; } -if test ${tcl_cv_cc_input_charset+y} -then : - printf %s "(cached) " >&6 -else case e in #( - e) - hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -finput-charset=UTF-8" - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -int -main (void) -{ +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO" -then : - tcl_cv_cc_input_charset=yes -else case e in #( - e) tcl_cv_cc_input_charset=no ;; -esac -fi -rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext - CFLAGS=$hold_cflags ;; -esac fi -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cc_input_charset" >&5 -printf "%s\n" "$tcl_cv_cc_input_charset" >&6; } - if test $tcl_cv_cc_input_charset = yes; then - extra_cflags="$extra_cflags -finput-charset=UTF-8" +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 fi - hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -Wl,--enable-auto-image-base" - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for working --enable-auto-image-base" >&5 -printf %s "checking for working --enable-auto-image-base... " >&6; } -if test ${ac_cv_enable_auto_image_base+y} -then : - printf %s "(cached) " >&6 -else case e in #( - e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -int -main (void) -{ - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO" -then : - ac_cv_enable_auto_image_base=yes -else case e in #( - e) ac_cv_enable_auto_image_base=no ;; -esac -fi -rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext - ;; -esac -fi -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_enable_auto_image_base" >&5 -printf "%s\n" "$ac_cv_enable_auto_image_base" >&6; } - CFLAGS=$hold_cflags - if test "$ac_cv_enable_auto_image_base" == "yes" ; then - extra_ldflags="$extra_ldflags -Wl,--enable-auto-image-base" - fi - - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking compiler flags" >&5 -printf %s "checking compiler flags... " >&6; } + echo "$as_me:$LINENO: checking compiler flags" >&5 +echo $ECHO_N "checking compiler flags... $ECHO_C" >&6 if test "${GCC}" = "yes" ; then SHLIB_LD="" - SHLIB_LD_LIBS='${LIBS}' - LIBS="-lnetapi32 -lkernel32 -luser32 -ladvapi32 -luserenv -lws2_32" + SHLIB_LD_LIBS="" + LIBS="-lws2_32" # mingw needs to link ole32 and oleaut32 for [send], but MSVC doesn't - LIBS_GUI="-lgdi32 -lcomdlg32 -limm32 -lcomctl32 -lshell32 -luuid -lole32 -loleaut32 -lwinspool" + LIBS_GUI="-lgdi32 -lcomdlg32 -limm32 -lcomctl32 -lshell32 -luuid -lole32 -loleaut32" STLIB_LD='${AR} cr' RC_OUT=-o RC_TYPE= @@ -4488,58 +3526,55 @@ printf %s "checking compiler flags... " >&6; } if test "${SHARED_BUILD}" = "0" ; then # static - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: using static flags" >&5 -printf "%s\n" "using static flags" >&6; } + echo "$as_me:$LINENO: result: using static flags" >&5 +echo "${ECHO_T}using static flags" >&6 runtime= + MAKE_DLL="echo " + LIBSUFFIX="s\${DBGX}.a" + LIBFLAGSUFFIX="s\${DBGX}" LIBRARIES="\${STATIC_LIBRARIES}" - EXESUFFIX="s.exe" + EXESUFFIX="s\${DBGX}.exe" else # dynamic - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: using shared flags" >&5 -printf "%s\n" "using shared flags" >&6; } + echo "$as_me:$LINENO: result: using shared flags" >&5 +echo "${ECHO_T}using shared flags" >&6 # ad-hoc check to see if CC supports -shared. if "${CC}" -shared 2>&1 | egrep ': -shared not supported' >/dev/null; then - as_fn_error $? "${CC} does not support the -shared option. - You will need to upgrade to a newer version of the toolchain." "$LINENO" 5 + { { 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= + # Link with gcc since ld does not link to default libs like + # -luser32 and -lmsvcrt by default. + SHLIB_LD='${CC} -shared' + SHLIB_LD_LIBS='${LIBS}' # Add SHLIB_LD_LIBS to the Make rule, not here. + MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -o \$@ ${extra_ldflags} \ + -Wl,--out-implib,\$(patsubst %.dll,lib%.a,\$@)" - EXESUFFIX=".exe" + LIBSUFFIX="\${DBGX}.a" + LIBFLAGSUFFIX="\${DBGX}" + EXESUFFIX="\${DBGX}.exe" LIBRARIES="\${SHARED_LIBRARIES}" fi - # Link with gcc since ld does not link to default libs like - # -luser32 and -lmsvcrt by default. - SHLIB_LD='${CC} -shared' - SHLIB_LD_LIBS='${LIBS}' - MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -o \$@ ${extra_ldflags} \ - -Wl,--out-implib,\$(patsubst %.dll,lib%.dll.a,\$@)" # DLLSUFFIX is separate because it is the building block for # users of tclConfig.sh that may build shared or static. - DLLSUFFIX=".dll" - LIBSUFFIX=".a" - LIBFLAGSUFFIX="" + DLLSUFFIX="\${DBGX}.dll" SHLIB_SUFFIX=.dll EXTRA_CFLAGS="${extra_cflags}" CFLAGS_DEBUG=-g CFLAGS_OPTIMIZE="-O2 -fomit-frame-pointer" - CFLAGS_WARNING="-Wall -Wextra -Wshadow -Wundef -Wwrite-strings -Wpointer-arith" + CFLAGS_WARNING="-Wall" LDFLAGS_DEBUG= LDFLAGS_OPTIMIZE= - case "${CC}" in - *++) - CFLAGS_WARNING="${CFLAGS_WARNING} -Wno-format" - ;; - *) - CFLAGS_WARNING="${CFLAGS_WARNING} -Wc++-compat -fextended-identifiers" - ;; - esac - # Specify the CC output file names based on the target name CC_OBJNAME="-o \$@" CC_EXENAME="-o \$@" @@ -4564,21 +3599,20 @@ printf "%s\n" "using shared flags" >&6; } case "$do64bit" in amd64|x64|yes) MACHINE="AMD64" ; # assume AMD64 as default 64-bit build - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: Using 64-bit $MACHINE mode" >&5 -printf "%s\n" " Using 64-bit $MACHINE mode" >&6; } - ;; - arm64|aarch64) - MACHINE="ARM64" - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: Using ARM64 $MACHINE mode" >&5 -printf "%s\n" " Using ARM64 $MACHINE mode" >&6; } + echo "$as_me:$LINENO: result: Using 64-bit $MACHINE mode" >&5 +echo "${ECHO_T} Using 64-bit $MACHINE mode" >&6 ;; ia64) MACHINE="IA64" - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: Using IA64 $MACHINE mode" >&5 -printf "%s\n" " Using IA64 $MACHINE mode" >&6; } + echo "$as_me:$LINENO: result: Using 64-bit $MACHINE mode" >&5 +echo "${ECHO_T} Using 64-bit $MACHINE mode" >&6 ;; *) - cat confdefs.h - <<_ACEOF >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. */ #ifndef _WIN64 @@ -4586,46 +3620,76 @@ printf "%s\n" " Using IA64 $MACHINE mode" >&6; } #endif int -main (void) +main () { ; return 0; } _ACEOF -if ac_fn_c_try_compile "$LINENO" -then : +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 case e in #( - e) tcl_win_64bit=no - ;; -esac +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +tcl_win_64bit=no + fi -rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext if test "$tcl_win_64bit" = "yes" ; then - do64bit=amd64 - MACHINE="AMD64" - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: Using 64-bit $MACHINE mode" >&5 -printf "%s\n" " Using 64-bit $MACHINE mode" >&6; } + 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 - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: using static flags" >&5 -printf "%s\n" "using static flags" >&6; } + echo "$as_me:$LINENO: result: using static flags" >&5 +echo "${ECHO_T}using static flags" >&6 runtime=-MT + MAKE_DLL="echo " + LIBSUFFIX="s\${DBGX}.lib" + LIBFLAGSUFFIX="s\${DBGX}" LIBRARIES="\${STATIC_LIBRARIES}" - EXESUFFIX="s.exe" + EXESUFFIX="s\${DBGX}.exe" + SHLIB_LD_LIBS="" else # dynamic - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: using shared flags" >&5 -printf "%s\n" "using shared flags" >&6; } + echo "$as_me:$LINENO: result: using shared flags" >&5 +echo "${ECHO_T}using shared flags" >&6 runtime=-MD # Add SHLIB_LD_LIBS to the Make rule, not here. + MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -out:\$@" + LIBSUFFIX="\${DBGX}.lib" + LIBFLAGSUFFIX="\${DBGX}" + EXESUFFIX="\${DBGX}.exe" LIBRARIES="\${SHARED_LIBRARIES}" - EXESUFFIX=".exe" + SHLIB_LD_LIBS='${LIBS}' case "x`echo \${VisualStudioVersion}`" in x1[4-9]*) lflags="${lflags} -nodefaultlib:libucrt.lib" @@ -4634,30 +3698,38 @@ printf "%s\n" "using shared flags" >&6; } ;; esac fi - MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -out:\$@" # DLLSUFFIX is separate because it is the building block for # users of tclConfig.sh that may build shared or static. - DLLSUFFIX=".dll" - LIBSUFFIX=".lib" - LIBFLAGSUFFIX="" + DLLSUFFIX="\${DBGX}.dll" + # 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 - ;; - arm64|aarch64) - MACHINE="ARM64" + PATH64="${MSSDK}/Bin/Win64/x86/AMD64" ;; ia64) MACHINE="IA64" + PATH64="${MSSDK}/Bin/Win64" ;; esac - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: Using 64-bit $MACHINE mode" >&5 -printf "%s\n" " Using 64-bit $MACHINE mode" >&6; } + 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" + LIBS="user32.lib advapi32.lib ws2_32.lib" case "x`echo \${VisualStudioVersion}`" in x1[4-9]*) @@ -4668,11 +3740,81 @@ printf "%s\n" " Using 64-bit $MACHINE mode" >&6; } esac if test "$do64bit" != "no" ; then - RC="rc" + # 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" - CFLAGS_OPTIMIZE="-nologo -O2 ${runtime}" - lflags="${lflags} -nologo -MACHINE:${MACHINE}" - LINKBIN="link" + # 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" @@ -4687,10 +3829,113 @@ printf "%s\n" " Using 64-bit $MACHINE mode" >&6; } LINKBIN="link" fi - LIBS_GUI="gdi32.lib comdlg32.lib imm32.lib comctl32.lib shell32.lib uuid.lib winspool.lib" + 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 @@ -4718,7 +3963,7 @@ printf "%s\n" " Using 64-bit $MACHINE mode" >&6; } # Specify linker flags depending on the type of app being # built -- Console vs. Window. - if test "${TARGETCPU}" != "X86"; then + if test "$doWince" != "no" -a "${TARGETCPU}" != "X86"; then LDFLAGS_CONSOLE="-link ${lflags}" LDFLAGS_WINDOW=${LDFLAGS_CONSOLE} else @@ -4728,66 +3973,26 @@ printf "%s\n" " Using 64-bit $MACHINE mode" >&6; } fi if test "$do64bit" != "no" ; then - printf "%s\n" "#define TCL_CFG_DO64BIT 1" >>confdefs.h + cat >>confdefs.h <<\_ACEOF +#define TCL_CFG_DO64BIT 1 +_ACEOF fi if test "${GCC}" = "yes" ; then - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for SEH support in compiler" >&5 -printf %s "checking for SEH support in compiler... " >&6; } -if test ${tcl_cv_seh+y} -then : - printf %s "(cached) " >&6 -else case e in #( - e) if test "$cross_compiling" = 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 case e in #( - e) -# ac_fn_c_try_run LINENO -# ---------------------- -# Try to run conftest.$ac_ext, and return whether this succeeded. Assumes that -# executables *can* be run. -ac_fn_c_try_run () -{ - as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack - if { { ac_try="$ac_link" -case "(($ac_try" in - *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; - *) ac_try_echo=$ac_try;; -esac -eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" -printf "%s\n" "$ac_try_echo"; } >&5 - (eval "$ac_link") 2>&5 - ac_status=$? - printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; } && { ac_try='./conftest$ac_exeext' - { { case "(($ac_try" in - *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; - *) ac_try_echo=$ac_try;; -esac -eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" -printf "%s\n" "$ac_try_echo"; } >&5 - (eval "$ac_try") 2>&5 - ac_status=$? - printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; }; } -then : - ac_retval=0 -else case e in #( - e) printf "%s\n" "$as_me: program exited with status $ac_status" >&5 - printf "%s\n" "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - - ac_retval=$ac_status ;; -esac -fi - rm -rf conftest.dSYM conftest_ipa8_conftest.oo - eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno - as_fn_set_status $ac_retval - -} # ac_fn_c_try_run -cat confdefs.h - <<_ACEOF >conftest.$ac_ext +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 @@ -4806,26 +4011,37 @@ cat confdefs.h - <<_ACEOF >conftest.$ac_ext } _ACEOF -if ac_fn_c_try_run "$LINENO" -then : +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 case e in #( - e) tcl_cv_seh=no ;; -esac +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 core.conftest.* gmon.out bb.out conftest$ac_exeext \ - conftest.$ac_objext conftest.beam conftest.$ac_ext ;; -esac +rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi - ;; -esac fi -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_seh" >&5 -printf "%s\n" "$tcl_cv_seh" >&6; } +echo "$as_me:$LINENO: result: $tcl_cv_seh" >&5 +echo "${ECHO_T}$tcl_cv_seh" >&6 if test "$tcl_cv_seh" = "no" ; then -printf "%s\n" "#define HAVE_NO_SEH 1" >>confdefs.h +cat >>confdefs.h <<\_ACEOF +#define HAVE_NO_SEH 1 +_ACEOF fi @@ -4835,13 +4051,16 @@ printf "%s\n" "#define HAVE_NO_SEH 1" >>confdefs.h # with Cygwin's version as of 2002-04-10, define it to be int, # sufficient for getting the current code to work. # - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for EXCEPTION_DISPOSITION support in include files" >&5 -printf %s "checking for EXCEPTION_DISPOSITION support in include files... " >&6; } -if test ${tcl_cv_eh_disposition+y} -then : - printf %s "(cached) " >&6 -else case e in #( - e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext + 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 @@ -4849,7 +4068,7 @@ else case e in #( # undef WIN32_LEAN_AND_MEAN int -main (void) +main () { EXCEPTION_DISPOSITION x; @@ -4858,49 +4077,141 @@ main (void) return 0; } _ACEOF -if ac_fn_c_try_compile "$LINENO" -then : +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 case e in #( - e) tcl_cv_eh_disposition=no ;; -esac +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +tcl_cv_eh_disposition=no fi -rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext - ;; -esac +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext + fi -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_eh_disposition" >&5 -printf "%s\n" "$tcl_cv_eh_disposition" >&6; } +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 -printf "%s\n" "#define EXCEPTION_DISPOSITION int" >>confdefs.h +cat >>confdefs.h <<\_ACEOF +#define EXCEPTION_DISPOSITION int +_ACEOF fi - ac_fn_c_check_header_compile "$LINENO" "stdbool.h" "ac_cv_header_stdbool_h" "$ac_includes_default" -if test "x$ac_cv_header_stdbool_h" = xyes -then : + # 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 () +{ -printf "%s\n" "#define HAVE_STDBOOL_H 1" >>confdefs.h + 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. - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for cast to union support" >&5 -printf %s "checking for cast to union support... " >&6; } -if test ${tcl_cv_cast_to_union+y} -then : - printf %s "(cached) " >&6 -else case e in #( - e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext + 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 (void) +main () { union foo { int i; double d; }; @@ -4910,22 +4221,45 @@ main (void) return 0; } _ACEOF -if ac_fn_c_try_compile "$LINENO" -then : +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 case e in #( - e) tcl_cv_cast_to_union=no ;; -esac +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +tcl_cv_cast_to_union=no fi -rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext - ;; -esac +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext + fi -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cast_to_union" >&5 -printf "%s\n" "$tcl_cv_cast_to_union" >&6; } +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 -printf "%s\n" "#define HAVE_CAST_TO_UNION 1" >>confdefs.h +cat >>confdefs.h <<\_ACEOF +#define HAVE_CAST_TO_UNION 1 +_ACEOF fi fi @@ -4937,506 +4271,295 @@ printf "%s\n" "#define HAVE_CAST_TO_UNION 1" >>confdefs.h +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 -# 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/libtommath; note that this is mostly done in the -# makefile now as we just assume that the platform hasn't got usable -# z.lib/tommath.lib -#------------------------------------------------------------------------ - -if test "${enable_shared+set}" = "set" -then : - - enableval="$enable_shared" - tcl_ok=$enableval - -else case e in #( - e) - tcl_ok=yes - ;; -esac -fi -zlib_lib_name=zdll.lib -tommath_lib_name=tommath.lib -if test "$tcl_ok" = "yes" -then : - - ZLIB_DLL_FILE=\${ZLIB_DLL_FILE} - - TOMMATH_DLL_FILE=\${TOMMATH_DLL_FILE} - - -printf "%s\n" "#define TCL_WITH_EXTERNAL_TOMMATH 1" >>confdefs.h - - if test "$do64bit" != "no" -then : - - -printf "%s\n" "#define MP_64BIT 1" >>confdefs.h - - if test "$do64bit" = "arm64" -then : - - if test "$GCC" == "yes" -then : - - ZLIB_LIBS=\${ZLIB_DIR_NATIVE}/win64-arm/libz.dll.a - - TOMMATH_LIBS=\${TOMMATH_DIR_NATIVE}/win64-arm/libtommath.dll.a - - zlib_lib_name=libz.dll.a - tommath_lib_name=libtommath.dll.a - -else case e in #( - e) - ZLIB_LIBS=\${ZLIB_DIR_NATIVE}/win64-arm/zdll.lib - - TOMMATH_LIBS=\${TOMMATH_DIR_NATIVE}/win64-arm/tommath.lib - - ;; -esac -fi - -else case e in #( - e) - if test "$GCC" == "yes" -then : - - ZLIB_LIBS=\${ZLIB_DIR_NATIVE}/win64/libz.dll.a - - TOMMATH_LIBS=\${TOMMATH_DIR_NATIVE}/win64/libtommath.dll.a - - zlib_lib_name=libz.dll.a - tommath_lib_name=libtommath.dll.a - -else case e in #( - e) - ZLIB_LIBS=\${ZLIB_DIR_NATIVE}/win64/zdll.lib - - TOMMATH_LIBS=\${TOMMATH_DIR_NATIVE}/win64/tommath.lib - - ;; -esac -fi - ;; -esac -fi - -else case e in #( - e) - ZLIB_LIBS=\${ZLIB_DIR_NATIVE}/win32/zdll.lib - - TOMMATH_LIBS=\${TOMMATH_DIR_NATIVE}/win32/tommath.lib - - ;; -esac -fi - -else case e in #( - e) - ZLIB_OBJS=\${ZLIB_OBJS} - - TOMMATH_OBJS=\${TOMMATH_OBJS} - - ;; -esac -fi - -printf "%s\n" "#define HAVE_ZLIB 1" >>confdefs.h - -TCL_ZLIB_LIB_NAME=$zlib_lib_name - -TCL_TOMMATH_LIB_NAME=$tommath_lib_name - -ac_fn_c_check_type "$LINENO" "intptr_t" "ac_cv_type_intptr_t" " -#include <stdint.h> - -" -if test "x$ac_cv_type_intptr_t" = xyes -then : - -printf "%s\n" "#define HAVE_INTPTR_T 1" >>confdefs.h - - -fi -ac_fn_c_check_type "$LINENO" "uintptr_t" "ac_cv_type_uintptr_t" " -#include <stdint.h> - -" -if test "x$ac_cv_type_uintptr_t" = xyes -then : - -printf "%s\n" "#define HAVE_UINTPTR_T 1" >>confdefs.h - - -fi - - -#-------------------------------------------------------------------- -# Zipfs support - Tip 430 -#-------------------------------------------------------------------- -# Check whether --enable-zipfs was given. -if test ${enable_zipfs+y} -then : - enableval=$enable_zipfs; tcl_ok=$enableval -else case e in #( - e) tcl_ok=yes ;; -esac -fi - -if test "$tcl_ok" = "yes" ; then - # - # Find a native compiler - # - # Put a plausible default for CC_FOR_BUILD in Makefile. -if test -z "$CC_FOR_BUILD"; then - if test "x$cross_compiling" = "xno"; then - CC_FOR_BUILD='$(CC)' - else - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for gcc" >&5 -printf %s "checking for gcc... " >&6; } - if test ${ac_cv_path_cc+y} -then : - printf %s "(cached) " >&6 -else case e in #( - e) - search_path=`echo ${PATH} | sed -e 's/:/ /g'` - for dir in $search_path ; do - for j in `ls -r $dir/gcc 2> /dev/null` \ - `ls -r $dir/gcc 2> /dev/null` ; do - if test x"$ac_cv_path_cc" = x ; then - if test -f "$j" ; then - ac_cv_path_cc=$j - break - fi - fi - done - done - ;; -esac -fi - - fi -fi - -# Also set EXEEXT_FOR_BUILD. -if test "x$cross_compiling" = "xno"; then - EXEEXT_FOR_BUILD='$(EXEEXT)' - OBJEXT_FOR_BUILD='$(OBJEXT)' -else - OBJEXT_FOR_BUILD='.no' - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for build system executable suffix" >&5 -printf %s "checking for build system executable suffix... " >&6; } -if test ${bfd_cv_build_exeext+y} -then : - printf %s "(cached) " >&6 -else case e in #( - e) rm -f conftest* - echo 'int main () { return 0; }' > conftest.c - bfd_cv_build_exeext= - ${CC_FOR_BUILD} -o conftest conftest.c 1>&5 2>&5 - for file in conftest.*; do - case $file in - *.c | *.o | *.obj | *.ilk | *.pdb) ;; - *) bfd_cv_build_exeext=`echo $file | sed -e s/conftest//` ;; - esac - done - rm -f conftest* - test x"${bfd_cv_build_exeext}" = x && bfd_cv_build_exeext=no ;; -esac -fi -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $bfd_cv_build_exeext" >&5 -printf "%s\n" "$bfd_cv_build_exeext" >&6; } - EXEEXT_FOR_BUILD="" - test x"${bfd_cv_build_exeext}" != xno && EXEEXT_FOR_BUILD=${bfd_cv_build_exeext} -fi - - # - # Find a native zip implementation - # - - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for tclsh" >&5 -printf %s "checking for tclsh... " >&6; } - - if test ${ac_cv_path_tclsh+y} -then : - printf %s "(cached) " >&6 -else case e in #( - e) - 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 - ;; -esac +ac_cv_type_intptr_t=no fi - - - if test -f "$ac_cv_path_tclsh" ; then - TCLSH_PROG="$ac_cv_path_tclsh" - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $TCLSH_PROG" >&5 -printf "%s\n" "$TCLSH_PROG" >&6; } - else - # It is not an error if an installed version of Tcl can't be located. - TCLSH_PROG="" - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: No tclsh found on PATH" >&5 -printf "%s\n" "No tclsh found on PATH" >&6; } - fi - - - - ZIP_PROG="" - ZIP_PROG_OPTIONS="" - ZIP_PROG_VFSSEARCH="" - ZIP_INSTALL_OBJS="" - - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for zip" >&5 -printf %s "checking for zip... " >&6; } - if test ${ac_cv_path_zip+y} -then : - printf %s "(cached) " >&6 -else case e in #( - e) - search_path=`echo ${PATH} | sed -e 's/:/ /g'` - for dir in $search_path ; do - for j in `ls -r $dir/zip 2> /dev/null` \ - `ls -r $dir/zip 2> /dev/null` ; do - if test x"$ac_cv_path_zip" = x ; then - if test -f "$j" ; then - ac_cv_path_zip=$j - break - fi - fi - done - done - ;; -esac +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi - - if test -f "$ac_cv_path_zip" ; then - ZIP_PROG="$ac_cv_path_zip" - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ZIP_PROG" >&5 -printf "%s\n" "$ZIP_PROG" >&6; } - ZIP_PROG_OPTIONS="-rq" - ZIP_PROG_VFSSEARCH="*" - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: Found INFO Zip in environment" >&5 -printf "%s\n" "Found INFO Zip in environment" >&6; } - # Use standard arguments for zip - else - # It is not an error if an installed version of Zip can't be located. - # We can use the locally distributed minizip instead - ZIP_PROG="./minizip${EXEEXT_FOR_BUILD}" - ZIP_PROG_OPTIONS="-o -r" - ZIP_PROG_VFSSEARCH="*" - ZIP_INSTALL_OBJS="minizip${EXEEXT_FOR_BUILD}" - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: No zip found on PATH building minizip" >&5 -printf "%s\n" "No zip found on PATH building minizip" >&6; } - 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 - ZIPFS_BUILD=1 - TCL_ZIP_FILE=libtcl${TCL_MAJOR_VERSION}.${TCL_MINOR_VERSION}${TCL_PATCH_LEVEL}.zip else - ZIPFS_BUILD=0 - TCL_ZIP_FILE= -fi -# Do checking message here to not mess up interleaved configure output -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for building with zipfs" >&5 -printf %s "checking for building with zipfs... " >&6; } -if test "${ZIPFS_BUILD}" = 1; then - if test "${SHARED_BUILD}" = 0; then - ZIPFS_BUILD=2; - -printf "%s\n" "#define ZIPFS_BUILD 2" >>confdefs.h - - else -printf "%s\n" "#define ZIPFS_BUILD 1" >>confdefs.h -\ - fi - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 -printf "%s\n" "yes" >&6; } + 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 -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 -printf "%s\n" "no" >&6; } -INSTALL_LIBRARIES=install-libraries -INSTALL_MSGS=install-msgs -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. - -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for FINDEX_INFO_LEVELS in winbase.h" >&5 -printf %s "checking for FINDEX_INFO_LEVELS in winbase.h... " >&6; } -if test ${tcl_cv_findex_enums+y} -then : - printf %s "(cached) " >&6 -else case e in #( - e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext + 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. */ - -#define WIN32_LEAN_AND_MEAN -#include <windows.h> -#undef WIN32_LEAN_AND_MEAN - +$ac_includes_default int -main (void) +main () { - - FINDEX_INFO_LEVELS i; - FINDEX_SEARCH_OPS j; +static int test_array [1 - 2 * !(sizeof (void *) <= sizeof ($tcl_cv_intptr_t))]; +test_array [0] = 0 ; return 0; } _ACEOF -if ac_fn_c_try_compile "$LINENO" -then : - tcl_cv_findex_enums=yes -else case e in #( - e) tcl_cv_findex_enums=no ;; -esac +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 core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext - ;; -esac +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext + test "$tcl_ok" = yes && break; fi + done fi -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_findex_enums" >&5 -printf "%s\n" "$tcl_cv_findex_enums" >&6; } -if test "$tcl_cv_findex_enums" = "no"; then +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 -printf "%s\n" "#define HAVE_NO_FINDEX_ENUMS 1" >>confdefs.h + fi fi -# See if the compiler supports intrinsics. - -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for intrinsics support in compiler" >&5 -printf %s "checking for intrinsics support in compiler... " >&6; } -if test ${tcl_cv_intrinsics+y} -then : - printf %s "(cached) " >&6 -else case e in #( - e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext +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. */ - -#define WIN32_LEAN_AND_MEAN -#include <windows.h> -#undef WIN32_LEAN_AND_MEAN -#include <intrin.h> - +$ac_includes_default int -main (void) +main () { - - __cpuidex(0,0,0); - +if ((uintptr_t *) 0) + return 0; +if (sizeof (uintptr_t)) + return 0; ; return 0; } _ACEOF -if ac_fn_c_try_link "$LINENO" -then : - tcl_cv_intrinsics=yes -else case e in #( - e) tcl_cv_intrinsics=no ;; -esac +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 core conftest.err conftest.$ac_objext conftest.beam \ - conftest$ac_exeext conftest.$ac_ext - ;; -esac +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_intrinsics" >&5 -printf "%s\n" "$tcl_cv_intrinsics" >&6; } -if test "$tcl_cv_intrinsics" = "yes"; then +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 -printf "%s\n" "#define HAVE_INTRIN_H 1" >>confdefs.h -fi - -# See if the <wspiapi.h> header file is present +cat >>confdefs.h <<\_ACEOF +#define HAVE_UINTPTR_T 1 +_ACEOF -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for wspiapi.h" >&5 -printf %s "checking for wspiapi.h... " >&6; } -if test ${tcl_cv_wspiapi_h+y} -then : - printf %s "(cached) " >&6 -else case e in #( - e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ +else -#include <wspiapi.h> + 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 (void) +main () { +static int test_array [1 - 2 * !(sizeof (void *) <= sizeof ($tcl_cv_uintptr_t))]; +test_array [0] = 0 ; return 0; } _ACEOF -if ac_fn_c_try_compile "$LINENO" -then : - tcl_cv_wspiapi_h=yes -else case e in #( - e) tcl_cv_wspiapi_h=no ;; -esac +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 core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext - ;; -esac +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext + test "$tcl_ok" = yes && break; fi + done fi -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_wspiapi_h" >&5 -printf "%s\n" "$tcl_cv_wspiapi_h" >&6; } -if test "$tcl_cv_wspiapi_h" = "yes"; then +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 -printf "%s\n" "#define HAVE_WSPIAPI_H 1" >>confdefs.h +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. -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for FINDEX_INFO_LEVELS in winbase.h" >&5 -printf %s "checking for FINDEX_INFO_LEVELS in winbase.h... " >&6; } -if test ${tcl_cv_findex_enums+y} -then : - printf %s "(cached) " >&6 -else case e in #( - e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext +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 @@ -5444,7 +4567,7 @@ else case e in #( #undef WIN32_LEAN_AND_MEAN int -main (void) +main () { FINDEX_INFO_LEVELS i; @@ -5454,22 +4577,45 @@ main (void) return 0; } _ACEOF -if ac_fn_c_try_compile "$LINENO" -then : +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 case e in #( - e) tcl_cv_findex_enums=no ;; -esac +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +tcl_cv_findex_enums=no fi -rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext - ;; -esac +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext + fi -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_findex_enums" >&5 -printf "%s\n" "$tcl_cv_findex_enums" >&6; } +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 -printf "%s\n" "#define HAVE_NO_FINDEX_ENUMS 1" >>confdefs.h +cat >>confdefs.h <<\_ACEOF +#define HAVE_NO_FINDEX_ENUMS 1 +_ACEOF fi @@ -5480,35 +4626,39 @@ fi #-------------------------------------------------------------------- - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for build with symbols" >&5 -printf %s "checking for build with symbols... " >&6; } - # Check whether --enable-symbols was given. -if test ${enable_symbols+y} -then : - enableval=$enable_symbols; tcl_ok=$enableval -else case e in #( - e) tcl_ok=no ;; -esac -fi - + 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="" -printf "%s\n" "#define NDEBUG 1" >>confdefs.h +cat >>confdefs.h <<\_ACEOF +#define NDEBUG 1 +_ACEOF - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 -printf "%s\n" "no" >&6; } + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 - printf "%s\n" "#define TCL_CFG_OPTIMIZED 1" >>confdefs.h + 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 - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes (standard debugging)" >&5 -printf "%s\n" "yes (standard debugging)" >&6; } + echo "$as_me:$LINENO: result: yes (standard debugging)" >&5 +echo "${ECHO_T}yes (standard debugging)" >&6 fi fi @@ -5516,319 +4666,52 @@ printf "%s\n" "yes (standard debugging)" >&6; } if test "$tcl_ok" = "mem" -o "$tcl_ok" = "all"; then -printf "%s\n" "#define TCL_MEM_DEBUG 1" >>confdefs.h +cat >>confdefs.h <<\_ACEOF +#define TCL_MEM_DEBUG 1 +_ACEOF fi if test "$tcl_ok" = "compile" -o "$tcl_ok" = "all"; then -printf "%s\n" "#define TCL_COMPILE_DEBUG 1" >>confdefs.h +cat >>confdefs.h <<\_ACEOF +#define TCL_COMPILE_DEBUG 1 +_ACEOF -printf "%s\n" "#define TCL_COMPILE_STATS 1" >>confdefs.h +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 - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: enabled symbols mem compile debugging" >&5 -printf "%s\n" "enabled symbols mem compile debugging" >&6; } + echo "$as_me:$LINENO: result: enabled symbols mem compile debugging" >&5 +echo "${ECHO_T}enabled symbols mem compile debugging" >&6 else - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: enabled $tcl_ok debugging" >&5 -printf "%s\n" "enabled $tcl_ok debugging" >&6; } + 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 #-------------------------------------------------------------------- -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 -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking how to run the C preprocessor" >&5 -printf %s "checking how to run the C preprocessor... " >&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+y} -then : - printf %s "(cached) " >&6 -else case e in #( - e) # Double quotes because $CC needs to be expanded - for CPP in "$CC -E" "$CC -E -traditional-cpp" 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. - # 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 confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include <limits.h> - Syntax error -_ACEOF -if ac_fn_c_try_cpp "$LINENO" -then : - -else case e in #( - e) # Broken: fails on valid input. -continue ;; -esac -fi -rm -f conftest.err conftest.i conftest.$ac_ext - - # OK, works on sane cases. Now check whether nonexistent headers - # can be detected and how. - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include <ac_nonexistent.h> -_ACEOF -if ac_fn_c_try_cpp "$LINENO" -then : - # Broken: success on invalid input. -continue -else case e in #( - e) # Passes both tests. -ac_preproc_ok=: -break ;; -esac -fi -rm -f conftest.err conftest.i conftest.$ac_ext - -done -# Because of 'break', _AC_PREPROC_IFELSE's cleaning code was skipped. -rm -f conftest.i conftest.err conftest.$ac_ext -if $ac_preproc_ok -then : - break -fi - done - ac_cv_prog_CPP=$CPP - ;; -esac -fi - CPP=$ac_cv_prog_CPP + 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 - ac_cv_prog_CPP=$CPP -fi -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CPP" >&5 -printf "%s\n" "$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. - # 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 confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include <limits.h> - Syntax error -_ACEOF -if ac_fn_c_try_cpp "$LINENO" -then : - -else case e in #( - e) # Broken: fails on valid input. -continue ;; -esac -fi -rm -f conftest.err conftest.i conftest.$ac_ext - - # OK, works on sane cases. Now check whether nonexistent headers - # can be detected and how. - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include <ac_nonexistent.h> -_ACEOF -if ac_fn_c_try_cpp "$LINENO" -then : - # Broken: success on invalid input. -continue -else case e in #( - e) # Passes both tests. -ac_preproc_ok=: -break ;; -esac -fi -rm -f conftest.err conftest.i conftest.$ac_ext - -done -# Because of 'break', _AC_PREPROC_IFELSE's cleaning code was skipped. -rm -f conftest.i conftest.err conftest.$ac_ext -if $ac_preproc_ok -then : - -else case e in #( - e) { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in '$ac_pwd':" >&5 -printf "%s\n" "$as_me: error: in '$ac_pwd':" >&2;} -as_fn_error $? "C preprocessor \"$CPP\" fails sanity check -See 'config.log' for more details" "$LINENO" 5; } ;; -esac -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 - - -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for egrep -e" >&5 -printf %s "checking for egrep -e... " >&6; } -if test ${ac_cv_path_EGREP_TRADITIONAL+y} -then : - printf %s "(cached) " >&6 -else case e in #( - e) if test -z "$EGREP_TRADITIONAL"; then - ac_path_EGREP_TRADITIONAL_found=false - # Loop through the user's path and test for each of PROGNAME-LIST - as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin -do - IFS=$as_save_IFS - case $as_dir in #((( - '') as_dir=./ ;; - */) ;; - *) as_dir=$as_dir/ ;; - esac - for ac_prog in grep ggrep - do - for ac_exec_ext in '' $ac_executable_extensions; do - ac_path_EGREP_TRADITIONAL="$as_dir$ac_prog$ac_exec_ext" - as_fn_executable_p "$ac_path_EGREP_TRADITIONAL" || continue -# Check for GNU ac_path_EGREP_TRADITIONAL and select it if it is found. - # Check for GNU $ac_path_EGREP_TRADITIONAL -case `"$ac_path_EGREP_TRADITIONAL" --version 2>&1` in #( -*GNU*) - ac_cv_path_EGREP_TRADITIONAL="$ac_path_EGREP_TRADITIONAL" ac_path_EGREP_TRADITIONAL_found=:;; -#( -*) - ac_count=0 - printf %s 0123456789 >"conftest.in" - while : - do - cat "conftest.in" "conftest.in" >"conftest.tmp" - mv "conftest.tmp" "conftest.in" - cp "conftest.in" "conftest.nl" - printf "%s\n" 'EGREP_TRADITIONAL' >> "conftest.nl" - "$ac_path_EGREP_TRADITIONAL" -E 'EGR(EP|AC)_TRADITIONAL$' < "conftest.nl" >"conftest.out" 2>/dev/null || break - diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break - as_fn_arith $ac_count + 1 && ac_count=$as_val - if test $ac_count -gt ${ac_path_EGREP_TRADITIONAL_max-0}; then - # Best one so far, save it but keep looking for a better one - ac_cv_path_EGREP_TRADITIONAL="$ac_path_EGREP_TRADITIONAL" - ac_path_EGREP_TRADITIONAL_max=$ac_count - fi - # 10*(2^10) chars as input seems more than enough - test $ac_count -gt 10 && break - done - rm -f conftest.in conftest.tmp conftest.nl conftest.out;; -esac - - $ac_path_EGREP_TRADITIONAL_found && break 3 - done - done - done -IFS=$as_save_IFS - if test -z "$ac_cv_path_EGREP_TRADITIONAL"; then - : - fi -else - ac_cv_path_EGREP_TRADITIONAL=$EGREP_TRADITIONAL -fi - - if test "$ac_cv_path_EGREP_TRADITIONAL" -then : - ac_cv_path_EGREP_TRADITIONAL="$ac_cv_path_EGREP_TRADITIONAL -E" -else case e in #( - e) if test -z "$EGREP_TRADITIONAL"; then - ac_path_EGREP_TRADITIONAL_found=false - # Loop through the user's path and test for each of PROGNAME-LIST - as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin -do - IFS=$as_save_IFS - case $as_dir in #((( - '') as_dir=./ ;; - */) ;; - *) as_dir=$as_dir/ ;; - esac - for ac_prog in egrep - do - for ac_exec_ext in '' $ac_executable_extensions; do - ac_path_EGREP_TRADITIONAL="$as_dir$ac_prog$ac_exec_ext" - as_fn_executable_p "$ac_path_EGREP_TRADITIONAL" || continue -# Check for GNU ac_path_EGREP_TRADITIONAL and select it if it is found. - # Check for GNU $ac_path_EGREP_TRADITIONAL -case `"$ac_path_EGREP_TRADITIONAL" --version 2>&1` in #( -*GNU*) - ac_cv_path_EGREP_TRADITIONAL="$ac_path_EGREP_TRADITIONAL" ac_path_EGREP_TRADITIONAL_found=:;; -#( -*) - ac_count=0 - printf %s 0123456789 >"conftest.in" - while : - do - cat "conftest.in" "conftest.in" >"conftest.tmp" - mv "conftest.tmp" "conftest.in" - cp "conftest.in" "conftest.nl" - printf "%s\n" 'EGREP_TRADITIONAL' >> "conftest.nl" - "$ac_path_EGREP_TRADITIONAL" 'EGR(EP|AC)_TRADITIONAL$' < "conftest.nl" >"conftest.out" 2>/dev/null || break - diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break - as_fn_arith $ac_count + 1 && ac_count=$as_val - if test $ac_count -gt ${ac_path_EGREP_TRADITIONAL_max-0}; then - # Best one so far, save it but keep looking for a better one - ac_cv_path_EGREP_TRADITIONAL="$ac_path_EGREP_TRADITIONAL" - ac_path_EGREP_TRADITIONAL_max=$ac_count - fi - # 10*(2^10) chars as input seems more than enough - test $ac_count -gt 10 && break - done - rm -f conftest.in conftest.tmp conftest.nl conftest.out;; -esac - - $ac_path_EGREP_TRADITIONAL_found && break 3 - done - done - done -IFS=$as_save_IFS - if test -z "$ac_cv_path_EGREP_TRADITIONAL"; then - as_fn_error $? "no acceptable egrep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5 - fi -else - ac_cv_path_EGREP_TRADITIONAL=$EGREP_TRADITIONAL -fi - ;; -esac -fi ;; -esac -fi -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_EGREP_TRADITIONAL" >&5 -printf "%s\n" "$ac_cv_path_EGREP_TRADITIONAL" >&6; } - EGREP_TRADITIONAL=$ac_cv_path_EGREP_TRADITIONAL - - - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether to embed manifest" >&5 -printf %s "checking whether to embed manifest... " >&6; } - # Check whether --enable-embedded-manifest was given. -if test ${enable_embedded_manifest+y} -then : - enableval=$enable_embedded_manifest; embed_ok=$enableval -else case e in #( - e) embed_ok=yes ;; -esac -fi - + embed_ok=yes +fi; VC_MANIFEST_EMBED_DLL= VC_MANIFEST_EMBED_EXE= @@ -5836,7 +4719,11 @@ fi 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 confdefs.h - <<_ACEOF >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. */ #if defined(_MSC_VER) && _MSC_VER >= 1400 @@ -5845,8 +4732,7 @@ print("manifest needed") _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - $EGREP_TRADITIONAL "manifest needed" >/dev/null 2>&1 -then : + $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 @@ -5862,11 +4748,11 @@ then : fi fi -rm -rf conftest* +rm -f conftest* fi - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $result" >&5 -printf "%s\n" "$result" >&6; } + echo "$as_me:$LINENO: result: $result" >&5 +echo "${ECHO_T}$result" >&6 @@ -5881,10 +4767,20 @@ 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_LIB_FILE=${LIBPREFIX}tcl$VER${LIBSUFFIX}" + +eval "TCL_LIB_FLAG=\"-ltcl${VER}${LIBFLAGSUFFIX}\"" +eval "TCL_BUILD_LIB_SPEC=\"-L`$CYGPATH $(pwd)` ${TCL_LIB_FLAG}\"" +eval "TCL_LIB_SPEC=\"-L${libdir} ${TCL_LIB_FLAG}\"" + eval "TCL_STUB_LIB_FILE=\"${LIBPREFIX}tclstub${VER}${LIBSUFFIX}\"" eval "TCL_STUB_LIB_FLAG=\"-ltclstub${VER}${LIBFLAGSUFFIX}\"" eval "TCL_BUILD_STUB_LIB_SPEC=\"-L`$CYGPATH $(pwd)` ${TCL_STUB_LIB_FLAG}\"" @@ -5892,24 +4788,18 @@ 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}\"" -if test ${SHARED_BUILD} = 0 -o "$GCC" != "yes" ; then - eval "TCL_LIB_FLAG=\"${LIBPREFIX}tcl${VER}${LIBSUFFIX}\"" - eval "TCL_LIB_FILE=\"${LIBPREFIX}tcl${VER}${LIBSUFFIX}\"" -else - eval "TCL_LIB_FLAG=\"-ltcl${VER}${FLAGSUFFIX}\"" - eval "TCL_LIB_FILE=\"${LIBPREFIX}tcl${VER}${DLLSUFFIX}.a\"" -fi -eval "TCL_BUILD_LIB_SPEC=\"-L`$CYGPATH $(pwd)` ${TCL_LIB_FLAG}\"" -eval "TCL_LIB_SPEC=\"-L${libdir} ${TCL_LIB_FLAG}\"" - # Install time header dir can be set via --includedir eval "TCL_INCLUDE_SPEC=\"-I${includedir}\"" -TCL_SHARED_LIB_SUFFIX="\${NODOT_VERSION}${DLLSUFFIX}" -TCL_UNSHARED_LIB_SUFFIX="\${NODOT_VERSION}${LIBSUFFIX}" + +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 @@ -5917,9 +4807,17 @@ CFG_TCL_UNSHARED_LIB_SUFFIX=${TCL_UNSHARED_LIB_SUFFIX} #-------------------------------------------------------------------- if test ${SHARED_BUILD} = 0 ; then - RC_DEFINES="${RC_DEFINE} STATIC_BUILD" + if test "${DBGX}" = "g"; then + RC_DEFINES="${RC_DEFINE} STATIC_BUILD ${RC_DEFINE} DEBUG" + else + RC_DEFINES="${RC_DEFINE} STATIC_BUILD" + fi else - RC_DEFINES="" + if test "${DBGX}" = "g"; then + RC_DEFINES="${RC_DEFINE} DEBUG" + else + RC_DEFINES="" + fi fi #-------------------------------------------------------------------- @@ -5930,9 +4828,9 @@ fi #-------------------------------------------------------------------- if test "$prefix/lib" != "$libdir"; then - TCL_PACKAGE_PATH="${libdir};${prefix}\\lib" + TCL_PACKAGE_PATH="${libdir} ${prefix}/lib" else - TCL_PACKAGE_PATH="${prefix}\\lib" + TCL_PACKAGE_PATH="${prefix}/lib" fi # The tclsh.exe.manifest requires these @@ -5945,10 +4843,7 @@ case "$TCL_PATCH_LEVEL" in esac TCL_WIN_VERSION="$TCL_VERSION.$TCL_RELEASE_LEVEL.`echo $TCL_PATCH_LEVEL | tr -d ab.`" -# X86|AMD64|ARM64|IA64 for manifest - - - +# X86|AMD64|IA64 for manifest @@ -5958,11 +4853,10 @@ TCL_WIN_VERSION="$TCL_VERSION.$TCL_RELEASE_LEVEL.`echo $TCL_PATCH_LEVEL | tr -d +# empty on win -# empty on win - @@ -6023,8 +4917,8 @@ TCL_WIN_VERSION="$TCL_VERSION.$TCL_RELEASE_LEVEL.`echo $TCL_PATCH_LEVEL | tr -d -# win only +# win only @@ -6039,8 +4933,8 @@ TCL_WIN_VERSION="$TCL_VERSION.$TCL_RELEASE_LEVEL.`echo $TCL_PATCH_LEVEL | tr -d -ac_config_files="$ac_config_files Makefile tclConfig.sh tclsh.exe.manifest" + 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 @@ -6051,78 +4945,47 @@ cat >confcache <<\_ACEOF # 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 +# `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, we kill variables containing newlines. +# 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. -( - for ac_var in `(set) 2>&1 | sed -n 's/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'`; do - eval ac_val=\$$ac_var - case $ac_val in #( - *${as_nl}*) - case $ac_var in #( - *_cv_*) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5 -printf "%s\n" "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;; - esac - case $ac_var in #( - _ | IFS | as_nl) ;; #( - BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #( - *) { eval $ac_var=; unset $ac_var;} ;; - esac ;; - esac - done - +{ (set) 2>&1 | - case $as_nl`(ac_space=' '; set) 2>&1` in #( - *${as_nl}ac_space=\ *) - # 'set' does not quote correctly, so add quotes: double-quote - # substitution turns \\\\ into \\, and sed turns \\ into \. + 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 "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/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 | - sort -) | + esac; +} | sed ' - /^ac_cv_env_/b end t clear - :clear - s/^\([^=]*\)=\(.*[{}].*\)$/test ${\1+y} || &/ + : clear + s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/ t end - s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/ - :end' >>confcache -if diff "$cache_file" confcache >/dev/null 2>&1; then :; else - if test -w "$cache_file"; then - if test "x$cache_file" != "x/dev/null"; then - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: updating cache $cache_file" >&5 -printf "%s\n" "$as_me: updating cache $cache_file" >&6;} - if test ! -f "$cache_file" || test -h "$cache_file"; then - cat confcache >"$cache_file" - else - case $cache_file in #( - */* | ?:*) - mv -f confcache "$cache_file"$$ && - mv -f "$cache_file"$$ "$cache_file" ;; #( - *) - mv -f confcache "$cache_file" ;; - esac - fi - fi + /^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 - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: not updating unwritable cache $cache_file" >&5 -printf "%s\n" "$as_me: not updating unwritable cache $cache_file" >&6;} + echo "not updating unwritable cache $cache_file" fi fi rm -f confcache @@ -6131,53 +4994,63 @@ 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 branch to the quote section. Otherwise, +# take arguments), then we branch to the quote section. Otherwise, # look for a macro that doesn't take arguments. -ac_script=' -:mline -/\\$/{ - N - s,\\\n,, - b mline -} +cat >confdef2opt.sed <<\_ACEOF t clear -:clear -s/^[ ]*#[ ]*define[ ][ ]*\([^ (][^ (]*([^)]*)\)[ ]*\(.*\)/-D\1=\2/g +: clear +s,^[ ]*#[ ]*define[ ][ ]*\([^ (][^ (]*([^)]*)\)[ ]*\(.*\),-D\1=\2,g t quote -s/^[ ]*#[ ]*define[ ][ ]*\([^ ][^ ]*\)[ ]*\(.*\)/-D\1=\2/g +s,^[ ]*#[ ]*define[ ][ ]*\([^ ][^ ]*\)[ ]*\(.*\),-D\1=\2,g t quote -b any -:quote -s/[][ `~#$^&*(){}\\|;'\''"<>?]/\\&/g -s/\$/$$/g -H -:any -${ - g - s/^\n// - s/\n/ /g - p -} -' -DEFS=`sed -n "$ac_script" confdefs.h` +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= -U= for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue # 1. Remove the extension, and $U if already installed. - ac_script='s/\$U\././;s/\.o$//;s/\.obj$//' - ac_i=`printf "%s\n" "$ac_i" | sed "$ac_script"` - # 2. Prepend LIBOBJDIR. When used with automake>=1.10 LIBOBJDIR - # will be set to the directory where LIBOBJS objects are built. - as_fn_append ac_libobjs " \${LIBOBJDIR}$ac_i\$U.$ac_objext" - as_fn_append ac_ltlibobjs " \${LIBOBJDIR}$ac_i"'$U.lo' + 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 @@ -6185,14 +5058,12 @@ LTLIBOBJS=$ac_ltlibobjs -: "${CONFIG_STATUS=./config.status}" -ac_write_fail=0 +: ${CONFIG_STATUS=./config.status} ac_clean_files_save=$ac_clean_files ac_clean_files="$ac_clean_files $CONFIG_STATUS" -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: creating $CONFIG_STATUS" >&5 -printf "%s\n" "$as_me: creating $CONFIG_STATUS" >&6;} -as_write_fail=0 -cat >$CONFIG_STATUS <<_ASEOF || as_write_fail=1 +{ 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. @@ -6202,237 +5073,81 @@ cat >$CONFIG_STATUS <<_ASEOF || as_write_fail=1 debug=false ac_cs_recheck=false ac_cs_silent=false - SHELL=\${CONFIG_SHELL-$SHELL} -export SHELL -_ASEOF -cat >>$CONFIG_STATUS <<\_ASEOF || as_write_fail=1 -## -------------------- ## -## M4sh Initialization. ## -## -------------------- ## - -# Be more Bourne compatible -DUALCASE=1; export DUALCASE # for MKS sh -if test ${ZSH_VERSION+y} && (emulate sh) >/dev/null 2>&1 -then : +_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=: - # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which + # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' - setopt NO_GLOB_SUBST -else case e in #( - e) case `(set -o) 2>/dev/null` in #( - *posix*) : - set -o posix ;; #( - *) : - ;; -esac ;; -esac +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 -# Reset variables that may have inherited troublesome values from -# the environment. - -# IFS needs to be set, to space, tab, and newline, in precisely that order. -# (If _AS_PATH_WALK were called with IFS unset, it would have the -# side effect of setting IFS to empty, thus disabling word splitting.) -# Quoting is to prevent editors from complaining about space-tab. -as_nl=' -' -export as_nl -IFS=" "" $as_nl" - +# Work around bugs in pre-3.0 UWIN ksh. +$as_unset ENV MAIL MAILPATH PS1='$ ' PS2='> ' PS4='+ ' -# Ensure predictable behavior from utilities with locale-dependent output. -LC_ALL=C -export LC_ALL -LANGUAGE=C -export LANGUAGE - -# We cannot yet rely on "unset" to work, but we need these variables -# to be unset--not just set to an empty or harmless value--now, to -# avoid bugs in old shells (e.g. pre-3.0 UWIN ksh). This construct -# also avoids known problems related to "unset" and subshell syntax -# in other old shells (e.g. bash 2.01 and pdksh 5.2.14). -for as_var in BASH_ENV ENV MAIL MAILPATH CDPATH -do eval test \${$as_var+y} \ - && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || : -done - -# Ensure that fds 0, 1, and 2 are open. -if (exec 3>&0) 2>/dev/null; then :; else exec 0</dev/null; fi -if (exec 3>&1) 2>/dev/null; then :; else exec 1>/dev/null; fi -if (exec 3>&2) ; then :; else exec 2>/dev/null; fi - -# The user is always right. -if ${PATH_SEPARATOR+false} :; then - PATH_SEPARATOR=: - (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && { - (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 || - PATH_SEPARATOR=';' - } -fi - - -# Find who we are. Look in the path if we contain no directory separator. -as_myself= -case $0 in #(( - *[\\/]* ) as_myself=$0 ;; - *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH +# 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 - IFS=$as_save_IFS - case $as_dir in #((( - '') as_dir=./ ;; - */) ;; - *) as_dir=$as_dir/ ;; - esac - test -r "$as_dir$0" && as_myself=$as_dir$0 && break - done -IFS=$as_save_IFS - - ;; -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 - printf "%s\n" "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 - exit 1 -fi - - - -# as_fn_error STATUS ERROR [LINENO LOG_FD] -# ---------------------------------------- -# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are -# provided, also output the error to LOG_FD, referencing LINENO. Then exit the -# script with STATUS, using 1 if that was 0. -as_fn_error () -{ - as_status=$1; test $as_status -eq 0 && as_status=1 - if test "$4"; then - as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack - printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: $2" >&$4 + 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 - printf "%s\n" "$as_me: error: $2" >&2 - as_fn_exit $as_status -} # as_fn_error - - -# as_fn_set_status STATUS -# ----------------------- -# Set $? to STATUS, without forking. -as_fn_set_status () -{ - return $1 -} # as_fn_set_status - -# as_fn_exit STATUS -# ----------------- -# Exit the shell with STATUS, even in a "trap 0" or "set -e" context. -as_fn_exit () -{ - set +e - as_fn_set_status $1 - exit $1 -} # as_fn_exit - -# as_fn_unset VAR -# --------------- -# Portably unset VAR. -as_fn_unset () -{ - { eval $1=; unset $1;} -} -as_unset=as_fn_unset - -# as_fn_append VAR VALUE -# ---------------------- -# Append the text in VALUE to the end of the definition contained in VAR. Take -# advantage of any shell optimizations that allow amortized linear growth over -# repeated appends, instead of the typical quadratic growth present in naive -# implementations. -if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null -then : - eval 'as_fn_append () - { - eval $1+=\$2 - }' -else case e in #( - e) as_fn_append () - { - eval $1=\$$1\$2 - } ;; -esac -fi # as_fn_append - -# as_fn_arith ARG... -# ------------------ -# Perform arithmetic evaluation on the ARGs, and store the result in the -# global $as_val. Take advantage of shells that can avoid forks. The arguments -# must be portable across $(()) and expr. -if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null -then : - eval 'as_fn_arith () - { - as_val=$(( $* )) - }' -else case e in #( - e) as_fn_arith () - { - as_val=`expr "$@" || test $? -eq 1` - } ;; -esac -fi # as_fn_arith - +done -if expr a : '\(a\)' >/dev/null 2>&1 && - test "X`expr 00001 : '.*\(...\)'`" = X001; then +# 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 +if (basename /) >/dev/null 2>&1 && test "X`basename / 2>&1`" = "X/"; then as_basename=basename else as_basename=false fi -if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then - as_dirname=dirname -else - as_dirname=false -fi -as_me=`$as_basename -- "$0" || +# Name of the executable. +as_me=`$as_basename "$0" || $as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ X"$0" : 'X\(//\)$' \| \ - X"$0" : 'X\(/\)' \| . 2>/dev/null || -printf "%s\n" X/"$0" | - sed '/^.*\/\([^/][^/]*\)\/*$/{ - s//\1/ - q - } - /^X\/\(\/\/\)$/{ - s//\1/ - q - } - /^X\/\(\/\).*/{ - s//\1/ - q - } - s/.*/./; q'` + 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' @@ -6440,145 +5155,181 @@ 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 -# Determine whether it's possible to make 'echo' print without a newline. -# These variables are no longer used directly by Autoconf, but are AC_SUBSTed -# for compatibility with existing Makefiles. -ECHO_C= ECHO_N= ECHO_T= -case `echo -n x` in #((((( --n*) - case `echo 'xy\c'` in - *c*) ECHO_T=' ';; # ECHO_T is single tab character. - xy) ECHO_C='\c';; - *) echo `echo ksh88 bug on AIX 6.1` > /dev/null - ECHO_T=' ';; - esac;; -*) - ECHO_N='-n';; -esac -# For backward compatibility with old third-party macros, we provide -# the shell variables $as_echo and $as_echo_n. New code should use -# AS_ECHO(["message"]) and AS_ECHO_N(["message"]), respectively. -as_echo='printf %s\n' -as_echo_n='printf %s' + 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 -rm -f conf$$ conf$$.exe conf$$.file -if test -d conf$$.dir; then - rm -f conf$$.dir/conf$$.file + ;; + 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 - rm -f conf$$.dir - mkdir conf$$.dir 2>/dev/null + as_expr=false fi -if (echo >conf$$.file) 2>/dev/null; then - if ln -s conf$$.file conf$$ 2>/dev/null; then - as_ln_s='ln -s' - # ... but there are two gotchas: - # 1) On MSYS, both 'ln -s file dir' and 'ln file dir' fail. - # 2) DJGPP < 2.04 has no symlinks; 'ln -s' creates a wrapper executable. - # In both cases, we have to default to 'cp -pR'. - ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || - as_ln_s='cp -pR' - elif ln conf$$.file conf$$ 2>/dev/null; then - as_ln_s=ln + +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='cp -pR' + as_ln_s='ln -s' fi +elif ln conf$$.file conf$$ 2>/dev/null; then + as_ln_s=ln else - as_ln_s='cp -pR' + as_ln_s='cp -p' fi -rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file -rmdir conf$$.dir 2>/dev/null - - -# as_fn_mkdir_p -# ------------- -# Create "$as_dir" as a directory, including parents if necessary. -as_fn_mkdir_p () -{ - - case $as_dir in #( - -*) as_dir=./$as_dir;; - esac - test -d "$as_dir" || eval $as_mkdir_p || { - as_dirs= - while :; do - case $as_dir in #( - *\'*) as_qdir=`printf "%s\n" "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'( - *) as_qdir=$as_dir;; - esac - as_dirs="'$as_qdir' $as_dirs" - as_dir=`$as_dirname -- "$as_dir" || -$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ - X"$as_dir" : 'X\(//\)[^/]' \| \ - X"$as_dir" : 'X\(//\)$' \| \ - X"$as_dir" : 'X\(/\)' \| . 2>/dev/null || -printf "%s\n" X"$as_dir" | - sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ - s//\1/ - q - } - /^X\(\/\/\)[^/].*/{ - s//\1/ - q - } - /^X\(\/\/\)$/{ - s//\1/ - q - } - /^X\(\/\).*/{ - s//\1/ - q - } - s/.*/./; q'` - test -d "$as_dir" && break - done - test -z "$as_dirs" || eval "mkdir $as_dirs" - } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir" - +rm -f conf$$ conf$$.exe conf$$.file -} # as_fn_mkdir_p if mkdir -p . 2>/dev/null; then - as_mkdir_p='mkdir -p "$as_dir"' + as_mkdir_p=: else test -d ./-p && rmdir ./-p as_mkdir_p=false fi - -# as_fn_executable_p FILE -# ----------------------- -# Test if FILE is an executable regular file. -as_fn_executable_p () -{ - test -f "$1" && test -x "$1" -} # as_fn_executable_p -as_test_x='test -x' -as_executable_p=as_fn_executable_p +as_executable_p="test -f" # Sed expression to map a string onto a valid CPP name. -as_sed_cpp="y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g" -as_tr_cpp="eval sed '$as_sed_cpp'" # deprecated +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_sed_sh="y%*+%pp%;s%[^_$as_cr_alnum]%_%g" -as_tr_sh="eval sed '$as_sed_sh'" # deprecated +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 -## ----------------------------------- ## -## Main body of $CONFIG_STATUS script. ## -## ----------------------------------- ## -_ASEOF -test $as_write_fail = 0 && chmod +x $CONFIG_STATUS || ac_write_fail=1 - -cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 -# Save the log message, to keep $0 and so on meaningful, and to + +# 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. -ac_log=" -This file was extended by tcl $as_me 8.7, which was -generated by GNU Autoconf 2.72. Invocation command line was +# 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 @@ -6586,118 +5337,124 @@ generated by GNU Autoconf 2.72. Invocation command line was CONFIG_COMMANDS = $CONFIG_COMMANDS $ $0 $@ -on `(hostname || uname -n) 2>/dev/null | sed 1q` -" - +_CSEOF +echo "on `(hostname || uname -n) 2>/dev/null | sed 1q`" >&5 +echo >&5 _ACEOF -case $ac_config_files in *" -"*) set x $ac_config_files; shift; ac_config_files=$*;; -esac +# 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 -cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 -# Files that config.status was made for. -config_files="$ac_config_files" +if test -n "$ac_config_commands"; then + echo "config_commands=\"$ac_config_commands\"" >>$CONFIG_STATUS +fi -_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF -cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 ac_cs_usage="\ -'$as_me' instantiates files and other configuration actions -from templates according to the current configuration. Unless the files -and actions are specified as TAGs, all are instantiated by default. +\`$as_me' instantiates files from templates according to the +current configuration. -Usage: $0 [OPTION]... [TAG]... +Usage: $0 [OPTIONS] [FILE]... -h, --help print this help, then exit - -V, --version print version number and configuration settings, then exit - --config print configuration, then exit - -q, --quiet, --silent - do not print progress messages + -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 + --file=FILE[:TEMPLATE] + instantiate the configuration file FILE Configuration files: $config_files -Report bugs to the package provider." - +Report bugs to <bug-autoconf@gnu.org>." _ACEOF -ac_cs_config=`printf "%s\n" "$ac_configure_args" | sed "$ac_safe_unquote"` -ac_cs_config_escaped=`printf "%s\n" "$ac_cs_config" | sed "s/^ //; s/'/'\\\\\\\\''/g"` -cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 -ac_cs_config='$ac_cs_config_escaped' + +cat >>$CONFIG_STATUS <<_ACEOF ac_cs_version="\\ -tcl config.status 8.7 -configured by $0, generated by GNU Autoconf 2.72, - with options \\"\$ac_cs_config\\" +config.status +configured by $0, generated by GNU Autoconf 2.59, + with options \\"`echo "$ac_configure_args" | sed 's/[\\""\`\$]/\\\\&/g'`\\" -Copyright (C) 2023 Free Software Foundation, Inc. +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." - -ac_pwd='$ac_pwd' -srcdir='$srcdir' -test -n "\$AWK" || AWK=awk +srcdir=$srcdir _ACEOF -cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 -# The default lists apply if the user does not specify any file. +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=`expr "X$1" : 'X\([^=]*\)='` - ac_optarg= + --*=*) + 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 | --versio | --versi | --vers | --ver | --ve | --v | -V ) - printf "%s\n" "$ac_cs_version"; exit ;; - --config | --confi | --conf | --con | --co | --c ) - printf "%s\n" "$ac_cs_config"; exit ;; - --debug | --debu | --deb | --de | --d | -d ) + --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 - case $ac_optarg in - *\'*) ac_optarg=`printf "%s\n" "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;; - '') as_fn_error $? "missing file argument" ;; - esac - as_fn_append CONFIG_FILES " '$ac_optarg'" + 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;; - --he | --h | --help | --hel | -h ) - printf "%s\n" "$ac_cs_usage"; exit ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil | --si | --s) ac_cs_silent=: ;; # This is an error. - -*) as_fn_error $? "unrecognized option: '$1' -Try '$0 --help' for more information." ;; + -*) { { 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; }; } ;; - *) as_fn_append ac_config_targets " $1" - ac_need_defaults=false ;; + *) ac_config_targets="$ac_config_targets $1" ;; esac shift @@ -6711,463 +5468,447 @@ if $ac_cs_silent; then fi _ACEOF -cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +cat >>$CONFIG_STATUS <<_ACEOF if \$ac_cs_recheck; then - set X $SHELL '$0' $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion - shift - \printf "%s\n" "running CONFIG_SHELL=$SHELL \$*" >&6 - CONFIG_SHELL='$SHELL' - export CONFIG_SHELL - exec "\$@" + 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 || ac_write_fail=1 -exec 5>>config.log -{ - echo - sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX -## Running $as_me. ## -_ASBOX - printf "%s\n" "$ac_log" -} >&5 -_ACEOF -cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 -_ACEOF -cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 -# Handling of arguments. + + +cat >>$CONFIG_STATUS <<\_ACEOF for ac_config_target in $ac_config_targets do - case $ac_config_target in - "Makefile") CONFIG_FILES="$CONFIG_FILES Makefile" ;; - "tclConfig.sh") CONFIG_FILES="$CONFIG_FILES tclConfig.sh" ;; - "tclsh.exe.manifest") CONFIG_FILES="$CONFIG_FILES tclsh.exe.manifest" ;; - - *) as_fn_error $? "invalid argument: '$ac_config_target'" "$LINENO" 5;; + 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+y} || CONFIG_FILES=$config_files + 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 against having it here, and in addition, +# simply because there is no reason to put it here, and in addition, # creating and moving files from /tmp can sometimes cause problems. -# Hook for its removal unless debugging. -# Note that there is a small window in which the directory will not be cleaned: -# after its creation but before its name has been assigned to '$tmp'. +# Create a temporary directory, and hook for its removal unless debugging. $debug || { - tmp= ac_tmp= - trap 'exit_status=$? - : "${ac_tmp:=$tmp}" - { test ! -d "$ac_tmp" || rm -fr "$ac_tmp"; } && exit $exit_status -' 0 - trap 'as_fn_exit 1' 1 2 13 15 + 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 "./confXXXXXX") 2>/dev/null` && - test -d "$tmp" + tmp=`(umask 077 && mktemp -d -q "./confstatXXXXXX") 2>/dev/null` && + test -n "$tmp" && test -d "$tmp" } || { - tmp=./conf$$-$RANDOM - (umask 077 && mkdir "$tmp") -} || as_fn_error $? "cannot create a temporary directory in ." "$LINENO" 5 -ac_tmp=$tmp - -# Set up the scripts for CONFIG_FILES section. -# No need to generate them if there are no CONFIG_FILES. -# This happens for instance with './config.status config.h'. -if test -n "$CONFIG_FILES"; then - - -ac_cr=`echo X | tr X '\015'` -# On cygwin, bash can eat \r inside `` if the user requested igncr. -# But we know of no other shell where ac_cr would be empty at this -# point, so we can use a bashism as a fallback. -if test "x$ac_cr" = x; then - eval ac_cr=\$\'\\r\' -fi -ac_cs_awk_cr=`$AWK 'BEGIN { print "a\rb" }' </dev/null 2>/dev/null` -if test "$ac_cs_awk_cr" = "a${ac_cr}b"; then - ac_cs_awk_cr='\\r' -else - ac_cs_awk_cr=$ac_cr -fi - -echo 'BEGIN {' >"$ac_tmp/subs1.awk" && -_ACEOF - - -{ - echo "cat >conf$$subs.awk <<_ACEOF" && - echo "$ac_subst_vars" | sed 's/.*/&!$&$ac_delim/' && - echo "_ACEOF" -} >conf$$subs.sh || - as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 -ac_delim_num=`echo "$ac_subst_vars" | grep -c '^'` -ac_delim='%!_!# ' -for ac_last_try in false false false false false :; do - . ./conf$$subs.sh || - as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 - - ac_delim_n=`sed -n "s/.*$ac_delim\$/X/p" conf$$subs.awk | grep -c X` - if test $ac_delim_n = $ac_delim_num; then - break - elif $ac_last_try; then - as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 - else - ac_delim="$ac_delim!$ac_delim _$ac_delim!! " - fi -done -rm -f conf$$subs.sh - -cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 -cat >>"\$ac_tmp/subs1.awk" <<\\_ACAWK && -_ACEOF -sed -n ' -h -s/^/S["/; s/!.*/"]=/ -p -g -s/^[^!]*!// -:repl -t repl -s/'"$ac_delim"'$// -t delim -:nl -h -s/\(.\{148\}\)..*/\1/ -t more1 -s/["\\]/\\&/g; s/^/"/; s/$/\\n"\\/ -p -n -b repl -:more1 -s/["\\]/\\&/g; s/^/"/; s/$/"\\/ -p -g -s/.\{148\}// -t nl -:delim -h -s/\(.\{148\}\)..*/\1/ -t more2 -s/["\\]/\\&/g; s/^/"/; s/$/"/ -p -b -:more2 -s/["\\]/\\&/g; s/^/"/; s/$/"\\/ -p -g -s/.\{148\}// -t delim -' <conf$$subs.awk | sed ' -/^[^""]/{ - N - s/\n// -} -' >>$CONFIG_STATUS || ac_write_fail=1 -rm -f conf$$subs.awk -cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 -_ACAWK -cat >>"\$ac_tmp/subs1.awk" <<_ACAWK && - for (key in S) S_is_set[key] = 1 - FS = "" - -} + tmp=./confstat$$-$RANDOM + (umask 077 && mkdir $tmp) +} || { - line = $ 0 - nfields = split(line, field, "@") - substed = 0 - len = length(field[1]) - for (i = 2; i < nfields; i++) { - key = field[i] - keylen = length(key) - if (S_is_set[key]) { - value = S[key] - line = substr(line, 1, len) "" value "" substr(line, len + keylen + 3) - len += length(value) + length(field[++i]) - substed = 1 - } else - len += 1 + keylen - } - - print line + echo "$me: cannot create a temporary directory in ." >&2 + { (exit 1); exit 1; } } -_ACAWK -_ACEOF -cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 -if sed "s/$ac_cr//" < /dev/null > /dev/null 2>&1; then - sed "s/$ac_cr\$//; s/$ac_cr/$ac_cs_awk_cr/g" -else - cat -fi < "$ac_tmp/subs1.awk" > "$ac_tmp/subs.awk" \ - || as_fn_error $? "could not setup config files machinery" "$LINENO" 5 _ACEOF -# VPATH may cause trouble with some makes, so we remove sole $(srcdir), -# ${srcdir} and @srcdir@ entries 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[ ]*=[ ]*/{ -h -s/// -s/^/:/ -s/[ ]*$/:/ -s/:\$(srcdir):/:/g -s/:\${srcdir}:/:/g -s/:@srcdir@:/:/g -s/^:*// -s/:*$// -x -s/\(=[ ]*\).*/\1/ -G -s/\n// -s/^[^=]*=[ ]*$// -}' -fi +cat >>$CONFIG_STATUS <<_ACEOF -cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 -fi # test -n "$CONFIG_FILES" +# +# CONFIG_FILES section. +# +# No need to generate the scripts if there are no CONFIG_FILES. +# This happens for instance when ./config.status config.h +if test -n "\$CONFIG_FILES"; then + # Protect against being on the right side of a sed subst in config.status. + sed 's/,@/@@/; s/@,/@@/; s/,;t t\$/@;t t/; /@;t t\$/s/[\\\\&,]/\\\\&/g; + s/@@/,@/; s/@@/@,/; s/@;t t\$/,;t t/' >\$tmp/subs.sed <<\\CEOF +s,@SHELL@,$SHELL,;t t +s,@PATH_SEPARATOR@,$PATH_SEPARATOR,;t t +s,@PACKAGE_NAME@,$PACKAGE_NAME,;t t +s,@PACKAGE_TARNAME@,$PACKAGE_TARNAME,;t t +s,@PACKAGE_VERSION@,$PACKAGE_VERSION,;t t +s,@PACKAGE_STRING@,$PACKAGE_STRING,;t t +s,@PACKAGE_BUGREPORT@,$PACKAGE_BUGREPORT,;t t +s,@exec_prefix@,$exec_prefix,;t t +s,@prefix@,$prefix,;t t +s,@program_transform_name@,$program_transform_name,;t t +s,@bindir@,$bindir,;t t +s,@sbindir@,$sbindir,;t t +s,@libexecdir@,$libexecdir,;t t +s,@datadir@,$datadir,;t t +s,@sysconfdir@,$sysconfdir,;t t +s,@sharedstatedir@,$sharedstatedir,;t t +s,@localstatedir@,$localstatedir,;t t +s,@libdir@,$libdir,;t t +s,@includedir@,$includedir,;t t +s,@oldincludedir@,$oldincludedir,;t t +s,@infodir@,$infodir,;t t +s,@mandir@,$mandir,;t t +s,@build_alias@,$build_alias,;t t +s,@host_alias@,$host_alias,;t t +s,@target_alias@,$target_alias,;t t +s,@DEFS@,$DEFS,;t t +s,@ECHO_C@,$ECHO_C,;t t +s,@ECHO_N@,$ECHO_N,;t t +s,@ECHO_T@,$ECHO_T,;t t +s,@LIBS@,$LIBS,;t t +s,@CC@,$CC,;t t +s,@CFLAGS@,$CFLAGS,;t t +s,@LDFLAGS@,$LDFLAGS,;t t +s,@CPPFLAGS@,$CPPFLAGS,;t t +s,@ac_ct_CC@,$ac_ct_CC,;t t +s,@EXEEXT@,$EXEEXT,;t t +s,@OBJEXT@,$OBJEXT,;t t +s,@CPP@,$CPP,;t t +s,@EGREP@,$EGREP,;t t +s,@AR@,$AR,;t t +s,@ac_ct_AR@,$ac_ct_AR,;t t +s,@RANLIB@,$RANLIB,;t t +s,@ac_ct_RANLIB@,$ac_ct_RANLIB,;t t +s,@RC@,$RC,;t t +s,@ac_ct_RC@,$ac_ct_RC,;t t +s,@SET_MAKE@,$SET_MAKE,;t t +s,@TCL_THREADS@,$TCL_THREADS,;t t +s,@CYGPATH@,$CYGPATH,;t t +s,@CELIB_DIR@,$CELIB_DIR,;t t +s,@DL_LIBS@,$DL_LIBS,;t t +s,@CFLAGS_DEBUG@,$CFLAGS_DEBUG,;t t +s,@CFLAGS_OPTIMIZE@,$CFLAGS_OPTIMIZE,;t t +s,@CFLAGS_WARNING@,$CFLAGS_WARNING,;t t +s,@CFLAGS_DEFAULT@,$CFLAGS_DEFAULT,;t t +s,@LDFLAGS_DEFAULT@,$LDFLAGS_DEFAULT,;t t +s,@VC_MANIFEST_EMBED_DLL@,$VC_MANIFEST_EMBED_DLL,;t t +s,@VC_MANIFEST_EMBED_EXE@,$VC_MANIFEST_EMBED_EXE,;t t +s,@TCL_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,@TCL_LIB_FILE@,$TCL_LIB_FILE,;t t +s,@TCL_LIB_FLAG@,$TCL_LIB_FLAG,;t t +s,@TCL_LIB_SPEC@,$TCL_LIB_SPEC,;t t +s,@TCL_STUB_LIB_FILE@,$TCL_STUB_LIB_FILE,;t t +s,@TCL_STUB_LIB_FLAG@,$TCL_STUB_LIB_FLAG,;t t +s,@TCL_STUB_LIB_SPEC@,$TCL_STUB_LIB_SPEC,;t t +s,@TCL_STUB_LIB_PATH@,$TCL_STUB_LIB_PATH,;t t +s,@TCL_INCLUDE_SPEC@,$TCL_INCLUDE_SPEC,;t t +s,@TCL_BUILD_STUB_LIB_SPEC@,$TCL_BUILD_STUB_LIB_SPEC,;t t +s,@TCL_BUILD_STUB_LIB_PATH@,$TCL_BUILD_STUB_LIB_PATH,;t t +s,@TCL_DLL_FILE@,$TCL_DLL_FILE,;t t +s,@TCL_SRC_DIR@,$TCL_SRC_DIR,;t t +s,@TCL_BIN_DIR@,$TCL_BIN_DIR,;t t +s,@TCL_DBGX@,$TCL_DBGX,;t t +s,@CFG_TCL_SHARED_LIB_SUFFIX@,$CFG_TCL_SHARED_LIB_SUFFIX,;t t +s,@CFG_TCL_UNSHARED_LIB_SUFFIX@,$CFG_TCL_UNSHARED_LIB_SUFFIX,;t t +s,@CFG_TCL_EXPORT_FILE_SUFFIX@,$CFG_TCL_EXPORT_FILE_SUFFIX,;t t +s,@EXTRA_CFLAGS@,$EXTRA_CFLAGS,;t t +s,@DEPARG@,$DEPARG,;t t +s,@CC_OBJNAME@,$CC_OBJNAME,;t t +s,@CC_EXENAME@,$CC_EXENAME,;t t +s,@LDFLAGS_DEBUG@,$LDFLAGS_DEBUG,;t t +s,@LDFLAGS_OPTIMIZE@,$LDFLAGS_OPTIMIZE,;t t +s,@LDFLAGS_CONSOLE@,$LDFLAGS_CONSOLE,;t t +s,@LDFLAGS_WINDOW@,$LDFLAGS_WINDOW,;t t +s,@STLIB_LD@,$STLIB_LD,;t t +s,@SHLIB_LD@,$SHLIB_LD,;t t +s,@SHLIB_LD_LIBS@,$SHLIB_LD_LIBS,;t t +s,@SHLIB_CFLAGS@,$SHLIB_CFLAGS,;t t +s,@SHLIB_SUFFIX@,$SHLIB_SUFFIX,;t t +s,@TCL_SHARED_BUILD@,$TCL_SHARED_BUILD,;t t +s,@LIBS_GUI@,$LIBS_GUI,;t t +s,@DLLSUFFIX@,$DLLSUFFIX,;t t +s,@LIBPREFIX@,$LIBPREFIX,;t t +s,@LIBSUFFIX@,$LIBSUFFIX,;t t +s,@EXESUFFIX@,$EXESUFFIX,;t t +s,@LIBRARIES@,$LIBRARIES,;t t +s,@MAKE_LIB@,$MAKE_LIB,;t t +s,@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_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 -eval set X " :F $CONFIG_FILES " -shift -for ac_tag -do - case $ac_tag in - :[FHLC]) ac_mode=$ac_tag; continue;; - esac - case $ac_mode$ac_tag in - :[FHL]*:*);; - :L* | :C*:*) as_fn_error $? "invalid tag '$ac_tag'" "$LINENO" 5;; - :[FH]-) ac_tag=-:-;; - :[FH]*) ac_tag=$ac_tag:$ac_tag.in;; - esac - ac_save_IFS=$IFS - IFS=: - set x $ac_tag - IFS=$ac_save_IFS - shift - ac_file=$1 - shift - - case $ac_mode in - :L) ac_source=$1;; - :[FH]) - ac_file_inputs= - for ac_f - do - case $ac_f in - -) ac_f="$ac_tmp/stdin";; - *) # Look for the file first in the build tree, then in the source tree - # (if the path is not absolute). The absolute path cannot be DOS-style, - # because $ac_f cannot contain ':'. - test -f "$ac_f" || - case $ac_f in - [\\/$]*) false;; - *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";; - esac || - as_fn_error 1 "cannot find input file: '$ac_f'" "$LINENO" 5;; - esac - case $ac_f in *\'*) ac_f=`printf "%s\n" "$ac_f" | sed "s/'/'\\\\\\\\''/g"`;; esac - as_fn_append ac_file_inputs " '$ac_f'" - done +_ACEOF - # 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. */ - configure_input='Generated from '` - printf "%s\n" "$*" | sed 's|^[^:]*/||;s|:[^:]*/|, |g' - `' by configure.' - if test x"$ac_file" != x-; then - configure_input="$ac_file. $configure_input" - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: creating $ac_file" >&5 -printf "%s\n" "$as_me: creating $ac_file" >&6;} + 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 - # Neutralize special characters interpreted by sed in replacement strings. - case $configure_input in #( - *\&* | *\|* | *\\* ) - ac_sed_conf_input=`printf "%s\n" "$configure_input" | - sed 's/[\\\\&|]/\\\\&/g'`;; #( - *) ac_sed_conf_input=$configure_input;; - esac + if test ! -s $tmp/subs.frag; then + ac_more_lines=false + else + # The purpose of the label and of the branching condition is to + # speed up the sed processing (if there are no `@' at all, there + # is no need to browse any of the substitutions). + # These are the two extra sed commands mentioned above. + (echo ':t + /@[a-zA-Z_][a-zA-Z_0-9]*@/!b' && cat $tmp/subs.frag) >$tmp/subs-$ac_sed_frag.sed + if test -z "$ac_sed_cmds"; then + ac_sed_cmds="sed -f $tmp/subs-$ac_sed_frag.sed" + else + ac_sed_cmds="$ac_sed_cmds | sed -f $tmp/subs-$ac_sed_frag.sed" + fi + ac_sed_frag=`expr $ac_sed_frag + 1` + ac_beg=$ac_end + ac_end=`expr $ac_end + $ac_max_sed_lines` + fi + done + if test -z "$ac_sed_cmds"; then + ac_sed_cmds=cat + fi +fi # test -n "$CONFIG_FILES" - case $ac_tag in - *:-:* | *:-) cat >"$ac_tmp/stdin" \ - || as_fn_error $? "could not create $ac_file" "$LINENO" 5 ;; - esac - ;; +_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 - ac_dir=`$as_dirname -- "$ac_file" || + # 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 || -printf "%s\n" X"$ac_file" | - sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ - s//\1/ - q - } - /^X\(\/\/\)[^/].*/{ - s//\1/ - q - } - /^X\(\/\/\)$/{ - s//\1/ - q - } - /^X\(\/\).*/{ - s//\1/ - q - } - s/.*/./; q'` - as_dir="$ac_dir"; as_fn_mkdir_p + 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=. -case "$ac_dir" in -.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; -*) - ac_dir_suffix=/`printf "%s\n" "$ac_dir" | sed 's|^\.[\\/]||'` - # A ".." for each directory in $ac_dir_suffix. - ac_top_builddir_sub=`printf "%s\n" "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'` - case $ac_top_builddir_sub in - "") ac_top_builddir_sub=. ac_top_build_prefix= ;; - *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; - esac ;; -esac -ac_abs_top_builddir=$ac_pwd -ac_abs_builddir=$ac_pwd$ac_dir_suffix -# for backward compatibility: -ac_top_builddir=$ac_top_build_prefix +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 - .) # We are building in place. + .) # No --srcdir option. We are building in place. ac_srcdir=. - ac_top_srcdir=$ac_top_builddir_sub - ac_abs_top_srcdir=$ac_pwd ;; - [\\/]* | ?:[\\/]* ) # Absolute name. + 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 - ac_abs_top_srcdir=$srcdir ;; - *) # Relative name. - ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix - ac_top_srcdir=$ac_top_build_prefix$srcdir - ac_abs_top_srcdir=$ac_pwd/$srcdir ;; + ac_top_srcdir=$srcdir ;; + *) # Relative path. + ac_srcdir=$ac_top_builddir$srcdir$ac_dir_suffix + ac_top_srcdir=$ac_top_builddir$srcdir ;; esac -ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix +# 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 - case $ac_mode in - :F) - # - # CONFIG_FILE - # -_ACEOF -cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 -# If the template does not know about datarootdir, expand it. -# FIXME: This hack should be removed a few years after 2.60. -ac_datarootdir_hack=; ac_datarootdir_seen= -ac_sed_dataroot=' -/datarootdir/ { - p - q -} -/@datadir@/p -/@docdir@/p -/@infodir@/p -/@localedir@/p -/@mandir@/p' -case `eval "sed -n \"\$ac_sed_dataroot\" $ac_file_inputs"` in -*datarootdir*) ac_datarootdir_seen=yes;; -*@datadir@*|*@docdir@*|*@infodir@*|*@localedir@*|*@mandir@*) - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&5 -printf "%s\n" "$as_me: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&2;} -_ACEOF -cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 - ac_datarootdir_hack=' - s&@datadir@&$datadir&g - s&@docdir@&$docdir&g - s&@infodir@&$infodir&g - s&@localedir@&$localedir&g - s&@mandir@&$mandir&g - s&\\\${datarootdir}&$datarootdir&g' ;; -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 - -# Neutralize VPATH when '$srcdir' = '.'. -# Shell code in configure.ac might set extrasub. -# FIXME: do we really want to maintain this feature? -cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 -ac_sed_extra="$ac_vpsub +cat >>$CONFIG_STATUS <<_ACEOF + sed "$ac_vpsub $extrasub _ACEOF -cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +cat >>$CONFIG_STATUS <<\_ACEOF :t /@[a-zA-Z_][a-zA-Z_0-9]*@/!b -s|@configure_input@|$ac_sed_conf_input|;t t -s&@top_builddir@&$ac_top_builddir_sub&;t t -s&@top_build_prefix@&$ac_top_build_prefix&;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&@abs_top_builddir@&$ac_abs_top_builddir&;t t -$ac_datarootdir_hack -" -eval sed \"\$ac_sed_extra\" "$ac_file_inputs" | $AWK -f "$ac_tmp/subs.awk" \ - >$ac_tmp/out || as_fn_error $? "could not create $ac_file" "$LINENO" 5 - -test -z "$ac_datarootdir_hack$ac_datarootdir_seen" && - { ac_out=`sed -n '/\${datarootdir}/p' "$ac_tmp/out"`; test -n "$ac_out"; } && - { ac_out=`sed -n '/^[ ]*datarootdir[ ]*:*=/p' \ - "$ac_tmp/out"`; test -z "$ac_out"; } && - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file contains a reference to the variable 'datarootdir' -which seems to be undefined. Please make sure it is defined" >&5 -printf "%s\n" "$as_me: WARNING: $ac_file contains a reference to the variable 'datarootdir' -which seems to be undefined. Please make sure it is defined" >&2;} - - rm -f "$ac_tmp/stdin" - case $ac_file in - -) cat "$ac_tmp/out" && rm -f "$ac_tmp/out";; - *) rm -f "$ac_file" && mv "$ac_tmp/out" "$ac_file";; - esac \ - || as_fn_error $? "could not create $ac_file" "$LINENO" 5 - ;; - - - - esac +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 # for ac_tag +done +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF -as_fn_exit 0 +{ (exit 0); exit 0; } _ACEOF +chmod +x $CONFIG_STATUS ac_clean_files=$ac_clean_files_save -test $ac_write_fail = 0 || - as_fn_error $? "write failure creating $CONFIG_STATUS" "$LINENO" 5 - # configure is writing to config.log, and then calls config.status. # config.status does its own redirection, appending to config.log. @@ -7187,12 +5928,7 @@ if test "$no_create" != yes; then 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 || as_fn_exit 1 -fi -if test -n "$ac_unrecognized_opts" && test "$enable_option_checking" != no; then - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: unrecognized options: $ac_unrecognized_opts" >&5 -printf "%s\n" "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2;} + $ac_cs_success || { (exit 1); exit 1; } fi - diff --git a/win/configure.ac b/win/configure.in index 25fa29f..6b30162 100644 --- a/win/configure.ac +++ b/win/configure.in @@ -3,38 +3,30 @@ # generate the file "configure", which is run during Tcl installation # to configure the system for the local environment. -AC_INIT([tcl],[8.7]) -AC_CONFIG_SRCDIR([../generic/tcl.h]) -AC_PREREQ([2.69]) +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.7 +TCL_VERSION=8.5 TCL_MAJOR_VERSION=8 -TCL_MINOR_VERSION=7 -TCL_PATCH_LEVEL="b1" +TCL_MINOR_VERSION=5 +TCL_PATCH_LEVEL=".18" VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION -TCL_DDE_VERSION=1.4 +TCL_DDE_VERSION=1.3 TCL_DDE_MAJOR_VERSION=1 -TCL_DDE_MINOR_VERSION=4 +TCL_DDE_MINOR_VERSION=3 DDEVER=$TCL_DDE_MAJOR_VERSION$TCL_DDE_MINOR_VERSION -TCL_REG_VERSION=1.3 +TCL_REG_VERSION=1.2 TCL_REG_MAJOR_VERSION=1 -TCL_REG_MINOR_VERSION=3 +TCL_REG_MINOR_VERSION=2 REGVER=$TCL_REG_MAJOR_VERSION$TCL_REG_MINOR_VERSION -PKG_CFG_ARGS=$@ - -#------------------------------------------------------------------------ -# Empty slate for bundled packages, to avoid stale configuration -#------------------------------------------------------------------------ -rm -Rf pkgs - #------------------------------------------------------------------------ # Handle the --prefix=... option #------------------------------------------------------------------------ @@ -60,6 +52,7 @@ fi AC_PROG_CC AC_C_INLINE +AC_HEADER_STDC AC_CHECK_TOOL(AR, ar) AC_CHECK_TOOL(RANLIB, ranlib) @@ -78,6 +71,12 @@ AC_PROG_MAKE_SET 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 #------------------------------------------------------------------------ @@ -92,20 +91,6 @@ SC_TCL_CFG_ENCODING SC_ENABLE_SHARED #-------------------------------------------------------------------- -# Check whether --enable-time64bit was given. -#-------------------------------------------------------------------- - -AC_MSG_CHECKING([force of 64-bit time_t]) -AC_ARG_ENABLE(time64bit, - AS_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. @@ -113,116 +98,37 @@ fi 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/libtommath; note that this is mostly done in the -# makefile now as we just assume that the platform hasn't got usable -# z.lib/tommath.lib -#------------------------------------------------------------------------ - -AS_IF([test "${enable_shared+set}" = "set"], [ - enableval="$enable_shared" - tcl_ok=$enableval -], [ - tcl_ok=yes -]) -zlib_lib_name=zdll.lib -tommath_lib_name=tommath.lib -AS_IF([test "$tcl_ok" = "yes"], [ - AC_SUBST(ZLIB_DLL_FILE,[\${ZLIB_DLL_FILE}]) - AC_SUBST(TOMMATH_DLL_FILE,[\${TOMMATH_DLL_FILE}]) - AC_DEFINE(TCL_WITH_EXTERNAL_TOMMATH, 1, [Tcl with external libtommath]) - AS_IF([test "$do64bit" != "no"], [ - AC_DEFINE(MP_64BIT, 1, [Using libtommath.dll in 64-bit mode]) - AS_IF([test "$do64bit" = "arm64"], [ - AS_IF([test "$GCC" == "yes"],[ - AC_SUBST(ZLIB_LIBS,[\${ZLIB_DIR_NATIVE}/win64-arm/libz.dll.a]) - AC_SUBST(TOMMATH_LIBS,[\${TOMMATH_DIR_NATIVE}/win64-arm/libtommath.dll.a]) - zlib_lib_name=libz.dll.a - tommath_lib_name=libtommath.dll.a - ], [ - AC_SUBST(ZLIB_LIBS,[\${ZLIB_DIR_NATIVE}/win64-arm/zdll.lib]) - AC_SUBST(TOMMATH_LIBS,[\${TOMMATH_DIR_NATIVE}/win64-arm/tommath.lib]) - ]) - ], [ - AS_IF([test "$GCC" == "yes"],[ - AC_SUBST(ZLIB_LIBS,[\${ZLIB_DIR_NATIVE}/win64/libz.dll.a]) - AC_SUBST(TOMMATH_LIBS,[\${TOMMATH_DIR_NATIVE}/win64/libtommath.dll.a]) - zlib_lib_name=libz.dll.a - tommath_lib_name=libtommath.dll.a - ], [ - AC_SUBST(ZLIB_LIBS,[\${ZLIB_DIR_NATIVE}/win64/zdll.lib]) - AC_SUBST(TOMMATH_LIBS,[\${TOMMATH_DIR_NATIVE}/win64/tommath.lib]) - ]) - ]) - ], [ - AC_SUBST(ZLIB_LIBS,[\${ZLIB_DIR_NATIVE}/win32/zdll.lib]) - AC_SUBST(TOMMATH_LIBS,[\${TOMMATH_DIR_NATIVE}/win32/tommath.lib]) - ]) -], [ - AC_SUBST(ZLIB_OBJS,[\${ZLIB_OBJS}]) - AC_SUBST(TOMMATH_OBJS,[\${TOMMATH_OBJS}]) +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_DEFINE(HAVE_ZLIB, 1, [Is there an installed zlib?]) -AC_SUBST(TCL_ZLIB_LIB_NAME, $zlib_lib_name) -AC_SUBST(TCL_TOMMATH_LIB_NAME, $tommath_lib_name) -AC_CHECK_TYPES([intptr_t, uintptr_t],,,[[ -#include <stdint.h> -]]) - -#-------------------------------------------------------------------- -# Zipfs support - Tip 430 -#-------------------------------------------------------------------- -AC_ARG_ENABLE(zipfs, - AS_HELP_STRING([--enable-zipfs], - [build with Zipfs support (default: on)]), - [tcl_ok=$enableval], [tcl_ok=yes]) -if test "$tcl_ok" = "yes" ; then - # - # Find a native compiler - # - AX_CC_FOR_BUILD - # - # Find a native zip implementation - # - SC_PROG_TCLSH - SC_ZIPFS_SUPPORT - ZIPFS_BUILD=1 - TCL_ZIP_FILE=libtcl${TCL_MAJOR_VERSION}.${TCL_MINOR_VERSION}${TCL_PATCH_LEVEL}.zip -else - ZIPFS_BUILD=0 - TCL_ZIP_FILE= -fi -# Do checking message here to not mess up interleaved configure output -AC_MSG_CHECKING([for building with zipfs]) -if test "${ZIPFS_BUILD}" = 1; then - if test "${SHARED_BUILD}" = 0; then - ZIPFS_BUILD=2; - AC_DEFINE(ZIPFS_BUILD, 2, [Are we building with zipfs enabled?]) - else - AC_DEFINE(ZIPFS_BUILD, 1, [Are we building with zipfs enabled?])\ +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 - AC_MSG_RESULT([yes]) -else -AC_MSG_RESULT([no]) -INSTALL_LIBRARIES=install-libraries -INSTALL_MSGS=install-msgs -fi -AC_SUBST(ZIPFS_BUILD) -AC_SUBST(TCL_ZIP_FILE) -AC_SUBST(INSTALL_LIBRARIES) -AC_SUBST(INSTALL_MSGS) - - +]) #-------------------------------------------------------------------- # Perform additinal compiler tests. #-------------------------------------------------------------------- @@ -233,73 +139,17 @@ AC_SUBST(INSTALL_MSGS) AC_CACHE_CHECK(for FINDEX_INFO_LEVELS in winbase.h, tcl_cv_findex_enums, -AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ -#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_LINK_IFELSE([AC_LANG_PROGRAM([[ -#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_COMPILE_IFELSE([AC_LANG_PROGRAM([[ -#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_COMPILE_IFELSE([AC_LANG_PROGRAM([[ +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]) +], + 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, @@ -314,6 +164,8 @@ fi SC_ENABLE_SYMBOLS +TCL_DBGX=${DBGX} + #-------------------------------------------------------------------- # Embed the manifest if we can determine how #-------------------------------------------------------------------- @@ -330,10 +182,20 @@ 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_LIB_FILE=${LIBPREFIX}tcl$VER${LIBSUFFIX}" + +eval "TCL_LIB_FLAG=\"-ltcl${VER}${LIBFLAGSUFFIX}\"" +eval "TCL_BUILD_LIB_SPEC=\"-L`$CYGPATH $(pwd)` ${TCL_LIB_FLAG}\"" +eval "TCL_LIB_SPEC=\"-L${libdir} ${TCL_LIB_FLAG}\"" + eval "TCL_STUB_LIB_FILE=\"${LIBPREFIX}tclstub${VER}${LIBSUFFIX}\"" eval "TCL_STUB_LIB_FLAG=\"-ltclstub${VER}${LIBFLAGSUFFIX}\"" eval "TCL_BUILD_STUB_LIB_SPEC=\"-L`$CYGPATH $(pwd)` ${TCL_STUB_LIB_FLAG}\"" @@ -341,24 +203,18 @@ 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}\"" -if test ${SHARED_BUILD} = 0 -o "$GCC" != "yes" ; then - eval "TCL_LIB_FLAG=\"${LIBPREFIX}tcl${VER}${LIBSUFFIX}\"" - eval "TCL_LIB_FILE=\"${LIBPREFIX}tcl${VER}${LIBSUFFIX}\"" -else - eval "TCL_LIB_FLAG=\"-ltcl${VER}${FLAGSUFFIX}\"" - eval "TCL_LIB_FILE=\"${LIBPREFIX}tcl${VER}${DLLSUFFIX}.a\"" -fi -eval "TCL_BUILD_LIB_SPEC=\"-L`$CYGPATH $(pwd)` ${TCL_LIB_FLAG}\"" -eval "TCL_LIB_SPEC=\"-L${libdir} ${TCL_LIB_FLAG}\"" - # Install time header dir can be set via --includedir eval "TCL_INCLUDE_SPEC=\"-I${includedir}\"" -TCL_SHARED_LIB_SUFFIX="\${NODOT_VERSION}${DLLSUFFIX}" -TCL_UNSHARED_LIB_SUFFIX="\${NODOT_VERSION}${LIBSUFFIX}" + +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 @@ -366,9 +222,17 @@ CFG_TCL_UNSHARED_LIB_SUFFIX=${TCL_UNSHARED_LIB_SUFFIX} #-------------------------------------------------------------------- if test ${SHARED_BUILD} = 0 ; then - RC_DEFINES="${RC_DEFINE} STATIC_BUILD" + if test "${DBGX}" = "g"; then + RC_DEFINES="${RC_DEFINE} STATIC_BUILD ${RC_DEFINE} DEBUG" + else + RC_DEFINES="${RC_DEFINE} STATIC_BUILD" + fi else - RC_DEFINES="" + if test "${DBGX}" = "g"; then + RC_DEFINES="${RC_DEFINE} DEBUG" + else + RC_DEFINES="" + fi fi #-------------------------------------------------------------------- @@ -379,9 +243,9 @@ fi #-------------------------------------------------------------------- if test "$prefix/lib" != "$libdir"; then - TCL_PACKAGE_PATH="${libdir};${prefix}\\lib" + TCL_PACKAGE_PATH="${libdir} ${prefix}/lib" else - TCL_PACKAGE_PATH="${prefix}\\lib" + TCL_PACKAGE_PATH="${prefix}/lib" fi # The tclsh.exe.manifest requires these @@ -394,22 +258,16 @@ case "$TCL_PATCH_LEVEL" in esac TCL_WIN_VERSION="$TCL_VERSION.$TCL_RELEASE_LEVEL.`echo $TCL_PATCH_LEVEL | tr -d ab.`" AC_SUBST(TCL_WIN_VERSION) -# X86|AMD64|ARM64|IA64 for manifest +# 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) @@ -423,8 +281,10 @@ 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) @@ -465,11 +325,12 @@ 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 @@ -488,9 +349,8 @@ AC_SUBST(RC_DEFINE) AC_SUBST(RC_DEFINES) AC_SUBST(RES) -AC_CONFIG_FILES([Makefile tclConfig.sh tclsh.exe.manifest]) -AC_OUTPUT +AC_OUTPUT(Makefile tclConfig.sh tcl.hpj tclsh.exe.manifest) dnl Local Variables: -dnl mode: autoconf +dnl mode: autoconf; dnl End: diff --git a/win/gitmanifest.in b/win/gitmanifest.in deleted file mode 100644 index 3e7de84..0000000 --- a/win/gitmanifest.in +++ /dev/null @@ -1 +0,0 @@ -git-
\ No newline at end of file diff --git a/win/makefile.bc b/win/makefile.bc new file mode 100644 index 0000000..6421682 --- /dev/null +++ b/win/makefile.bc @@ -0,0 +1,597 @@ +#
+# Makefile for Borland C++ 5.5 (or C++ Builder 5), adapted from the makefile
+# for Visual C++ that came with tcl 8.3.3
+#
+# 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-1999 by Scriptics Corporation.
+
+# TIP #59 information.
+#
+# This makefile does not set the following configuration cpp
+# defines. Behind the defines are the makefile variables listed to set
+# to -D... when that feature is enabled.
+#
+# - TCL_CFG_PROFILED PROFDEFINES
+# - TCL_CFG_OPTIMIZED OPTDEFINES
+# - TCL_CFG_DO64BIT SIXFOURDEFINES
+
+# Have a look at the complete description on how to build and test Tcl with
+# the current Borland compilers at www.ratiosoft.com/tcl/borland.
+#
+# Usage:
+# - Adapt the paths below to match your compiler's location
+# - Make sure the compiler's bin directory is on your path
+# - Open a console
+# - To make a debug version enter
+# make -fmakefile.bc -DNODEBUG=0 xxx
+# where 'xxx' is the target you want (e.g. 'all', 'test', ...)
+# Please note: I omitted the 'd' suffix for debug versions because Tcl
+# will always call tclpip83.dll and not tclpip83d.dll, causing an error.
+# ^
+# Besides, the debug version goes into a separate directory, so there
+# should be no problem having DLLs and EXEs with the same name.
+# If you prefer your debug version having the 'd' suffix just uncomment
+# the line
+# #DBGX = d
+#
+# - To make a 'normal' version enter
+# make -fmakefile.bc xxx
+# where 'xxx' is the target you want (e.g. 'all', 'test', ...)
+#
+# DISCLAIMER:
+# This makefile has an experimental status - that is those targets which
+# have been modified do in fact compile and link with Borland's C++
+# Builder 5 and with the free Borland compiler (Borland C++ 5.5).
+# However the author assumes no responsiblity for any effect which the use of
+# this makefile or of the resulting programs might have on your system.
+#
+# Not yet modified:
+# - The 'plug-in-DLL' and the associated shell.
+# - The programs to create the windows help files.
+#
+# Suggestions and / or improvements are always welcome.
+#
+# May 2001, H. Giese (hgiese@ratiosoft.com)
+#
+
+# Does not depend on the presence of any environment variables in
+# order to compile tcl; all needed information is derived from
+# location of the compiler directories.
+
+#
+# Project directories
+#
+# ROOT = top of source tree
+#
+# TOOLS32 = location of Borland development tools.
+#
+# INSTALLDIR = where the install-targets should copy the binaries and
+# support files
+#
+
+ROOT = ..
+INSTALLDIR = c:\program files\tcl
+
+# If you have C++ Builder 5 or the free Borland C++ 5.5 compiler
+# adapt the following paths as appropriate for your system
+TOOLS32 = c:\dev\bcc55
+TOOLS32_rc = c:\dev\bcc55
+#TOOLS32 = c:\bc55
+#TOOLS32_rc = c:\bc55
+
+cc32 = "$(TOOLS32)\bin\bcc32.exe"
+link32 = "$(TOOLS32)\bin\ilink32.exe"
+lib32 = "$(TOOLS32)\bin\tlib.exe"
+rc32 = "$(TOOLS32_rc)\bin\brcc32.exe"
+include32 = -I"$(TOOLS32)\include"
+libpath32 = -L"$(TOOLS32)\lib"
+
+# Uncomment the following line to compile with thread support
+#THREADDEFINES = -DTCL_THREADS=1
+
+# Allow definition of NDEBUG via command line
+# Set NODEBUG to 0 to compile with symbols
+!if !defined(NODEBUG)
+NODEBUG = 1
+!endif
+
+# CFG_ENCODING=encoding
+# name of encoding for configuration information. Defaults
+# to cp1252
+!if !defined(CFG_ENCODING)
+CFG_ENCODING = \"cp1252\"
+!endif
+
+# The following defines can be used to control the amount of debugging
+# code that is added to the compilation.
+#
+# -DTCL_MEM_DEBUG Enables the debugging memory allocator.
+# -DTCL_COMPILE_DEBUG Enables byte compilation logging.
+# -DTCL_COMPILE_STATS Enables byte compilation statistics gathering.
+# -DUSE_TCLALLOC=0 Disables the Tcl memory allocator in favor
+# of the native malloc implementation. This is
+# needed when using Purify.
+#
+#DEBUGDEFINES = -DTCL_MEM_DEBUG -DTCL_COMPILE_DEBUG -DTCL_COMPILE_STATS
+#DEBUGDEFINES = -DUSE_TCLALLOC=0
+
+######################################################################
+# Do not modify below this line
+######################################################################
+
+NAMEPREFIX = tcl
+STUBPREFIX = $(NAMEPREFIX)stub
+DOTVERSION = 8.5
+VERSION = 85
+
+DDEVERSION = 13
+DDEDOTVERSION = 1.3
+
+REGVERSION = 12
+REGDOTVERSION = 1.2
+
+BINROOT = ..
+!IF "$(NODEBUG)" == "1"
+TMPDIRNAME = Release
+DBGX =
+SYMDEFINES = -DNDEBUG
+!ELSE
+TMPDIRNAME = Debug
+#DBGX = d
+DBGX =
+SYMDEFINES = -DTCL_CFG_DEBUG
+!ENDIF
+TMPDIR = $(BINROOT)\$(TMPDIRNAME)
+OUTDIRNAME = $(TMPDIRNAME)
+OUTDIR = $(TMPDIR)
+
+TCLLIB = $(OUTDIR)\$(NAMEPREFIX)$(VERSION)$(DBGX).lib
+TCLDLLNAME = $(NAMEPREFIX)$(VERSION)$(DBGX).dll
+TCLDLL = $(OUTDIR)\$(TCLDLLNAME)
+
+TCLSTUBLIBNAME = $(STUBPREFIX)$(VERSION)$(DBGX).lib
+TCLSTUBLIB = $(OUTDIR)\$(TCLSTUBLIBNAME)
+
+TCLPLUGINLIB = $(OUTDIR)\$(NAMEPREFIX)$(VERSION)p$(DBGX).lib
+TCLPLUGINDLLNAME = $(NAMEPREFIX)$(VERSION)p$(DBGX).dll
+TCLPLUGINDLL = $(OUTDIR)\$(TCLPLUGINDLLNAME)
+TCLSH = $(OUTDIR)\$(NAMEPREFIX)sh$(VERSION)$(DBGX).exe
+TCLSHP = $(OUTDIR)\$(NAMEPREFIX)shp$(VERSION)$(DBGX).exe
+TCLPIPEDLLNAME = $(NAMEPREFIX)pip$(VERSION)$(DBGX).dll
+TCLPIPEDLL = $(OUTDIR)\$(TCLPIPEDLLNAME)
+TCLREGDLLNAME = $(NAMEPREFIX)reg$(REGVERSION)$(DBGX).dll
+TCLREGDLL = $(OUTDIR)\$(TCLREGDLLNAME)
+TCLDDEDLLNAME = $(NAMEPREFIX)dde$(DDEVERSION)$(DBGX).dll
+TCLDDEDLL = $(OUTDIR)\$(TCLDDEDLLNAME)
+TCLTEST = $(OUTDIR)\$(NAMEPREFIX)test.exe
+CAT32 = $(TMPDIR)\cat32.exe
+RMDIR = .\rmd.bat
+MKDIR = .\mkd.bat
+RM = del
+
+LIB_INSTALL_DIR = $(INSTALLDIR)\lib
+BIN_INSTALL_DIR = $(INSTALLDIR)\bin
+SCRIPT_INSTALL_DIR = $(INSTALLDIR)\lib\tcl$(DOTVERSION)
+INCLUDE_INSTALL_DIR = $(INSTALLDIR)\include
+
+TCLSHOBJS = \
+ $(TMPDIR)\tclAppInit.obj
+
+TCLTESTOBJS = \
+ $(TMPDIR)\tclTest.obj \
+ $(TMPDIR)\tclTestObj.obj \
+ $(TMPDIR)\tclTestProcBodyObj.obj \
+ $(TMPDIR)\tclThreadTest.obj \
+ $(TMPDIR)\tclWinTest.obj \
+ $(TMPDIR)\testMain.obj
+
+TCLOBJS = \
+ $(TMPDIR)\regcomp.obj \
+ $(TMPDIR)\regexec.obj \
+ $(TMPDIR)\regfree.obj \
+ $(TMPDIR)\regerror.obj \
+ $(TMPDIR)\tclAlloc.obj \
+ $(TMPDIR)\tclAsync.obj \
+ $(TMPDIR)\tclBasic.obj \
+ $(TMPDIR)\tclBinary.obj \
+ $(TMPDIR)\tclCkalloc.obj \
+ $(TMPDIR)\tclClock.obj \
+ $(TMPDIR)\tclCmdAH.obj \
+ $(TMPDIR)\tclCmdIL.obj \
+ $(TMPDIR)\tclCmdMZ.obj \
+ $(TMPDIR)\tclCompCmds.obj \
+ $(TMPDIR)\tclCompExpr.obj \
+ $(TMPDIR)\tclCompile.obj \
+ $(TMPDIR)\tclConfig.obj \
+ $(TMPDIR)\tclDate.obj \
+ $(TMPDIR)\tclDictObj.obj \
+ $(TMPDIR)\tclEncoding.obj \
+ $(TMPDIR)\tclEnv.obj \
+ $(TMPDIR)\tclEvent.obj \
+ $(TMPDIR)\tclExecute.obj \
+ $(TMPDIR)\tclFCmd.obj \
+ $(TMPDIR)\tclFileName.obj \
+ $(TMPDIR)\tclGet.obj \
+ $(TMPDIR)\tclHash.obj \
+ $(TMPDIR)\tclHistory.obj \
+ $(TMPDIR)\tclIndexObj.obj \
+ $(TMPDIR)\tclInterp.obj \
+ $(TMPDIR)\tclIO.obj \
+ $(TMPDIR)\tclIOCmd.obj \
+ $(TMPDIR)\tclIOGT.obj \
+ $(TMPDIR)\tclIOSock.obj \
+ $(TMPDIR)\tclIOUtil.obj \
+ $(TMPDIR)\tclLink.obj \
+ $(TMPDIR)\tclLiteral.obj \
+ $(TMPDIR)\tclListObj.obj \
+ $(TMPDIR)\tclLoad.obj \
+ $(TMPDIR)\tclMain.obj \
+ $(TMPDIR)\tclNamesp.obj \
+ $(TMPDIR)\tclNotify.obj \
+ $(TMPDIR)\tclObj.obj \
+ $(TMPDIR)\tclPanic.obj \
+ $(TMPDIR)\tclParse.obj \
+ $(TMPDIR)\tclPipe.obj \
+ $(TMPDIR)\tclPkg.obj \
+ $(TMPDIR)\tclPkgConfig.obj \
+ $(TMPDIR)\tclPosixStr.obj \
+ $(TMPDIR)\tclPreserve.obj \
+ $(TMPDIR)\tclProc.obj \
+ $(TMPDIR)\tclRegexp.obj \
+ $(TMPDIR)\tclResolve.obj \
+ $(TMPDIR)\tclResult.obj \
+ $(TMPDIR)\tclScan.obj \
+ $(TMPDIR)\tclStringObj.obj \
+ $(TMPDIR)\tclStubInit.obj \
+ $(TMPDIR)\tclStubLib.obj \
+ $(TMPDIR)\tclThread.obj \
+ $(TMPDIR)\tclThreadJoin.obj \
+ $(TMPDIR)\tclTimer.obj \
+ $(TMPDIR)\tclTrace.obj \
+ $(TMPDIR)\tclUtf.obj \
+ $(TMPDIR)\tclUtil.obj \
+ $(TMPDIR)\tclVar.obj \
+ $(TMPDIR)\tclWin32Dll.obj \
+ $(TMPDIR)\tclWinChan.obj \
+ $(TMPDIR)\tclWinConsole.obj \
+ $(TMPDIR)\tclWinSerial.obj \
+ $(TMPDIR)\tclWinError.obj \
+ $(TMPDIR)\tclWinFCmd.obj \
+ $(TMPDIR)\tclWinFile.obj \
+ $(TMPDIR)\tclWinInit.obj \
+ $(TMPDIR)\tclWinLoad.obj \
+ $(TMPDIR)\tclWinNotify.obj \
+ $(TMPDIR)\tclWinPipe.obj \
+ $(TMPDIR)\tclWinSock.obj \
+ $(TMPDIR)\tclWinThrd.obj \
+ $(TMPDIR)\tclWinTime.obj
+
+TCLSTUBOBJS = $(TMPDIR)\tclStubLib.obj
+
+WINDIR = $(ROOT)\win
+GENERICDIR = $(ROOT)\generic
+
+TCL_INCLUDES = -I"$(WINDIR)" -I"$(GENERICDIR)"
+TCL_DEFINES = $(DEBUGDEFINES) $(THREADDEFINES) $(SYMDEFINES) \
+ $(PROFDEFINES) $(OPTDEFINES) $(SIXFOURDEFINES) \
+ -DTCL_CFGVAL_ENCODING=${CFG_ENCODING}
+
+######################################################################
+# Compiler flags
+######################################################################
+
+!IF "$(NODEBUG)" == "1"
+# these macros cause maximum optimization and no symbols
+cdebug = -v- -vi- -O2 -D_DEBUG
+!ELSE
+# these macros enable debugging
+cdebug = -k -Od -r- -v -vi- -y
+!ENDIF
+
+SYSDEFINES = _MT;NO_STRICT;_NO_VCL
+
+# declarations common to all compiler options
+cbase = -c -q -3 -a4 -g0 -tWM -Ve -Vx -X-
+WARNINGS = -w-rch -w-pch -w-par -w-dup -w-pro -w-dpu
+
+ccons = -tWC
+
+INCLUDEPATH = $(include32) $(TCL_INCLUDES)
+
+CFLAGS = $(cdebug) $(cbase) $(INCLUDEPATH) $(WARNINGS) -D$(SYSDEFINES)
+TCL_CFLAGS = $(CFLAGS) $(TCL_DEFINES)
+CONS_CFLAGS = $(CFLAGS) $(TCL_DEFINES) $(ccons)
+
+######################################################################
+# Linker flags
+######################################################################
+
+!IF "$(NODEBUG)" == "1"
+ldebug =
+!ELSE
+ldebug = -v
+!ENDIF
+
+# declarations common to all linker options
+LNFLAGS = -D"" -Gn -I$(TMPDIR) -x $(ldebug) $(libpath32)
+# -Gi: create lib file (is -Gl in doc)
+# -aa: Windows app, -ap: Windows console app
+LNFLAGS_DLL = -ap -Gi -Tpd
+LNFLAGS_CONS = -ap -Tpe
+
+LNLIBS = import32 cw32mt
+
+
+######################################################################
+# Project specific targets
+######################################################################
+
+release: setup $(TCLSH) dlls
+dlls: setup $(TCLPIPEDLL) $(TCLREGDLL) $(TCLDDEDLL)
+all: setup $(TCLSH) dlls $(CAT32)
+tcltest: setup $(TCLTEST) dlls $(CAT32)
+plugin: setup $(TCLPLUGINDLL) $(TCLSHP)
+install: install-binaries install-libraries
+
+test: setup $(TCLTEST) dlls $(CAT32)
+ set TCL_LIBRARY=$(ROOT)/library
+ $(TCLTEST) $(ROOT)/tests/all.tcl
+
+setup:
+ @if not exist $(OUT_DIR)\nul mkdir $(OUT_DIR) &\
+ echo *** Created directory '$(OUT_DIR)'
+ @if not exist $(TMP_DIR)\nul mkdir $(TMP_DIR) &\
+ echo *** Created directory '$(TMP_DIR)'
+
+
+$(TCLLIB): $(TCLDLL)
+
+$(TCLDLL): $(TCLOBJS) $(TMPDIR)\$(NAMEPREFIX).res
+ $(link32) $(ldebug) $(LNFLAGS) $(LNFLAGS_DLL) $(TOOLS32)\lib\c0d32 @&&!
+ $(TCLOBJS), $@, -x, $(LNLIBS),, $(TMPDIR)\$(NAMEPREFIX).res
+!
+
+$(TCLSTUBLIB): $(TCLSTUBOBJS)
+ $(lib32) /u $@ $(TCLSTUBOBJS)
+
+$(TCLPLUGINLIB): $(TCLPLUGINDLL)
+
+$(TCLPLUGINDLL): $(TCLOBJS) $(TMPDIR)\tcl.res
+ $(link32) $(ldebug) $(dlllflags) \
+ -out:$@ $(TMPDIR)\tcl.res $(guilibsdll) @&&!
+$(TCLOBJS)
+!
+
+$(TCLSH): $(TCLSHOBJS) $(TCLLIB) $(TMPDIR)\$(NAMEPREFIX)sh.res
+ $(link32) $(ldebug) -S:2400000 $(LNFLAGS) $(LNFLAGS_CONS) $(TOOLS32)\lib\c0x32 @&&!
+ $(TCLSHOBJS), $@, -x, $(LNLIBS) $(TCLLIB),, $(TMPDIR)\$(NAMEPREFIX)sh.res
+!
+
+$(TCLSHP): $(TCLSHOBJS) $(TCLPLUGINLIB) $(TMPDIR)\tclsh.res
+ $(link32) $(ldebug) $(conlflags) $(TMPDIR)\tclsh.res -stack:2300000 \
+ -out:$@ $(conlibsdll) $(TCLPLUGINLIB) $(TCLSHOBJS)
+
+$(TCLTEST): $(TCLTESTOBJS) $(TCLLIB) $(TMPDIR)\$(NAMEPREFIX)sh.res
+ $(link32) $(ldebug) -S:2400000 $(LNFLAGS) $(LNFLAGS_CONS) $(TOOLS32)\lib\c0x32 @&&!
+ $(TCLTESTOBJS), $@, -x, $(LNLIBS) $(TCLLIB),, $(TMPDIR)\$(NAMEPREFIX)sh.res
+!
+
+$(TCLPIPEDLL): $(WINDIR)\stub16.c
+ $(cc32) $(CFLAGS) -o$(TMPDIR)\stub16.obj $(WINDIR)\stub16.c
+ $(link32) $(ldebug) $(LNFLAGS) $(LNFLAGS_CONS) $(TOOLS32)\lib\c0x32 \
+ $(TMPDIR)\stub16.obj, $@, -x, $(LNLIBS),, $(TMPDIR)\$(NAMEPREFIX).res
+
+$(TCLDDEDLL): $(TMPDIR)\tclWinDde.obj $(TCLSTUBLIB)
+ $(link32) $(ldebug) $(LNFLAGS) $(LNFLAGS_DLL) $(TOOLS32)\lib\c0d32 \
+ $(TMPDIR)\tclWinDde.obj, $@, -x, $(LNLIBS) $(TCLSTUBLIB),, \
+ $(TMPDIR)\$(NAMEPREFIX).res
+
+$(TCLREGDLL): $(TMPDIR)\tclWinReg.obj $(TCLSTUBLIB)
+ $(link32) $(ldebug) $(LNFLAGS) $(LNFLAGS_DLL) $(TOOLS32)\lib\c0d32 \
+ $(TMPDIR)\tclWinReg.obj, $@, -x, $(LNLIBS) $(TCLSTUBLIB),, \
+ $(TMPDIR)\$(NAMEPREFIX).res
+
+$(CAT32): $(WINDIR)\cat.c
+ $(cc32) $(CONS_CFLAGS) -o$(TMPDIR)\cat.obj $?
+ $(link32) $(ldebug) $(LNFLAGS) $(LNFLAGS_CONS) $(TOOLS32)\lib\c0x32 \
+ $(TMPDIR)\cat.obj, $@, -x, $(LNLIBS),,
+
+install-binaries: $(TCLSH)
+ $(MKDIR) "$(BIN_INSTALL_DIR)"
+ $(MKDIR) "$(LIB_INSTALL_DIR)"
+ @echo Installing $(TCLDLLNAME)
+ @copy "$(TCLDLL)" "$(BIN_INSTALL_DIR)"
+ @copy "$(TCLLIB)" "$(LIB_INSTALL_DIR)"
+ @echo Installing "$(TCLSH)"
+ @copy "$(TCLSH)" "$(BIN_INSTALL_DIR)"
+ @echo Installing $(TCLPIPEDLLNAME)
+ @copy "$(TCLPIPEDLL)" "$(BIN_INSTALL_DIR)"
+ @echo Installing $(TCLSTUBLIBNAME)
+ @copy "$(TCLSTUBLIB)" "$(LIB_INSTALL_DIR)"
+
+install-libraries:
+ -@$(MKDIR) "$(LIB_INSTALL_DIR)"
+ -@$(MKDIR) "$(INCLUDE_INSTALL_DIR)"
+ -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)"
+ @echo Installing http1.0
+ -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\http1.0"
+ -@copy "$(ROOT)\library\http1.0\http.tcl" "$(SCRIPT_INSTALL_DIR)\http1.0"
+ -@copy "$(ROOT)\library\http1.0\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\http1.0"
+ @echo Installing http2.7
+ -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\http2.7"
+ -@copy "$(ROOT)\library\http\http.tcl" "$(SCRIPT_INSTALL_DIR)\http2.7"
+ -@copy "$(ROOT)\library\http\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\http2.7"
+ @echo Installing opt0.4
+ -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\opt0.4"
+ -@copy "$(ROOT)\library\opt\optparse.tcl" "$(SCRIPT_INSTALL_DIR)\opt0.4"
+ -@copy "$(ROOT)\library\opt\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\opt0.4"
+ @echo Installing msgcat1.5
+ -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\msgcat1.5"
+ -@copy "$(ROOT)\library\msgcat\msgcat.tcl" "$(SCRIPT_INSTALL_DIR)\msgcat1.5"
+ -@copy "$(ROOT)\library\msgcat\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\msgcat1.5"
+ @echo Installing tcltest2.3
+ -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\tcltest2.3"
+ -@copy "$(ROOT)\library\tcltest\tcltest.tcl" "$(SCRIPT_INSTALL_DIR)\tcltest2.3"
+ -@copy "$(ROOT)\library\tcltest\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\tcltest2.3"
+ @echo Installing platform1.0
+ -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\platform1.0"
+ -@copy "$(ROOT)\library\platform\platform.tcl" "$(SCRIPT_INSTALL_DIR)\platform1.0"
+ -@copy "$(ROOT)\library\platform\shell.tcl" "$(SCRIPT_INSTALL_DIR)\platform1.0"
+ -@copy "$(ROOT)\library\platform\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\platform1.0"
+ @echo Installing $(TCLDDEDLLNAME)
+ -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\dde1.3"
+ -@copy "$(TCLDDEDLL)" "$(SCRIPT_INSTALL_DIR)\dde1.3"
+ -@copy "$(ROOT)\library\dde\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\dde1.3"
+ @echo Installing $(TCLREGDLLNAME)
+ -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\reg1.2"
+ -@copy "$(TCLREGDLL)" "$(SCRIPT_INSTALL_DIR)\reg1.2"
+ -@copy "$(ROOT)\library\reg\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\reg1.2"
+ @echo Installing encoding files
+ -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\encoding"
+ -@copy "$(ROOT)\library\encoding\*.enc" "$(SCRIPT_INSTALL_DIR)\encoding"
+ @echo Installing library files
+ -@copy "$(GENERICDIR)\tcl.h" "$(INCLUDE_INSTALL_DIR)"
+ -@copy "$(GENERICDIR)\tclDecls.h" "$(INCLUDE_INSTALL_DIR)"
+ -@copy "$(GENERICDIR)\tclPlatDecls.h" "$(INCLUDE_INSTALL_DIR)"
+ -@copy "$(ROOT)\library\history.tcl" "$(SCRIPT_INSTALL_DIR)"
+ -@copy "$(ROOT)\library\init.tcl" "$(SCRIPT_INSTALL_DIR)"
+ -@copy "$(ROOT)\library\parray.tcl" "$(SCRIPT_INSTALL_DIR)"
+ -@copy "$(ROOT)\library\safe.tcl" "$(SCRIPT_INSTALL_DIR)"
+ -@copy "$(ROOT)\library\tclIndex" "$(SCRIPT_INSTALL_DIR)"
+ -@copy "$(ROOT)\library\package.tcl" "$(SCRIPT_INSTALL_DIR)"
+ -@copy "$(ROOT)\library\word.tcl" "$(SCRIPT_INSTALL_DIR)"
+ -@copy "$(ROOT)\library\auto.tcl" "$(SCRIPT_INSTALL_DIR)"
+
+#
+# Regenerate the stubs files.
+#
+
+genstubs:
+ tclsh$(VERSION) $(ROOT)\tools\genStubs.tcl $(GENERICDIR) \
+ $(GENERICDIR)\tcl.decls $(GENERICDIR)\tclInt.decls
+
+#
+# Regenerate the windows help files.
+#
+
+TCLTOOLS = $(ROOT)/tools
+MAN2TCL = $(TCLTOOLS)/man2tcl
+TCLRTF = $(TCLTOOLS)/tcl.rtf
+TCLHPJ = $(TCLTOOLS)/tcl.hpj
+MAN2HELP = $(TCLTOOLS)/man2help.tcl
+HCRTF = $(TOOLS32)/bin/hcrtf.exe
+
+winhelp: $(TCLRTF)
+ cd $(TCLTOOLS)
+ start /wait $(HCRTF) -xn $(TCLHPJ)
+
+$(MAN2TCL).exe: $(MAN2TCL).obj
+ cd $(TCLTOOLS)
+ $(cc32) /nologo /G4 /ML /O2 $(MAN2TCL).c
+
+$(TCLRTF): $(MAN2TCL).exe $(TCLSH)
+ cd $(TCLTOOLS)
+ ..\win\$(TCLSH) $(MAN2HELP) $(NAMEPREFIX) $(VERSION) $(ROOT)/doc ../../tk$(DOTVERSION)/doc
+
+#
+# Special case object file targets
+#
+$(TMPDIR)\tclWinInit.obj: $(WINDIR)\tclWinInit.c
+ $(cc32) -DBUILD_tcl $(TCL_CFLAGS) -o$(TMPDIR)\$@ $?
+
+$(TMPDIR)\testMain.obj: $(WINDIR)\tclAppInit.c
+ $(cc32) $(TCL_CFLAGS) -DTCL_TEST -o$(TMPDIR)\testMain.obj $?
+
+$(TMPDIR)\tclTest.obj: $(GENERICDIR)\tclTest.c
+ $(cc32) $(TCL_CFLAGS) -o$(TMPDIR)\$@ $?
+
+$(TMPDIR)\tclTestObj.obj: $(GENERICDIR)\tclTestObj.c
+ $(cc32) $(TCL_CFLAGS) -o$(TMPDIR)\$@ $?
+
+$(TMPDIR)\tclWinTest.obj: $(WINDIR)\tclWinTest.c
+ $(cc32) $(TCL_CFLAGS) -o$(TMPDIR)\$@ $?
+
+$(TMP_DIR)\tclPkgConfig.obj: $(GENERICDIR)\tclPkgConfig.c
+ $(cc32) $(TCL_CFLAGS) \
+ -DCFG_INSTALL_EXEC_PREFIX=\"$(INSTALL_EXEC_PREFIX)\" \
+ -DCFG_INSTALL_PREFIX=\"$(INSTALL_PREFIX)\" \
+ -DCFG_RUNTIME_EXEC_PREFIX=\"$(RUNTIME_EXEC_PREFIX)\" \
+ -DCFG_RUNTIME_PREFIX=\"$(RUNTIME_PREFIX)\" \
+ -o$(TMPDIR)\$@ $?
+
+$(TMPDIR)\tclAppInit.obj : $(WINDIR)\tclAppInit.c
+ $(cc32) $(TCL_CFLAGS) -o$(TMPDIR)\$@ $?
+
+# The following objects should be built using the stub interfaces
+
+# tclWinReg: Produces errors in ANSI mode
+$(TMPDIR)\tclWinReg.obj : $(WINDIR)\tclWinReg.c
+ $(cc32) $(TCL_CFLAGS) -DUSE_TCL_STUBS -o$(TMPDIR)\$@ $?
+
+# tclWinDde: Produces errors in ANSI mode
+$(TMPDIR)\tclWinDde.obj : $(WINDIR)\tclWinDde.c
+ $(cc32) $(TCL_CFLAGS) -DUSE_TCL_STUBS -o$(TMPDIR)\$@ $?
+
+
+# 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
+
+$(TMPDIR)\tclStubLib.obj : $(GENERICDIR)\tclStubLib.c
+ $(cc32) $(TCL_CFLAGS) -DSTATIC_BUILD -o$(TMPDIR)\$@ $?
+
+
+# Dedependency rules
+
+$(GENERICDIR)\regcomp.c: \
+ $(GENERICDIR)\regguts.h \
+ $(GENERICDIR)\regc_lex.c \
+ $(GENERICDIR)\regc_color.c \
+ $(GENERICDIR)\regc_nfa.c \
+ $(GENERICDIR)\regc_cvec.c \
+ $(GENERICDIR)\regc_locale.c
+
+$(GENERICDIR)\regcustom.h: \
+ $(GENERICDIR)\tclInt.h \
+ $(GENERICDIR)\tclPort.h \
+ $(GENERICDIR)\regex.h
+
+$(GENERICDIR)\regexec.c: \
+ $(GENERICDIR)\rege_dfa.c \
+ $(GENERICDIR)\regguts.h
+
+$(GENERICDIR)\regerror.c: $(GENERICDIR)\regguts.h
+$(GENERICDIR)\regfree.c: $(GENERICDIR)\regguts.h
+$(GENERICDIR)\regfronts.c: $(GENERICDIR)\regguts.h
+$(GENERICDIR)\regguts.h: $(GENERICDIR)\regcustom.h
+
+#
+# Implicit rules
+#
+
+{$(WINDIR)}.c{$(TMPDIR)}.obj:
+ $(cc32) -DBUILD_tcl $(TCL_CFLAGS) -o$@ $<
+
+{$(GENERICDIR)}.c{$(TMPDIR)}.obj:
+ $(cc32) -DBUILD_tcl $(TCL_CFLAGS) -o$@ $<
+
+{$(ROOT)\compat}.c{$(TMPDIR)}.obj:
+ $(cc32) -DBUILD_tcl $(TCL_CFLAGS) -o$@ $<
+
+{$(WINDIR)}.rc{$(TMPDIR)}.res:
+ $(rc32) $(INCLUDEPATH) -D$(USERDEFINES);$(SYSDEFINES) -fo$@ $<
+
+clean:
+ -@$(RM) $(OUTDIR)\*.exp
+ -@$(RM) $(OUTDIR)\*.lib
+ -@$(RM) $(OUTDIR)\*.dll
+ -@$(RM) $(OUTDIR)\*.exe
+ -@$(RM) $(OUTDIR)\*.pdb
+ -@$(RM) $(TMPDIR)\*.pch
+ -@$(RM) $(TMPDIR)\*.obj
+ -@$(RM) $(TMPDIR)\*.res
+ -@$(RM) $(TMPDIR)\*.exe
+ -@$(RMDIR) $(OUTDIR)
+ -@$(RMDIR) $(TMPDIR)
diff --git a/win/makefile.vc b/win/makefile.vc index 987bcb8..8c8ecdf 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -1,6 +1,7 @@ #------------------------------------------------------------- -*- makefile -*-
+# makefile.vc --
#
-# Microsoft Visual C++ makefile for building Tcl with nmake
+# Microsoft Visual C++ makefile for use with nmake.exe v1.62+ (VC++ 5.0+)
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -10,20 +11,42 @@ # 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] [...]]
+# 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 = ^
+You need to run vcvars32.bat from Developer Studio or setenv.bat from the^
+Platform SDK first to setup the environment. Jump to this line to read^
+the build instructions.
+!error $(MSG)
+!endif
+
+#------------------------------------------------------------------------------
+# HOW TO USE this makefile:
+#
+# 1) It is now necessary to have MSVCDir, MSDevDir or MSSDK set in the
+# environment. This is used as a check to see if vcvars32.bat had been
+# run prior to running nmake or during the installation of Microsoft
+# Visual C++, MSVCDir had been set globally and the PATH adjusted.
+# Either way is valid.
#
-# For MACRODEF, see TIP 477 (https://core.tcl-lang.org/tips/doc/main/tip/477.md)
-# or examine Sections 7-9 in rules.vc.
+# You'll need to run vcvars32.bat contained in the MsDev's vc(98)/bin
+# directory to setup the proper environment, if needed, for your
+# current setup. This is a needed bootstrap requirement and allows the
+# swapping of different environments to be easier.
#
-# Possible values for TARGET are:
-# release -- Builds everything that ships with a release. (default)
-# core -- Builds the core [tclXX.(dll|lib)]
-# shell -- Builds tclsh and the core.
-# dlls -- Just builds the windows extensions.
+# 2) 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.
+#
+# 3) Targets are:
+# release -- Builds the core, the shell and the dlls. (default)
+# dlls -- Just builds the windows extensions and the 16-bit DOS
+# pipe/thunk helper app.
+# 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.
@@ -39,47 +62,38 @@ # troff manual pages found in $(ROOT)\doc. You need to
# have installed the HTML Help Compiler package from Microsoft
# to produce the .chm file.
+# winhelp -- Builds the windows .hlp file for Tcl from the troff man
+# files found in $(ROOT)\doc.
#
-# 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.
+# 4) Macros usable on the commandline:
+# INSTALLDIR=<path>
+# Sets where to install Tcl from the built binaries.
+# C:\Progra~1\Tcl is assumed when not specified.
#
-# Basic macros and options usable on the commandline (see rules.vc for more info):
-# OPTS=msvcrt,noembed,nothreads,pdbs,profile,static,symbols,thrdalloc,time64bit,unchecked,none
+# OPTS=loimpact,msvcrt,static,staticpkg,symbols,threads,profile,unchecked,none
# Sets special options for the core. The default is for none.
# Any combination of the above may be used (comma separated).
# 'none' will over-ride everything to nothing.
#
-# noembed = Without this option, the Tcl core library scripts
-# are embedded into the executable if "static" is
-# specified in OPTS, or into the DLL otherwise. If
-# "noembed" is specified, the scripts are not embedded
-# but copied to the installation target (as in 8.6).
-# nomsvcrt = Affects the static option only to switch it from
-# using msvcrt(d) as the C runtime [by default] to
-# libcmt(d). This is useful for static embedding
-# support.
-# none = Overrides all other options to nothing.
-# nothreads = Turns off full multithreading support (default on).
-# pdbs = Produce separate debug symbol files.
-# profile = Adds profiling hooks. Map file is assumed.
-# static = Builds a static library of the core instead of a
-# dll. The shell will be static (and large), and
-# have the dde and registry extensions linked inside.
-# symbols = Adds symbols for step debugging.
+# loimpact = Adds a flag for how NT treats the heap to keep memory
+# in use, low. This is said to impact alloc performance.
+# 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.
+# threads = Turns on full multithreading support.
# thrdalloc = Use the thread allocator (shared global free pool).
-# time64bit = Forces a build using 64-bit time_t for 32-bit build
-# (CRT library should support this).
+# thrdstorage = Use the generic thread storage support.
+# symbols = Adds symbols for step debugging.
+# profile = Adds profiling hooks. Map file is assumed.
# unchecked = Allows a symbols build to not use the debug
-# enabled runtime (msvcrt.dll not msvcrtd.dll
-# or libcmt.lib not libcmtd.lib).
+# enabled runtime (msvcrt.dll not msvcrtd.dll
+# or libcmt.lib not libcmtd.lib).
#
# STATS=compdbg,memdbg,none
# Sets optional memory and bytecode compiler debugging code added
@@ -91,15 +105,15 @@ # memdbg = Enables the debugging memory allocator.
#
# CHECKS=64bit,fullwarn,nodep,none
-# Sets special macros for checking compatibility.
+# Sets special macros for checking compatability.
#
# 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
+# nodep = Turns off compatability macros to ensure the core
# isn't being built with deprecated functions.
#
-# MACHINE=(ALPHA|AMD64|ARM64|IA64|IX86)
+# 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
@@ -111,123 +125,115 @@ # 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 be $(OUT_DIR)\<buildtype> by default.
+# $(TMP_DIR) will de $(OUT_DIR)\<buildtype> by default.
#
# TESTPAT=<file>
# Reads the tests requested to be run from this file.
#
-# Examples:
+# CFG_ENCODING=encoding
+# name of encoding for configuration information. Defaults
+# to cp1252
+#
+# 5) Examples:
+#
+# Basic syntax of calling nmake looks like this:
+# nmake [-nologo] -f makefile.vc [target|macrodef [target|macrodef] [...]]
+#
+# Standard (no frills)
+# c:\tcl_src\win\>c:\progra~1\micros~1\vc98\bin\vcvars32.bat
+# Setting environment for using Microsoft Visual C++ tools.
# 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
#
+# Building for Win64
+# c:\tcl_src\win\>c:\progra~1\micros~1\vc98\bin\vcvars32.bat
+# Setting environment for using Microsoft Visual C++ tools.
+# c:\tcl_src\win\>c:\progra~1\platfo~1\setenv.bat /pre64 /RETAIL
+# Targeting Windows pre64 RETAIL
+# c:\tcl_src\win\>nmake -f makefile.vc MACHINE=IA64
+#
+#------------------------------------------------------------------------------
+#==============================================================================
+###############################################################################
-# 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
+# //==================================================================\\
+# >>[ -> Do not modify below this line. <- ]<<
+# >>[ Please, use the commandline macros to modify how Tcl is built. ]<<
+# >>[ If you need more features, send us a patch for more macros. ]<<
+# \\==================================================================//
-# 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 have a custom resource file
-RCFILE = tcl.rc
+###############################################################################
+#==============================================================================
+#------------------------------------------------------------------------------
-# The rules.vc file does much of the hard work in terms of defining
-# the build configuration, macros, output directories etc.
-!include "rules.vc"
+!if !exist("makefile.vc")
+MSG = ^
+You must run this makefile only from the directory it is in.^
+Please `cd` to its location first.
+!error $(MSG)
+!endif
-#
-# The tclsh executable without the embedded libzip. We need this
-# separately from tclsh to have dependency and build order work right.
-# Ditto for the DLL and tcltest
-TCLSHRAW=$(TCLSH:.exe=-raw.exe)
-TCLLIBRAW=$(TCLLIB:.dll=-raw.dll)
+PROJECT = tcl
+!include "rules.vc"
-# Tcl version info based on macros set up by rules.vc
+STUBPREFIX = $(PROJECT)stub
DOTVERSION = $(TCL_MAJOR_VERSION).$(TCL_MINOR_VERSION)
VERSION = $(TCL_MAJOR_VERSION)$(TCL_MINOR_VERSION)
-# The staticpkg option is not longer supported in Tcl 8.7
-# though extensions may still be using it. If specified together
-# with "static", ignore it as that is now the default for
-# static build. For non-static builds, no longer supported
-# now (was permitted in 8.6)
-!if $(TCL_USE_STATIC_PACKAGES)
-!if $(STATIC_BUILD)
-!message *** NOTE: The "staticpkg" option redundant in 8.7.
-!else
-!message *** NOTE: The "staticpkg" option ignored for shared library builds.
-!endif
-!endif
+DDEDOTVERSION = 1.3
+DDEVERSION = $(DDEDOTVERSION:.=)
-!if [nmakehlp -f $(OPTS) "noembed"]
-!message *** Option noembed specified. Tcl script library will not be appended to the binary.
-TCL_EMBED_SCRIPTS = 0
-TCL_TEST_LIBRARY=$(ROOT:\=/)/library
-!else
-!message *** Tcl script library will be appended to the binary.
-TCL_EMBED_SCRIPTS = 1
-TCL_TEST_LIBRARY=
-!endif
+REGDOTVERSION = 1.2
+REGVERSION = $(REGDOTVERSION:.=)
-# 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_OPT_VER = \>> versions.vc] \
- && [nmakehlp -V ..\library\opt\pkgIndex.tcl opt >> versions.vc]
-!endif
-!if [echo PKG_COOKIEJAR_VER = \>> versions.vc] \
- && [nmakehlp -V ..\library\cookiejar\pkgIndex.tcl cookiejar >> 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\registry\pkgIndex.tcl "registry " >> versions.vc]
-!endif
+BINROOT = .
+ROOT = ..
-!include versions.vc
+TCLIMPLIB = $(OUT_DIR)\$(PROJECT)$(VERSION)$(SUFX).lib
+TCLLIBNAME = $(PROJECT)$(VERSION)$(SUFX).$(EXT)
+TCLLIB = $(OUT_DIR)\$(TCLLIBNAME)
-DDEDOTVERSION = 1.4
-DDEVERSION = $(DDEDOTVERSION:.=)
+TCLSTUBLIBNAME = $(STUBPREFIX)$(VERSION).lib
+TCLSTUBLIB = $(OUT_DIR)\$(TCLSTUBLIBNAME)
-REGDOTVERSION = 1.3
-REGVERSION = $(REGDOTVERSION:.=)
+TCLSHNAME = $(PROJECT)sh$(VERSION)$(SUFX).exe
+TCLSH = $(OUT_DIR)\$(TCLSHNAME)
+TCLPIPEDLLNAME = $(PROJECT)pip$(VERSION)$(SUFX:t=).dll
+TCLPIPEDLL = $(OUT_DIR)\$(TCLPIPEDLLNAME)
-TCLREGLIBNAME = $(PROJECT)registry$(REGVERSION)$(SUFX:t=).$(EXT)
+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$(VERSION)$(SUFX:t=).exe
-TCLTESTRAW = $(TCLTEST:.exe=-raw.exe)
+TCLTEST = $(OUT_DIR)\$(PROJECT)test.exe
+CAT32 = $(OUT_DIR)\cat32.exe
+
+# Can we run what we build? IX86 runs on all architectures.
+!ifndef TCLSH_NATIVE
+!if "$(MACHINE)" == "IX86" || "$(MACHINE)" == "$(NATIVE_ARCH)"
+TCLSH_NATIVE = $(TCLSH)
+!else
+!error You must explicitly set TCLSH_NATIVE for cross-compilation
+!endif
+!endif
+
+### Make sure we use backslash only.
+LIB_INSTALL_DIR = $(_INSTALLDIR)\lib
+BIN_INSTALL_DIR = $(_INSTALLDIR)\bin
+DOC_INSTALL_DIR = $(_INSTALLDIR)\doc
+SCRIPT_INSTALL_DIR = $(_INSTALLDIR)\lib\tcl$(DOTVERSION)
+INCLUDE_INSTALL_DIR = $(_INSTALLDIR)\include
TCLSHOBJS = \
$(TMP_DIR)\tclAppInit.obj \
+!if $(TCL_USE_STATIC_PACKAGES)
+ $(TMP_DIR)\tclWinReg.obj \
+ $(TMP_DIR)\tclWinDde.obj \
+!endif
$(TMP_DIR)\tclsh.res
TCLTESTOBJS = \
@@ -236,20 +242,18 @@ TCLTESTOBJS = \ $(TMP_DIR)\tclTestProcBodyObj.obj \
$(TMP_DIR)\tclThreadTest.obj \
$(TMP_DIR)\tclWinTest.obj \
-!if !$(STATIC_BUILD)
- $(OUT_DIR)\tommath.lib \
+!if $(TCL_USE_STATIC_PACKAGES)
+ $(TMP_DIR)\tclWinReg.obj \
+ $(TMP_DIR)\tclWinDde.obj \
!endif
- $(TMP_DIR)\testMain.obj \
- $(TMP_DIR)\tcltest.res
+ $(TMP_DIR)\testMain.obj
-COREOBJS = \
+TCLOBJS = \
$(TMP_DIR)\regcomp.obj \
$(TMP_DIR)\regerror.obj \
$(TMP_DIR)\regexec.obj \
$(TMP_DIR)\regfree.obj \
$(TMP_DIR)\tclAlloc.obj \
- $(TMP_DIR)\tclArithSeries.obj \
- $(TMP_DIR)\tclAssembly.obj \
$(TMP_DIR)\tclAsync.obj \
$(TMP_DIR)\tclBasic.obj \
$(TMP_DIR)\tclBinary.obj \
@@ -259,16 +263,12 @@ COREOBJS = \ $(TMP_DIR)\tclCmdIL.obj \
$(TMP_DIR)\tclCmdMZ.obj \
$(TMP_DIR)\tclCompCmds.obj \
- $(TMP_DIR)\tclCompCmdsGR.obj \
- $(TMP_DIR)\tclCompCmdsSZ.obj \
$(TMP_DIR)\tclCompExpr.obj \
$(TMP_DIR)\tclCompile.obj \
$(TMP_DIR)\tclConfig.obj \
$(TMP_DIR)\tclDate.obj \
$(TMP_DIR)\tclDictObj.obj \
- $(TMP_DIR)\tclDisassemble.obj \
$(TMP_DIR)\tclEncoding.obj \
- $(TMP_DIR)\tclEnsemble.obj \
$(TMP_DIR)\tclEnv.obj \
$(TMP_DIR)\tclEvent.obj \
$(TMP_DIR)\tclExecute.obj \
@@ -285,24 +285,14 @@ COREOBJS = \ $(TMP_DIR)\tclIOSock.obj \
$(TMP_DIR)\tclIOUtil.obj \
$(TMP_DIR)\tclIORChan.obj \
- $(TMP_DIR)\tclIORTrans.obj \
$(TMP_DIR)\tclLink.obj \
$(TMP_DIR)\tclListObj.obj \
$(TMP_DIR)\tclLiteral.obj \
$(TMP_DIR)\tclLoad.obj \
- $(TMP_DIR)\tclMainW.obj \
$(TMP_DIR)\tclMain.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 \
@@ -312,7 +302,6 @@ COREOBJS = \ $(TMP_DIR)\tclPosixStr.obj \
$(TMP_DIR)\tclPreserve.obj \
$(TMP_DIR)\tclProc.obj \
- $(TMP_DIR)\tclProcess.obj \
$(TMP_DIR)\tclRegexp.obj \
$(TMP_DIR)\tclResolve.obj \
$(TMP_DIR)\tclResult.obj \
@@ -320,6 +309,7 @@ COREOBJS = \ $(TMP_DIR)\tclStringObj.obj \
$(TMP_DIR)\tclStrToD.obj \
$(TMP_DIR)\tclStubInit.obj \
+ $(TMP_DIR)\tclStubLib.obj \
$(TMP_DIR)\tclThread.obj \
$(TMP_DIR)\tclThreadAlloc.obj \
$(TMP_DIR)\tclThreadJoin.obj \
@@ -330,28 +320,24 @@ COREOBJS = \ $(TMP_DIR)\tclUtf.obj \
$(TMP_DIR)\tclUtil.obj \
$(TMP_DIR)\tclVar.obj \
- $(TMP_DIR)\tclZipfs.obj \
- $(TMP_DIR)\tclZlib.obj
-
-!if $(STATIC_BUILD)
-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
-!else
-ZLIBOBJS = $(OUT_DIR)\zdll.lib
-!endif
-
-!if $(STATIC_BUILD)
-TOMMATHOBJS = \
+ $(TMP_DIR)\tclWin32Dll.obj \
+ $(TMP_DIR)\tclWinChan.obj \
+ $(TMP_DIR)\tclWinConsole.obj \
+ $(TMP_DIR)\tclWinSerial.obj \
+ $(TMP_DIR)\tclWinError.obj \
+ $(TMP_DIR)\tclWinFCmd.obj \
+ $(TMP_DIR)\tclWinFile.obj \
+ $(TMP_DIR)\tclWinInit.obj \
+ $(TMP_DIR)\tclWinLoad.obj \
+ $(TMP_DIR)\tclWinNotify.obj \
+ $(TMP_DIR)\tclWinPipe.obj \
+ $(TMP_DIR)\tclWinSock.obj \
+ $(TMP_DIR)\tclWinThrd.obj \
+ $(TMP_DIR)\tclWinTime.obj \
+ $(TMP_DIR)\bncore.obj \
+ $(TMP_DIR)\bn_reverse.obj \
+ $(TMP_DIR)\bn_fast_s_mp_mul_digs.obj \
+ $(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 \
@@ -370,16 +356,16 @@ TOMMATHOBJS = \ $(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_u32.obj \
- $(TMP_DIR)\bn_mp_get_mag_u64.obj \
+ $(TMP_DIR)\bn_mp_expt_d.obj \
$(TMP_DIR)\bn_mp_grow.obj \
$(TMP_DIR)\bn_mp_init.obj \
$(TMP_DIR)\bn_mp_init_copy.obj \
- $(TMP_DIR)\bn_mp_init_i64.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_init_u64.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 \
@@ -389,313 +375,256 @@ TOMMATHOBJS = \ $(TMP_DIR)\bn_mp_mul_d.obj \
$(TMP_DIR)\bn_mp_neg.obj \
$(TMP_DIR)\bn_mp_or.obj \
- $(TMP_DIR)\bn_mp_pack.obj \
- $(TMP_DIR)\bn_mp_pack_count.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_i64.obj \
- $(TMP_DIR)\bn_mp_set_u64.obj \
+ $(TMP_DIR)\bn_mp_set.obj \
+ $(TMP_DIR)\bn_mp_set_int.obj \
$(TMP_DIR)\bn_mp_shrink.obj \
$(TMP_DIR)\bn_mp_sqr.obj \
$(TMP_DIR)\bn_mp_sqrt.obj \
$(TMP_DIR)\bn_mp_sub.obj \
$(TMP_DIR)\bn_mp_sub_d.obj \
- $(TMP_DIR)\bn_mp_signed_rsh.obj \
- $(TMP_DIR)\bn_mp_to_ubin.obj \
- $(TMP_DIR)\bn_mp_to_radix.obj \
- $(TMP_DIR)\bn_mp_ubin_size.obj \
- $(TMP_DIR)\bn_mp_unpack.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_balance_mul.obj \
- $(TMP_DIR)\bn_s_mp_karatsuba_mul.obj \
- $(TMP_DIR)\bn_s_mp_karatsuba_sqr.obj \
$(TMP_DIR)\bn_s_mp_mul_digs.obj \
- $(TMP_DIR)\bn_s_mp_mul_digs_fast.obj \
- $(TMP_DIR)\bn_s_mp_reverse.obj \
$(TMP_DIR)\bn_s_mp_sqr.obj \
- $(TMP_DIR)\bn_s_mp_sqr_fast.obj \
$(TMP_DIR)\bn_s_mp_sub.obj \
- $(TMP_DIR)\bn_s_mp_toom_sqr.obj \
- $(TMP_DIR)\bn_s_mp_toom_mul.obj
-!else
-TOMMATHOBJS = $(OUT_DIR)\tommath.lib
-!endif
-
-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)\tclWinPanic.obj \
- $(TMP_DIR)\tclWinReg.obj \
- $(TMP_DIR)\tclWinDde.obj \
-!else
+!if !$(STATIC_BUILD)
$(TMP_DIR)\tcl.res
!endif
-TCLOBJS = $(COREOBJS) $(ZLIBOBJS) $(TOMMATHOBJS) $(PLATFORMOBJS)
-
TCLSTUBOBJS = \
- $(TMP_DIR)\tclStubLib.obj \
- $(TMP_DIR)\tclTomMathStubLib.obj \
- $(TMP_DIR)\tclOOStubLib.obj \
- $(TMP_DIR)\tclWinPanic.obj
+ $(TMP_DIR)\tclStubLib.obj
-### The following paths CANNOT have spaces in them as they appear on
-### the left side of implicit rules.
+### The following paths CANNOT have spaces in them.
+COMPATDIR = $(ROOT)\compat
+DOCDIR = $(ROOT)\doc
+GENERICDIR = $(ROOT)\generic
TOMMATHDIR = $(ROOT)\libtommath
-PKGSDIR = $(ROOT)\pkgs
+TOOLSDIR = $(ROOT)\tools
+WINDIR = $(ROOT)\win
-LIBTCLVFS = $(OUT_DIR)\libtcl.vfs
+#---------------------------------------------------------------------
+# Compile flags
+#---------------------------------------------------------------------
-# 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 /DMP_FIXED_CUTOFFS
+!if !$(DEBUG)
+!if $(OPTIMIZING)
+### This cranks the optimization level to maximize speed
+cdebug = -O2 $(OPTIMIZATIONS)
+!else
+cdebug =
+!endif
+!if $(SYMBOLS)
+cdebug = $(cdebug) -Zi
+!endif
+!else if "$(MACHINE)" == "IA64" || "$(MACHINE)" == "AMD64"
+### Warnings are too many, can't support warnings into errors.
+cdebug = -Zi -Od $(DEBUGFLAGS)
+!else
+cdebug = -Zi -WX $(DEBUGFLAGS)
+!endif
+
+### Declarations common to all compiler options
+cwarn = $(WARNINGS) -D _CRT_SECURE_NO_DEPRECATE -D _CRT_NONSTDC_NO_DEPRECATE
+cflags = -nologo -c $(COMPILERFLAGS) $(cwarn) -Fp$(TMP_DIR)^\
+
+!if $(MSVCRT)
+!if $(DEBUG) && !$(UNCHECKED)
+crt = -MDd
+!else
+crt = -MD
+!endif
+!else
+!if $(DEBUG) && !$(UNCHECKED)
+crt = -MTd
+!else
+crt = -MT
+!endif
+!endif
+
+TCL_INCLUDES = -I"$(WINDIR)" -I"$(GENERICDIR)" -I"$(TOMMATHDIR)"
+TCL_DEFINES = -DTCL_PIPE_DLL=\"$(TCLPIPEDLLNAME)\" -DTCL_TOMMATH -DMP_PREC=4 -Dinline=__inline
+BASE_CFLAGS = $(cflags) $(cdebug) $(crt) $(TCL_INCLUDES) $(TCL_DEFINES)
+CON_CFLAGS = $(cflags) $(cdebug) $(crt) -DCONSOLE
+TCL_CFLAGS = $(BASE_CFLAGS) $(OPTDEFINES)
+STUB_CFLAGS = $(cflags) $(cdebug) $(OPTDEFINES)
-# Additional Link libraries needed beyond those in rules.vc
-PRJ_LIBS = netapi32.lib user32.lib userenv.lib ws2_32.lib
#---------------------------------------------------------------------
-# TclTest flags
+# Link flags
#---------------------------------------------------------------------
-!if "$(TESTPAT)" != ""
-TESTFLAGS = $(TESTFLAGS) -file $(TESTPAT)
+!if $(DEBUG)
+ldebug = -debug -debugtype:cv
+!else
+ldebug = -release -opt:ref -opt:icf,3
+!if $(SYMBOLS)
+ldebug = $(ldebug) -debug -debugtype:cv
+!endif
!endif
+### Declarations common to all linker options
+lflags = -nologo -machine:$(MACHINE) $(LINKERFLAGS) $(ldebug)
-#---------------------------------------------------------------------
-# Project specific targets
-# There are 4 primary build configurations to consider from the combination
-# of static/shared and embed/noembed of the library zip. The targets are
-# done in the following order.
-# $(TCLLIB) - this is either the core static .lib or the .dll. The target
-# build does not embed the library zip in the DLL irrespective
-# of the noembed setting. A copy is made as $(TCLLIBRAW)
-# as the $(TCLLIB) binary is potentially modified later.
-# dlls - these are the registry and dde DLL's or static libraries
-# $(TCLSH) - the Tcl shell WITHOUT any embedded zip. This needs $(TCLLIB)
-# to be built first as it links against it. A copy is made
-# as $(TCLSHRAW) as $(TCLSH) binary may be modified later.
-# $(TCLSCRIPTZIP) - the zip file that is to be embedded. Note this also
-# ships separately and needs to be built irrespective of the
-# whether it is embedded or not. All above targets need to
-# be built prior as they are used to build the zip (unlike
-# Unix where the external zip program is used.)
-# core - this virtual target builds the final release ready Tcl
-# library. For shared, embedded builds it appends $(TCLSCRIPTZIP)
-# to the $(TCLLIB). For other build configurations, this
-# is a no-op.
-# shell - this virtual target builds the final release ready tclsh shell.
-# For static, embedded builds it appends $(TCLSCRIPTZIP)
-# to the $(TCLSH). For other build configurations, this
-# is a no-op.
-# release - Everything that builds as part of a release
-#---------------------------------------------------------------------
+!if $(PROFILE)
+lflags = $(lflags) -profile
+!endif
-release: setup libtclzip core dlls shell pkgs
-all: setup libtclzip core dlls shell pkgs
+!if $(MSVCRT) && !($(DEBUG) && !$(UNCHECKED)) && $(VCVERSION) >= 1900
+lflags = $(lflags) -nodefaultlib:libucrt.lib
+!endif
-core: setup $(TCLLIB)
-!if $(TCL_EMBED_SCRIPTS) && !$(STATIC_BUILD)
-core: libtclzip
- @$(COPY) /b "$(TCLLIBRAW)"+"$(TCLSCRIPTZIP)" "$(TCLLIB)"
+!if $(ALIGN98_HACK) && !$(STATIC_BUILD)
+### Align sections for PE size savings.
+lflags = $(lflags) -opt:nowin98
+!else if !$(ALIGN98_HACK) && $(STATIC_BUILD)
+### Align sections for speed in loading by choosing the virtual page size.
+lflags = $(lflags) -align:4096
!endif
-shell: setup core $(TCLSH)
-!if $(TCL_EMBED_SCRIPTS) && $(STATIC_BUILD)
-shell: libtclzip
- @$(COPY) /b "$(TCLSHRAW)"+"$(TCLSCRIPTZIP)" "$(TCLSH)"
+!if $(LOIMPACT)
+lflags = $(lflags) -ws:aggressive
!endif
-dlls: setup $(TCLREGLIB) $(TCLDDELIB) $(OUT_DIR)\zlib1.dll $(OUT_DIR)\libtommath.dll
-libtclzip: $(TCLSCRIPTZIP)
+dlllflags = $(lflags) -dll
+conlflags = $(lflags) -subsystem:console
+guilflags = $(lflags) -subsystem:windows
-tcltest: setup core $(TCLTEST) dlls
-!if $(TCL_EMBED_SCRIPTS) && $(STATIC_BUILD)
-tcltest: libtclzip
- @$(COPY) /b "$(TCLTESTRAW)"+"$(TCLSCRIPTZIP)" "$(TCLTEST)"
+baselibs = kernel32.lib user32.lib ws2_32.lib
+# Avoid 'unresolved external symbol __security_cookie' errors.
+# c.f. http://support.microsoft.com/?id=894573
+!if "$(MACHINE)" == "IA64" || "$(MACHINE)" == "AMD64"
+!if $(VCVERSION) > 1399 && $(VCVERSION) < 1500
+baselibs = $(baselibs) bufferoverflowU.lib
+!endif
+!endif
+!if $(MSVCRT) && !($(DEBUG) && !$(UNCHECKED)) && $(VCVERSION) >= 1900
+baselibs = $(baselibs) ucrt.lib
!endif
-install: install-binaries install-libraries install-docs install-pkgs
-!if $(SYMBOLS)
-install: install-pdbs
+#---------------------------------------------------------------------
+# TclTest flags
+#---------------------------------------------------------------------
+
+!if "$(TESTPAT)" != ""
+TESTFLAGS = $(TESTFLAGS) -file $(TESTPAT)
!endif
-setup: default-setup
-test: test-core test-pkgs
-test-core: tcltest
- set TCL_LIBRARY=$(TCL_TEST_LIBRARY)
+
+#---------------------------------------------------------------------
+# Project specific targets
+#---------------------------------------------------------------------
+
+release: setup $(TCLSH) $(TCLSTUBLIB) dlls
+core: setup $(TCLLIB) $(TCLSTUBLIB)
+shell: setup $(TCLSH)
+dlls: setup $(TCLPIPEDLL) $(TCLREGLIB) $(TCLDDELIB)
+all: setup $(TCLSH) $(TCLSTUBLIB) dlls $(CAT32)
+tcltest: setup $(TCLTEST) dlls $(CAT32)
+install: install-binaries install-libraries install-docs
+
+test: test-core
+test-core: setup $(TCLTEST) dlls $(CAT32)
+ set TCL_LIBRARY=$(ROOT:\=/)/library
+!if "$(OS)" == "Windows_NT" || "$(MSVCDIR)" == "IDE"
$(DEBUGGER) $(TCLTEST) "$(ROOT:\=/)/tests/all.tcl" $(TESTFLAGS) -loadfile <<
- package ifneeded dde 1.4.5 [list load "$(TCLDDELIB:\=/)"]
- package ifneeded registry 1.3.7 [list load "$(TCLREGLIB:\=/)"]
+ package ifneeded dde 1.3.3 [list load "$(TCLDDELIB:\=/)" dde]
+ package ifneeded registry 1.2.2 [list load "$(TCLREGLIB:\=/)" registry]
+<<
+!else
+ @echo Please wait while the tests are collected...
+ $(TCLTEST) "$(ROOT:\=/)/tests/all.tcl" $(TESTFLAGS) -loadfile << > tests.log
+ package ifneeded dde 1.3.3 "$(TCLDDELIB:\=/)" dde]
+ package ifneeded registry 1.2.2 "$(TCLREGLIB:\=/)" registry]
<<
+ type tests.log | more
+!endif
-runtest: setup $(TCLTEST) dlls
- set TCL_LIBRARY=$(TCL_TEST_LIBRARY)
+runtest: setup $(TCLTEST) dlls $(CAT32)
+ set TCL_LIBRARY=$(ROOT:\=/)/library
$(DEBUGGER) $(TCLTEST) $(SCRIPT)
-runshell: setup core shell dlls
- set TCL_LIBRARY=$(TCL_TEST_LIBRARY)
+runshell: setup $(TCLSH) dlls
+ set TCL_LIBRARY=$(ROOT:\=/)/library
$(DEBUGGER) $(TCLSH) $(SCRIPT)
-!if $(STATIC_BUILD)
+setup:
+ @if not exist $(OUT_DIR)\nul mkdir $(OUT_DIR)
+ @if not exist $(TMP_DIR)\nul mkdir $(TMP_DIR)
+
+!if !$(STATIC_BUILD)
+$(TCLIMPLIB): $(TCLLIB)
+!endif
$(TCLLIB): $(TCLOBJS)
- $(LIBCMD) @<<
+!if $(STATIC_BUILD)
+ $(lib32) -nologo $(LINKERFLAGS) -out:$@ @<<
$**
<<
-
!else
-
-$(TCLLIB): $(TCLOBJS)
- $(DLLCMD) @<<
+ $(link32) $(dlllflags) -base:@$(WINDIR)\coffbase.txt,tcl -out:$@ \
+ $(baselibs) @<<
$**
<<
$(_VC_MANIFEST_EMBED_DLL)
-!if $(TCL_EMBED_SCRIPTS) && !$(STATIC_BUILD)
- $(COPY) $@ $(TCLLIBRAW)
+ -@del $*.exp
!endif
-$(TCLIMPLIB): $(TCLLIB)
-
-!endif # $(STATIC_BUILD)
-
$(TCLSTUBLIB): $(TCLSTUBOBJS)
- $(LIBCMD) -nodefaultlib $(TCLSTUBOBJS)
+ $(lib32) -nologo $(LINKERFLAGS) -nodefaultlib -out:$@ $(TCLSTUBOBJS)
$(TCLSH): $(TCLSHOBJS) $(TCLSTUBLIB) $(TCLIMPLIB)
- $(CONEXECMD) -stack:2300000 $**
- copy $(TMP_DIR)\tclsh.exe.manifest $(TCLSH).manifest
+ $(link32) $(conlflags) -stack:2300000 -out:$@ $(baselibs) $**
$(_VC_MANIFEST_EMBED_EXE)
-!if $(TCL_EMBED_SCRIPTS) && $(STATIC_BUILD)
- $(COPY) $@ $(TCLSHRAW)
-!endif
-
$(TCLTEST): $(TCLTESTOBJS) $(TCLSTUBLIB) $(TCLIMPLIB)
- $(CONEXECMD) -stack:2300000 $**
- copy $(TMP_DIR)\tclsh.exe.manifest $(TCLTEST).manifest
+ $(link32) $(conlflags) -stack:2300000 -out:$@ $(baselibs) $**
$(_VC_MANIFEST_EMBED_EXE)
-!if $(TCL_EMBED_SCRIPTS) && $(STATIC_BUILD)
- $(COPY) $@ $(TCLTESTRAW)
-!endif
+
+$(TCLPIPEDLL): $(WINDIR)\stub16.c
+ $(cc32) $(CON_CFLAGS) -Fo$(TMP_DIR)\ $(WINDIR)\stub16.c
+ $(link32) $(conlflags) -out:$@ $(TMP_DIR)\stub16.obj $(baselibs)
+ $(_VC_MANIFEST_EMBED_DLL)
!if $(STATIC_BUILD)
$(TCLDDELIB): $(TMP_DIR)\tclWinDde.obj
- $(LIBCMD) $**
+ $(lib32) -nologo $(LINKERFLAGS) -out:$@ $**
!else
$(TCLDDELIB): $(TMP_DIR)\tclWinDde.obj $(TCLSTUBLIB)
- $(DLLCMD) $**
+ $(link32) $(dlllflags) -base:@$(WINDIR)\coffbase.txt,tcldde -out:$@ \
+ $** $(baselibs)
$(_VC_MANIFEST_EMBED_DLL)
+ -@del $*.exp
+ -@del $*.lib
!endif
!if $(STATIC_BUILD)
$(TCLREGLIB): $(TMP_DIR)\tclWinReg.obj
- $(LIBCMD) $**
+ $(lib32) -nologo $(LINKERFLAGS) -out:$@ $**
!else
$(TCLREGLIB): $(TMP_DIR)\tclWinReg.obj $(TCLSTUBLIB)
- $(DLLCMD) $**
+ $(link32) $(dlllflags) -base:@$(WINDIR)\coffbase.txt,tclreg -out:$@ \
+ $** $(baselibs)
$(_VC_MANIFEST_EMBED_DLL)
+ -@del $*.exp
+ -@del $*.lib
!endif
-!if "$(MACHINE)" == "ARM64"
-$(OUT_DIR)\zlib1.dll: $(COMPATDIR)\zlib\win64-arm\zlib1.dll
- $(COPY) $(COMPATDIR)\zlib\win64-arm\zlib1.dll $(OUT_DIR)\zlib1.dll
-$(OUT_DIR)\zdll.lib: $(COMPATDIR)\zlib\win64-arm\zdll.lib
- $(COPY) $(COMPATDIR)\zlib\win64-arm\zdll.lib $(OUT_DIR)\zdll.lib
-$(OUT_DIR)\libtommath.dll: $(TOMMATHDIR)\win64-arm\libtommath.dll
- $(COPY) $(TOMMATHDIR)\win64-arm\libtommath.dll $(OUT_DIR)\libtommath.dll
-$(OUT_DIR)\tommath.lib: $(TOMMATHDIR)\win64-arm\tommath.lib
- $(COPY) $(TOMMATHDIR)\win64-arm\tommath.lib $(OUT_DIR)\tommath.lib
-!elseif "$(MACHINE)" == "IX86"
-$(OUT_DIR)\zlib1.dll: $(COMPATDIR)\zlib\win32\zlib1.dll
- $(COPY) $(COMPATDIR)\zlib\win32\zlib1.dll $(OUT_DIR)\zlib1.dll
-$(OUT_DIR)\zdll.lib: $(COMPATDIR)\zlib\win32\zdll.lib
- $(COPY) $(COMPATDIR)\zlib\win32\zdll.lib $(OUT_DIR)\zdll.lib
-$(OUT_DIR)\libtommath.dll: $(TOMMATHDIR)\win32\libtommath.dll
- $(COPY) $(TOMMATHDIR)\win32\libtommath.dll $(OUT_DIR)\libtommath.dll
-$(OUT_DIR)\tommath.lib: $(TOMMATHDIR)\win32\tommath.lib
- $(COPY) $(TOMMATHDIR)\win32\tommath.lib $(OUT_DIR)\tommath.lib
-!else
-$(OUT_DIR)\zlib1.dll: $(COMPATDIR)\zlib\win64\zlib1.dll
- $(COPY) $(COMPATDIR)\zlib\win64\zlib1.dll $(OUT_DIR)\zlib1.dll
-$(OUT_DIR)\zdll.lib: $(COMPATDIR)\zlib\win64\zdll.lib
- $(COPY) $(COMPATDIR)\zlib\win64\zdll.lib $(OUT_DIR)\zdll.lib
-$(OUT_DIR)\libtommath.dll: $(TOMMATHDIR)\win64\libtommath.dll
- $(COPY) $(TOMMATHDIR)\win64\libtommath.dll $(OUT_DIR)\libtommath.dll
-$(OUT_DIR)\tommath.lib: $(TOMMATHDIR)\win64\tommath.lib
- $(COPY) $(TOMMATHDIR)\win64\tommath.lib $(OUT_DIR)\tommath.lib
-!endif
-
-$(TCLSCRIPTZIP): $(TCLLIB) $(TCLSH) dlls
- @echo Building Tcl library zip file $(TCLSCRIPTZIP)
- @set TCL_LIBRARY=$(ROOT:\=/)/library
- @if exist "$(LIBTCLVFS)" $(RMDIR) "$(LIBTCLVFS)"
- @$(MKDIR) "$(LIBTCLVFS)"
- @$(CPYDIR) $(LIBDIR) "$(LIBTCLVFS)\tcl_library"
- @move /y "$(LIBTCLVFS)\tcl_library\manifest.txt" "$(LIBTCLVFS)\tcl_library\pkgIndex.tcl" > NUL
-!if $(STATIC_BUILD)
-# Remove the registry and dde directories as the DLLS are still external
- @del "$(LIBTCLVFS)\tcl_library\registry\pkgIndex.tcl"
- @rmdir "$(LIBTCLVFS)\tcl_library\registry"
- @del "$(LIBTCLVFS)\tcl_library\dde\pkgIndex.tcl"
- @rmdir "$(LIBTCLVFS)\tcl_library\dde"
-!else
- @$(COPY) $(TCLDDELIB) "$(LIBTCLVFS)\tcl_library\dde
- @$(COPY) $(TCLREGLIB) "$(LIBTCLVFS)\tcl_library\registry
-!endif
- @echo file delete -force {$@} > "$(OUT_DIR)\zipper.tcl"
- @echo zipfs mkzip {$@} {$(LIBTCLVFS)} {$(LIBTCLVFS)} >> "$(OUT_DIR)\zipper.tcl"
- @cd "$(OUT_DIR)" && $(TCLSH_NATIVE) zipper.tcl
-
-pkgs:
- @for /d %d in ($(PKGSDIR)\*) do \
- @if exist "%~fd\win\makefile.vc" ( \
- pushd "%~fd\win" & \
- $(MAKE) -$(MAKEFLAGS) -f makefile.vc TCLDIR=$(ROOT) &\
- popd \
- )
-
-test-pkgs:
- @for /d %d in ($(PKGSDIR)\*) do \
- @if exist "%~fd\win\makefile.vc" ( \
- pushd "%~fd\win" & \
- $(MAKE) -$(MAKEFLAGS) -f makefile.vc TCLDIR=$(ROOT) test &\
- popd \
- )
-
-install-pkgs:
- @for /d %d in ($(PKGSDIR)\*) do \
- @if exist "%~fd\win\makefile.vc" ( \
- pushd "%~fd\win" & \
- $(MAKE) -$(MAKEFLAGS) -f makefile.vc TCLDIR=$(ROOT) install &\
- popd \
- )
-
-clean-pkgs:
- @for /d %d in ($(PKGSDIR)\*) do \
- @if exist "%~fd\win\makefile.vc" ( \
- pushd "%~fd\win" & \
- $(MAKE) -$(MAKEFLAGS) -f makefile.vc TCLDIR=$(ROOT) clean &\
- popd \
- )
+$(CAT32): $(WINDIR)\cat.c
+ $(cc32) $(CON_CFLAGS) -Fo$(TMP_DIR)\ $?
+ $(link32) $(conlflags) -out:$@ -stack:16384 $(TMP_DIR)\cat.obj \
+ $(baselibs)
+ $(_VC_MANIFEST_EMBED_EXE)
#---------------------------------------------------------------------
# Regenerate the stubs files. [Development use only]
@@ -708,22 +637,33 @@ genstubs: $(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"
+# NOTE: you can define HHC on the command-line to override this
+!ifndef HHC
+HHC=""%ProgramFiles%\HTML Help Workshop\hhc.exe""
!endif
-HTMLDIR=$(OUT_DIR)\html
+HTMLDIR=$(ROOT)\html
HTMLBASE=TclTk$(VERSION)
HHPFILE=$(HTMLDIR)\$(HTMLBASE).hhp
CHMFILE=$(HTMLDIR)\$(HTMLBASE).chm
@@ -731,51 +671,100 @@ CHMFILE=$(HTMLDIR)\$(HTMLBASE).chm htmlhelp: chmsetup $(CHMFILE)
$(CHMFILE): $(DOCDIR)\*
- @$(TCLSH) -encoding utf-8 $(TOOLSDIR)\tcltk-man2html.tcl "--htmldir=$(HTMLDIR)"
+ @$(TCLSH) $(TOOLSDIR)\tcltk-man2html.tcl
@echo Compiling HTML help project
- -"$(HHC)" <<$(HHPFILE) >NUL
+ @$(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
+Title=Tcl/Tk $(DOT_VERSION) Help
[FILES]
contents.htm
docs.css
-Keywords\*.htm
-TclCmd\*.htm
-TclLib\*.htm
-TkCmd\*.htm
-TkLib\*.htm
-UserCmd\*.htm
+Keywords
+TclCmd
+TclLib
+TkCmd
+TkLib
+UserCmd
<<
chmsetup:
@if not exist $(HTMLDIR)\nul mkdir $(HTMLDIR)
+#-------------------------------------------------------------------------
+# Build the old-style Windows .hlp file
+#-------------------------------------------------------------------------
+
+TCLHLPBASE = $(PROJECT)$(VERSION)
+HELPFILE = $(OUT_DIR)\$(TCLHLPBASE).hlp
+HELPCNT = $(OUT_DIR)\$(TCLHLPBASE).cnt
+DOCTMP_DIR = $(OUT_DIR)\$(PROJECT)_docs
+HELPRTF = $(DOCTMP_DIR)\$(PROJECT).rtf
+MAN2HELP = $(DOCTMP_DIR)\man2help.tcl
+MAN2HELP2 = $(DOCTMP_DIR)\man2help2.tcl
+INDEX = $(DOCTMP_DIR)\index.tcl
+BMP = $(DOCTMP_DIR)\feather.bmp
+BMP_NOPATH = feather.bmp
+MAN2TCL = $(DOCTMP_DIR)\man2tcl.exe
+
+winhelp: docsetup $(HELPFILE)
+
+docsetup:
+ @if not exist $(DOCTMP_DIR)\nul mkdir $(DOCTMP_DIR)
+
+$(MAN2HELP) $(MAN2HELP2) $(INDEX) $(BMP): $(TOOLSDIR)\$$(@F)
+ @$(CPY) $(TOOLSDIR)\$(@F) $(@D)
+
+$(HELPFILE): $(HELPRTF) $(BMP)
+ cd $(DOCTMP_DIR)
+ start /wait hcrtf.exe -x <<$(PROJECT).hpj
+[OPTIONS]
+COMPRESS=12 Hall Zeck
+LCID=0x409 0x0 0x0 ; English (United States)
+TITLE=Tcl/Tk Reference Manual
+BMROOT=.
+CNT=$(@B).cnt
+HLP=$(@B).hlp
+
+[FILES]
+$(PROJECT).rtf
+
+[WINDOWS]
+main="Tcl/Tk Reference Manual",,27648,(r15263976),(r65535)
+
+[CONFIG]
+BrowseButtons()
+CreateButton(1, "Web", ExecFile("http://www.tcl.tk"))
+CreateButton(2, "SF", ExecFile("http://sf.net/projects/tcl"))
+CreateButton(3, "Wiki", ExecFile("http://wiki.tcl.tk"))
+CreateButton(4, "FAQ", ExecFile("http://www.purl.org/NET/Tcl-FAQ/"))
+<<
+ cd $(MAKEDIR)
+ @$(CPY) "$(DOCTMP_DIR)\$(@B).hlp" "$(OUT_DIR)"
+ @$(CPY) "$(DOCTMP_DIR)\$(@B).cnt" "$(OUT_DIR)"
+
+$(MAN2TCL): $(TOOLSDIR)\$$(@B).c
+ $(cc32) $(TCL_CFLAGS) -Fo$(@D)\ $(TOOLSDIR)\$(@B).c
+ $(link32) $(conlflags) -out:$@ -stack:16384 $(@D)\man2tcl.obj
+ $(_VC_MANIFEST_EMBED_EXE)
+
+$(HELPRTF): $(MAN2TCL) $(MAN2HELP) $(MAN2HELP2) $(INDEX) $(DOCDIR)\*
+ $(TCLSH) $(MAN2HELP) -bitmap $(BMP_NOPATH) $(PROJECT) $(VERSION) $(DOCDIR:\=/)
+
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_USE_THREAD_ALLOC = $(USE_THREAD_ALLOC)
-<<
+!if exist("$(HELPFILE)")
+ @echo Installing Windows help
+ @$(CPY) "$(HELPFILE)" "$(DOC_INSTALL_DIR)\"
+ @$(CPY) "$(HELPCNT)" "$(DOC_INSTALL_DIR)\"
+!endif
#---------------------------------------------------------------------
# Build tclConfig.sh for the TEA build system.
@@ -783,8 +772,7 @@ CORE_USE_THREAD_ALLOC = $(USE_THREAD_ALLOC) 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
+$(OUT_DIR)\tclConfig.sh: $(WINDIR)\tclConfig.sh.in
@echo Creating tclConfig.sh
@nmakehlp -s << $** >$@
@TCL_DLL_FILE@ $(TCLLIBNAME)
@@ -793,13 +781,15 @@ $(OUT_DIR)\tclConfig.sh: $(WIN_DIR)\tclConfig.sh.in @TCL_MINOR_VERSION@ $(TCL_MINOR_VERSION)
@TCL_PATCH_LEVEL@ $(TCL_PATCH_LEVEL)
@CC@ $(CC)
-@DEFS@ $(pkgcflags)
+@DEFS@ $(TCL_CFLAGS)
@CFLAGS_DEBUG@ -nologo -c -W3 -YX -Fp$(TMP_DIR)\ -MDd
@CFLAGS_OPTIMIZE@ -nologo -c -W3 -YX -Fp$(TMP_DIR)\ -MD
@LDFLAGS_DEBUG@ -nologo -machine:$(MACHINE) -debug -debugtype:cv
@LDFLAGS_OPTIMIZE@ -nologo -machine:$(MACHINE) -release -opt:ref -opt:icf,3
+@TCL_DBGX@ $(SUFX)
@TCL_LIB_FILE@ $(PROJECT)$(VERSION)$(SUFX).lib
-@LIBS@ $(baselibs) $(PRJ_LIBS)
+@TCL_NEEDS_EXP_FILE@
+@LIBS@ $(baselibs)
@prefix@ $(_INSTALLDIR)
@exec_prefix@ $(BIN_INSTALL_DIR)
@SHLIB_CFLAGS@
@@ -808,26 +798,28 @@ $(OUT_DIR)\tclConfig.sh: $(WIN_DIR)\tclConfig.sh.in @EXTRA_CFLAGS@ -YX
@SHLIB_LD@ $(link32) $(dlllflags)
@STLIB_LD@ $(lib32) -nologo
-@SHLIB_LD_LIBS@ $(baselibs) $(PRJ_LIBS)
+@SHLIB_LD_LIBS@ $(baselibs)
@SHLIB_SUFFIX@ .dll
@DL_LIBS@
@LDFLAGS@
-@TCL_CC_SEARCH_FLAGS@
@TCL_LD_SEARCH_FLAGS@
@LIBOBJS@
@RANLIB@
-@TCL_LIB_FLAG@ $(PROJECT)$(VERSION)$(SUFX).lib
-@TCL_BUILD_LIB_SPEC@ $(OUT_DIR)\$(PROJECT)$(VERSION)$(SUFX).lib
+@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@ $(LIB_INSTALL_DIR)
+@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)
@@ -835,8 +827,6 @@ $(OUT_DIR)\tclConfig.sh: $(WIN_DIR)\tclConfig.sh.in !else
@TCL_SHARED_BUILD@ 1
!endif
-@TCL_ZLIB_LIB_NAME@ zdll.lib
-@TCL_TOMMATH_LIB_NAME@ tommath.lib
<<
@@ -857,83 +847,56 @@ gendate: # Special case object file targets
#---------------------------------------------------------------------
-$(TMP_DIR)\testMain.obj: $(WIN_DIR)\tclAppInit.c
- $(cc32) $(appcflags) /DTCL_TEST /DUNICODE /D_UNICODE \
+$(TMP_DIR)\testMain.obj: $(WINDIR)\tclAppInit.c
+ $(cc32) $(TCL_CFLAGS) -DTCL_TEST \
+ -DTCL_USE_STATIC_PACKAGES=$(TCL_USE_STATIC_PACKAGES) \
-Fo$@ $?
-$(TMP_DIR)\tclMainW.obj: $(GENERICDIR)\tclMain.c
- $(cc32) $(pkgcflags) /DUNICODE /D_UNICODE \
- -Fo$@ $?
-
-$(ROOT)\manifest.uuid:
- copy $(WIN_DIR)\gitmanifest.in $(ROOT)\manifest.uuid
- git rev-parse HEAD >>$(ROOT)\manifest.uuid
-
-$(TMP_DIR)\tclUuid.h: $(ROOT)\manifest.uuid
- copy $(WIN_DIR)\tclUuid.h.in+$(ROOT)\manifest.uuid $(TMP_DIR)\tclUuid.h
-
-$(TMP_DIR)\tclEvent.obj: $(GENERICDIR)\tclEvent.c $(TMP_DIR)\tclUuid.h
- $(cc32) $(pkgcflags) -I$(TMP_DIR) \
- -Fo$@ $(GENERICDIR)\tclEvent.c
-
-$(TMP_DIR)\tclTest.obj: $(GENERICDIR)\tclTest.c $(TMP_DIR)\tclUuid.h
- $(cc32) $(appcflags) -I$(TMP_DIR) \
- -Fo$@ $(GENERICDIR)\tclTest.c
+$(TMP_DIR)\tclTest.obj: $(GENERICDIR)\tclTest.c
+ $(cc32) $(TCL_CFLAGS) -Fo$@ $?
$(TMP_DIR)\tclTestObj.obj: $(GENERICDIR)\tclTestObj.c
- $(cc32) $(appcflags) -Fo$@ $?
-
-$(TMP_DIR)\tclWinTest.obj: $(WIN_DIR)\tclWinTest.c
- $(CCAPPCMD) $?
+ $(cc32) $(TCL_CFLAGS) -Fo$@ $?
-$(TMP_DIR)\tclZipfs.obj: $(GENERICDIR)\tclZipfs.c
- $(cc32) $(pkgcflags) \
- -I$(COMPATDIR)\zlib -I$(COMPATDIR)\zlib\contrib\minizip \
- -Fo$@ $?
+$(TMP_DIR)\tclWinTest.obj: $(WINDIR)\tclWinTest.c
+ $(cc32) $(TCL_CFLAGS) -Fo$@ $?
-$(TMP_DIR)\tclZlib.obj: $(GENERICDIR)\tclZlib.c
- $(cc32) $(pkgcflags) -I$(COMPATDIR)\zlib -Fo$@ $?
-
-# Following the lead of the autoconf based make, we define the
-# CFG_RUNTIME_*DIR flags specifically for tclPkgConfig
-# and not as part of the global defines. These are all defined
-# as empty strings because they are intended to represent paths
-# at *runtime*, not build time. This may make sense on Unix systems
-# where end-user does configure and make on the target system. It
-# makes no sense on Windows where binary distributions may be installed
-# anywhere. Storing build time paths as runtime paths is misleading
-# at best and inefficient at worst as the code goes looking for
-# files and directories that do not exist.
-# Note: the same is true for the other CFG_RUNTIME* and CFG_INSTALL*
-# settings as well but they are historical and I do not want to change
-# them.
$(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:\=\\)\"" \
- /DCFG_RUNTIME_DLLFILE="\"$(TCL_LIB_FILE)\"" \
+ $(cc32) -DBUILD_tcl $(TCL_CFLAGS) \
+ -DCFG_INSTALL_LIBDIR="\"$(LIB_INSTALL_DIR:\=\\)\"" \
+ -DCFG_INSTALL_BINDIR="\"$(BIN_INSTALL_DIR:\=\\)\"" \
+ -DCFG_INSTALL_SCRDIR="\"$(SCRIPT_INSTALL_DIR:\=\\)\"" \
+ -DCFG_INSTALL_INCDIR="\"$(INCLUDE_INSTALL_DIR:\=\\)\"" \
+ -DCFG_INSTALL_DOCDIR="\"$(DOC_INSTALL_DIR:\=\\)\"" \
+ -DCFG_RUNTIME_LIBDIR="\"$(LIB_INSTALL_DIR:\=\\)\"" \
+ -DCFG_RUNTIME_BINDIR="\"$(BIN_INSTALL_DIR:\=\\)\"" \
+ -DCFG_RUNTIME_SCRDIR="\"$(SCRIPT_INSTALL_DIR:\=\\)\"" \
+ -DCFG_RUNTIME_INCDIR="\"$(INCLUDE_INSTALL_DIR:\=\\)\"" \
+ -DCFG_RUNTIME_DOCDIR="\"$(DOC_INSTALL_DIR:\=\\)\"" \
-Fo$@ $?
-$(TMP_DIR)\tclAppInit.obj: $(WIN_DIR)\tclAppInit.c
- $(cc32) $(appcflags) /DUNICODE /D_UNICODE \
+$(TMP_DIR)\tclAppInit.obj: $(WINDIR)\tclAppInit.c
+ $(cc32) $(TCL_CFLAGS) \
+ -DTCL_USE_STATIC_PACKAGES=$(TCL_USE_STATIC_PACKAGES) \
-Fo$@ $?
### The following objects should be built using the stub interfaces
+### *ALL* extensions need to built with -DTCL_THREADS=1
-$(TMP_DIR)\tclWinReg.obj: $(WIN_DIR)\tclWinReg.c
- $(cc32) $(appcflags) /DUSE_TCL_STUBS -Fo$@ $?
+$(TMP_DIR)\tclWinReg.obj: $(WINDIR)\tclWinReg.c
+!if $(STATIC_BUILD)
+ $(cc32) $(TCL_CFLAGS) -DTCL_THREADS=1 -DSTATIC_BUILD -Fo$@ $?
+!else
+ $(cc32) $(TCL_CFLAGS) -DTCL_THREADS=1 -DUSE_TCL_STUBS -Fo$@ $?
+!endif
-$(TMP_DIR)\tclWinDde.obj: $(WIN_DIR)\tclWinDde.c
- $(cc32) $(appcflags) /DUSE_TCL_STUBS -Fo$@ $?
+$(TMP_DIR)\tclWinDde.obj: $(WINDIR)\tclWinDde.c
+!if $(STATIC_BUILD)
+ $(cc32) $(TCL_CFLAGS) -DTCL_THREADS=1 -DSTATIC_BUILD -Fo$@ $?
+!else
+ $(cc32) $(TCL_CFLAGS) -DTCL_THREADS=1 -DUSE_TCL_STUBS -Fo$@ $?
+!endif
### The following objects are part of the stub library and should not
@@ -941,18 +904,9 @@ $(TMP_DIR)\tclWinDde.obj: $(WIN_DIR)\tclWinDde.c ### specific C run-time.
$(TMP_DIR)\tclStubLib.obj: $(GENERICDIR)\tclStubLib.c
- $(cc32) $(stubscflags) -Fo$@ $?
-
-$(TMP_DIR)\tclTomMathStubLib.obj: $(GENERICDIR)\tclTomMathStubLib.c
- $(cc32) $(stubscflags) -Fo$@ $?
+ $(cc32) $(STUB_CFLAGS) -Zl -DSTATIC_BUILD $(TCL_INCLUDES) -Fo$@ $?
-$(TMP_DIR)\tclOOStubLib.obj: $(GENERICDIR)\tclOOStubLib.c
- $(cc32) $(stubscflags) -Fo$@ $?
-
-$(TMP_DIR)\tclWinPanic.obj: $(WIN_DIR)\tclWinPanic.c
- $(cc32) $(stubscflags) -Fo$@ $?
-
-$(TMP_DIR)\tclsh.exe.manifest: $(WIN_DIR)\tclsh.exe.manifest.in
+$(TMP_DIR)\tclsh.exe.manifest: $(WINDIR)\tclsh.exe.manifest.in
@nmakehlp -s << $** >$@
@MACHINE@ $(MACHINE:IX86=X86)
@TCL_WIN_VERSION@ $(DOTVERSION).0.0
@@ -971,8 +925,8 @@ depend: @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) @<<
+ -passthru:"-DBUILD_tcl $(TCL_INCLUDES)" $(GENERICDIR),$$(GENERICDIR) \
+ $(COMPATDIR),$$(COMPATDIR) $(TOMMATHDIR),$$(TOMMATHDIR) $(WINDIR),$$(WINDIR) @<<
$(TCLOBJS)
<<
!endif
@@ -993,25 +947,41 @@ $(TCLOBJS) #---------------------------------------------------------------------
-# 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.
+# Implicit rules
#---------------------------------------------------------------------
+{$(WINDIR)}.c{$(TMP_DIR)}.obj::
+ $(cc32) $(TCL_CFLAGS) -DBUILD_tcl -Fo$(TMP_DIR)\ @<<
+$<
+<<
+
{$(TOMMATHDIR)}.c{$(TMP_DIR)}.obj::
- $(cc32) $(pkgcflags) -Fo$(TMP_DIR)\ @<<
+ $(cc32) $(TCL_CFLAGS) -DBUILD_tcl -Fo$(TMP_DIR)\ @<<
+$<
+<<
+
+{$(GENERICDIR)}.c{$(TMP_DIR)}.obj::
+ $(cc32) $(TCL_CFLAGS) -DBUILD_tcl -Fo$(TMP_DIR)\ @<<
$<
<<
-{$(COMPATDIR)\zlib}.c{$(TMP_DIR)}.obj::
- $(cc32) $(pkgcflags) -Fo$(TMP_DIR)\ @<<
+{$(COMPATDIR)}.c{$(TMP_DIR)}.obj::
+ $(cc32) $(TCL_CFLAGS) -DBUILD_tcl -Fo$(TMP_DIR)\ @<<
$<
<<
-$(TMP_DIR)\tclsh.res: $(TMP_DIR)\tclsh.exe.manifest $(WIN_DIR)\tclsh.rc
+{$(WINDIR)}.rc{$(TMP_DIR)}.res:
+ $(rc32) -fo $@ -r -i "$(GENERICDIR)" -i "$(TMP_DIR)" \
+ -d DEBUG=$(DEBUG) -d UNCHECKED=$(UNCHECKED) \
+ -d TCL_THREADS=$(TCL_THREADS) \
+ -d STATIC_BUILD=$(STATIC_BUILD) \
+ $<
+
+$(TMP_DIR)\tclsh.res: $(TMP_DIR)\tclsh.exe.manifest
+
+.SUFFIXES:
+.SUFFIXES:.c .rc
-$(TMP_DIR)\tcltest.res: $(TMP_DIR)\tclsh.exe.manifest $(WIN_DIR)\tcltest.rc
#---------------------------------------------------------------------
# Installation.
@@ -1024,35 +994,39 @@ install-binaries: @$(CPY) "$(TCLLIB)" "$(BIN_INSTALL_DIR)\"
!endif
@$(CPY) "$(TCLIMPLIB)" "$(LIB_INSTALL_DIR)\"
- @$(CPY) "$(OUT_DIR)\zlib1.dll" "$(BIN_INSTALL_DIR)\"
- @$(CPY) "$(OUT_DIR)\libtommath.dll" "$(BIN_INSTALL_DIR)\"
-!if !$(STATIC_BUILD)
- @$(CPY) "$(OUT_DIR)\zdll.lib" "$(LIB_INSTALL_DIR)\"
- @$(CPY) "$(OUT_DIR)\tommath.lib" "$(LIB_INSTALL_DIR)\"
-!endif
!if exist($(TCLSH))
@echo Installing $(TCLSHNAME)
@$(CPY) "$(TCLSH)" "$(BIN_INSTALL_DIR)\"
!endif
+!if exist($(TCLPIPEDLL))
+ @echo Installing $(TCLPIPEDLLNAME)
+ @$(CPY) "$(TCLPIPEDLL)" "$(BIN_INSTALL_DIR)\"
+!endif
@echo Installing $(TCLSTUBLIBNAME)
@$(CPY) "$(TCLSTUBLIB)" "$(LIB_INSTALL_DIR)\"
-install-libraries: tclConfig tcl-nmake install-msgs install-tzdata
- @if not exist "$(LIB_INSTALL_DIR)\nmake" \
- $(MKDIR) "$(LIB_INSTALL_DIR)\nmake"
+#" emacs fix
+
+install-libraries: tclConfig install-msgs install-tzdata
+ @if not exist "$(SCRIPT_INSTALL_DIR)$(NULL)" \
+ $(MKDIR) "$(SCRIPT_INSTALL_DIR)"
+ @if not exist "$(SCRIPT_INSTALL_DIR)\..\tcl8$(NULL)" \
+ $(MKDIR) "$(SCRIPT_INSTALL_DIR)\..\tcl8"
+ @if not exist "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.4$(NULL)" \
+ $(MKDIR) "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.4"
+ @if not exist "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.4\platform$(NULL)" \
+ $(MKDIR) "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.4\platform"
+ @if not exist "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.5$(NULL)" \
+ $(MKDIR) "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.5"
@echo Installing header files
@$(CPY) "$(GENERICDIR)\tcl.h" "$(INCLUDE_INSTALL_DIR)\"
@$(CPY) "$(GENERICDIR)\tclDecls.h" "$(INCLUDE_INSTALL_DIR)\"
- @$(CPY) "$(GENERICDIR)\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.h" "$(INCLUDE_INSTALL_DIR)\"
-!if !$(TCL_EMBED_SCRIPTS)
+ @$(CPY) "$(TOMMATHDIR)\tommath_class.h" "$(INCLUDE_INSTALL_DIR)\"
+ @$(CPY) "$(TOMMATHDIR)\tommath_superclass.h" "$(INCLUDE_INSTALL_DIR)\"
@echo Installing library files to $(SCRIPT_INSTALL_DIR)
- @if not exist "$(SCRIPT_INSTALL_DIR)" \
- $(MKDIR) "$(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)\"
@@ -1063,95 +1037,65 @@ install-libraries: tclConfig tcl-nmake install-msgs install-tzdata @$(CPY) "$(ROOT)\library\package.tcl" "$(SCRIPT_INSTALL_DIR)\"
@$(CPY) "$(ROOT)\library\word.tcl" "$(SCRIPT_INSTALL_DIR)\"
@$(CPY) "$(ROOT)\library\auto.tcl" "$(SCRIPT_INSTALL_DIR)\"
-!endif
@$(CPY) "$(OUT_DIR)\tclConfig.sh" "$(LIB_INSTALL_DIR)\"
- @$(CPY) "$(WIN_DIR)\tclooConfig.sh" "$(LIB_INSTALL_DIR)\"
- @$(CPY) "$(TCLSCRIPTZIP)" "$(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) "$(WIN_DIR)\x86_64-w64-mingw32-nmakehlp.exe" "$(LIB_INSTALL_DIR)\nmake\"
- @$(CPY) "$(OUT_DIR)\tcl.nmake" "$(LIB_INSTALL_DIR)\nmake\"
-!if !$(TCL_EMBED_SCRIPTS)
- @echo Installing package cookiejar $(PKG_COOKIEJAR_VER)
- @if not exist "$(SCRIPT_INSTALL_DIR)\cookiejar0.2" \
- $(MKDIR) "$(SCRIPT_INSTALL_DIR)\cookiejar0.2"
- @$(CPY) "$(ROOT)\library\cookiejar\*.tcl" \
- "$(SCRIPT_INSTALL_DIR)\cookiejar0.2\"
- @$(CPY) "$(ROOT)\library\cookiejar\*.gz" \
- "$(SCRIPT_INSTALL_DIR)\cookiejar0.2\"
- @echo Installing package opt $(PKG_OPT_VER)
- @if not exist "$(SCRIPT_INSTALL_DIR)\opt0.4" \
- $(MKDIR) "$(SCRIPT_INSTALL_DIR)\opt0.4"
+ @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\"
- @if not exist "$(MODULE_INSTALL_DIR)" \
- $(MKDIR) "$(MODULE_INSTALL_DIR)"
@echo Installing package http $(PKG_HTTP_VER) as a Tcl Module
- @if not exist "$(MODULE_INSTALL_DIR)\8.6" \
- $(MKDIR) "$(MODULE_INSTALL_DIR)\8.6"
@$(COPY) "$(ROOT)\library\http\http.tcl" \
- "$(MODULE_INSTALL_DIR)\8.6\http-$(PKG_HTTP_VER).tm"
+ "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.4\http-$(PKG_HTTP_VER).tm"
@echo Installing package msgcat $(PKG_MSGCAT_VER) as a Tcl Module
- @if not exist "$(MODULE_INSTALL_DIR)\8.7" \
- $(MKDIR) "$(MODULE_INSTALL_DIR)\8.7"
@$(COPY) "$(ROOT)\library\msgcat\msgcat.tcl" \
- "$(MODULE_INSTALL_DIR)\8.7\msgcat-$(PKG_MSGCAT_VER).tm"
+ "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.5\msgcat-$(PKG_MSGCAT_VER).tm"
@echo Installing package tcltest $(PKG_TCLTEST_VER) as a Tcl Module
- @if not exist "$(MODULE_INSTALL_DIR)\8.5" \
- $(MKDIR) "$(MODULE_INSTALL_DIR)\8.5"
@$(COPY) "$(ROOT)\library\tcltest\tcltest.tcl" \
- "$(MODULE_INSTALL_DIR)\8.5\tcltest-$(PKG_TCLTEST_VER).tm"
+ "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.5\tcltest-$(PKG_TCLTEST_VER).tm"
@echo Installing package platform $(PKG_PLATFORM_VER) as a Tcl Module
- @if not exist "$(MODULE_INSTALL_DIR)\8.4" \
- $(MKDIR) "$(MODULE_INSTALL_DIR)\8.4"
- @if not exist "$(MODULE_INSTALL_DIR)\8.4\platform" \
- $(MKDIR) "$(MODULE_INSTALL_DIR)\8.4\platform"
@$(COPY) "$(ROOT)\library\platform\platform.tcl" \
- "$(MODULE_INSTALL_DIR)\8.4\platform-$(PKG_PLATFORM_VER).tm"
+ "$(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" \
- "$(MODULE_INSTALL_DIR)\8.4\platform\shell-$(PKG_SHELL_VER).tm"
-!endif
+ "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.4\platform\shell-$(PKG_SHELL_VER).tm"
@echo Installing $(TCLDDELIBNAME)
-!if !$(STATIC_BUILD)
+!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)
- @$(CPY) "$(TCLREGLIB)" "$(LIB_INSTALL_DIR)\registry$(REGDOTVERSION)\"
- @$(CPY) "$(ROOT)\library\registry\pkgIndex.tcl" \
- "$(LIB_INSTALL_DIR)\registry$(REGDOTVERSION)\"
+!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
-!if !$(TCL_EMBED_SCRIPTS)
@echo Installing encodings
@$(CPY) "$(ROOT)\library\encoding\*.enc" \
"$(SCRIPT_INSTALL_DIR)\encoding\"
-!endif
-# "emacs font-lock highlighting fix
+
+#" emacs fix
install-tzdata:
-!if !$(TCL_EMBED_SCRIPTS)
@echo Installing time zone data
@set TCL_LIBRARY=$(ROOT:\=/)/library
@$(TCLSH_NATIVE) "$(ROOT:\=/)/tools/installData.tcl" \
"$(ROOT:\=/)/library/tzdata" "$(SCRIPT_INSTALL_DIR)/tzdata"
-!endif
install-msgs:
-!if !$(TCL_EMBED_SCRIPTS)
@echo Installing message catalogs
@set TCL_LIBRARY=$(ROOT:\=/)/library
@$(TCLSH_NATIVE) "$(ROOT:\=/)/tools/installData.tcl" \
"$(ROOT:\=/)/library/msgs" "$(SCRIPT_INSTALL_DIR)/msgs"
-!endif
-
-install-pdbs:
- @echo Installing debug symbols
- @$(CPY) "$(OUT_DIR)\*.pdb" "$(BIN_INSTALL_DIR)\"
-# "emacs font-lock highlighting fix
#---------------------------------------------------------------------
# Clean up
@@ -1173,11 +1117,24 @@ tidy: @echo Removing $(TCLREGLIB) ...
@if exist $(TCLREGLIB) del $(TCLREGLIB)
-clean: default-clean clean-pkgs
-hose: default-hose
+clean:
+ @echo Cleaning $(TMP_DIR)\* ...
+ @if exist $(TMP_DIR)\nul $(RMDIR) $(TMP_DIR)
+ @echo Cleaning $(WINDIR)\nmakehlp.obj ...
+ @if exist $(WINDIR)\nmakehlp.obj del $(WINDIR)\nmakehlp.obj
+ @echo Cleaning $(WINDIR)\nmakehlp.exe ...
+ @if exist $(WINDIR)\nmakehlp.exe del $(WINDIR)\nmakehlp.exe
+ @echo Cleaning $(WINDIR)\_junk.pch ...
+ @if exist $(WINDIR)\_junk.pch del $(WINDIR)\_junk.pch
+ @echo Cleaning $(WINDIR)\vercl.x ...
+ @if exist $(WINDIR)\vercl.x del $(WINDIR)\vercl.x
+ @echo Cleaning $(WINDIR)\vercl.i ...
+ @if exist $(WINDIR)\vercl.i del $(WINDIR)\vercl.i
+ @echo Cleaning $(WINDIR)\versions.vc ...
+ @if exist $(WINDIR)\versions.vc del $(WINDIR)\versions.vc
+
realclean: hose
-.PHONY:
-# Local Variables:
-# mode: makefile
-# End:
+hose:
+ @echo Hosing $(OUT_DIR)\* ...
+ @if exist $(OUT_DIR)\nul $(RMDIR) $(OUT_DIR)
diff --git a/win/nmakehlp.c b/win/nmakehlp.c index b0799f8..84cf75c 100644 --- a/win/nmakehlp.c +++ b/win/nmakehlp.c @@ -4,8 +4,8 @@ * * This is used to fix limitations within nmake and the environment. * - * Copyright (c) 2002 David Gravereaux. - * Copyright (c) 2006 Pat Thoyts + * 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. @@ -14,11 +14,15 @@ #define _CRT_SECURE_NO_DEPRECATE #include <windows.h> -#ifdef _MSC_VER +#define NO_SHLWAPI_GDI +#define NO_SHLWAPI_STREAM +#define NO_SHLWAPI_REG +#include <shlwapi.h> #pragma comment (lib, "user32.lib") #pragma comment (lib, "kernel32.lib") -#endif +#pragma comment (lib, "shlwapi.lib") #include <stdio.h> +#include <math.h> /* * This library is required for x64 builds with _some_ versions of MSVC @@ -30,19 +34,19 @@ #endif /* ISO hack for dumb VC++ */ -#if defined(_WIN32) && defined(_MSC_VER) && _MSC_VER < 1900 +#ifdef _MSC_VER #define snprintf _snprintf #endif + /* protos */ static int CheckForCompilerFeature(const char *option); -static int CheckForLinkerFeature(char **options, int count); +static int CheckForLinkerFeature(const char *option); 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); @@ -55,8 +59,8 @@ typedef struct { char buffer[STATICBUFFERSIZE]; } pipeinfo; -pipeinfo Out = {INVALID_HANDLE_VALUE, ""}; -pipeinfo Err = {INVALID_HANDLE_VALUE, ""}; +pipeinfo Out = {INVALID_HANDLE_VALUE, '\0'}; +pipeinfo Err = {INVALID_HANDLE_VALUE, '\0'}; /* * exitcodes: 0 == no, 1 == yes, 2 == error @@ -70,7 +74,6 @@ main( char msg[300]; DWORD dwWritten; int chars; - const char *s; /* * Make sure children (cl.exe and link.exe) are kept quiet. @@ -99,16 +102,16 @@ main( } return CheckForCompilerFeature(argv[2]); case 'l': - if (argc < 3) { + if (argc != 3) { chars = snprintf(msg, sizeof(msg) - 1, - "usage: %s -l <linker option> ?<mandatory option> ...?\n" + "usage: %s -l <linker 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); + return CheckForLinkerFeature(argv[2]); case 'f': if (argc == 2) { chars = snprintf(msg, sizeof(msg) - 1, @@ -150,13 +153,8 @@ main( &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 */ - + printf("%s\n", GetVersionFromFile(argv[2], argv[3], *(argv[1]+2) - '0')); + return 0; case 'Q': if (argc != 3) { chars = snprintf(msg, sizeof(msg) - 1, @@ -168,18 +166,6 @@ main( 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, @@ -206,25 +192,25 @@ CheckForCompilerFeature( hProcess = GetCurrentProcess(); - memset(&pi, 0, sizeof(PROCESS_INFORMATION)); - memset(&si, 0, sizeof(STARTUPINFO)); + ZeroMemory(&pi, sizeof(PROCESS_INFORMATION)); + ZeroMemory(&si, sizeof(STARTUPINFO)); si.cb = sizeof(STARTUPINFO); si.dwFlags = STARTF_USESTDHANDLES; si.hStdInput = INVALID_HANDLE_VALUE; - memset(&sa, 0, sizeof(SECURITY_ATTRIBUTES)); + ZeroMemory(&sa, sizeof(SECURITY_ATTRIBUTES)); sa.nLength = sizeof(SECURITY_ATTRIBUTES); sa.lpSecurityDescriptor = NULL; sa.bInheritHandle = FALSE; /* - * Create a non-inheritable pipe. + * Create a non-inheritible pipe. */ CreatePipe(&Out.pipe, &h, &sa, 0); /* - * Dupe the write side, make it inheritable, and close the original. + * Dupe the write side, make it inheritible, and close the original. */ DuplicateHandle(hProcess, h, hProcess, &si.hStdOutput, 0, TRUE, @@ -271,10 +257,10 @@ CheckForCompilerFeature( if (!ok) { DWORD err = GetLastError(); int chars = snprintf(msg, sizeof(msg) - 1, - "Tried to launch: \"%s\", but got error [%lu]: ", cmdline, err); + "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, (LPSTR)&msg[chars], + 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; @@ -327,8 +313,7 @@ CheckForCompilerFeature( static int CheckForLinkerFeature( - char **options, - int count) + const char *option) { STARTUPINFO si; PROCESS_INFORMATION pi; @@ -337,18 +322,17 @@ CheckForLinkerFeature( char msg[300]; BOOL ok; HANDLE hProcess, h, pipeThreads[2]; - int i; - char cmdline[255]; + char cmdline[100]; hProcess = GetCurrentProcess(); - memset(&pi, 0, sizeof(PROCESS_INFORMATION)); - memset(&si, 0, sizeof(STARTUPINFO)); + ZeroMemory(&pi, sizeof(PROCESS_INFORMATION)); + ZeroMemory(&si, sizeof(STARTUPINFO)); si.cb = sizeof(STARTUPINFO); si.dwFlags = STARTF_USESTDHANDLES; si.hStdInput = INVALID_HANDLE_VALUE; - memset(&sa, 0, sizeof(SECURITY_ATTRIBUTES)); + ZeroMemory(&sa, sizeof(SECURITY_ATTRIBUTES)); sa.nLength = sizeof(SECURITY_ATTRIBUTES); sa.lpSecurityDescriptor = NULL; sa.bInheritHandle = TRUE; @@ -360,7 +344,7 @@ CheckForLinkerFeature( CreatePipe(&Out.pipe, &h, &sa, 0); /* - * Dupe the write side, make it inheritable, and close the original. + * Dupe the write side, make it inheritible, and close the original. */ DuplicateHandle(hProcess, h, hProcess, &si.hStdOutput, 0, TRUE, @@ -384,11 +368,7 @@ CheckForLinkerFeature( * Append our option for testing. */ - for (i = 0; i < count; i++) { - lstrcat(cmdline, " \""); - lstrcat(cmdline, options[i]); - lstrcat(cmdline, "\""); - } + lstrcat(cmdline, option); ok = CreateProcess( NULL, /* Module name. */ @@ -405,10 +385,10 @@ CheckForLinkerFeature( if (!ok) { DWORD err = GetLastError(); int chars = snprintf(msg, sizeof(msg) - 1, - "Tried to launch: \"%s\", but got error [%lu]: ", cmdline, err); + "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, (LPSTR)&msg[chars], + 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; @@ -453,9 +433,7 @@ CheckForLinkerFeature( 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); + strstr(Err.buffer, "LNK4044") != NULL); } static DWORD WINAPI @@ -504,6 +482,7 @@ GetVersionFromFile( const char *match, int numdots) { + size_t cbBuffer = 100; static char szBuffer[100]; char *szResult = NULL; FILE *fp = fopen(filename, "rt"); @@ -513,7 +492,7 @@ GetVersionFromFile( * Read data until we see our match string. */ - while (fgets(szBuffer, sizeof(szBuffer), fp) != NULL) { + while (fgets(szBuffer, cbBuffer, fp) != NULL) { LPSTR p, q; p = strstr(szBuffer, match); @@ -523,7 +502,7 @@ GetVersionFromFile( */ p += strlen(match); - while (*p && !isdigit((unsigned char)*p)) { + while (*p && !isdigit(*p)) { ++p; } @@ -532,13 +511,14 @@ GetVersionFromFile( */ q = p; - while (*q && (strchr("0123456789.ab", *q)) && (((!strchr(".ab", *q) - && !strchr("ab", q[-1])) || --numdots))) { + while (*q && (strchr("0123456789.ab", *q)) && ((!strchr(".ab", *q) + && (!strchr("ab", q[-1])) || --numdots))) { ++q; } - *q = 0; - szResult = p; + memcpy(szBuffer, p, q - p); + szBuffer[q-p] = 0; + szResult = szBuffer; break; } } @@ -561,7 +541,7 @@ typedef struct list_item_t { static list_item_t * list_insert(list_item_t **listPtrPtr, const char *key, const char *value) { - list_item_t *itemPtr = (list_item_t *)malloc(sizeof(list_item_t)); + list_item_t *itemPtr = malloc(sizeof(list_item_t)); if (itemPtr) { itemPtr->key = strdup(key); itemPtr->value = strdup(value); @@ -592,7 +572,7 @@ list_free(list_item_t **listPtrPtr) * 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 - - * e.g. compiling AMD64 target from IX86) we provide a simple substitution + * 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: @@ -610,7 +590,9 @@ 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; @@ -618,12 +600,12 @@ SubstituteFile( if (fp != NULL) { /* - * Build a list of substitutions from the first filename + * Build a list of substutitions from the first filename */ sp = fopen(substitutions, "rt"); if (sp != NULL) { - while (fgets(szBuffer, sizeof(szBuffer), sp) != NULL) { + while (fgets(szBuffer, cbBuffer, sp) != NULL) { unsigned char *ks, *ke, *vs, *ve; ks = (unsigned char*)szBuffer; while (ks && *ks && isspace(*ks)) ++ks; @@ -640,7 +622,7 @@ SubstituteFile( } /* debug: dump the list */ -#ifndef NDEBUG +#ifdef _DEBUG { int n = 0; list_item_t *p = NULL; @@ -654,7 +636,7 @@ SubstituteFile( * Run the substitutions over each line of the input */ - while (fgets(szBuffer, sizeof(szBuffer), fp) != NULL) { + 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); @@ -671,7 +653,7 @@ SubstituteFile( memcpy(szBuffer, szCopy, sizeof(szCopy)); } } - printf("%s", szBuffer); + printf(szBuffer); } list_free(&substPtr); @@ -680,17 +662,6 @@ SubstituteFile( 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 -- * @@ -704,109 +675,18 @@ QualifyPath( const char *szPath) { char szCwd[MAX_PATH + 1]; - - GetFullPathName(szPath, sizeof(szCwd)-1, szCwd, NULL); + char szTmp[MAX_PATH + 1]; + char *p; + GetCurrentDirectory(MAX_PATH, szCwd); + while ((p = strchr(szPath, '/')) && *p) + *p = '\\'; + PathCombine(szTmp, szCwd, szPath); + PathCanonicalize(szCwd, szTmp); 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]; - size_t dirlen; - int 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 > sizeof(path) - 3) { - 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) -{ - size_t i; - int 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 diff --git a/win/rules-ext.vc b/win/rules-ext.vc deleted file mode 100644 index 6d31a03..0000000 --- a/win/rules-ext.vc +++ /dev/null @@ -1,123 +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 "$(MACHINE)" == "IX86" || "$(MACHINE)" == "$(NATIVE_ARCH)"
-!if [$(CC) -nologo -DNDEBUG "nmakehlp.c" -link -subsystem:console > nul]
-!endif
-!else
-!if [copy x86_64-w64-mingw32-nmakehlp.exe nmakehlp.exe >NUL]
-!endif
-!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/win/rules.vc b/win/rules.vc index 143ea9e..78a167a 100644 --- a/win/rules.vc +++ b/win/rules.vc @@ -1,431 +1,60 @@ -#------------------------------------------------------------- -*- 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-lang.org/tips/doc/main/tip/477.md) for
-# detailed documentation.
+# Microsoft Visual C++ makefile include for decoding the commandline
+# macros. This file does not need editing to build Tcl.
#
# 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 = 11
-
-# 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
+cc32 = $(CC) # built-in default.
+link32 = link
+lib32 = lib
+rc32 = $(RC) # built-in default.
-!ifdef NEED_TK_SOURCE
-!if $(NEED_TK_SOURCE)
-NEED_TK = 1
-!endif
+!ifndef INSTALLDIR
+### Assume the normal default.
+_INSTALLDIR = C:\Program Files\Tcl
!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. Extract Tcl, Tk, and possibly extensions, version numbers from the
-# headers
-# 7. Parse the OPTS macro value for user-specified build configuration
-# 8. Parse the STATS macro value for statistics instrumentation
-# 9. Parse the CHECKS macro for additional compilation checks
-# 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)
+### Fix the path separators.
+_INSTALLDIR = $(INSTALLDIR:/=\)
!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.
#----------------------------------------------------------
+!if "$(OS)" == "Windows_NT"
RMDIR = rmdir /S /Q
+ERRNULL = 2>NUL
+!if ![ver | find "4.0" > nul]
+CPY = echo y | xcopy /i >NUL
+COPY = copy >NUL
+!else
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
+!else # "$(OS)" != "Windows_NT"
+CPY = xcopy /i >_JUNK.OUT # On Win98 NUL does not work here.
+COPY = copy >_JUNK.OUT # On Win98 NUL does not work here.
+RMDIR = deltree /Y
+NULL = \NUL # Used in testing directory existence
+ERRNULL = >NUL # Win9x shell cannot redirect stderr
!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, ARM64 or AMD64 depending on 32- or 64-bit target
-# NATIVE_ARCH - set to IX86, ARM64 or AMD64 for the host machine
-# MACHINE - same as $(ARCH) - legacy
-# _VC_MANIFEST_EMBED_{DLL,EXE} - commands for embedding a manifest if needed
-
-cc32 = $(CC) # built-in default.
-link32 = link
-lib32 = lib
-rc32 = $(RC) # built-in default.
+MKDIR = mkdir
-#----------------------------------------------------------------
-# 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
+#------------------------------------------------------------------------------
+# Determine the host and target architectures and compiler version.
+#------------------------------------------------------------------------------
_HASH=^#
_VC_MANIFEST_EMBED_EXE=
@@ -436,70 +65,19 @@ VCVER=0 && ![echo ARCH=IX86 >> vercl.x] \
&& ![echo $(_HASH)elif defined(_M_AMD64) >> vercl.x] \
&& ![echo ARCH=AMD64 >> vercl.x] \
- && ![echo $(_HASH)elif defined(_M_ARM64) >> vercl.x] \
- && ![echo ARCH=ARM64 >> vercl.x] \
&& ![echo $(_HASH)endif >> vercl.x] \
- && ![$(cc32) -nologo -TC -P vercl.x 2>NUL]
+ && ![cl -nologo -TC -P vercl.x $(ERRNULL)]
!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)" == "arm64"
-!undef MACHINE
-MACHINE = ARM64
-!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
-!elseif "$(MACHINE)" == "ARM64"
-PLATFORM_IDENTIFY = win32-arm
-!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
+!if ![del $(ERRNUL) /q/f vercl.x vercl.i vercl.vc]
!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
-!elseif ![reg query HKLM\Hardware\Description\System\CentralProcessor\0 /v Identifier | findstr /i ARM | findstr /i 64-bit]
-NATIVE_ARCH=ARM64
!else
NATIVE_ARCH=AMD64
!endif
@@ -510,408 +88,190 @@ _VC_MANIFEST_EMBED_EXE=if exist $@.manifest mt -nologo -manifest $@.manifest -ou _VC_MANIFEST_EMBED_DLL=if exist $@.manifest mt -nologo -manifest $@.manifest -outputresource:$@;2
!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. It will be kept updated there.
-#
-# 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 MACHINE
+MACHINE=$(ARCH)
+!endif
-!ifndef NMAKEHLPC
-# Default to the one in the current directory (the extension's own nmakehlp.c)
-NMAKEHLPC = nmakehlp.c
+!ifndef CFG_ENCODING
+CFG_ENCODING = \"cp1252\"
+!endif
-!if !$(DOING_TCL)
-!if $(TCLINSTALL)
-!if exist("$(_TCLDIR)\lib\nmake\nmakehlp.c")
-NMAKEHLPC = $(_TCLDIR)\lib\nmake\nmakehlp.c
+!message ===============================================================================
+
+#----------------------------------------------------------
+# build the helper app we need to overcome nmake's limiting
+# environment.
+#----------------------------------------------------------
+
+!if !exist(nmakehlp.exe)
+!if [$(cc32) -nologo nmakehlp.c -link -subsystem:console > nul]
!endif
-!else # !$(TCLINSTALL)
-!if exist("$(_TCLDIR)\win\nmakehlp.c")
-NMAKEHLPC = $(_TCLDIR)\win\nmakehlp.c
!endif
-!endif # $(TCLINSTALL)
-!endif # !$(DOING_TCL)
-!endif # NMAKEHLPC
+#----------------------------------------------------------
+# Test for compiler features
+#----------------------------------------------------------
-# We always build nmakehlp even if it exists since we do not know
-# what source it was built from.
-!if "$(MACHINE)" == "IX86" || "$(MACHINE)" == "$(NATIVE_ARCH)"
-!if [$(cc32) -nologo "$(NMAKEHLPC)" -link -subsystem:console > nul]
-!endif
+### test for optimizations
+!if [nmakehlp -c -Ot]
+!message *** Compiler has 'Optimizations'
+OPTIMIZING = 1
!else
-!if [copy $(NMAKEHLPC:nmakehlp.c=x86_64-w64-mingw32-nmakehlp.exe) nmakehlp.exe >NUL]
-!endif
+!message *** Compiler does not have 'Optimizations'
+OPTIMIZING = 0
!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.
+OPTIMIZATIONS =
-# -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
+!if [nmakehlp -c -Ot]
+OPTIMIZATIONS = $(OPTIMIZATIONS) -Ot
!endif
-# Strict floating point semantics - present in newer compilers in lieu of -Op
-!if [nmakehlp -c -fp:strict]
-FPOPTS = $(FPOPTS) -fp:strict
+!if [nmakehlp -c -Oi]
+OPTIMIZATIONS = $(OPTIMIZATIONS) -Oi
!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'
+!if [nmakehlp -c -Op]
+OPTIMIZATIONS = $(OPTIMIZATIONS) -Op
!endif
+
+!if [nmakehlp -c -fp:strict]
+OPTIMIZATIONS = $(OPTIMIZATIONS) -fp:strict
!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
+!if [nmakehlp -c -Gs]
+OPTIMIZATIONS = $(OPTIMIZATIONS) -Gs
!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)
+DEBUGFLAGS =
-# 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
+COMPILERFLAGS =-W3
-# 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. Extract various version numbers from headers
-# 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_RELEASE_SERIAL
-# TCL_PATCH_LEVEL
-# TCL_PATCH_LETTER
-# TCL_VERSION
-# TK_MAJOR_VERSION
-# TK_MINOR_VERSION
-# TK_RELEASE_SERIAL
-# TK_PATCH_LEVEL
-# TK_PATCH_LETTER
-# 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)" "define TCL_MAJOR_VERSION" >> versions.vc]
-!endif
-!if [echo TCL_MINOR_VERSION = \>> versions.vc] \
- && [nmakehlp -V "$(_TCL_H)" TCL_MINOR_VERSION >> versions.vc]
+# In v13 -GL and -YX are incompatible.
+!if [nmakehlp -c -YX]
+!if ![nmakehlp -c -GL]
+OPTIMIZATIONS = $(OPTIMIZATIONS) -YX
!endif
-!if [echo TCL_RELEASE_SERIAL = \>> versions.vc] \
- && [nmakehlp -V "$(_TCL_H)" TCL_RELEASE_SERIAL >> 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) "define 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_RELEASE_SERIAL = \>> versions.vc] \
- && [nmakehlp -V "$(_TK_H)" TK_RELEASE_SERIAL >> versions.vc]
+!if "$(MACHINE)" == "IX86"
+### test for pentium errata
+!if [nmakehlp -c -QI0f]
+!message *** Compiler has 'Pentium 0x0f fix'
+COMPILERFLAGS = $(COMPILERFLAGS) -QI0f
+!else
+!message *** Compiler does not have 'Pentium 0x0f fix'
!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 [nmakehlp -f $(TCL_PATCH_LEVEL) "a"]
-TCL_PATCH_LETTER = a
-!elseif [nmakehlp -f $(TCL_PATCH_LEVEL) "b"]
-TCL_PATCH_LETTER = b
+!if "$(MACHINE)" == "IA64"
+### test for Itanium errata
+!if [nmakehlp -c -QIA64_Bx]
+!message *** Compiler has 'B-stepping errata workarounds'
+COMPILERFLAGS = $(COMPILERFLAGS) -QIA64_Bx
!else
-TCL_PATCH_LETTER = .
+!message *** Compiler does not have 'B-stepping errata workarounds'
+!endif
!endif
-!if defined(_TK_H)
-
-TK_VERSION = $(TK_MAJOR_VERSION)$(TK_MINOR_VERSION)
-TK_DOTVERSION = $(TK_MAJOR_VERSION).$(TK_MINOR_VERSION)
-!if [nmakehlp -f $(TK_PATCH_LEVEL) "a"]
-TK_PATCH_LETTER = a
-!elseif [nmakehlp -f $(TK_PATCH_LEVEL) "b"]
-TK_PATCH_LETTER = b
+!if "$(MACHINE)" == "IX86"
+### test for -align:4096, when align:512 will do.
+!if [nmakehlp -l -opt:nowin98]
+!message *** Linker has 'Win98 alignment problem'
+ALIGN98_HACK = 1
!else
-TK_PATCH_LETTER = .
+!message *** Linker does not have 'Win98 alignment problem'
+ALIGN98_HACK = 0
!endif
-
+!else
+ALIGN98_HACK = 0
!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
+LINKERFLAGS =
-# 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
+!if [nmakehlp -l -ltcg]
+LINKERFLAGS =-ltcg
!endif
-!include versions.vc
-!endif # DOTVERSION
-VERSION = $(DOTVERSION:.=)
-
-!endif # $(DOING_TCL) ... etc.
-
-# Windows RC files have 3 version components. Ensure this irrespective
-# of how many components the package has specified. Basically, ensure
-# minimum 4 components by appending 4 0's and then pick out the first 4.
-# Also take care of the fact that DOTVERSION may have "a" or "b" instead
-# of "." separating the version components.
-DOTSEPARATED=$(DOTVERSION:a=.)
-DOTSEPARATED=$(DOTSEPARATED:b=.)
-!if [echo RCCOMMAVERSION = \> versions.vc] \
- || [for /f "tokens=1,2,3,4,5* delims=." %a in ("$(DOTSEPARATED).0.0.0.0") do echo %a,%b,%c,%d >> versions.vc]
-!error *** Could not generate RCCOMMAVERSION ***
-!endif
-!include versions.vc
-########################################################################
-# 7. 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)
-# Default: 1 for Tcl 8.7 and up, 0 otherwise.
-# TCL_USE_STATIC_PACKAGES - 1 -> statically link the registry and dde extensions
-# in the Tcl and Wish shell. 0 -> keep them as shared libraries. Does
-# not impact shared Tcl builds. Implied by STATIC_BUILD since Tcl 8.7.
-# 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, not needed for Tcl 9.x)
-# Further, LINKERFLAGS are modified based on above.
-
-# Default values for all the above
+#----------------------------------------------------------
+# Decode the options requested.
+#----------------------------------------------------------
+
+!if "$(OPTS)" == "" || [nmakehlp -f "$(OPTS)" "none"]
STATIC_BUILD = 0
-TCL_THREADS = 1
+TCL_THREADS = 0
DEBUG = 0
SYMBOLS = 0
PROFILE = 0
PGO = 0
MSVCRT = 1
+LOIMPACT = 0
TCL_USE_STATIC_PACKAGES = 0
-USE_THREAD_ALLOC = 1
+USE_THREAD_ALLOC = 0
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
+STATIC_BUILD = 0
+!endif
!if [nmakehlp -f $(OPTS) "msvcrt"]
!message *** Doing msvcrt
+MSVCRT = 1
+!else
+!if !$(STATIC_BUILD)
+MSVCRT = 1
!else
-!if $(TCL_MAJOR_VERSION) == 8 && $(TCL_MINOR_VERSION) < 7 && $(STATIC_BUILD)
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
-!endif
-
-!if [nmakehlp -f $(OPTS) "tcl8"]
-!message *** Build for Tcl8
-TCL_BUILD_FOR = 8
-!endif
-
-!if $(TCL_MAJOR_VERSION) == 8
-!if [nmakehlp -f $(OPTS) "time64bit"]
-!message *** Force 64-bit time_t
-_USE_64BIT_TIME_T = 1
-!endif
+!if [nmakehlp -f $(OPTS) "threads"]
+!message *** Doing threads
+TCL_THREADS = 1
+USE_THREAD_ALLOC = 1
+!else
+TCL_THREADS = 0
+USE_THREAD_ALLOC = 0
!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
@@ -921,149 +281,44 @@ PGO = 2 !else
PGO = 0
!endif
-
!if [nmakehlp -f $(OPTS) "loimpact"]
-!message *** Warning: ignoring option "loimpact" - deprecated on modern Windows.
+!message *** Doing loimpact
+LOIMPACT = 1
+!else
+LOIMPACT = 0
!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"]
+!message *** Doing 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
-################################################################
-# 8. 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
-
-####################################################################
-# 9. 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
-
-
-################################################################
-# 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)
+# We wouldn't want different builds to use the same .obj files
+# by accident.
+#----------------------------------------------------------
+#----------------------------------------
+# Naming convention:
+# t = full thread support.
+# s = static library (as opposed to an
+# import library)
+# g = linked to the debug enabled C
+# run-time.
+# x = special static build when it
+# links to the dynamic C run-time.
+#----------------------------------------
SUFX = tsgx
!if $(DEBUG)
@@ -1079,7 +334,7 @@ BUILDDIRTOP =$(BUILDDIRTOP)_$(MACHINE) BUILDDIRTOP =$(BUILDDIRTOP)_VC$(VCVER)
!endif
-!if !$(DEBUG) || $(TCL_VERSION) > 86 || $(DEBUG) && $(UNCHECKED)
+!if !$(DEBUG) || $(DEBUG) && $(UNCHECKED)
SUFX = $(SUFX:g=)
!endif
@@ -1094,13 +349,13 @@ SUFX = $(SUFX:x=) !else
TMP_DIRFULL = $(TMP_DIRFULL:Dynamic=)
EXT = lib
-!if $(MSVCRT) && $(TCL_VERSION) > 86 || !$(MSVCRT) && $(TCL_VERSION) < 87
+!if !$(MSVCRT)
TMP_DIRFULL = $(TMP_DIRFULL:X=)
SUFX = $(SUFX:x=)
!endif
!endif
-!if !$(TCL_THREADS) || $(TCL_VERSION) > 86
+!if !$(TCL_THREADS)
TMP_DIRFULL = $(TMP_DIRFULL:Threaded=)
SUFX = $(SUFX:t=)
!endif
@@ -1116,800 +371,328 @@ 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
-#
-
-# TIP 430. Unused for 8.6 but no harm defining it to allow a common rules.vc
-TCLSCRIPTZIPNAME = libtcl$(TCL_MAJOR_VERSION).$(TCL_MINOR_VERSION)$(TCL_PATCH_LETTER)$(TCL_RELEASE_SERIAL).zip
-TKSCRIPTZIPNAME = libtk$(TK_MAJOR_VERSION).$(TK_MINOR_VERSION)$(TK_PATCH_LETTER)$(TK_RELEASE_SERIAL).zip
-
-!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)
-TCLSCRIPTZIP = $(OUT_DIR)\$(TCLSCRIPTZIPNAME)
+#----------------------------------------------------------
+# Decode the statistics requested.
+#----------------------------------------------------------
-!if $(TCL_MAJOR_VERSION) == 8
-TCLSTUBLIBNAME = $(STUBPREFIX)$(VERSION).lib
+!if "$(STATS)" == "" || [nmakehlp -f "$(STATS)" "none"]
+TCL_MEM_DEBUG = 0
+TCL_COMPILE_DEBUG = 0
!else
-TCLSTUBLIBNAME = $(STUBPREFIX).lib
-!endif
-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
-
-!if $(TCL_MAJOR_VERSION) == 8
-TCLSTUBLIB = $(_TCLDIR)\lib\tclstub$(TCL_VERSION).lib
+!if [nmakehlp -f $(STATS) "memdbg"]
+!message *** Doing memdbg
+TCL_MEM_DEBUG = 1
!else
-TCLSTUBLIB = $(_TCLDIR)\lib\tclstub.lib
-!endif
-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
-TCLSCRIPTZIP = $(_TCLDIR)\lib\$(TCLSCRIPTZIPNAME)
-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
+TCL_MEM_DEBUG = 0
!endif
-!if $(TCL_MAJOR_VERSION) == 8
-TCLSTUBLIB = $(_TCLDIR)\win\$(BUILDDIRTOP)\tclstub$(TCL_VERSION).lib
+!if [nmakehlp -f $(STATS) "compdbg"]
+!message *** Doing compdbg
+TCL_COMPILE_DEBUG = 1
!else
-TCLSTUBLIB = $(_TCLDIR)\win\$(BUILDDIRTOP)\tclstub.lib
+TCL_COMPILE_DEBUG = 0
!endif
-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
-TCLSCRIPTZIP = $(_TCLDIR)\win\$(BUILDDIRTOP)\$(TCLSCRIPTZIPNAME)
-TCLTOOLSDIR = $(_TCLDIR)\tools
-TCL_INCLUDES = -I"$(_TCLDIR)\generic" -I"$(_TCLDIR)\win"
-!endif # TCLINSTALL
-!if !$(STATIC_BUILD) && "$(TCL_BUILD_FOR)" == "8"
-tcllibs = "$(TCLSTUBLIB)"
-!else
-tcllibs = "$(TCLSTUBLIB)" "$(TCLIMPLIB)"
-!endif
-
-!endif # $(DOING_TCL)
+#----------------------------------------------------------
+# Decode the checks requested.
+#----------------------------------------------------------
-# 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)
+!if "$(CHECKS)" == "" || [nmakehlp -f "$(CHECKS)" "none"]
+TCL_NO_DEPRECATED = 0
+WARNINGS = -W3
!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
-TKLIBNAME8 = tk$(TK_VERSION)$(SUFX).$(EXT)
-TKLIBNAME9 = tcl9tk$(TK_VERSION)$(SUFX).$(EXT)
-!if $(TCL_MAJOR_VERSION) == 8 || "$(TCL_BUILD_FOR)" == "8"
-TKLIBNAME = tk$(TK_VERSION)$(SUFX).$(EXT)
-TKIMPLIBNAME = tk$(TK_VERSION)$(SUFX).lib
+!if [nmakehlp -f $(CHECKS) "nodep"]
+!message *** Doing nodep check
+TCL_NO_DEPRECATED = 1
!else
-TKLIBNAME = tcl9tk$(TK_VERSION)$(SUFX).$(EXT)
-TKIMPLIBNAME = tcl9tk$(TK_VERSION)$(SUFX).lib
+TCL_NO_DEPRECATED = 0
!endif
-!if $(TK_MAJOR_VERSION) == 8
-TKSTUBLIBNAME = tkstub$(TK_VERSION).lib
-!else
-TKSTUBLIBNAME = tkstub.lib
+!if [nmakehlp -f $(CHECKS) "fullwarn"]
+!message *** Doing full warnings check
+WARNINGS = -W4
+!if [nmakehlp -l -warn:3]
+LINKERFLAGS = $(LINKERFLAGS) -warn:3
!endif
-
-!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)"
-TKSCRIPTZIP = $(OUT_DIR)\$(TKSCRIPTZIPNAME)
-
-!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)
+!else
+WARNINGS = -W3
!endif
-TK_INCLUDES = -I"$(_TKDIR)\include"
-TKSCRIPTZIP = $(_TKDIR)\lib\$(TKSCRIPTZIPNAME)
-
-!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)
+!if [nmakehlp -f $(CHECKS) "64bit"] && [nmakehlp -c -Wp64]
+!message *** Doing 64bit portability warnings
+WARNINGS = $(WARNINGS) -Wp64
!endif
-TK_INCLUDES = -I"$(_TKDIR)\generic" -I"$(_TKDIR)\win" -I"$(_TKDIR)\xlib"
-TKSCRIPTZIP = $(_TKDIR)\win\$(BUILDDIRTOP)\$(TKSCRIPTZIPNAME)
-
-!endif # TKINSTALL
-
-tklibs = "$(TKSTUBLIB)" "$(TKIMPLIB)"
-
-!endif # $(DOING_TK)
-!endif # $(DOING_TK) || $(NEED_TK)
-
-# Various output paths
-PRJIMPLIB = $(OUT_DIR)\$(PROJECT)$(VERSION)$(SUFX).lib
-PRJLIBNAME8 = $(PROJECT)$(VERSION)$(SUFX).$(EXT)
-PRJLIBNAME9 = tcl9$(PROJECT)$(VERSION)$(SUFX).$(EXT)
-!if $(TCL_MAJOR_VERSION) == 8 || "$(TCL_BUILD_FOR)" == "8"
-PRJLIBNAME = $(PRJLIBNAME8)
-!else
-PRJLIBNAME = $(PRJLIBNAME9)
!endif
-PRJLIB = $(OUT_DIR)\$(PRJLIBNAME)
-!if $(TCL_MAJOR_VERSION) == 8
-PRJSTUBLIBNAME = $(STUBPREFIX)$(VERSION).lib
+!if $(PGO) > 1
+!if [nmakehlp -l -ltcg:pgoptimize]
+LINKERFLAGS = $(LINKERFLAGS:-ltcg=) -ltcg:pgoptimize
!else
-PRJSTUBLIBNAME = $(STUBPREFIX).lib
+MSG=^
+This compiler does not support profile guided optimization.
+!error $(MSG)
!endif
-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)
-MODULE_INSTALL_DIR = $(_INSTALLDIR)\lib\tcl$(TCL_MAJOR_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 options
-# 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 = /DSTDC_HEADERS /DUSE_NMAKE=1
-!if $(VCVERSION) > 1600
-OPTDEFINES = $(OPTDEFINES) /DHAVE_STDINT_H=1
+!elseif $(PGO) > 0
+!if [nmakehlp -l -ltcg:pginstrument]
+LINKERFLAGS = $(LINKERFLAGS:-ltcg=) -ltcg:pginstrument
!else
-OPTDEFINES = $(OPTDEFINES) /DMP_NO_STDINT=1
+MSG=^
+This compiler does not support profile guided optimization.
+!error $(MSG)
!endif
-!if $(VCVERSION) >= 1800
-OPTDEFINES = $(OPTDEFINES) /DHAVE_INTTYPES_H=1 /DHAVE_STDBOOL_H=1
!endif
+#----------------------------------------------------------
+# Set our defines now armed with our options.
+#----------------------------------------------------------
+
+OPTDEFINES = -DTCL_CFGVAL_ENCODING=$(CFG_ENCODING) -DSTDC_HEADERS
+
!if $(TCL_MEM_DEBUG)
-OPTDEFINES = $(OPTDEFINES) /DTCL_MEM_DEBUG
+OPTDEFINES = $(OPTDEFINES) -DTCL_MEM_DEBUG
!endif
!if $(TCL_COMPILE_DEBUG)
-OPTDEFINES = $(OPTDEFINES) /DTCL_COMPILE_DEBUG /DTCL_COMPILE_STATS
+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
+!if $(TCL_THREADS)
+OPTDEFINES = $(OPTDEFINES) -DTCL_THREADS=1
+!if $(USE_THREAD_ALLOC)
+OPTDEFINES = $(OPTDEFINES) -DUSE_THREAD_ALLOC=1
!endif
!endif
!if $(STATIC_BUILD)
-OPTDEFINES = $(OPTDEFINES) /DSTATIC_BUILD
-!elseif $(TCL_VERSION) > 86
-OPTDEFINES = $(OPTDEFINES) /DTCL_WITH_EXTERNAL_TOMMATH
-!if "$(MACHINE)" == "AMD64" || "$(MACHINE)" == "ARM64"
-OPTDEFINES = $(OPTDEFINES) /DMP_64BIT
-!endif
+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
+OPTDEFINES = $(OPTDEFINES) -DTCL_NO_DEPRECATED
!endif
-!endif # USE_STUBS
!if !$(DEBUG)
-OPTDEFINES = $(OPTDEFINES) /DNDEBUG
+OPTDEFINES = $(OPTDEFINES) -DNDEBUG
!if $(OPTIMIZING)
-OPTDEFINES = $(OPTDEFINES) /DTCL_CFG_OPTIMIZED
+OPTDEFINES = $(OPTDEFINES) -DTCL_CFG_OPTIMIZED
!endif
!endif
!if $(PROFILE)
-OPTDEFINES = $(OPTDEFINES) /DTCL_CFG_PROFILED
+OPTDEFINES = $(OPTDEFINES) -DTCL_CFG_PROFILED
!endif
-!if "$(MACHINE)" == "AMD64" || "$(MACHINE)" == "ARM64"
-OPTDEFINES = $(OPTDEFINES) /DTCL_CFG_DO64BIT
+!if "$(MACHINE)" == "IA64" || "$(MACHINE)" == "AMD64"
+OPTDEFINES = $(OPTDEFINES) -DTCL_CFG_DO64BIT
!endif
!if $(VCVERSION) < 1300
-OPTDEFINES = $(OPTDEFINES) /DNO_STRTOI64=1
+OPTDEFINES = $(OPTDEFINES) -DNO_STRTOI64
!endif
-!if $(TCL_MAJOR_VERSION) == 8
-!if "$(_USE_64BIT_TIME_T)" == "1"
-OPTDEFINES = $(OPTDEFINES) /D_USE_64BIT_TIME_T=1
-!endif
+#----------------------------------------------------------
+# Locate the Tcl headers to build against
+#----------------------------------------------------------
-# _ATL_XP_TARGETING - Newer SDK's need this to build for XP
-COMPILERFLAGS = /D_ATL_XP_TARGETING
-!endif
-!if "$(TCL_BUILD_FOR)" == "8"
-OPTDEFINES = $(OPTDEFINES) /DTCL_MAJOR_VERSION=8
-!endif
+!if "$(PROJECT)" == "tcl"
+
+_TCL_H = ..\generic\tcl.h
+
+!else
-# 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
+# If INSTALLDIR set to tcl root dir then reset to the lib dir.
+!if exist("$(_INSTALLDIR)\include\tcl.h")
+_INSTALLDIR=$(_INSTALLDIR)\lib
!endif
-# crt picks the C run time based on selected OPTS
-!if $(MSVCRT)
-!if $(DEBUG) && !$(UNCHECKED)
-crt = -MDd
+!if !defined(TCLDIR)
+!if exist("$(_INSTALLDIR)\..\include\tcl.h")
+TCLINSTALL = 1
+_TCLDIR = $(_INSTALLDIR)\..
+_TCL_H = $(_INSTALLDIR)\..\include\tcl.h
+TCLDIR = $(_INSTALLDIR)\..
!else
-crt = -MD
+MSG=^
+Failed to find tcl.h. Set the TCLDIR macro.
+!error $(MSG)
!endif
!else
-!if $(DEBUG) && !$(UNCHECKED)
-crt = -MTd
+_TCLDIR = $(TCLDIR:/=\)
+!if exist("$(_TCLDIR)\include\tcl.h")
+TCLINSTALL = 1
+_TCL_H = $(_TCLDIR)\include\tcl.h
+!elseif exist("$(_TCLDIR)\generic\tcl.h")
+TCLINSTALL = 0
+_TCL_H = $(_TCLDIR)\generic\tcl.h
!else
-crt = -MT
+MSG =^
+Failed to find tcl.h. The TCLDIR macro does not appear correct.
+!error $(MSG)
!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, also C4090 (buggy) and C4146 is useless.
-cwarn = $(WARNINGS) -wd4090 -wd4146
+#--------------------------------------------------------------
+# Extract various version numbers from tcl headers
+# The generated file is then included in the makefile.
+#--------------------------------------------------------------
-!if "$(MACHINE)" == "AMD64" || "$(MACHINE)" == "ARM64"
-# 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
+!if [echo REM = This file is generated from rules.vc > versions.vc]
!endif
-
-### Common compiler options that are architecture specific
-!if "$(MACHINE)" == "ARM"
-carch = /D_ARM_WINAPI_PARTITION_DESKTOP_SDK_AVAILABLE
-!else
-carch =
+!if [echo TCL_MAJOR_VERSION = \>> versions.vc] \
+ && [nmakehlp -V "$(_TCL_H)" TCL_MAJOR_VERSION >> versions.vc]
!endif
-
-# cpuid is only available on intel machines
-!if "$(MACHINE)" == "IX86" || "$(MACHINE)" == "AMD64"
-carch = $(carch) /DHAVE_CPUID=1
+!if [echo TCL_MINOR_VERSION = \>> versions.vc] \
+ && [nmakehlp -V "$(_TCL_H)" TCL_MINOR_VERSION >> versions.vc]
!endif
-
-!if $(DEBUG)
-# Turn warnings into errors
-cwarn = $(cwarn) -WX
+!if [echo TCL_PATCH_LEVEL = \>> versions.vc] \
+ && [nmakehlp -V "$(_TCL_H)" TCL_PATCH_LEVEL >> versions.vc]
!endif
-INCLUDES = $(TCL_INCLUDES) $(TK_INCLUDES) $(PRJ_INCLUDES)
-!if !$(DOING_TCL) && !$(DOING_TK)
-INCLUDES = $(INCLUDES) -I"$(GENERICDIR)" -I"$(WIN_DIR)" -I"$(COMPATDIR)"
+# If building the tcl core then we need additional package versions
+!if "$(PROJECT)" == "tcl"
+!if [echo PKG_HTTP_VER = \>> versions.vc] \
+ && [nmakehlp -V ..\library\http\pkgIndex.tcl http >> versions.vc]
!endif
-
-# 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)
-
-!if $(TCL_MAJOR_VERSION) == 8 && $(TCL_MINOR_VERSION) < 7
-cflags = $(cflags) -DTcl_Size=int
+!if [echo PKG_TCLTEST_VER = \>> versions.vc] \
+ && [nmakehlp -V ..\library\tcltest\pkgIndex.tcl tcltest >> versions.vc]
!endif
-
-# 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 /GL- /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
+!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
-
-# 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)
+!include versions.vc
-!if $(MSVCRT) && !($(DEBUG) && !$(UNCHECKED)) && $(VCVERSION) >= 1900
-lflags = $(lflags) -nodefaultlib:libucrt.lib
-!endif
+#--------------------------------------------------------------
+# Setup tcl version dependent stuff headers
+#--------------------------------------------------------------
-dlllflags = $(lflags) -dll
-conlflags = $(lflags) -subsystem:console
-guilflags = $(lflags) -subsystem:windows
+!if "$(PROJECT)" != "tcl"
-# Libraries that are required for every image.
-# Extensions should define any additional libraries with $(PRJ_LIBS)
-winlibs = kernel32.lib advapi32.lib
+TCL_VERSION = $(TCL_MAJOR_VERSION)$(TCL_MINOR_VERSION)
-!if $(NEED_TK)
-winlibs = $(winlibs) gdi32.lib user32.lib uxtheme.lib
+!if $(TCLINSTALL)
+TCLSH = "$(_TCLDIR)\bin\tclsh$(TCL_VERSION)$(SUFX).exe"
+!if !exist($(TCLSH)) && $(TCL_THREADS)
+TCLSH = "$(_TCLDIR)\bin\tclsh$(TCL_VERSION)t$(SUFX).exe"
!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
+TCLSTUBLIB = "$(_TCLDIR)\lib\tclstub$(TCL_VERSION).lib"
+TCLIMPLIB = "$(_TCLDIR)\lib\tcl$(TCL_VERSION)$(SUFX).lib"
+TCL_LIBRARY = $(_TCLDIR)\lib
+TCLREGLIB = "$(_TCLDIR)\lib\tclreg12$(SUFX:t=).lib"
+TCLDDELIB = "$(_TCLDIR)\lib\tcldde13$(SUFX:t=).lib"
+COFFBASE = \must\have\tcl\sources\to\build\this\target
+TCLTOOLSDIR = \must\have\tcl\sources\to\build\this\target
+TCL_INCLUDES = -I"$(_TCLDIR)\include"
+!else
+TCLSH = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclsh$(TCL_VERSION)$(SUFX).exe"
+!if !exist($(TCLSH)) && $(TCL_THREADS)
+TCLSH = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclsh$(TCL_VERSION)t$(SUFX).exe"
!endif
+TCLSTUBLIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclstub$(TCL_VERSION).lib"
+TCLIMPLIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tcl$(TCL_VERSION)$(SUFX).lib"
+TCL_LIBRARY = $(_TCLDIR)\library
+TCLREGLIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclreg12$(SUFX:t=).lib"
+TCLDDELIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tcldde13$(SUFX:t=).lib"
+COFFBASE = "$(_TCLDIR)\win\coffbase.txt"
+TCLTOOLSDIR = $(_TCLDIR)\tools
+TCL_INCLUDES = -I"$(_TCLDIR)\generic" -I"$(_TCLDIR)\win"
!endif
-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
+#-------------------------------------------------------------------------
+# Locate the Tk headers to build against
+#-------------------------------------------------------------------------
-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) /DSTATIC_BUILD=$(STATIC_BUILD) \
- /DDEBUG=$(DEBUG) -d UNCHECKED=$(UNCHECKED) \
- /DCOMMAVERSION=$(RCCOMMAVERSION) \
- /DDOTVERSION=\"$(DOTVERSION)\" \
- /DVERSION=\"$(VERSION)\" \
- /DSUFX=\"$(SUFX)\" \
- /DPROJECT=\"$(PROJECT)\" \
- /DPRJLIBNAME=\"$(PRJLIBNAME)\"
-
-!ifndef DEFAULT_BUILD_TARGET
-DEFAULT_BUILD_TARGET = $(PROJECT)
+!if "$(PROJECT)" == "tk"
+_TK_H = ..\generic\tk.h
+_INSTALLDIR = $(_INSTALLDIR)\..
!endif
-default-target: $(DEFAULT_BUILD_TARGET)
-
-!if $(MULTIPLATFORM_INSTALL)
-default-pkgindex:
- @echo if {[package vsatisfies [package provide Tcl] 9.0-]} { > $(OUT_DIR)\pkgIndex.tcl
- @echo package ifneeded $(PRJ_PACKAGE_TCLNAME) $(DOTVERSION) \
- [list load [file join $$dir $(PLATFORM_IDENTIFY) $(PRJLIBNAME9)]] >> $(OUT_DIR)\pkgIndex.tcl
- @echo } else { >> $(OUT_DIR)\pkgIndex.tcl
- @echo package ifneeded $(PRJ_PACKAGE_TCLNAME) $(DOTVERSION) \
- [list load [file join $$dir $(PLATFORM_IDENTIFY) $(PRJLIBNAME8)]] >> $(OUT_DIR)\pkgIndex.tcl
- @echo } >> $(OUT_DIR)\pkgIndex.tcl
+!ifdef PROJECT_REQUIRES_TK
+!if !defined(TKDIR)
+!if exist("$(_INSTALLDIR)\..\include\tk.h")
+TKINSTALL = 1
+_TKDIR = $(_INSTALLDIR)\..
+_TK_H = $(_TKDIR)\include\tk.h
+TKDIR = $(_TKDIR)
+!elseif exist("$(_TCLDIR)\include\tk.h")
+TKINSTALL = 1
+_TKDIR = $(_TCLDIR)
+_TK_H = $(_TKDIR)\include\tk.h
+TKDIR = $(_TKDIR)
+!endif
!else
-default-pkgindex:
- @echo if {[package vsatisfies [package provide Tcl] 9.0-]} { > $(OUT_DIR)\pkgIndex.tcl
- @echo package ifneeded $(PRJ_PACKAGE_TCLNAME) $(DOTVERSION) \
- [list load [file join $$dir $(PRJLIBNAME9)]] >> $(OUT_DIR)\pkgIndex.tcl
- @echo } else { >> $(OUT_DIR)\pkgIndex.tcl
- @echo package ifneeded $(PRJ_PACKAGE_TCLNAME) $(DOTVERSION) \
- [list load [file join $$dir $(PRJLIBNAME8)]] >> $(OUT_DIR)\pkgIndex.tcl
- @echo } >> $(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)
-@PKG_LIB_FILE8@ $(PRJLIBNAME8)
-@PKG_LIB_FILE9@ $(PRJLIBNAME9)
-<<
-
-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)\"
-
-# "emacs font-lock highlighting fix
-
-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 "main" rc must be passed to the resource compiler
-$(TMP_DIR)\$(PROJECT).res: $(RCDIR)\$(PROJECT).rc
- $(RESCMD) $(RCDIR)\$(PROJECT).rc
-
+_TKDIR = $(TKDIR:/=\)
+!if exist("$(_TKDIR)\include\tk.h")
+TKINSTALL = 1
+_TK_H = $(_TKDIR)\include\tk.h
+!elseif exist("$(_TKDIR)\generic\tk.h")
+TKINSTALL = 0
+_TK_H = $(_TKDIR)\generic\tk.h
!else
-
-# 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
+MSG =^
+Failed to find tk.h. The TKDIR macro does not appear correct.
+!error $(MSG)
+!endif
+!endif
!endif
-!if !$(DISABLE_IMPLICIT_RULES)
-# Implicit rule definitions - only for building library objects. For stubs and
-# main application, the 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) $<
+#-------------------------------------------------------------------------
+# Extract Tk version numbers
+#-------------------------------------------------------------------------
-.SUFFIXES:
-.SUFFIXES:.c .rc
+!if defined(PROJECT_REQUIRES_TK) || "$(PROJECT)" == "tk"
+!if [echo TK_MAJOR_VERSION = \>> versions.vc] \
+ && [nmakehlp -V $(_TK_H) TK_MAJOR_VERSION >> versions.vc]
!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"
+!if [echo TK_MINOR_VERSION = \>> versions.vc] \
+ && [nmakehlp -V $(_TK_H) TK_MINOR_VERSION >> versions.vc]
!endif
-!else # !$(TCLINSTALL) - building against Tcl source
-!if exist("$(_TCLDIR)\win\$(BUILDDIRTOP)\tcl.nmake")
-TCLNMAKECONFIG = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tcl.nmake"
+!if [echo TK_PATCH_LEVEL = \>> versions.vc] \
+ && [nmakehlp -V $(_TK_H) TK_PATCH_LEVEL >> versions.vc]
!endif
-!endif # TCLINSTALL
-!if $(CONFIG_CHECK)
-!ifdef TCLNMAKECONFIG
-!include $(TCLNMAKECONFIG)
+!include versions.vc
-!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)).
+TK_DOTVERSION = $(TK_MAJOR_VERSION).$(TK_MINOR_VERSION)
+TK_VERSION = $(TK_MAJOR_VERSION)$(TK_MINOR_VERSION)
+
+!if "$(PROJECT)" != "tk"
+!if $(TKINSTALL)
+WISH = "$(_TKDIR)\bin\wish$(TK_VERSION)$(SUFX).exe"
+TKSTUBLIB = "$(_TKDIR)\lib\tkstub$(TK_VERSION).lib"
+TKIMPLIB = "$(_TKDIR)\lib\tk$(TK_VERSION)$(SUFX).lib"
+TK_INCLUDES = -I"$(_TKDIR)\include"
+!else
+WISH = "$(_TKDIR)\win\$(BUILDDIRTOP)\wish$(TCL_VERSION)$(SUFX).exe"
+TKSTUBLIB = "$(_TKDIR)\win\$(BUILDDIRTOP)\tkstub$(TCL_VERSION).lib"
+TKIMPLIB = "$(_TKDIR)\win\$(BUILDDIRTOP)\tk$(TCL_VERSION)$(SUFX).lib"
+TK_INCLUDES = -I"$(_TKDIR)\generic" -I"$(_TKDIR)\win" -I"$(_TKDIR)\xlib"
!endif
!endif
-!endif # TCLNMAKECONFIG
-
-!endif # !$(DOING_TCL)
-
+!endif
#----------------------------------------------------------
# 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).
+!message *** Optional defines are '$(OPTDEFINES)'
+!message *** Compiler version $(VCVER). Target machine is $(MACHINE)
+!message *** Host architecture is $(NATIVE_ARCH)
+!message *** Compiler options '$(COMPILERFLAGS) $(OPTIMIZATIONS) $(DEBUGFLAGS) $(WARNINGS)'
+!message *** Link options '$(LINKERFLAGS)'
-!endif # ifdef _RULES_VC
+!endif
diff --git a/win/stub16.c b/win/stub16.c new file mode 100644 index 0000000..70fc051 --- /dev/null +++ b/win/stub16.c @@ -0,0 +1,195 @@ +/* + * stub16.c + * + * A helper program used for running 16-bit DOS applications under + * Windows 95. + * + * Copyright (c) 1996 by Sun Microsystems, Inc. + * + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + +#define STRICT + +#include <windows.h> +#include <stdio.h> + +static HANDLE CreateTempFile(void); + +/* + *--------------------------------------------------------------------------- + * + * main + * + * Entry point for the 32-bit console mode app used by Windows 95 to help + * run the 16-bit program specified on the command line. + * + * 1. EOF on a pipe that connects a detached 16-bit process and a 32-bit + * process is never seen. So, this process runs the 16-bit process + * _attached_, and then it is run detached from the calling 32-bit + * process. + * + * 2. If a 16-bit process blocks reading from or writing to a pipe, it + * never wakes up, and eventually brings the whole system down with it if + * you try to kill the process. This app simulates pipes. If any of the + * stdio handles is a pipe, this program accumulates information into + * temp files and forwards it to or from the DOS application as + * appropriate. This means that this program must receive EOF from a + * stdin pipe before it will actually start the DOS app, and the DOS app + * must finish generating stdout or stderr before the data will be sent + * to the next stage of the pipe. If the stdio handles are not pipes, no + * accumulation occurs and the data is passed straight through to and + * from the DOS application. + * + * Results: + * None. + * + * Side effects: + * The child process is created and this process waits for it to + * complete. + * + *--------------------------------------------------------------------------- + */ + +int +main(void) +{ + DWORD dwRead, dwWrite; + char *cmdLine; + HANDLE hStdInput, hStdOutput, hStdError; + HANDLE hFileInput, hFileOutput, hFileError; + STARTUPINFO si; + PROCESS_INFORMATION pi; + char buf[8192]; + DWORD result; + + hFileInput = INVALID_HANDLE_VALUE; + hFileOutput = INVALID_HANDLE_VALUE; + hFileError = INVALID_HANDLE_VALUE; + result = 1; + + /* + * Don't get command line from argc, argv, because the command line + * tokenizer will have stripped off all the escape sequences needed for + * quotes and backslashes, and then we'd have to put them all back in + * again. Get the raw command line and parse off what we want ourselves. + * The command line should be of the form: + * + * stub16.exe program arg1 arg2 ... + */ + + cmdLine = strchr(GetCommandLine(), ' '); + if (cmdLine == NULL) { + return 1; + } + cmdLine++; + + hStdInput = GetStdHandle(STD_INPUT_HANDLE); + hStdOutput = GetStdHandle(STD_OUTPUT_HANDLE); + hStdError = GetStdHandle(STD_ERROR_HANDLE); + + if (GetFileType(hStdInput) == FILE_TYPE_PIPE) { + hFileInput = CreateTempFile(); + if (hFileInput == INVALID_HANDLE_VALUE) { + goto cleanup; + } + while (ReadFile(hStdInput, buf, sizeof(buf), &dwRead, NULL) != FALSE) { + if (dwRead == 0) { + break; + } + if (WriteFile(hFileInput, buf, dwRead, &dwWrite, NULL) == FALSE) { + goto cleanup; + } + } + SetFilePointer(hFileInput, 0, 0, FILE_BEGIN); + SetStdHandle(STD_INPUT_HANDLE, hFileInput); + } + if (GetFileType(hStdOutput) == FILE_TYPE_PIPE) { + hFileOutput = CreateTempFile(); + if (hFileOutput == INVALID_HANDLE_VALUE) { + goto cleanup; + } + SetStdHandle(STD_OUTPUT_HANDLE, hFileOutput); + } + if (GetFileType(hStdError) == FILE_TYPE_PIPE) { + hFileError = CreateTempFile(); + if (hFileError == INVALID_HANDLE_VALUE) { + goto cleanup; + } + SetStdHandle(STD_ERROR_HANDLE, hFileError); + } + + ZeroMemory(&si, sizeof(si)); + si.cb = sizeof(si); + if (CreateProcess(NULL, cmdLine, NULL, NULL, TRUE, 0, NULL, NULL, &si, + &pi) == FALSE) { + goto cleanup; + } + + WaitForInputIdle(pi.hProcess, 5000); + WaitForSingleObject(pi.hProcess, INFINITE); + GetExitCodeProcess(pi.hProcess, &result); + CloseHandle(pi.hProcess); + CloseHandle(pi.hThread); + + if (hFileOutput != INVALID_HANDLE_VALUE) { + SetFilePointer(hFileOutput, 0, 0, FILE_BEGIN); + while (ReadFile(hFileOutput, buf, sizeof(buf), &dwRead, NULL) != FALSE) { + if (dwRead == 0) { + break; + } + if (WriteFile(hStdOutput, buf, dwRead, &dwWrite, NULL) == FALSE) { + break; + } + } + } + if (hFileError != INVALID_HANDLE_VALUE) { + SetFilePointer(hFileError, 0, 0, FILE_BEGIN); + while (ReadFile(hFileError, buf, sizeof(buf), &dwRead, NULL) != FALSE) { + if (dwRead == 0) { + break; + } + if (WriteFile(hStdError, buf, dwRead, &dwWrite, NULL) == FALSE) { + break; + } + } + } + + cleanup: + if (hFileInput != INVALID_HANDLE_VALUE) { + CloseHandle(hFileInput); + } + if (hFileOutput != INVALID_HANDLE_VALUE) { + CloseHandle(hFileOutput); + } + if (hFileError != INVALID_HANDLE_VALUE) { + CloseHandle(hFileError); + } + CloseHandle(hStdInput); + CloseHandle(hStdOutput); + CloseHandle(hStdError); + ExitProcess(result); + return 1; +} + +static HANDLE +CreateTempFile(void) +{ + char name[MAX_PATH]; + SECURITY_ATTRIBUTES sa; + + if (GetTempPath(sizeof(name), name) == 0) { + return INVALID_HANDLE_VALUE; + } + if (GetTempFileName(name, "tcl", 0, name) == 0) { + return INVALID_HANDLE_VALUE; + } + + sa.nLength = sizeof(sa); + sa.lpSecurityDescriptor = NULL; + sa.bInheritHandle = TRUE; + return CreateFile(name, GENERIC_READ | GENERIC_WRITE, 0, &sa, + CREATE_ALWAYS, FILE_ATTRIBUTE_TEMPORARY | FILE_FLAG_DELETE_ON_CLOSE, + NULL); +} diff --git a/win/svnmanifest.in b/win/svnmanifest.in deleted file mode 100644 index 18d2cad..0000000 --- a/win/svnmanifest.in +++ /dev/null @@ -1 +0,0 @@ -svn-r
\ No newline at end of file diff --git a/win/targets.vc b/win/targets.vc deleted file mode 100644 index 077e8f7..0000000 --- a/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-lang.org/tips/doc/main/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/win/tcl.dsp b/win/tcl.dsp index d033560..68920ad 100644 --- a/win/tcl.dsp +++ b/win/tcl.dsp @@ -34,18 +34,18 @@ CFG=tcl - Win32 Debug Static # 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 MSVCDIR=IDE"
+# PROP BASE Cmd_Line "nmake -nologo -f makefile.vc OPTS=none MSVCDIR=IDE"
# PROP BASE Rebuild_Opt "-a"
-# PROP BASE Target_File "Release\tclsh87.exe"
+# PROP BASE Target_File "Release\tclsh85.exe"
# PROP BASE Bsc_Name ""
# PROP BASE Target_Dir ""
# PROP Use_MFC 0
# PROP Use_Debug_Libraries 0
# PROP Output_Dir "Release"
# PROP Intermediate_Dir "Release\tcl_Dynamic"
-# PROP Cmd_Line "nmake -nologo -f makefile.vc MSVCDIR=IDE"
+# PROP Cmd_Line "nmake -nologo -f makefile.vc OPTS=threads MSVCDIR=IDE"
# PROP Rebuild_Opt "clean release"
-# PROP Target_File "Release\tclsh87t.exe"
+# PROP Target_File "Release\tclsh85t.exe"
# PROP Bsc_Name ""
# PROP Target_Dir ""
@@ -57,7 +57,7 @@ CFG=tcl - Win32 Debug Static # PROP BASE Intermediate_Dir "Debug\tcl_Dynamic"
# PROP BASE Cmd_Line "nmake -nologo -f makefile.vc OPTS=symbols MSVCDIR=IDE"
# PROP BASE Rebuild_Opt "-a"
-# PROP BASE Target_File "Debug\tclsh87g.exe"
+# PROP BASE Target_File "Debug\tclsh85g.exe"
# PROP BASE Bsc_Name ""
# PROP BASE Target_Dir ""
# PROP Use_MFC 0
@@ -66,7 +66,7 @@ CFG=tcl - Win32 Debug Static # 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\tclsh87tg.exe"
+# PROP Target_File "Debug\tclsh85tg.exe"
# PROP Bsc_Name ""
# PROP Target_Dir ""
@@ -78,7 +78,7 @@ CFG=tcl - Win32 Debug Static # PROP BASE Intermediate_Dir "Debug\tcl_Static"
# PROP BASE Cmd_Line "nmake -nologo -f makefile.vc OPTS=symbols,static MSVCDIR=IDE"
# PROP BASE Rebuild_Opt "-a"
-# PROP BASE Target_File "Debug\tclsh87sg.exe"
+# PROP BASE Target_File "Debug\tclsh85sg.exe"
# PROP BASE Bsc_Name ""
# PROP BASE Target_Dir ""
# PROP Use_MFC 0
@@ -87,7 +87,7 @@ CFG=tcl - Win32 Debug Static # PROP Intermediate_Dir "Debug\tcl_Static"
# PROP Cmd_Line "nmake -nologo -f makefile.vc OPTS=symbols,static MSVCDIR=IDE"
# PROP Rebuild_Opt "-a"
-# PROP Target_File "Debug\tclsh87sg.exe"
+# PROP Target_File "Debug\tclsh85sg.exe"
# PROP Bsc_Name ""
# PROP Target_Dir ""
@@ -99,7 +99,7 @@ CFG=tcl - Win32 Debug Static # PROP BASE Intermediate_Dir "Release\tcl_Static"
# PROP BASE Cmd_Line "nmake -nologo -f makefile.vc OPTS=static MSVCDIR=IDE"
# PROP BASE Rebuild_Opt "-a"
-# PROP BASE Target_File "Release\tclsh87s.exe"
+# PROP BASE Target_File "Release\tclsh85s.exe"
# PROP BASE Bsc_Name ""
# PROP BASE Target_Dir ""
# PROP Use_MFC 0
@@ -108,7 +108,7 @@ CFG=tcl - Win32 Debug Static # PROP Intermediate_Dir "Release\tcl_Static"
# PROP Cmd_Line "nmake -nologo -f makefile.vc OPTS=static MSVCDIR=IDE"
# PROP Rebuild_Opt "-a"
-# PROP Target_File "Release\tclsh87s.exe"
+# PROP Target_File "Release\tclsh85s.exe"
# PROP Bsc_Name ""
# PROP Target_Dir ""
@@ -136,10 +136,26 @@ CFG=tcl - Win32 Debug Static # 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
@@ -148,12 +164,56 @@ 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"
@@ -232,6 +292,10 @@ 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
@@ -300,7 +364,7 @@ SOURCE=..\doc\CrtObjCmd.3 # End Source File
# Begin Source File
-SOURCE=..\doc\CrtAlias.3
+SOURCE=..\doc\CrtSlave.3
# End Source File
# Begin Source File
@@ -712,7 +776,7 @@ SOURCE=..\doc\safe.n # End Source File
# Begin Source File
-SOURCE=..\doc\SaveInterpState.3
+SOURCE=..\doc\SaveResult.3
# End Source File
# Begin Source File
@@ -776,7 +840,7 @@ SOURCE=..\doc\SplitPath.3 # End Source File
# Begin Source File
-SOURCE=..\doc\StaticLibrary.3
+SOURCE=..\doc\StaticPkg.3
# End Source File
# Begin Source File
@@ -1204,10 +1268,6 @@ SOURCE=..\generic\tclProc.c # End Source File
# Begin Source File
-SOURCE=..\generic\tclProcess.c
-# End Source File
-# Begin Source File
-
SOURCE=..\generic\tclRegexp.c
# End Source File
# Begin Source File
@@ -1240,14 +1300,6 @@ SOURCE=..\generic\tclStubLib.c # End Source File
# Begin Source File
-SOURCE=..\generic\tclOOStubLib.c
-# End Source File
-# Begin Source File
-
-SOURCE=..\generic\tclTomMathStubLib.c
-# End Source File
-# Begin Source File
-
SOURCE=..\generic\tclTest.c
# End Source File
# Begin Source File
@@ -1364,7 +1416,11 @@ SOURCE=.\configure # End Source File
# Begin Source File
-SOURCE=.\configure.ac
+SOURCE=.\configure.in
+# End Source File
+# Begin Source File
+
+SOURCE=.\makefile.bc
# End Source File
# Begin Source File
@@ -1396,6 +1452,14 @@ SOURCE=.\rules.vc # End Source File
# Begin Source File
+SOURCE=.\stub16.c
+# End Source File
+# Begin Source File
+
+SOURCE=.\tcl.hpj.in
+# End Source File
+# Begin Source File
+
SOURCE=.\tcl.m4
# End Source File
# Begin Source File
@@ -1464,10 +1528,6 @@ SOURCE=.\tclWinNotify.c # End Source File
# Begin Source File
-SOURCE=.\tclWinPanic.c
-# End Source File
-# Begin Source File
-
SOURCE=.\tclWinPipe.c
# End Source File
# Begin Source File
@@ -1496,6 +1556,10 @@ SOURCE=.\tclWinThrd.c # End Source File
# Begin Source File
+SOURCE=.\tclWinThrd.h
+# End Source File
+# Begin Source File
+
SOURCE=.\tclWinTime.c
# End Source File
# End Group
diff --git a/win/tcl.hpj.in b/win/tcl.hpj.in new file mode 100644 index 0000000..8efff0b --- /dev/null +++ b/win/tcl.hpj.in @@ -0,0 +1,19 @@ +; 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=tcl85.cnt
+COPYRIGHT=Copyright © 2000 Ajuba Solutions
+HLP=tcl85.hlp
+
+[FILES]
+tcl.rtf
+
+[WINDOWS]
+main="Tcl/Tk Reference Manual",,0
+
+[CONFIG]
+BrowseButtons()
@@ -28,9 +28,9 @@ AC_DEFUN([SC_PATH_TCLCONFIG], [ # we reset no_tcl in case something fails here no_tcl=true AC_ARG_WITH(tcl, - AS_HELP_STRING([--with-tcl], + AC_HELP_STRING([--with-tcl], [directory containing tcl configuration (tclConfig.sh)]), - [with_tclconfig="${withval}"]) + with_tclconfig="${withval}") AC_MSG_CHECKING([for Tcl configuration]) AC_CACHE_VAL(ac_cv_c_tclconfig,[ @@ -146,9 +146,9 @@ AC_DEFUN([SC_PATH_TKCONFIG], [ # we reset no_tk in case something fails here no_tk=true AC_ARG_WITH(tk, - AS_HELP_STRING([--with-tk], + AC_HELP_STRING([--with-tk], [directory containing tk configuration (tkConfig.sh)]), - [with_tkconfig="${withval}"]) + with_tkconfig="${withval}") AC_MSG_CHECKING([for Tk configuration]) AC_CACHE_VAL(ac_cv_c_tkconfig,[ @@ -247,7 +247,7 @@ AC_DEFUN([SC_PATH_TKCONFIG], [ # # Results: # -# Substitutes the following vars: +# Subst the following vars: # TCL_BIN_DIR # TCL_SRC_DIR # TCL_LIB_FILE @@ -279,6 +279,14 @@ AC_DEFUN([SC_LOAD_TCLCONFIG], [ 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}\"" @@ -356,6 +364,14 @@ AC_DEFUN([SC_ENABLE_SHARED], [ 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 @@ -364,7 +380,42 @@ AC_DEFUN([SC_ENABLE_SHARED], [ SHARED_BUILD=0 AC_DEFINE(STATIC_BUILD, 1, [Is this a static build?]) fi - AC_SUBST(SHARED_BUILD) +]) + +#------------------------------------------------------------------------ +# 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: off)], + [tcl_ok=$enableval], [tcl_ok=no]) + + if test "$tcl_ok" = "yes"; then + AC_MSG_RESULT(yes) + 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 (default)]) + fi + AC_SUBST(TCL_THREADS) ]) #------------------------------------------------------------------------ @@ -391,6 +442,7 @@ AC_DEFUN([SC_ENABLE_SHARED], [ # Sets to $(CFLAGS_OPTIMIZE) if false # LDFLAGS_DEFAULT Sets to $(LDFLAGS_DEBUG) if true # Sets to $(LDFLAGS_OPTIMIZE) if false +# DBGX Debug library extension # #------------------------------------------------------------------------ @@ -401,6 +453,7 @@ AC_DEFUN([SC_ENABLE_SYMBOLS], [ 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]) @@ -408,6 +461,7 @@ AC_DEFUN([SC_ENABLE_SYMBOLS], [ else CFLAGS_DEFAULT='$(CFLAGS_DEBUG)' LDFLAGS_DEFAULT='$(LDFLAGS_DEBUG)' + DBGX=g if test "$tcl_ok" = "yes"; then AC_MSG_RESULT([yes (standard debugging)]) fi @@ -453,7 +507,6 @@ AC_DEFUN([SC_ENABLE_SYMBOLS], [ # CFLAGS_DEBUG # CFLAGS_OPTIMIZE # CFLAGS_WARNING -# CFLAGS_NOLTO # LDFLAGS_DEBUG # LDFLAGS_OPTIMIZE # LDFLAGS_CONSOLE @@ -491,50 +544,52 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ 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) - AC_CHECK_PROG(WINE, wine, wine,) SHLIB_SUFFIX=".dll" # MACHINE is IX86 for LINK, but this is used by the manifest, - # which requires x86|amd64|arm64|ia64. + # 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_COMPILE_IFELSE([AC_LANG_PROGRAM([[ - #ifndef _WIN32 + AC_TRY_COMPILE([ + #ifndef __WIN32__ #error cross-compiler #endif - ]], [[]])], - [ac_cv_cross=no], - [ac_cv_cross=yes]) + ], [], + 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-${CC}" + 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" ;; - arm64|aarch64) - CC="aarch64-w64-mingw32-${CC}" - LD="aarch64-w64-mingw32-ld" - AR="aarch64-w64-mingw32-ar" - RANLIB="aarch64-w64-mingw32-ranlib" - RC="aarch64-w64-mingw32-windres" - ;; *) - CC="i686-w64-mingw32-${CC}" + CC="i686-w64-mingw32-gcc" LD="i686-w64-mingw32-ld" AR="i686-w64-mingw32-ar" RANLIB="i686-w64-mingw32-ranlib" @@ -582,79 +637,26 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ extra_ldflags="-pipe -static-libgcc" AC_CACHE_CHECK(for mingw32 version of gcc, ac_cv_win32, - AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ - #ifdef _WIN32 + AC_TRY_COMPILE([ + #ifdef __WIN32__ #error win32 #endif - ]], [[]])], - [ac_cv_win32=no], - [ac_cv_win32=yes]) + ], [], + ac_cv_win32=no, + ac_cv_win32=yes) ) if test "$ac_cv_win32" != "yes"; then AC_MSG_ERROR([${CC} cannot produce win32 executables.]) fi - if test "$do64bit" != "arm64"; then - extra_cflags="$extra_cflags -DHAVE_CPUID=1" - fi - - hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -mwindows -municode -Dmain=xxmain" - AC_CACHE_CHECK(for working -municode linker flag, - ac_cv_municode, - AC_LINK_IFELSE([AC_LANG_PROGRAM([[ - #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 - hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -fno-lto" - AC_CACHE_CHECK(for working -fno-lto, - ac_cv_nolto, - AC_COMPILE_IFELSE([AC_LANG_PROGRAM([])], - [ac_cv_nolto=yes], - [ac_cv_nolto=no]) - ) - CFLAGS=$hold_cflags - if test "$ac_cv_nolto" = "yes" ; then - CFLAGS_NOLTO="-fno-lto" - else - CFLAGS_NOLTO="" - fi - AC_CACHE_CHECK([if the compiler understands -finput-charset], - tcl_cv_cc_input_charset, [ - hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -finput-charset=UTF-8" - AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[]], [[]])],[tcl_cv_cc_input_charset=yes],[tcl_cv_cc_input_charset=no]) - CFLAGS=$hold_cflags]) - if test $tcl_cv_cc_input_charset = yes; then - extra_cflags="$extra_cflags -finput-charset=UTF-8" - fi - fi - - hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -Wl,--enable-auto-image-base" - AC_CACHE_CHECK(for working --enable-auto-image-base, - ac_cv_enable_auto_image_base, - AC_COMPILE_IFELSE([AC_LANG_PROGRAM([])], - [ac_cv_enable_auto_image_base=yes], - [ac_cv_enable_auto_image_base=no]) - ) - CFLAGS=$hold_cflags - if test "$ac_cv_enable_auto_image_base" == "yes" ; then - extra_ldflags="$extra_ldflags -Wl,--enable-auto-image-base" fi AC_MSG_CHECKING([compiler flags]) if test "${GCC}" = "yes" ; then SHLIB_LD="" - SHLIB_LD_LIBS='${LIBS}' - LIBS="-lnetapi32 -lkernel32 -luser32 -ladvapi32 -luserenv -lws2_32" + SHLIB_LD_LIBS="" + LIBS="-lws2_32" # mingw needs to link ole32 and oleaut32 for [send], but MSVC doesn't - LIBS_GUI="-lgdi32 -lcomdlg32 -limm32 -lcomctl32 -lshell32 -luuid -lole32 -loleaut32 -lwinspool" + LIBS_GUI="-lgdi32 -lcomdlg32 -limm32 -lcomctl32 -lshell32 -luuid -lole32 -loleaut32" STLIB_LD='${AR} cr' RC_OUT=-o RC_TYPE= @@ -671,8 +673,11 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ # static AC_MSG_RESULT([using static flags]) runtime= + MAKE_DLL="echo " + LIBSUFFIX="s\${DBGX}.a" + LIBFLAGSUFFIX="s\${DBGX}" LIBRARIES="\${STATIC_LIBRARIES}" - EXESUFFIX="s.exe" + EXESUFFIX="s\${DBGX}.exe" else # dynamic AC_MSG_RESULT([using shared flags]) @@ -684,41 +689,32 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ fi runtime= + # Link with gcc since ld does not link to default libs like + # -luser32 and -lmsvcrt by default. + SHLIB_LD='${CC} -shared' + SHLIB_LD_LIBS='${LIBS}' # Add SHLIB_LD_LIBS to the Make rule, not here. + MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -o \[$]@ ${extra_ldflags} \ + -Wl,--out-implib,\$(patsubst %.dll,lib%.a,\[$]@)" - EXESUFFIX=".exe" + LIBSUFFIX="\${DBGX}.a" + LIBFLAGSUFFIX="\${DBGX}" + EXESUFFIX="\${DBGX}.exe" LIBRARIES="\${SHARED_LIBRARIES}" fi - # Link with gcc since ld does not link to default libs like - # -luser32 and -lmsvcrt by default. - SHLIB_LD='${CC} -shared' - SHLIB_LD_LIBS='${LIBS}' - MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -o \[$]@ ${extra_ldflags} \ - -Wl,--out-implib,\$(patsubst %.dll,lib%.dll.a,\[$]@)" # DLLSUFFIX is separate because it is the building block for # users of tclConfig.sh that may build shared or static. - DLLSUFFIX=".dll" - LIBSUFFIX=".a" - LIBFLAGSUFFIX="" + DLLSUFFIX="\${DBGX}.dll" SHLIB_SUFFIX=.dll EXTRA_CFLAGS="${extra_cflags}" CFLAGS_DEBUG=-g CFLAGS_OPTIMIZE="-O2 -fomit-frame-pointer" - CFLAGS_WARNING="-Wall -Wextra -Wshadow -Wundef -Wwrite-strings -Wpointer-arith" + CFLAGS_WARNING="-Wall" LDFLAGS_DEBUG= LDFLAGS_OPTIMIZE= - case "${CC}" in - *++) - CFLAGS_WARNING="${CFLAGS_WARNING} -Wno-format" - ;; - *) - CFLAGS_WARNING="${CFLAGS_WARNING} -Wc++-compat -fextended-identifiers" - ;; - esac - # Specify the CC output file names based on the target name CC_OBJNAME="-o \[$]@" CC_EXENAME="-o \[$]@" @@ -745,27 +741,23 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ MACHINE="AMD64" ; # assume AMD64 as default 64-bit build AC_MSG_RESULT([ Using 64-bit $MACHINE mode]) ;; - arm64|aarch64) - MACHINE="ARM64" - AC_MSG_RESULT([ Using ARM64 $MACHINE mode]) - ;; ia64) MACHINE="IA64" - AC_MSG_RESULT([ Using IA64 $MACHINE mode]) + AC_MSG_RESULT([ Using 64-bit $MACHINE mode]) ;; *) - AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ + AC_TRY_COMPILE([ #ifndef _WIN64 #error 32-bit #endif - ]], [[]])], - [tcl_win_64bit=yes], - [tcl_win_64bit=no] + ], [], + 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]) + do64bit=amd64 + MACHINE="AMD64" + AC_MSG_RESULT([ Using 64-bit $MACHINE mode]) fi ;; esac @@ -774,15 +766,23 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ # static AC_MSG_RESULT([using static flags]) runtime=-MT + MAKE_DLL="echo " + LIBSUFFIX="s\${DBGX}.lib" + LIBFLAGSUFFIX="s\${DBGX}" LIBRARIES="\${STATIC_LIBRARIES}" - EXESUFFIX="s.exe" + EXESUFFIX="s\${DBGX}.exe" + SHLIB_LD_LIBS="" else # dynamic AC_MSG_RESULT([using shared flags]) runtime=-MD # Add SHLIB_LD_LIBS to the Make rule, not here. + MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -out:\[$]@" + LIBSUFFIX="\${DBGX}.lib" + LIBFLAGSUFFIX="\${DBGX}" + EXESUFFIX="\${DBGX}.exe" LIBRARIES="\${SHARED_LIBRARIES}" - EXESUFFIX=".exe" + SHLIB_LD_LIBS='${LIBS}' case "x`echo \${VisualStudioVersion}`" in x1[[4-9]]*) lflags="${lflags} -nodefaultlib:libucrt.lib" @@ -791,29 +791,36 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ ;; esac fi - MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -out:\[$]@" # DLLSUFFIX is separate because it is the building block for # users of tclConfig.sh that may build shared or static. - DLLSUFFIX=".dll" - LIBSUFFIX=".lib" - LIBFLAGSUFFIX="" + DLLSUFFIX="\${DBGX}.dll" + # 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 - ;; - arm64|aarch64) - MACHINE="ARM64" + 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" + LIBS="user32.lib advapi32.lib ws2_32.lib" case "x`echo \${VisualStudioVersion}`" in x1[[4-9]]*) @@ -824,11 +831,21 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ esac if test "$do64bit" != "no" ; then - RC="rc" + # 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" - CFLAGS_OPTIMIZE="-nologo -O2 ${runtime}" - lflags="${lflags} -nologo -MACHINE:${MACHINE}" - LINKBIN="link" + # 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" @@ -843,10 +860,100 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ LINKBIN="link" fi - LIBS_GUI="gdi32.lib comdlg32.lib imm32.lib comctl32.lib shell32.lib uuid.lib winspool.lib" + 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 @@ -874,7 +981,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ # Specify linker flags depending on the type of app being # built -- Console vs. Window. - if test "${TARGETCPU}" != "X86"; then + if test "$doWince" != "no" -a "${TARGETCPU}" != "X86"; then LDFLAGS_CONSOLE="-link ${lflags}" LDFLAGS_WINDOW=${LDFLAGS_CONSOLE} else @@ -890,7 +997,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ if test "${GCC}" = "yes" ; then AC_CACHE_CHECK(for SEH support in compiler, tcl_cv_seh, - AC_RUN_IFELSE([AC_LANG_SOURCE([[ + AC_TRY_RUN([ #define WIN32_LEAN_AND_MEAN #include <windows.h> #undef WIN32_LEAN_AND_MEAN @@ -905,10 +1012,10 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ } return 1; } - ]])], - [tcl_cv_seh=yes], - [tcl_cv_seh=no], - [tcl_cv_seh=no]) + ], + 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, @@ -923,22 +1030,44 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ # AC_CACHE_CHECK(for EXCEPTION_DISPOSITION support in include files, tcl_cv_eh_disposition, - AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ + 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]) + ], + 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 - AC_CHECK_HEADER(stdbool.h, [AC_DEFINE(HAVE_STDBOOL_H, 1, [Do we have <stdbool.h>?])],) + # 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 @@ -946,12 +1075,13 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ AC_CACHE_CHECK(for cast to union support, tcl_cv_cast_to_union, - AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[]], [[ + 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]) + ], + 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, @@ -964,7 +1094,6 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ AC_SUBST(CFLAGS_DEBUG) AC_SUBST(CFLAGS_OPTIMIZE) AC_SUBST(CFLAGS_WARNING) - AC_SUBST(CFLAGS_NOLTO) ]) #------------------------------------------------------------------------ @@ -985,13 +1114,13 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ #------------------------------------------------------------------------ AC_DEFUN([SC_WITH_TCL], [ - if test -d ../../tcl8.7$1/win; then - TCL_BIN_DEFAULT=../../tcl8.7$1/win + if test -d ../../tcl8.5$1/win; then + TCL_BIN_DEFAULT=../../tcl8.5$1/win else - TCL_BIN_DEFAULT=../../tcl8.7/win + TCL_BIN_DEFAULT=../../tcl8.5/win fi - AC_ARG_WITH(tcl, [ --with-tcl=DIR use Tcl 8.7 binaries from DIR], + AC_ARG_WITH(tcl, [ --with-tcl=DIR use Tcl 8.5 binaries from DIR], TCL_BIN_DIR=$withval, TCL_BIN_DIR=`cd $TCL_BIN_DEFAULT; pwd`) if test ! -d $TCL_BIN_DIR; then AC_MSG_ERROR(Tcl directory $TCL_BIN_DIR does not exist) @@ -1020,7 +1149,7 @@ AC_DEFUN([SC_WITH_TCL], [ # none # # Results -# Substitutes the following values: +# Subst's the following values: # TCLSH_PROG #------------------------------------------------------------------------ @@ -1066,13 +1195,13 @@ AC_DEFUN([SC_PROG_TCLSH], [ # none # # Results -# Substitutes the following values: +# 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}\${EXESUFFIX} + BUILD_TCLSH=${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}${TCL_DBGX}${EXEEXT} AC_MSG_RESULT($BUILD_TCLSH) AC_SUBST(BUILD_TCLSH) ]) @@ -1100,7 +1229,8 @@ AC_DEFUN([SC_TCL_CFG_ENCODING], [ if test x"${with_tcencoding}" != x ; then AC_DEFINE_UNQUOTED(TCL_CFGVAL_ENCODING,"${with_tcencoding}") else - AC_DEFINE(TCL_CFGVAL_ENCODING,"utf-8") + # Default encoding on windows is not "iso8859-1" + AC_DEFINE(TCL_CFGVAL_ENCODING,"cp1252") fi ]) @@ -1122,7 +1252,7 @@ AC_DEFUN([SC_TCL_CFG_ENCODING], [ AC_DEFUN([SC_EMBED_MANIFEST], [ AC_MSG_CHECKING(whether to embed manifest) AC_ARG_ENABLE(embedded-manifest, - AS_HELP_STRING([--enable-embedded-manifest], + AC_HELP_STRING([--enable-embedded-manifest], [embed manifest if possible (default: yes)]), [embed_ok=$enableval], [embed_ok=yes]) @@ -1155,126 +1285,3 @@ print("manifest needed") AC_SUBST(VC_MANIFEST_EMBED_DLL) AC_SUBST(VC_MANIFEST_EMBED_EXE) ]) - -#------------------------------------------------------------------------ -# SC_CC_FOR_BUILD -# For cross compiles, locate a C compiler that can generate native binaries. -# -# Arguments: -# none -# -# Results: -# Substitutes the following vars: -# CC_FOR_BUILD -# EXEEXT_FOR_BUILD -#------------------------------------------------------------------------ - -dnl Get a default for CC_FOR_BUILD to put into Makefile. -AC_DEFUN([AX_CC_FOR_BUILD], -[# Put a plausible default for CC_FOR_BUILD in Makefile. -if test -z "$CC_FOR_BUILD"; then - if test "x$cross_compiling" = "xno"; then - CC_FOR_BUILD='$(CC)' - else - AC_MSG_CHECKING([for gcc]) - AC_CACHE_VAL(ac_cv_path_cc, [ - search_path=`echo ${PATH} | sed -e 's/:/ /g'` - for dir in $search_path ; do - for j in `ls -r $dir/gcc 2> /dev/null` \ - `ls -r $dir/gcc 2> /dev/null` ; do - if test x"$ac_cv_path_cc" = x ; then - if test -f "$j" ; then - ac_cv_path_cc=$j - break - fi - fi - done - done - ]) - fi -fi -AC_SUBST(CC_FOR_BUILD) -# Also set EXEEXT_FOR_BUILD. -if test "x$cross_compiling" = "xno"; then - EXEEXT_FOR_BUILD='$(EXEEXT)' - OBJEXT_FOR_BUILD='$(OBJEXT)' -else - OBJEXT_FOR_BUILD='.no' - AC_CACHE_CHECK([for build system executable suffix], bfd_cv_build_exeext, - [rm -f conftest* - echo 'int main () { return 0; }' > conftest.c - bfd_cv_build_exeext= - ${CC_FOR_BUILD} -o conftest conftest.c 1>&5 2>&5 - for file in conftest.*; do - case $file in - *.c | *.o | *.obj | *.ilk | *.pdb) ;; - *) bfd_cv_build_exeext=`echo $file | sed -e s/conftest//` ;; - esac - done - rm -f conftest* - test x"${bfd_cv_build_exeext}" = x && bfd_cv_build_exeext=no]) - EXEEXT_FOR_BUILD="" - test x"${bfd_cv_build_exeext}" != xno && EXEEXT_FOR_BUILD=${bfd_cv_build_exeext} -fi -AC_SUBST(EXEEXT_FOR_BUILD)])dnl -AC_SUBST(OBJEXT_FOR_BUILD)])dnl - - - -#------------------------------------------------------------------------ -# SC_ZIPFS_SUPPORT -# Locate a zip encoder installed on the system path, or none. -# -# Arguments: -# none -# -# Results: -# Substitutes the following vars: -# ZIP_PROG -# ZIP_PROG_OPTIONS -# ZIP_PROG_VFSSEARCH -# ZIP_INSTALL_OBJS -#------------------------------------------------------------------------ - -AC_DEFUN([SC_ZIPFS_SUPPORT], [ - ZIP_PROG="" - ZIP_PROG_OPTIONS="" - ZIP_PROG_VFSSEARCH="" - ZIP_INSTALL_OBJS="" - - AC_MSG_CHECKING([for zip]) - AC_CACHE_VAL(ac_cv_path_zip, [ - search_path=`echo ${PATH} | sed -e 's/:/ /g'` - for dir in $search_path ; do - for j in `ls -r $dir/zip 2> /dev/null` \ - `ls -r $dir/zip 2> /dev/null` ; do - if test x"$ac_cv_path_zip" = x ; then - if test -f "$j" ; then - ac_cv_path_zip=$j - break - fi - fi - done - done - ]) - if test -f "$ac_cv_path_zip" ; then - ZIP_PROG="$ac_cv_path_zip" - AC_MSG_RESULT([$ZIP_PROG]) - ZIP_PROG_OPTIONS="-rq" - ZIP_PROG_VFSSEARCH="*" - AC_MSG_RESULT([Found INFO Zip in environment]) - # Use standard arguments for zip - else - # It is not an error if an installed version of Zip can't be located. - # We can use the locally distributed minizip instead - ZIP_PROG="./minizip${EXEEXT_FOR_BUILD}" - ZIP_PROG_OPTIONS="-o -r" - ZIP_PROG_VFSSEARCH="*" - ZIP_INSTALL_OBJS="minizip${EXEEXT_FOR_BUILD}" - AC_MSG_RESULT([No zip found on PATH building minizip]) - fi - AC_SUBST(ZIP_PROG) - AC_SUBST(ZIP_PROG_OPTIONS) - AC_SUBST(ZIP_PROG_VFSSEARCH) - AC_SUBST(ZIP_INSTALL_OBJS) -]) @@ -7,13 +7,19 @@ // // 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_DEBUG +#define SUFFIX SUFFIX_THREADS SUFFIX_DEBUG LANGUAGE 0x9, 0x1 /* LANG_ENGLISH, SUBLANG_DEFAULT */ @@ -37,8 +43,9 @@ BEGIN 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 1987-2022 Regents of the University of California and other parties\0" + 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 diff --git a/win/tclAppInit.c b/win/tclAppInit.c index d1b38ee..251a610 100644 --- a/win/tclAppInit.c +++ b/win/tclAppInit.c @@ -2,78 +2,31 @@ * tclAppInit.c -- * * Provides a default version of the main program and Tcl_AppInit - * procedure for tclsh and other Tcl-based applications (without Tk). - * Note that this program must be built in Win32 console mode to work - * properly. + * function for Tcl applications (without Tk). Note that this program + * must be built in Win32 console mode to work properly. * - * Copyright (c) 1993 The Regents of the University of California. - * Copyright (c) 1994-1997 Sun Microsystems, Inc. - * Copyright (c) 1998-1999 Scriptics Corporation. + * Copyright (c) 1996-1997 by Sun Microsystems, Inc. + * Copyright (c) 1998-1999 by Scriptics Corporation. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tcl.h" -#if TCL_MAJOR_VERSION < 9 -# if defined(USE_TCL_STUBS) -# error "Don't build with USE_TCL_STUBS!" -# endif -# if TCL_MINOR_VERSION < 7 -# define Tcl_LibraryInitProc Tcl_PackageInitProc -# define Tcl_StaticLibrary Tcl_StaticPackage -# endif -#endif +#include <windows.h> +#include <locale.h> #ifdef TCL_TEST -extern Tcl_LibraryInitProc Tcltest_Init; -extern Tcl_LibraryInitProc Tcltest_SafeInit; +extern Tcl_PackageInitProc Procbodytest_Init; +extern Tcl_PackageInitProc Procbodytest_SafeInit; +extern Tcl_PackageInitProc Tcltest_Init; +extern Tcl_PackageInitProc TclObjTest_Init; #endif /* TCL_TEST */ -#if defined(STATIC_BUILD) -extern Tcl_LibraryInitProc Registry_Init; -extern Tcl_LibraryInitProc Dde_Init; -extern Tcl_LibraryInitProc Dde_SafeInit; -#endif - -#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> -#if defined(__GNUC__) || defined(TCL_BROKEN_MAINARGS) +#if defined(__GNUC__) 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 +static void setargv(int *argcPtr, char ***argvPtr); +#endif /* __GNUC__ */ /* *---------------------------------------------------------------------- @@ -83,46 +36,53 @@ MODULE_SCOPE int TCL_LOCAL_MAIN_HOOK(int *argc, TCHAR ***argv); * This is the main program for the application. * * Results: - * None: Tcl_Main never returns here, so this procedure never returns + * None: Tcl_Main never returns here, so this function never returns * either. * * Side effects: - * Just about anything, since from here we call arbitrary Tcl code. + * Whatever the application does. * *---------------------------------------------------------------------- */ -#ifdef TCL_BROKEN_MAINARGS int main( - int argc, /* Number of command-line arguments. */ - char **argv1) /* Not used. */ -{ - TCHAR **argv; -#else -int -_tmain( - int argc, /* Number of command-line arguments. */ - TCHAR *argv[]) /* Values of command-line arguments. */ + int argc, + char *argv[]) { + /* + * The following #if block allows you to change the AppInit function by + * using a #define of TCL_LOCAL_APPINIT instead of rewriting this entire + * file. The #if checks for that #define and uses Tcl_AppInit if it + * doesn't exist. + */ + +#ifndef TCL_LOCAL_APPINIT +#define TCL_LOCAL_APPINIT Tcl_AppInit #endif - TCHAR *p; + extern int TCL_LOCAL_APPINIT (Tcl_Interp *interp); /* - * Set up the default locale to be standard "C" locale so parsing is - * performed correctly. + * The following #if block allows you to change how Tcl finds the startup + * script, prime the library or encoding paths, fiddle with the argv, + * etc., without needing to rewrite Tcl_Main() */ - setlocale(LC_ALL, "C"); +#ifdef TCL_LOCAL_MAIN_HOOK + extern int TCL_LOCAL_MAIN_HOOK (int *argc, char ***argv); +#endif + + char *p; -#ifdef TCL_BROKEN_MAINARGS /* - * Get our args from the c-runtime. Ignore command line. + * Set up the default locale to be standard "C" locale so parsing is + * performed correctly. */ - (void)argv1; - setargv(&argc, &argv); +#if defined(__GNUC__) + setargv( &argc, &argv ); #endif + setlocale(LC_ALL, "C"); /* * Forward slashes substituted for backslashes. @@ -136,12 +96,10 @@ _tmain( #ifdef TCL_LOCAL_MAIN_HOOK TCL_LOCAL_MAIN_HOOK(&argc, &argv); -#elif (TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6) && (!defined(_WIN32) || defined(UNICODE)) - /* New in Tcl 8.7. This doesn't work on Windows without UNICODE */ - TclZipfs_AppHook(&argc, &argv); #endif Tcl_Main(argc, argv, TCL_LOCAL_APPINIT); + return 0; /* Needed only to prevent compiler warning. */ } @@ -150,9 +108,9 @@ _tmain( * * Tcl_AppInit -- * - * This procedure performs application-specific initialization. Most + * This function performs application-specific initialization. Most * applications, especially those that incorporate additional packages, - * will have their own version of this procedure. + * will have their own version of this function. * * Results: * Returns a standard Tcl completion code, and leaves an error message in @@ -172,40 +130,53 @@ Tcl_AppInit( return TCL_ERROR; } -#if defined(STATIC_BUILD) - if (Registry_Init(interp) == TCL_ERROR) { +#ifdef TCL_TEST + if (Tcltest_Init(interp) == TCL_ERROR) { return TCL_ERROR; } - Tcl_StaticLibrary(interp, "Registry", Registry_Init, NULL); - - if (Dde_Init(interp) == TCL_ERROR) { + Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init, NULL); + if (TclObjTest_Init(interp) == TCL_ERROR) { return TCL_ERROR; } - Tcl_StaticLibrary(interp, "Dde", Dde_Init, Dde_SafeInit); -#endif - -#ifdef TCL_TEST - if (Tcltest_Init(interp) == TCL_ERROR) { + if (Procbodytest_Init(interp) == TCL_ERROR) { return TCL_ERROR; } - Tcl_StaticLibrary(interp, "Tcltest", Tcltest_Init, Tcltest_SafeInit); + Tcl_StaticPackage(interp, "procbodytest", Procbodytest_Init, + Procbodytest_SafeInit); #endif /* TCL_TEST */ +#if defined(STATIC_BUILD) && TCL_USE_STATIC_PACKAGES + { + extern Tcl_PackageInitProc Registry_Init; + extern Tcl_PackageInitProc Dde_Init; + extern Tcl_PackageInitProc Dde_SafeInit; + + if (Registry_Init(interp) == TCL_ERROR) { + return TCL_ERROR; + } + Tcl_StaticPackage(interp, "registry", Registry_Init, NULL); + + if (Dde_Init(interp) == TCL_ERROR) { + return TCL_ERROR; + } + Tcl_StaticPackage(interp, "dde", Dde_Init, Dde_SafeInit); + } +#endif + /* - * Call the init procedures for included packages. Each call should look + * Call the init functions for included packages. Each call should look * like this: * * if (Mod_Init(interp) == TCL_ERROR) { * return TCL_ERROR; * } * - * where "Mod" is the name of the module. (Dynamically-loadable packages - * should have the same entry-point name.) + * where "Mod" is the name of the module. */ /* - * Call Tcl_CreateObjCommand for application-specific commands, if they - * weren't already created by the init procedures called above. + * Call Tcl_CreateCommand for application-specific commands, if they + * weren't already created by the init functions called above. */ /* @@ -215,8 +186,7 @@ Tcl_AppInit( * user-specific startup file will be run under any conditions. */ - Tcl_ObjSetVar2(interp, Tcl_NewStringObj("tcl_rcFileName", TCL_INDEX_NONE), NULL, - Tcl_NewStringObj("~/tclshrc.tcl", TCL_INDEX_NONE), TCL_GLOBAL_ONLY); + Tcl_SetVar(interp, "tcl_rcFileName", "~/tclshrc.tcl", TCL_GLOBAL_ONLY); return TCL_OK; } @@ -247,17 +217,17 @@ Tcl_AppInit( *-------------------------------------------------------------------------- */ -#ifdef TCL_BROKEN_MAINARGS +#if defined(__GNUC__) static void setargv( int *argcPtr, /* Filled with number of argument strings. */ - TCHAR ***argvPtr) /* Filled with argument strings (malloc'd). */ + char ***argvPtr) /* Filled with argument strings (malloc'd). */ { - TCHAR *cmdLine, *p, *arg, *argSpace; - TCHAR **argv; + char *cmdLine, *p, *arg, *argSpace; + char **argv; int argc, size, inquote, copy, slashes; - cmdLine = GetCommandLine(); + cmdLine = GetCommandLine(); /* INTL: BUG */ /* * Precompute an overly pessimistic guess at the number of arguments in @@ -276,15 +246,10 @@ setargv( } } } - - /* Make sure we don't call ckalloc through the (not yet initialized) stub table */ -# undef Tcl_Alloc -# undef Tcl_DbCkalloc - - argSpace = (TCHAR *)ckalloc(size * sizeof(char *) - + (_tcslen(cmdLine) * sizeof(TCHAR)) + sizeof(TCHAR)); - argv = (TCHAR **) argSpace; - argSpace += size * (sizeof(char *)/sizeof(TCHAR)); + argSpace = (char *) ckalloc( + (unsigned) (size * sizeof(char *) + strlen(cmdLine) + 1)); + argv = (char **) argSpace; + argSpace += size * sizeof(char *); size--; p = cmdLine; @@ -342,7 +307,7 @@ setargv( *argcPtr = argc; *argvPtr = argv; } -#endif /* TCL_BROKEN_MAINARGS */ +#endif /* __GNUC__ */ /* * Local Variables: diff --git a/win/tclConfig.sh.in b/win/tclConfig.sh.in index 1c33246..75324b2 100644 --- a/win/tclConfig.sh.in +++ b/win/tclConfig.sh.in @@ -23,10 +23,9 @@ TCL_CC='@CC@' # -D flags for use with the C compiler. TCL_DEFS='@DEFS@' -# TCL_DBGX used to be used to distinguish debug vs. non-debug builds. -# This was a righteous pain so the core doesn't do that any more. -# DEPRECATED, will be removed in Tcl 9! -TCL_DBGX='' +# 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@' @@ -42,14 +41,14 @@ 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@' -# The name of a zip containing the /library and /encodings (may be either a .zip file or a shared library): -TCL_ZIP_FILE='@TCL_ZIP_FILE@' - # Flag to indicate whether shared libraries need export files. -TCL_NEEDS_EXP_FILE='' +TCL_NEEDS_EXP_FILE=@TCL_NEEDS_EXP_FILE@ -# Deprecated. Same as TCL_UNSHARED_LIB_SUFFIX -TCL_EXPORT_FILE_SUFFIX='@CFG_TCL_UNSHARED_LIB_SUFFIX@' +# 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@' @@ -78,7 +77,7 @@ TCL_SHLIB_LD='@SHLIB_LD@' 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.ac for more +# shared libraries) or an empty string. See Tcl's configure.in for more # explanation. TCL_SHLIB_LD_LIBS='@SHLIB_LD_LIBS@' @@ -93,11 +92,10 @@ TCL_DL_LIBS='@DL_LIBS@' # 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 +# Flags to pass to 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 @@ -126,7 +124,7 @@ TCL_INCLUDE_SPEC='@TCL_INCLUDE_SPEC@' # ("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='nodots' +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, @@ -177,8 +175,6 @@ 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@' -# Name of the zlib library that extensions should use -TCL_ZLIB_LIB_NAME='@TCL_ZLIB_LIB_NAME@' +# Flag, 1: we built Tcl with threads enabled, 0 we didn't +TCL_THREADS=@TCL_THREADS@ -# Name of the tommath library that extensions should use -TCL_TOMMATH_LIB_NAME='@TCL_TOMMATH_LIB_NAME@' diff --git a/win/tclUuid.h.in b/win/tclUuid.h.in deleted file mode 100644 index cbb83e4..0000000 --- a/win/tclUuid.h.in +++ /dev/null @@ -1 +0,0 @@ -#define TCL_VERSION_UUID \ diff --git a/win/tclWin32Dll.c b/win/tclWin32Dll.c index 7c3d8a4..e5e5202 100644 --- a/win/tclWin32Dll.c +++ b/win/tclWin32Dll.c @@ -4,17 +4,38 @@ * This file contains the DLL entry point and other low-level bit bashing * code that needs inline assembly. * - * Copyright © 1995-1996 Sun Microsystems, Inc. - * Copyright © 1998-2000 Scriptics Corporation. + * 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 + +#ifndef TCL_NO_STACK_CHECK +/* + * The following functions implement stack depth checking + */ +typedef struct ThreadSpecificData { + int *stackBound; /* The current stack boundary */ +} ThreadSpecificData; +static Tcl_ThreadDataKey dataKey; +#endif /* TCL_NO_STACK_CHECK */ + +/* + * The following data structures are used when loading the thunking library + * for execing child processes under Win32s. + */ + +typedef DWORD (WINAPI UT32PROC)(LPVOID lpBuff, DWORD dwUserDefined, + LPVOID *lpTranslationList); + +typedef BOOL (WINAPI UTREGISTER)(HANDLE hModule, LPCSTR SixteenBitDLL, + LPCSTR InitName, LPCSTR ProcName, UT32PROC **ThirtyTwoBitThunk, + FARPROC UT32Callback, LPVOID Buff); + +typedef VOID (WINAPI UTUNREGISTER)(HANDLE hModule); /* * The following variables keep track of information about this DLL on a @@ -23,13 +44,160 @@ */ 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) +#define cpuid __asm __emit 0fh __asm __emit 0a2h +#endif + +/* + * The following function tables are used to dispatch to either the + * wide-character or multi-byte versions of the operating system calls, + * depending on whether the Unicode calls are available. + */ + +static TclWinProcs asciiProcs = { + 0, + + (BOOL (WINAPI *)(CONST TCHAR *, LPDCB)) BuildCommDCBA, + (TCHAR *(WINAPI *)(TCHAR *)) CharLowerA, + (BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR *, BOOL)) CopyFileA, + (BOOL (WINAPI *)(CONST TCHAR *, LPSECURITY_ATTRIBUTES)) CreateDirectoryA, + (HANDLE (WINAPI *)(CONST TCHAR *, DWORD, DWORD, SECURITY_ATTRIBUTES *, + DWORD, DWORD, HANDLE)) CreateFileA, + (BOOL (WINAPI *)(CONST TCHAR *, TCHAR *, LPSECURITY_ATTRIBUTES, + LPSECURITY_ATTRIBUTES, BOOL, DWORD, LPVOID, CONST TCHAR *, + LPSTARTUPINFOA, LPPROCESS_INFORMATION)) CreateProcessA, + (BOOL (WINAPI *)(CONST TCHAR *)) DeleteFileA, + (HANDLE (WINAPI *)(CONST TCHAR *, WIN32_FIND_DATAT *)) FindFirstFileA, + (BOOL (WINAPI *)(HANDLE, WIN32_FIND_DATAT *)) FindNextFileA, + (BOOL (WINAPI *)(WCHAR *, LPDWORD)) GetComputerNameA, + (DWORD (WINAPI *)(DWORD, WCHAR *)) GetCurrentDirectoryA, + (DWORD (WINAPI *)(CONST TCHAR *)) GetFileAttributesA, + (DWORD (WINAPI *)(CONST TCHAR *, DWORD nBufferLength, WCHAR *, + TCHAR **)) GetFullPathNameA, + (DWORD (WINAPI *)(HMODULE, WCHAR *, int)) GetModuleFileNameA, + (DWORD (WINAPI *)(CONST TCHAR *, WCHAR *, DWORD)) GetShortPathNameA, + (UINT (WINAPI *)(CONST TCHAR *, CONST TCHAR *, UINT uUnique, + WCHAR *)) GetTempFileNameA, + (DWORD (WINAPI *)(DWORD, WCHAR *)) GetTempPathA, + (BOOL (WINAPI *)(CONST TCHAR *, WCHAR *, DWORD, LPDWORD, LPDWORD, LPDWORD, + WCHAR *, DWORD)) GetVolumeInformationA, + (HINSTANCE (WINAPI *)(CONST TCHAR *, HANDLE, DWORD)) LoadLibraryExA, + (TCHAR (WINAPI *)(WCHAR *, CONST TCHAR *)) lstrcpyA, + (BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR *)) MoveFileA, + (BOOL (WINAPI *)(CONST TCHAR *)) RemoveDirectoryA, + (DWORD (WINAPI *)(CONST TCHAR *, CONST TCHAR *, CONST TCHAR *, DWORD, + WCHAR *, TCHAR **)) SearchPathA, + (BOOL (WINAPI *)(CONST TCHAR *)) SetCurrentDirectoryA, + (BOOL (WINAPI *)(CONST TCHAR *, DWORD)) SetFileAttributesA, + + /* + * The three NULL function pointers will only be set when + * Tcl_FindExecutable is called. If you don't ever call that function, the + * application will crash whenever WinTcl tries to call functions through + * these null pointers. That is not a bug in Tcl - Tcl_FindExecutable is + * mandatory in recent Tcl releases. + */ + + NULL, + NULL, + /* deleted (int (__cdecl*)(CONST TCHAR *, struct _utimbuf *)) _utime, */ + NULL, + NULL, + /* getLongPathNameProc */ + NULL, + /* Security SDK - not available on 95,98,ME */ + NULL, NULL, NULL, NULL, NULL, NULL, + /* ReadConsole and WriteConsole */ + (BOOL (WINAPI *)(HANDLE, LPVOID, DWORD, LPDWORD, LPVOID)) ReadConsoleA, + (BOOL (WINAPI *)(HANDLE, const VOID*, DWORD, LPDWORD, LPVOID)) WriteConsoleA, + (BOOL (WINAPI *)(LPTSTR, LPDWORD)) GetUserNameA +}; + +static TclWinProcs unicodeProcs = { + 1, + + (BOOL (WINAPI *)(CONST TCHAR *, LPDCB)) BuildCommDCBW, + (TCHAR *(WINAPI *)(TCHAR *)) CharLowerW, + (BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR *, BOOL)) CopyFileW, + (BOOL (WINAPI *)(CONST TCHAR *, LPSECURITY_ATTRIBUTES)) CreateDirectoryW, + (HANDLE (WINAPI *)(CONST TCHAR *, DWORD, DWORD, SECURITY_ATTRIBUTES *, + DWORD, DWORD, HANDLE)) CreateFileW, + (BOOL (WINAPI *)(CONST TCHAR *, TCHAR *, LPSECURITY_ATTRIBUTES, + LPSECURITY_ATTRIBUTES, BOOL, DWORD, LPVOID, CONST TCHAR *, + LPSTARTUPINFOA, LPPROCESS_INFORMATION)) CreateProcessW, + (BOOL (WINAPI *)(CONST TCHAR *)) DeleteFileW, + (HANDLE (WINAPI *)(CONST TCHAR *, WIN32_FIND_DATAT *)) FindFirstFileW, + (BOOL (WINAPI *)(HANDLE, WIN32_FIND_DATAT *)) FindNextFileW, + (BOOL (WINAPI *)(WCHAR *, LPDWORD)) GetComputerNameW, + (DWORD (WINAPI *)(DWORD, WCHAR *)) GetCurrentDirectoryW, + (DWORD (WINAPI *)(CONST TCHAR *)) GetFileAttributesW, + (DWORD (WINAPI *)(CONST TCHAR *, DWORD nBufferLength, WCHAR *, + TCHAR **)) GetFullPathNameW, + (DWORD (WINAPI *)(HMODULE, WCHAR *, int)) GetModuleFileNameW, + (DWORD (WINAPI *)(CONST TCHAR *, WCHAR *, DWORD)) GetShortPathNameW, + (UINT (WINAPI *)(CONST TCHAR *, CONST TCHAR *, UINT uUnique, + WCHAR *)) GetTempFileNameW, + (DWORD (WINAPI *)(DWORD, WCHAR *)) GetTempPathW, + (BOOL (WINAPI *)(CONST TCHAR *, WCHAR *, DWORD, LPDWORD, LPDWORD, LPDWORD, + WCHAR *, DWORD)) GetVolumeInformationW, + (HINSTANCE (WINAPI *)(CONST TCHAR *, HANDLE, DWORD)) LoadLibraryExW, + (TCHAR (WINAPI *)(WCHAR *, CONST TCHAR *)) lstrcpyW, + (BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR *)) MoveFileW, + (BOOL (WINAPI *)(CONST TCHAR *)) RemoveDirectoryW, + (DWORD (WINAPI *)(CONST TCHAR *, CONST TCHAR *, CONST TCHAR *, DWORD, + WCHAR *, TCHAR **)) SearchPathW, + (BOOL (WINAPI *)(CONST TCHAR *)) SetCurrentDirectoryW, + (BOOL (WINAPI *)(CONST TCHAR *, DWORD)) SetFileAttributesW, + + /* + * The three NULL function pointers will only be set when + * Tcl_FindExecutable is called. If you don't ever call that function, the + * application will crash whenever WinTcl tries to call functions through + * these null pointers. That is not a bug in Tcl - Tcl_FindExecutable is + * mandatory in recent Tcl releases. + */ + + NULL, + NULL, + /* deleted (int (__cdecl*)(CONST TCHAR *, struct _utimbuf *)) _wutime, */ + NULL, + NULL, + /* getLongPathNameProc */ + NULL, + /* Security SDK - will be filled in on NT,XP,2000,2003 */ + NULL, NULL, NULL, NULL, NULL, NULL, + /* ReadConsole and WriteConsole */ + (BOOL (WINAPI *)(HANDLE, LPVOID, DWORD, LPDWORD, LPVOID)) ReadConsoleW, + (BOOL (WINAPI *)(HANDLE, const VOID*, DWORD, LPDWORD, LPVOID)) WriteConsoleW, + (BOOL (WINAPI *)(LPTSTR, LPDWORD)) GetUserNameW +}; + +TclWinProcs *tclWinProcs; +static Tcl_Encoding tclWinTCharEncoding; + +#ifdef HAVE_NO_SEH +/* + * Need to add noinline flag to DllMain declaration so that gcc -O3 does not + * inline asm code into DllEntryPoint and cause a compile time error because + * of redefined local labels. + */ + +BOOL APIENTRY DllMain(HINSTANCE hInst, DWORD reason, + LPVOID reserved) __attribute__ ((noinline)); +#else +/* * The following declaration is for the VC++ DLL entry point. */ BOOL APIENTRY DllMain(HINSTANCE hInst, DWORD reason, LPVOID reserved); +#endif /* HAVE_NO_SEH */ /* * The following structure and linked list is to allow us to map between @@ -38,8 +206,8 @@ BOOL APIENTRY DllMain(HINSTANCE hInst, DWORD reason, */ typedef struct MountPointMap { - WCHAR *volumeName; /* Native wide string volume name. */ - WCHAR driveLetter; /* Drive letter corresponding to the volume + CONST WCHAR *volumeName; /* Native wide string volume name. */ + char driveLetter; /* Drive letter corresponding to the volume * name. */ struct MountPointMap *nextPtr; /* Pointer to next structure in list, or @@ -58,7 +226,9 @@ TCL_DECLARE_MUTEX(mountPointMap) * We will need this below. */ -#ifdef _WIN32 +extern Tcl_FSDupInternalRepProc TclNativeDupInternalRep; + +#ifdef __WIN32__ #ifndef STATIC_BUILD /* @@ -82,7 +252,7 @@ BOOL APIENTRY DllEntryPoint( HINSTANCE hInst, /* Library instance handle. */ DWORD reason, /* Reason this function is being called. */ - LPVOID reserved) + LPVOID reserved) /* Not used. */ { return DllMain(hInst, reason, reserved); } @@ -100,7 +270,10 @@ DllEntryPoint( * TRUE on sucess, FALSE on failure. * * Side effects: - * Initializes most rudimentary Windows bits. + * Establishes 32-to-16 bit thunk and initializes sockets library. This + * might call some sycronization functions, but MSDN documentation + * states: "Waiting on synchronization objects in DllMain can cause a + * deadlock." * *---------------------------------------------------------------------- */ @@ -109,24 +282,113 @@ BOOL APIENTRY DllMain( HINSTANCE hInst, /* Library instance handle. */ DWORD reason, /* Reason this function is being called. */ - TCL_UNUSED(LPVOID)) + LPVOID reserved) /* Not used. */ { +#if defined(HAVE_NO_SEH) && !defined(_WIN64) + TCLEXCEPTION_REGISTRATION registration; +#endif + switch (reason) { case DLL_PROCESS_ATTACH: DisableThreadLibraryCalls(hInst); TclWinInit(hInst); return TRUE; + case DLL_PROCESS_DETACH: /* - * DLL_PROCESS_DETACH is unnecessary as the user should call - * Tcl_Finalize explicitly before unloading Tcl. + * Protect the call to Tcl_Finalize. The OS could be unloading us from + * an exception handler and the state of the stack might be unstable. */ + +#if defined(HAVE_NO_SEH) && !defined(_WIN64) + __asm__ __volatile__ ( + + /* + * Construct an TCLEXCEPTION_REGISTRATION to protect the call to + * Tcl_Finalize + */ + + "leal %[registration], %%edx" "\n\t" + "movl %%fs:0, %%eax" "\n\t" + "movl %%eax, 0x0(%%edx)" "\n\t" /* link */ + "leal 1f, %%eax" "\n\t" + "movl %%eax, 0x4(%%edx)" "\n\t" /* handler */ + "movl %%ebp, 0x8(%%edx)" "\n\t" /* ebp */ + "movl %%esp, 0xc(%%edx)" "\n\t" /* esp */ + "movl %[error], 0x10(%%edx)" "\n\t" /* status */ + + /* + * Link the TCLEXCEPTION_REGISTRATION on the chain + */ + + "movl %%edx, %%fs:0" "\n\t" + + /* + * Call Tcl_Finalize + */ + + "call _Tcl_Finalize" "\n\t" + + /* + * Come here on a normal exit. Recover the TCLEXCEPTION_REGISTRATION + * and store a TCL_OK status + */ + + "movl %%fs:0, %%edx" "\n\t" + "movl %[ok], %%eax" "\n\t" + "movl %%eax, 0x10(%%edx)" "\n\t" + "jmp 2f" "\n" + + /* + * Come here on an exception. Get the TCLEXCEPTION_REGISTRATION that + * we previously put on the chain. + */ + + "1:" "\t" + "movl %%fs:0, %%edx" "\n\t" + "movl 0x8(%%edx), %%edx" "\n" + + + /* + * Come here however we exited. Restore context from the + * TCLEXCEPTION_REGISTRATION in case the stack is unbalanced. + */ + + "2:" "\t" + "movl 0xc(%%edx), %%esp" "\n\t" + "movl 0x8(%%edx), %%ebp" "\n\t" + "movl 0x0(%%edx), %%eax" "\n\t" + "movl %%eax, %%fs:0" "\n\t" + + : + /* No outputs */ + : + [registration] "m" (registration), + [ok] "i" (TCL_OK), + [error] "i" (TCL_ERROR) + : + "%eax", "%ebx", "%ecx", "%edx", "%esi", "%edi", "memory" + ); + +#else +#ifndef HAVE_NO_SEH + __try { +#endif + Tcl_Finalize(); +#ifndef HAVE_NO_SEH + } __except (EXCEPTION_EXECUTE_HANDLER) { + /* empty handler body. */ + } +#endif +#endif + + break; } return TRUE; } #endif /* !STATIC_BUILD */ -#endif /* _WIN32 */ +#endif /* __WIN32__ */ /* *---------------------------------------------------------------------- @@ -175,15 +437,44 @@ TclWinInit( hInstance = hInst; os.dwOSVersionInfoSize = sizeof(OSVERSIONINFOW); GetVersionExW(&os); + platformId = os.dwPlatformId; /* - * We no longer support Win32s or Win9x or Windows CE or Windows XP, so just - * in case someone manages to get a runtime there, make sure they know that. + * We no longer support Win32s, so just in case someone manages to get a + * runtime there, make sure they know that. */ - if (os.dwPlatformId != VER_PLATFORM_WIN32_NT) { - Tcl_Panic("Windows 7 is the minimum supported platform"); + if (platformId == VER_PLATFORM_WIN32s) { + Tcl_Panic("Win32s is not a supported platform"); } + + tclWinProcs = &asciiProcs; +} + +/* + *---------------------------------------------------------------------- + * + * 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. + * VER_PLATFORM_WIN32_NT Win32 on Windows NT, 2000, XP + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +int +TclWinGetPlatformId(void) +{ + return platformId; } /* @@ -218,12 +509,95 @@ TclWinNoBackslash( } /* + *---------------------------------------------------------------------- + * + * TclpGetStackParams -- + * + * Determine the stack params for the current thread: in which + * direction does the stack grow, and what is the stack lower (resp. + * upper) bound for safe invocation of a new command? This is used to + * cache the values needed for an efficient computation of + * TclpCheckStackSpace() when the interp is known. + * + * Results: + * Returns 1 if the stack grows down, in which case a stack lower bound + * is stored at stackBoundPtr. If the stack grows up, 0 is returned and + * an upper bound is stored at stackBoundPtr. If a bound cannot be + * determined NULL is stored at stackBoundPtr. + * + *---------------------------------------------------------------------- + */ + +#ifndef TCL_NO_STACK_CHECK +int +TclpGetCStackParams( + int **stackBoundPtr) +{ + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + SYSTEM_INFO si; /* The system information, used to + * determine the page size */ + MEMORY_BASIC_INFORMATION mbi; + /* The information about the memory + * area in which the stack resides */ + + if (!tsdPtr->stackBound + || ((UINT_PTR)&tsdPtr < (UINT_PTR)tsdPtr->stackBound)) { + + /* + * Either we haven't determined the stack bound in this thread, + * or else we've overflowed the bound that we previously + * determined. We need to find a new stack bound from + * Windows. + */ + + GetSystemInfo(&si); + if (VirtualQuery((LPCVOID) &tsdPtr, &mbi, sizeof(mbi)) == 0) { + + /* For some reason, the system didn't let us query the + * stack size. Nevertheless, we got here and haven't + * blown up yet. Don't update the calculated stack bound. + * If there is no calculated stack bound yet, set it to + * the base of the current page of stack. */ + + if (!tsdPtr->stackBound) { + tsdPtr->stackBound = + (int*) ((UINT_PTR)(&tsdPtr) + & ~ (UINT_PTR)(si.dwPageSize - 1)); + } + + } else { + + /* The allocation base of the stack segment has to be advanced + * by one page (to allow for the guard page maintained in the + * C runtime) and then by TCL_WIN_STACK_THRESHOLD (to allow + * for the amount of stack that Tcl needs). + */ + + tsdPtr->stackBound = + (int*) ((UINT_PTR)(mbi.AllocationBase) + + (UINT_PTR)(si.dwPageSize) + + TCL_WIN_STACK_THRESHOLD); + } + } + *stackBoundPtr = tsdPtr->stackBound; + return 1; +} +#endif + + +/* *--------------------------------------------------------------------------- * - * TclWinEncodingsCleanup -- + * TclWinSetInterfaces -- * - * Called during finalization to clean up any memory allocated in our - * mount point map which is used to follow certain kinds of symlinks. + * A helper proc that allows the test library to change the tclWinProcs + * structure to dispatch to either the wide-character or multi-byte + * versions of the operating system calls, depending on whether Unicode + * is the system encoding. + * + * As well as this, we can also try to load in some additional procs + * which may/may not be present depending on the current Windows version + * (e.g. Win95 will not have the procs below). * * Results: * None. @@ -235,9 +609,137 @@ TclWinNoBackslash( */ void -TclWinEncodingsCleanup(void) +TclWinSetInterfaces( + int wide) /* Non-zero to use wide interfaces, 0 + * otherwise. */ +{ + Tcl_FreeEncoding(tclWinTCharEncoding); + + if (wide) { + tclWinProcs = &unicodeProcs; + tclWinTCharEncoding = Tcl_GetEncoding(NULL, "unicode"); + if (tclWinProcs->getFileAttributesExProc == NULL) { + HINSTANCE hInstance = LoadLibraryA("kernel32"); + if (hInstance != NULL) { + tclWinProcs->getFileAttributesExProc = + (BOOL (WINAPI *)(CONST TCHAR *, GET_FILEEX_INFO_LEVELS, + LPVOID)) GetProcAddress(hInstance, + "GetFileAttributesExW"); + tclWinProcs->createHardLinkProc = + (BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR*, + LPSECURITY_ATTRIBUTES)) GetProcAddress(hInstance, + "CreateHardLinkW"); + tclWinProcs->findFirstFileExProc = + (HANDLE (WINAPI *)(CONST TCHAR*, UINT, LPVOID, UINT, + LPVOID, DWORD)) GetProcAddress(hInstance, + "FindFirstFileExW"); + tclWinProcs->getVolumeNameForVMPProc = + (BOOL (WINAPI *)(CONST TCHAR*, TCHAR*, + DWORD)) GetProcAddress(hInstance, + "GetVolumeNameForVolumeMountPointW"); + tclWinProcs->getLongPathNameProc = + (DWORD (WINAPI *)(CONST TCHAR*, TCHAR*, + DWORD)) GetProcAddress(hInstance, "GetLongPathNameW"); + FreeLibrary(hInstance); + } + hInstance = LoadLibraryA("advapi32"); + if (hInstance != NULL) { + tclWinProcs->getFileSecurityProc = (BOOL (WINAPI *)( + LPCTSTR lpFileName, + SECURITY_INFORMATION RequestedInformation, + PSECURITY_DESCRIPTOR pSecurityDescriptor, + DWORD nLength, LPDWORD lpnLengthNeeded)) + GetProcAddress(hInstance, "GetFileSecurityW"); + tclWinProcs->impersonateSelfProc = (BOOL (WINAPI *) ( + SECURITY_IMPERSONATION_LEVEL ImpersonationLevel)) + GetProcAddress(hInstance, "ImpersonateSelf"); + tclWinProcs->openThreadTokenProc = (BOOL (WINAPI *) ( + HANDLE ThreadHandle, DWORD DesiredAccess, + BOOL OpenAsSelf, PHANDLE TokenHandle)) + GetProcAddress(hInstance, "OpenThreadToken"); + tclWinProcs->revertToSelfProc = (BOOL (WINAPI *) (void)) + GetProcAddress(hInstance, "RevertToSelf"); + tclWinProcs->mapGenericMaskProc = (VOID (WINAPI *) ( + PDWORD AccessMask, PGENERIC_MAPPING GenericMapping)) + GetProcAddress(hInstance, "MapGenericMask"); + tclWinProcs->accessCheckProc = (BOOL (WINAPI *)( + PSECURITY_DESCRIPTOR pSecurityDescriptor, + HANDLE ClientToken, DWORD DesiredAccess, + PGENERIC_MAPPING GenericMapping, + PPRIVILEGE_SET PrivilegeSet, + LPDWORD PrivilegeSetLength, LPDWORD GrantedAccess, + LPBOOL AccessStatus)) GetProcAddress(hInstance, + "AccessCheck"); + FreeLibrary(hInstance); + } + } + } else { + tclWinProcs = &asciiProcs; + tclWinTCharEncoding = NULL; + if (tclWinProcs->getFileAttributesExProc == NULL) { + HINSTANCE hInstance = LoadLibraryA("kernel32"); + if (hInstance != NULL) { + tclWinProcs->getFileAttributesExProc = + (BOOL (WINAPI *)(CONST TCHAR *, GET_FILEEX_INFO_LEVELS, + LPVOID)) GetProcAddress(hInstance, + "GetFileAttributesExA"); + tclWinProcs->createHardLinkProc = + (BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR*, + LPSECURITY_ATTRIBUTES)) GetProcAddress(hInstance, + "CreateHardLinkA"); + tclWinProcs->findFirstFileExProc = NULL; + tclWinProcs->getLongPathNameProc = NULL; + /* + * The 'findFirstFileExProc' function exists on some of + * 95/98/ME, but it seems not to work as anticipated. + * Therefore we don't set this function pointer. The relevant + * code will fall back on a slower approach using the normal + * findFirstFileProc. + * + * (HANDLE (WINAPI *)(CONST TCHAR*, UINT, + * LPVOID, UINT, LPVOID, DWORD)) GetProcAddress(hInstance, + * "FindFirstFileExA"); + */ + tclWinProcs->getVolumeNameForVMPProc = + (BOOL (WINAPI *)(CONST TCHAR*, TCHAR*, + DWORD)) GetProcAddress(hInstance, + "GetVolumeNameForVolumeMountPointA"); + FreeLibrary(hInstance); + } + } + } +} + +/* + *--------------------------------------------------------------------------- + * + * TclWinResetInterfaceEncodings -- + * + * Called during finalization to free up any encodings we use. The + * tclWinProcs-> look up table is still ok to use after this call, + * provided no encoding conversion is required. + * + * 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 +TclWinResetInterfaceEncodings(void) { MountPointMap *dlIter, *dlIter2; + if (tclWinTCharEncoding != NULL) { + Tcl_FreeEncoding(tclWinTCharEncoding); + tclWinTCharEncoding = NULL; + } /* * Clean up the mount point map. @@ -247,14 +749,37 @@ TclWinEncodingsCleanup(void) dlIter = driveLetterLookup; while (dlIter != NULL) { dlIter2 = dlIter->nextPtr; - ckfree(dlIter->volumeName); - ckfree(dlIter); + ckfree((char*)dlIter->volumeName); + ckfree((char*)dlIter); dlIter = dlIter2; } Tcl_MutexUnlock(&mountPointMap); } /* + *--------------------------------------------------------------------------- + * + * TclWinResetInterfaces -- + * + * Called during finalization to reset us to a safe state for reuse. + * After this call, it is best not to use the tclWinProcs-> look up table + * since it is likely to be different to what is expected. + * + * Results: + * None. + * + * Side effects: + * None. + * + *--------------------------------------------------------------------------- + */ +void +TclWinResetInterfaces(void) +{ + tclWinProcs = &asciiProcs; +} + +/* *-------------------------------------------------------------------- * * TclWinDriveLetterForVolMountPoint @@ -278,11 +803,11 @@ TclWinEncodingsCleanup(void) char TclWinDriveLetterForVolMountPoint( - const WCHAR *mountPoint) + CONST WCHAR *mountPoint) { MountPointMap *dlIter, *dlPtr2; WCHAR Target[55]; /* Target of mount at mount point */ - WCHAR drive[4] = L"A:\\"; + WCHAR drive[4] = { L'A', L':', L'\\', L'\0' }; /* * Detect the volume mounted there. Unfortunately, there is no simple way @@ -300,21 +825,21 @@ TclWinDriveLetterForVolMountPoint( * mount points on the fly. */ - drive[0] = (WCHAR) dlIter->driveLetter; + drive[0] = L'A' + (dlIter->driveLetter - 'A'); /* * Try to read the volume mount point and see where it points. */ - if (GetVolumeNameForVolumeMountPointW(drive, - Target, 55) != 0) { - if (wcscmp(dlIter->volumeName, Target) == 0) { + if ((*tclWinProcs->getVolumeNameForVMPProc)((TCHAR*)drive, + (TCHAR*)Target, 55) != 0) { + if (wcscmp((WCHAR*)dlIter->volumeName, Target) == 0) { /* * Nothing has changed. */ Tcl_MutexUnlock(&mountPointMap); - return (char) dlIter->driveLetter; + return dlIter->driveLetter; } } @@ -341,8 +866,8 @@ TclWinDriveLetterForVolMountPoint( * Now dlPtr2 points to the structure to free. */ - ckfree(dlPtr2->volumeName); - ckfree(dlPtr2); + ckfree((char*)dlPtr2->volumeName); + ckfree((char*)dlPtr2); /* * Restart the loop - we could try to be clever and continue half @@ -360,28 +885,28 @@ TclWinDriveLetterForVolMountPoint( * We couldn't find it, so we must iterate over the letters. */ - for (drive[0] = 'A'; drive[0] <= 'Z'; drive[0]++) { + 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) { + if ((*tclWinProcs->getVolumeNameForVMPProc)((TCHAR*)drive, + (TCHAR*)Target, 55) != 0) { int alreadyStored = 0; for (dlIter = driveLetterLookup; dlIter != NULL; dlIter = dlIter->nextPtr) { - if (wcscmp(dlIter->volumeName, Target) == 0) { + if (wcscmp((WCHAR*)dlIter->volumeName, Target) == 0) { alreadyStored = 1; break; } } if (!alreadyStored) { - dlPtr2 = (MountPointMap *)ckalloc(sizeof(MountPointMap)); - dlPtr2->volumeName = (WCHAR *)TclNativeDupInternalRep(Target); - dlPtr2->driveLetter = (WCHAR) drive[0]; + dlPtr2 = (MountPointMap *) ckalloc(sizeof(MountPointMap)); + dlPtr2->volumeName = TclNativeDupInternalRep(Target); + dlPtr2->driveLetter = 'A' + (drive[0] - L'A'); dlPtr2->nextPtr = driveLetterLookup; - driveLetterLookup = dlPtr2; + driveLetterLookup = dlPtr2; } } } @@ -394,7 +919,7 @@ TclWinDriveLetterForVolMountPoint( dlIter = dlIter->nextPtr) { if (wcscmp(dlIter->volumeName, mountPoint) == 0) { Tcl_MutexUnlock(&mountPointMap); - return (char) dlIter->driveLetter; + return dlIter->driveLetter; } } @@ -403,11 +928,11 @@ TclWinDriveLetterForVolMountPoint( * that fact and store '-1' so we don't have to look it up each time. */ - dlPtr2 = (MountPointMap *)ckalloc(sizeof(MountPointMap)); - dlPtr2->volumeName = (WCHAR *)TclNativeDupInternalRep((void *)mountPoint); - dlPtr2->driveLetter = (WCHAR)-1; + dlPtr2 = (MountPointMap*) ckalloc(sizeof(MountPointMap)); + dlPtr2->volumeName = TclNativeDupInternalRep((ClientData)mountPoint); + dlPtr2->driveLetter = -1; dlPtr2->nextPtr = driveLetterLookup; - driveLetterLookup = dlPtr2; + driveLetterLookup = dlPtr2; Tcl_MutexUnlock(&mountPointMap); return -1; } @@ -417,32 +942,39 @@ TclWinDriveLetterForVolMountPoint( * * Tcl_WinUtfToTChar, Tcl_WinTCharToUtf -- * - * Convert between UTF-8 and Unicode when running Windows. + * Convert between UTF-8 and Unicode when running Windows NT or the + * current ANSI code page when running Windows 95. * - * 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 Mac, Unix, and Windows 95, all strings exchanged between Tcl and + * the OS are "char" oriented. We need only one Tcl_Encoding to convert + * between UTF-8 and the system's native encoding. We use NULL to + * represent that encoding. * - * On Windows, some strings exchanged between Tcl and the OS are "char" + * On NT, some strings exchanged between Tcl and the OS are "char" * oriented, while others are in Unicode. We need two Tcl_Encoding APIs * depending on whether we are targeting a "char" or Unicode interface. * - * Calling Tcl_UtfToExternal() or Tcl_ExternalToUtf() with an encoding - * of NULL should always used to convert between UTF-8 and the system's + * 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 + * Windows-specific code to convert between UTF-8 and Unicode strings + * (NT) or "char" strings(95). This saves you the trouble of writing the * following type of fragment over and over: * - * encoding <- Tcl_GetEncoding("unicode"); - * nativeBuffer <- UtfToExternal(encoding, utfBuffer); - * Tcl_FreeEncoding(encoding); + * if (running NT) { + * encoding <- Tcl_GetEncoding("unicode"); + * nativeBuffer <- UtfToExternal(encoding, utfBuffer); + * Tcl_FreeEncoding(encoding); + * } else { + * nativeBuffer <- UtfToExternal(NULL, utfBuffer); + * } * - * 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. + * By convention, in Windows a TCHAR is a character in the ANSI code page + * on Windows 95, a Unicode character on Windows NT. If you plan on + * targeting a Unicode interfaces when running on NT and a "char" + * oriented interface while running on 95, these functions should be + * used. If you plan on targetting the same "char" oriented function on + * both 95 and NT, use Tcl_UtfToExternal() with an encoding of NULL. * * Results: * The result is a pointer to the string in the desired target encoding. @@ -455,32 +987,30 @@ TclWinDriveLetterForVolMountPoint( *--------------------------------------------------------------------------- */ -#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 -#undef Tcl_WinUtfToTChar TCHAR * Tcl_WinUtfToTChar( - const char *string, /* Source string in UTF-8. */ - int len, /* Source string length in bytes, or -1 for + CONST char *string, /* Source string in UTF-8. */ + int len, /* Source string length in bytes, or < 0 for * strlen(). */ Tcl_DString *dsPtr) /* Uninitialized or free DString in which the * converted string is stored. */ { - Tcl_DStringInit(dsPtr); - return (TCHAR *)Tcl_UtfToWCharDString(string, len, dsPtr); + return (TCHAR *) Tcl_UtfToExternalDString(tclWinTCharEncoding, + string, len, dsPtr); } -#undef Tcl_WinTCharToUtf + char * Tcl_WinTCharToUtf( - const TCHAR *string, /* Source string in Unicode. */ - int len, /* Source string length in bytes, or -1 for + CONST TCHAR *string, /* Source string in Unicode when running NT, + * ANSI when running 95. */ + int len, /* Source string length in bytes, or < 0 for * platform-specific string length. */ Tcl_DString *dsPtr) /* Uninitialized or free DString in which the * converted string is stored. */ { - Tcl_DStringInit(dsPtr); - return Tcl_WCharToUtfDString((WCHAR *)string, len >> 1, dsPtr); + return Tcl_ExternalToUtfDString(tclWinTCharEncoding, + (CONST char *) string, len, dsPtr); } -#endif /* !defined(TCL_NO_DEPRECATED) */ /* *------------------------------------------------------------------------ @@ -502,21 +1032,16 @@ Tcl_WinTCharToUtf( int TclWinCPUID( - int index, /* Which CPUID value to retrieve. */ - int *regsPtr) /* Registers after the CPUID. */ + 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) && defined(HAVE_CPUID) - - __cpuid((int *)regsPtr, index); - status = TCL_OK; - -#elif defined(__GNUC__) && defined(HAVE_CPUID) +#if defined(__GNUC__) # if defined(_WIN64) /* * Execute the CPUID instruction with the given index, and store results - * off 'regPtr'. + * off 'regsPtr'. */ __asm__ __volatile__( @@ -531,7 +1056,7 @@ TclWinCPUID( "movl %%eax, 0x0(%%edi)" "\n\t" "movl %%ebx, 0x4(%%edi)" "\n\t" "movl %%ecx, 0x8(%%edi)" "\n\t" - "movl %%edx, 0xC(%%edi)" "\n\t" + "movl %%edx, 0xc(%%edi)" "\n\t" : /* No outputs */ @@ -563,7 +1088,7 @@ TclWinCPUID( "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 %%esp, 0xc(%%edx)" "\n\t" /* esp */ "movl %[error], 0x10(%%edx)" "\n\t" /* status */ /* @@ -583,7 +1108,7 @@ TclWinCPUID( "movl %%eax, 0x0(%%edi)" "\n\t" "movl %%ebx, 0x4(%%edi)" "\n\t" "movl %%ecx, 0x8(%%edi)" "\n\t" - "movl %%edx, 0xC(%%edi)" "\n\t" + "movl %%edx, 0xc(%%edi)" "\n\t" /* * Come here on a normal exit. Recover the TCLEXCEPTION_REGISTRATION and @@ -610,7 +1135,7 @@ TclWinCPUID( */ "2:" "\t" - "movl 0xC(%%edx), %%esp" "\n\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" @@ -628,13 +1153,13 @@ TclWinCPUID( status = registration.status; # endif /* !_WIN64 */ -#elif defined(_MSC_VER) && defined(HAVE_CPUID) +#elif defined(_MSC_VER) # if defined(_WIN64) __cpuid(regsPtr, index); status = TCL_OK; -# elif defined (_M_IX86) +# else /* * Define a structure in the stack frame to hold the registers. */ @@ -683,8 +1208,6 @@ TclWinCPUID( # endif #else - (void)index; - (void)regsPtr; /* * Don't know how to do assembly code for this compiler and/or * architecture. diff --git a/win/tclWinChan.c b/win/tclWinChan.c index 9b018e4..a271919 100644 --- a/win/tclWinChan.c +++ b/win/tclWinChan.c @@ -4,7 +4,7 @@ * Channel drivers for Windows channels based on files, command pipes and * TCP sockets. * - * Copyright © 1995-1997 Sun Microsystems, Inc. + * 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. @@ -25,8 +25,7 @@ #define FILE_TYPE_CONSOLE (FILE_TYPE_PIPE+2) /* - * The following structure contains per-instance data for a file based - * channel. + * The following structure contains per-instance data for a file based channel. */ typedef struct FileInfo { @@ -44,7 +43,7 @@ typedef struct FileInfo { * pending on the channel. */ } FileInfo; -typedef struct { +typedef struct ThreadSpecificData { /* * List of all file channels currently open. */ @@ -59,7 +58,7 @@ static Tcl_ThreadDataKey dataKey; * events are generated. */ -typedef struct { +typedef struct FileEvent { Tcl_Event header; /* Information that is standard for all * events. */ FileInfo *infoPtr; /* Pointer to file info structure. Note that @@ -72,110 +71,54 @@ typedef struct { * Static routines for this file: */ -static int FileBlockProc(void *instanceData, int mode); -static void FileChannelExitHandler(void *clientData); -static void FileCheckProc(void *clientData, int flags); -static int FileCloseProc(void *instanceData, - Tcl_Interp *interp, int flags); +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(void *instanceData, - int direction, void **handlePtr); -static int FileGetOptionProc(void *instanceData, - Tcl_Interp *interp, const char *optionName, - Tcl_DString *dsPtr); +static int FileGetHandleProc(ClientData instanceData, + int direction, ClientData *handlePtr); static ThreadSpecificData *FileInit(void); -static int FileInputProc(void *instanceData, char *buf, +static int FileInputProc(ClientData instanceData, char *buf, int toRead, int *errorCode); -static int FileOutputProc(void *instanceData, - const char *buf, int toWrite, int *errorCode); -#ifndef TCL_NO_DEPRECATED -static int FileSeekProc(void *instanceData, long offset, +static int FileOutputProc(ClientData instanceData, + CONST char *buf, int toWrite, int *errorCode); +static int FileSeekProc(ClientData instanceData, long offset, int mode, int *errorCode); -#endif -static long long FileWideSeekProc(void *instanceData, - long long offset, int mode, int *errorCode); -static void FileSetupProc(void *clientData, int flags); -static void FileWatchProc(void *instanceData, int mask); -static void FileThreadActionProc(void *instanceData, +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(void *instanceData, - long long length); +static int FileTruncateProc(ClientData instanceData, + Tcl_WideInt length); static DWORD FileGetType(HANDLE handle); -static int NativeIsComPort(const WCHAR *nativeName); -static Tcl_Channel OpenFileChannel(HANDLE handle, char *channelName, - int permissions, int appendMode); - +static int NativeIsComPort(CONST TCHAR *nativeName); /* * This structure describes the channel type structure for file based IO. */ -static const Tcl_ChannelType fileChannelType = { +static Tcl_ChannelType fileChannelType = { "file", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ - TCL_CLOSE2PROC, /* Close proc. */ + FileCloseProc, /* Close proc. */ FileInputProc, /* Input proc. */ FileOutputProc, /* Output proc. */ -#ifndef TCL_NO_DEPRECATED FileSeekProc, /* Seek proc. */ -#else - NULL, -#endif NULL, /* Set option proc. */ - FileGetOptionProc, /* Get option proc. */ + NULL, /* Get option proc. */ FileWatchProc, /* Set up the notifier to watch the channel. */ FileGetHandleProc, /* Get an OS handle from channel. */ - FileCloseProc, /* close2proc. */ + 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. */ + FileTruncateProc, /* Truncate proc. */ }; - -/* - * General useful clarification macros. - */ - -#define SET_FLAG(var, flag) ((var) |= (flag)) -#define CLEAR_FLAG(var, flag) ((var) &= ~(flag)) -#define TEST_FLAG(value, flag) (((value) & (flag)) != 0) - -/* - * 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 \ - ((long long) 116444736 * (long long) 1000000000) - - -/* - *---------------------------------------------------------------------- - * - * TclWinGenerateChannelName -- - * - * This function generates names for channels. - * - * Results: - * None. - * - * Side effects: - * Creates a new window and creates an exit handler. - * - *---------------------------------------------------------------------- - */ -void -TclWinGenerateChannelName( - char channelName[], /* Buffer to accept the name. */ - const char *channelTypeName,/* Name of type of channel. */ - void *channelImpl) /* Pointer to channel implementation - * structure, used to generate a unique - * ID. */ -{ - snprintf(channelName, 16 + TCL_INTEGER_SPACE, "%s%" TCL_Z_MODIFIER "x", - channelTypeName, (size_t) channelImpl); -} /* *---------------------------------------------------------------------- @@ -197,7 +140,7 @@ static ThreadSpecificData * FileInit(void) { ThreadSpecificData *tsdPtr = - (ThreadSpecificData *) TclThreadDataKeyGet(&dataKey); + (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); if (tsdPtr == NULL) { tsdPtr = TCL_TSD_INIT(&dataKey); @@ -227,7 +170,7 @@ FileInit(void) static void FileChannelExitHandler( - TCL_UNUSED(void *)) + ClientData clientData) /* Old window proc */ { Tcl_DeleteEventSource(FileSetupProc, FileCheckProc, NULL); } @@ -251,14 +194,14 @@ FileChannelExitHandler( void FileSetupProc( - TCL_UNUSED(void *), + 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 (!TEST_FLAG(flags, TCL_FILE_EVENTS)) { + if (!(flags & TCL_FILE_EVENTS)) { return; } @@ -294,14 +237,14 @@ FileSetupProc( static void FileCheckProc( - TCL_UNUSED(void *), + ClientData data, /* Not used. */ int flags) /* Event flags as passed to Tcl_DoOneEvent. */ { FileEvent *evPtr; FileInfo *infoPtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - if (!TEST_FLAG(flags, TCL_FILE_EVENTS)) { + if (!(flags & TCL_FILE_EVENTS)) { return; } @@ -312,9 +255,9 @@ FileCheckProc( for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL; infoPtr = infoPtr->nextPtr) { - if (infoPtr->watchMask && !TEST_FLAG(infoPtr->flags, FILE_PENDING)) { - SET_FLAG(infoPtr->flags, FILE_PENDING); - evPtr = (FileEvent *)ckalloc(sizeof(FileEvent)); + if (infoPtr->watchMask && !(infoPtr->flags & FILE_PENDING)) { + infoPtr->flags |= FILE_PENDING; + evPtr = (FileEvent *) ckalloc(sizeof(FileEvent)); evPtr->header.proc = FileEventProc; evPtr->infoPtr = infoPtr; Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL); @@ -353,7 +296,7 @@ FileEventProc( FileInfo *infoPtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - if (!TEST_FLAG(flags, TCL_FILE_EVENTS)) { + if (!(flags & TCL_FILE_EVENTS)) { return 0; } @@ -367,7 +310,7 @@ FileEventProc( for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL; infoPtr = infoPtr->nextPtr) { if (fileEvPtr->infoPtr == infoPtr) { - CLEAR_FLAG(infoPtr->flags, FILE_PENDING); + infoPtr->flags &= ~(FILE_PENDING); Tcl_NotifyChannel(infoPtr->channel, infoPtr->watchMask); break; } @@ -393,11 +336,11 @@ FileEventProc( static int FileBlockProc( - void *instanceData, /* Instance data for channel. */ + ClientData instanceData, /* Instance data for channel. */ int mode) /* TCL_MODE_BLOCKING or * TCL_MODE_NONBLOCKING. */ { - FileInfo *infoPtr = (FileInfo *)instanceData; + FileInfo *infoPtr = (FileInfo *) instanceData; /* * Files on Windows can not be switched between blocking and nonblocking, @@ -407,9 +350,9 @@ FileBlockProc( */ if (mode == TCL_MODE_NONBLOCKING) { - SET_FLAG(infoPtr->flags, FILE_ASYNC); + infoPtr->flags |= FILE_ASYNC; } else { - CLEAR_FLAG(infoPtr->flags, FILE_ASYNC); + infoPtr->flags &= ~(FILE_ASYNC); } return 0; } @@ -432,19 +375,14 @@ FileBlockProc( static int FileCloseProc( - void *instanceData, /* Pointer to FileInfo structure. */ - TCL_UNUSED(Tcl_Interp *), - int flags) + ClientData instanceData, /* Pointer to FileInfo structure. */ + Tcl_Interp *interp) /* Not used. */ { - FileInfo *fileInfoPtr = (FileInfo *)instanceData; + FileInfo *fileInfoPtr = (FileInfo *) instanceData; FileInfo *infoPtr; ThreadSpecificData *tsdPtr; int errorCode = 0; - if ((flags & (TCL_CLOSE_READ | TCL_CLOSE_WRITE)) != 0) { - return EINVAL; - } - /* * Remove the file from the watch list. */ @@ -462,7 +400,7 @@ FileCloseProc( && (GetStdHandle(STD_OUTPUT_HANDLE) != fileInfoPtr->handle) && (GetStdHandle(STD_ERROR_HANDLE) != fileInfoPtr->handle))) { if (CloseHandle(fileInfoPtr->handle) == FALSE) { - Tcl_WinConvertError(GetLastError()); + TclWinConvertError(GetLastError()); errorCode = errno; } } @@ -486,7 +424,7 @@ FileCloseProc( break; } } - ckfree(fileInfoPtr); + ckfree((char *)fileInfoPtr); return errorCode; } @@ -507,15 +445,15 @@ FileCloseProc( * *---------------------------------------------------------------------- */ -#ifndef TCL_NO_DEPRECATED + static int FileSeekProc( - void *instanceData, /* File state. */ + ClientData instanceData, /* File state. */ long offset, /* Offset to seek to. */ int mode, /* Relative to where should we seek? */ int *errorCodePtr) /* To store error code. */ { - FileInfo *infoPtr = (FileInfo *)instanceData; + FileInfo *infoPtr = (FileInfo *) instanceData; LONG newPos, newPosHigh, oldPos, oldPosHigh; DWORD moveMethod; @@ -534,11 +472,11 @@ FileSeekProc( oldPosHigh = 0; oldPos = SetFilePointer(infoPtr->handle, 0, &oldPosHigh, FILE_CURRENT); - if (oldPos == (LONG) INVALID_SET_FILE_POINTER) { + if (oldPos == (LONG)INVALID_SET_FILE_POINTER) { DWORD winError = GetLastError(); if (winError != NO_ERROR) { - Tcl_WinConvertError(winError); + TclWinConvertError(winError); *errorCodePtr = errno; return -1; } @@ -546,11 +484,11 @@ FileSeekProc( newPosHigh = (offset < 0 ? -1 : 0); newPos = SetFilePointer(infoPtr->handle, offset, &newPosHigh, moveMethod); - if (newPos == (LONG) INVALID_SET_FILE_POINTER) { + if (newPos == (LONG)INVALID_SET_FILE_POINTER) { DWORD winError = GetLastError(); if (winError != NO_ERROR) { - Tcl_WinConvertError(winError); + TclWinConvertError(winError); *errorCodePtr = errno; return -1; } @@ -567,7 +505,6 @@ FileSeekProc( } return (int) newPos; } -#endif /* *---------------------------------------------------------------------- @@ -587,14 +524,14 @@ FileSeekProc( *---------------------------------------------------------------------- */ -static long long +static Tcl_WideInt FileWideSeekProc( - void *instanceData, /* File state. */ - long long offset, /* Offset to seek to. */ + ClientData instanceData, /* File state. */ + Tcl_WideInt offset, /* Offset to seek to. */ int mode, /* Relative to where should we seek? */ int *errorCodePtr) /* To store error code. */ { - FileInfo *infoPtr = (FileInfo *)instanceData; + FileInfo *infoPtr = (FileInfo *) instanceData; DWORD moveMethod; LONG newPos, newPosHigh; @@ -607,20 +544,19 @@ FileWideSeekProc( moveMethod = FILE_END; } - newPosHigh = (LONG)(offset >> 32); - newPos = SetFilePointer(infoPtr->handle, (LONG)offset, + newPosHigh = Tcl_WideAsLong(offset >> 32); + newPos = SetFilePointer(infoPtr->handle, Tcl_WideAsLong(offset), &newPosHigh, moveMethod); - if (newPos == (LONG) INVALID_SET_FILE_POINTER) { + if (newPos == (LONG)INVALID_SET_FILE_POINTER) { DWORD winError = GetLastError(); if (winError != NO_ERROR) { - Tcl_WinConvertError(winError); + TclWinConvertError(winError); *errorCodePtr = errno; return -1; } } - return (((long long)((unsigned)newPos)) - | ((long long)newPosHigh << 32)); + return (((Tcl_WideInt)((unsigned)newPos)) | (Tcl_LongAsWide(newPosHigh) << 32)); } /* @@ -641,10 +577,10 @@ FileWideSeekProc( static int FileTruncateProc( - void *instanceData, /* File state. */ - long long length) /* Length to truncate at. */ + ClientData instanceData, /* File state. */ + Tcl_WideInt length) /* Length to truncate at. */ { - FileInfo *infoPtr = (FileInfo *)instanceData; + FileInfo *infoPtr = (FileInfo *) instanceData; LONG newPos, newPosHigh, oldPos, oldPosHigh; /* @@ -653,11 +589,10 @@ FileTruncateProc( oldPosHigh = 0; oldPos = SetFilePointer(infoPtr->handle, 0, &oldPosHigh, FILE_CURRENT); - if (oldPos == (LONG) INVALID_SET_FILE_POINTER) { + if (oldPos == (LONG)INVALID_SET_FILE_POINTER) { DWORD winError = GetLastError(); - if (winError != NO_ERROR) { - Tcl_WinConvertError(winError); + TclWinConvertError(winError); return errno; } } @@ -666,14 +601,13 @@ FileTruncateProc( * Move to where we want to truncate */ - newPosHigh = (LONG)(length >> 32); - newPos = SetFilePointer(infoPtr->handle, (LONG)length, + newPosHigh = Tcl_WideAsLong(length >> 32); + newPos = SetFilePointer(infoPtr->handle, Tcl_WideAsLong(length), &newPosHigh, FILE_BEGIN); - if (newPos == (LONG) INVALID_SET_FILE_POINTER) { + if (newPos == (LONG)INVALID_SET_FILE_POINTER) { DWORD winError = GetLastError(); - if (winError != NO_ERROR) { - Tcl_WinConvertError(winError); + TclWinConvertError(winError); return errno; } } @@ -684,7 +618,7 @@ FileTruncateProc( */ if (!SetEndOfFile(infoPtr->handle)) { - Tcl_WinConvertError(GetLastError()); + TclWinConvertError(GetLastError()); return errno; } @@ -717,21 +651,18 @@ FileTruncateProc( static int FileInputProc( - void *instanceData, /* File state. */ + 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 = (FileInfo *)instanceData; + FileInfo *infoPtr; DWORD bytesRead; *errorCode = 0; + infoPtr = (FileInfo *) instanceData; /* - * TODO: This comment appears to be out of date. We *do* have a console - * driver, over in tclWinConsole.c. After some Windows developer confirms, - * this comment should be revised. - * * Note that we will block on reads from a console buffer until a full * line has been entered. The only way I know of to get around this is to * write a console driver. We should probably do this at some point, but @@ -741,10 +672,10 @@ FileInputProc( if (ReadFile(infoPtr->handle, (LPVOID) buf, (DWORD) bufSize, &bytesRead, (LPOVERLAPPED) NULL) != FALSE) { - return (int)bytesRead; + return bytesRead; } - Tcl_WinConvertError(GetLastError()); + TclWinConvertError(GetLastError()); *errorCode = errno; if (errno == EPIPE) { return 0; @@ -772,12 +703,12 @@ FileInputProc( static int FileOutputProc( - void *instanceData, /* File state. */ - const char *buf, /* The data buffer. */ + ClientData instanceData, /* File state. */ + CONST char *buf, /* The data buffer. */ int toWrite, /* How many bytes to write? */ int *errorCode) /* Where to store error code. */ { - FileInfo *infoPtr = (FileInfo *)instanceData; + FileInfo *infoPtr = (FileInfo *) instanceData; DWORD bytesWritten; *errorCode = 0; @@ -787,18 +718,18 @@ FileOutputProc( * seek to the end of the file before writing the current buffer. */ - if (TEST_FLAG(infoPtr->flags, FILE_APPEND)) { + if (infoPtr->flags & FILE_APPEND) { SetFilePointer(infoPtr->handle, 0, NULL, FILE_END); } if (WriteFile(infoPtr->handle, (LPVOID) buf, (DWORD) toWrite, &bytesWritten, (LPOVERLAPPED) NULL) == FALSE) { - Tcl_WinConvertError(GetLastError()); + TclWinConvertError(GetLastError()); *errorCode = errno; return -1; } infoPtr->dirty = 1; - return (int)bytesWritten; + return bytesWritten; } /* @@ -819,12 +750,12 @@ FileOutputProc( static void FileWatchProc( - void *instanceData, /* File state. */ + ClientData instanceData, /* File state. */ int mask) /* What events to watch for; OR-ed combination * of TCL_READABLE, TCL_WRITABLE and * TCL_EXCEPTION. */ { - FileInfo *infoPtr = (FileInfo *)instanceData; + FileInfo *infoPtr = (FileInfo *) instanceData; Tcl_Time blockTime = { 0, 0 }; /* @@ -858,207 +789,18 @@ FileWatchProc( static int FileGetHandleProc( - void *instanceData, /* The file state. */ + ClientData instanceData, /* The file state. */ int direction, /* TCL_READABLE or TCL_WRITABLE */ - void **handlePtr) /* Where to store the handle. */ -{ - FileInfo *infoPtr = (FileInfo *)instanceData; - - if (!TEST_FLAG(direction, infoPtr->validMask)) { - return TCL_ERROR; - } - - *handlePtr = (void *)infoPtr->handle; - return TCL_OK; -} - -/* - *---------------------------------------------------------------------- - * - * FileGetOptionProc -- - * - * Gets an option associated with an open file. 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. Sets error message if needed - * (by calling Tcl_BadChannelOption). - * - *---------------------------------------------------------------------- - */ - -static inline ULONGLONG -CombineDwords( - DWORD hi, - DWORD lo) -{ - ULARGE_INTEGER converter; - - converter.LowPart = lo; - converter.HighPart = hi; - return converter.QuadPart; -} - -static inline void -StoreElementInDict( - Tcl_Obj *dictObj, - const char *name, - Tcl_Obj *valueObj) -{ - /* - * We assume that the dict is being built fresh and that there's never any - * duplicate keys. - */ - - Tcl_Obj *nameObj = Tcl_NewStringObj(name, TCL_INDEX_NONE); - Tcl_DictObjPut(NULL, dictObj, nameObj, valueObj); -} - -static inline time_t -ToCTime( - FILETIME fileTime) /* UTC time */ -{ - LARGE_INTEGER convertedTime; - - convertedTime.LowPart = fileTime.dwLowDateTime; - convertedTime.HighPart = (LONG) fileTime.dwHighDateTime; - - return (time_t) ((convertedTime.QuadPart - - (long long) POSIX_EPOCH_AS_FILETIME) / (long long) 10000000); -} - -static Tcl_Obj * -StatOpenFile( - FileInfo *infoPtr) -{ - DWORD attr; - int dev, nlink = 1; - unsigned short mode; - unsigned long long size, inode; - long long atime, ctime, mtime; - BY_HANDLE_FILE_INFORMATION data; - Tcl_Obj *dictObj; - - if (GetFileInformationByHandle(infoPtr->handle, &data) != TRUE) { - Tcl_SetErrno(ENOENT); - return NULL; - } - - atime = ToCTime(data.ftLastAccessTime); - mtime = ToCTime(data.ftLastWriteTime); - ctime = ToCTime(data.ftCreationTime); - attr = data.dwFileAttributes; - size = CombineDwords(data.nFileSizeHigh, data.nFileSizeLow); - 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 = CombineDwords(data.nFileIndexHigh, data.nFileIndexLow); - - dev = data.dwVolumeSerialNumber; - - /* - * Note that this code has no idea whether the file can be executed. - */ - - mode = (attr & FILE_ATTRIBUTE_DIRECTORY) ? S_IFDIR|S_IEXEC : S_IFREG; - mode |= (attr & FILE_ATTRIBUTE_READONLY) ? S_IREAD : S_IREAD|S_IWRITE; - mode |= (mode & (S_IREAD|S_IWRITE|S_IEXEC)) >> 3; - mode |= (mode & (S_IREAD|S_IWRITE|S_IEXEC)) >> 6; - - /* - * We don't construct a Tcl_StatBuf; we're using the info immediately. - */ - - TclNewObj(dictObj); -#define STORE_ELEM(name, value) StoreElementInDict(dictObj, name, value) - - STORE_ELEM("dev", Tcl_NewWideIntObj((long) dev)); - STORE_ELEM("ino", Tcl_NewWideIntObj((long long) inode)); - STORE_ELEM("nlink", Tcl_NewIntObj(nlink)); - STORE_ELEM("uid", Tcl_NewIntObj(0)); - STORE_ELEM("gid", Tcl_NewIntObj(0)); - STORE_ELEM("size", Tcl_NewWideIntObj((long long) size)); - STORE_ELEM("atime", Tcl_NewWideIntObj(atime)); - STORE_ELEM("mtime", Tcl_NewWideIntObj(mtime)); - STORE_ELEM("ctime", Tcl_NewWideIntObj(ctime)); - STORE_ELEM("mode", Tcl_NewWideIntObj(mode)); - - /* - * Windows only has files and directories, as far as we're concerned. - * Anything else and we definitely couldn't have got here anyway. - */ - if (attr & FILE_ATTRIBUTE_DIRECTORY) { - STORE_ELEM("type", Tcl_NewStringObj("directory", TCL_INDEX_NONE)); - } else { - STORE_ELEM("type", Tcl_NewStringObj("file", TCL_INDEX_NONE)); - } -#undef STORE_ELEM - - return dictObj; -} - -static int -FileGetOptionProc( - void *instanceData, /* The file state. */ - Tcl_Interp *interp, /* For error reporting. */ - const char *optionName, /* What option to read, or NULL for all. */ - Tcl_DString *dsPtr) /* Where to write the value read. */ + ClientData *handlePtr) /* Where to store the handle. */ { - FileInfo *infoPtr = (FileInfo *)instanceData; - int valid = 0; /* Flag if valid option parsed. */ - int len; - - if (optionName == NULL) { - len = 0; - valid = 1; - } else { - len = strlen(optionName); - } + FileInfo *infoPtr = (FileInfo *) instanceData; - /* - * Get option -stat - * Option is readonly and returned by [fconfigure chan -stat] but not - * returned by [fconfigure chan] without explicit option name. - */ - - if ((len > 1) && (strncmp(optionName, "-stat", len) == 0)) { - Tcl_Obj *dictObj = StatOpenFile(infoPtr); - const char *dictContents; - Tcl_Size dictLength; - - if (dictObj == NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "couldn't read file channel status: %s", - Tcl_PosixError(interp))); - return TCL_ERROR; - } - - /* - * Transfer dictionary to the DString. Note that we don't do this as - * an element as this is an option that can't be retrieved with a - * general probe. - */ - - dictContents = TclGetStringFromObj(dictObj, &dictLength); - Tcl_DStringAppend(dsPtr, dictContents, dictLength); - Tcl_DecrRefCount(dictObj); - return TCL_OK; - } - - if (valid) { + if (direction & infoPtr->validMask) { + *handlePtr = (ClientData) infoPtr->handle; return TCL_OK; + } else { + return TCL_ERROR; } - return Tcl_BadChannelOption(interp, optionName, - "stat"); } /* @@ -1091,17 +833,17 @@ TclpOpenFileChannel( Tcl_Channel channel = 0; int channelPermissions = 0; DWORD accessMode = 0, createMode, shareMode, flags; - const WCHAR *nativeName; + CONST TCHAR *nativeName; HANDLE handle; char channelName[16 + TCL_INTEGER_SPACE]; TclFile readFile = NULL, writeFile = NULL; - nativeName = (const WCHAR *)Tcl_FSGetNativePath(pathPtr); + nativeName = (TCHAR*) Tcl_FSGetNativePath(pathPtr); if (nativeName == NULL) { - if (interp) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "couldn't open \"%s\": filename is invalid on this platform", - TclGetString(pathPtr))); + if (interp != (Tcl_Interp *) NULL) { + Tcl_AppendResult(interp, "couldn't open \"", + TclGetString(pathPtr), "\": filename is invalid on this platform", + NULL); } return NULL; } @@ -1149,46 +891,45 @@ TclpOpenFileChannel( } /* - * [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. + * [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)) { + if( NativeIsComPort(nativeName) ) { + handle = TclWinSerialOpen(INVALID_HANDLE_VALUE, nativeName, accessMode); if (handle == INVALID_HANDLE_VALUE) { - Tcl_WinConvertError(GetLastError()); - if (interp) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "couldn't open serial \"%s\": %s", - TclGetString(pathPtr), Tcl_PosixError(interp))); + 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. - */ - + * 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 (TEST_FLAG(mode, O_CREAT)) { - if (TEST_FLAG(permissions, S_IWRITE)) { + if (mode & O_CREAT) { + if (permissions & S_IWRITE) { flags = FILE_ATTRIBUTE_NORMAL; } else { flags = FILE_ATTRIBUTE_READONLY; } } else { - flags = GetFileAttributesW(nativeName); + flags = (*tclWinProcs->getFileAttributesProc)(nativeName); if (flags == 0xFFFFFFFF) { flags = 0; } @@ -1204,21 +945,19 @@ TclpOpenFileChannel( * Now we get to create the file. */ - handle = CreateFileW(nativeName, accessMode, shareMode, - NULL, createMode, flags, (HANDLE) NULL); + handle = (*tclWinProcs->createFileProc)(nativeName, accessMode, + shareMode, NULL, createMode, flags, (HANDLE) NULL); if (handle == INVALID_HANDLE_VALUE) { DWORD err = GetLastError(); - if ((err & 0xFFFFL) == ERROR_OPEN_FAILED) { - err = TEST_FLAG(mode, O_CREAT) ? ERROR_FILE_EXISTS - : ERROR_FILE_NOT_FOUND; + if ((err & 0xffffL) == ERROR_OPEN_FAILED) { + err = (mode & O_CREAT) ? ERROR_FILE_EXISTS : ERROR_FILE_NOT_FOUND; } - Tcl_WinConvertError(err); - if (interp) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "couldn't open \"%s\": %s", - TclGetString(pathPtr), Tcl_PosixError(interp))); + TclWinConvertError(err); + if (interp != (Tcl_Interp *) NULL) { + Tcl_AppendResult(interp, "couldn't open \"", TclGetString(pathPtr), + "\": ", Tcl_PosixError(interp), NULL); } return NULL; } @@ -1228,9 +967,9 @@ TclpOpenFileChannel( 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. + * 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. @@ -1238,11 +977,11 @@ TclpOpenFileChannel( handle = TclWinSerialOpen(handle, nativeName, accessMode); if (handle == INVALID_HANDLE_VALUE) { - Tcl_WinConvertError(GetLastError()); - if (interp) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "couldn't reopen serial \"%s\": %s", - TclGetString(pathPtr), Tcl_PosixError(interp))); + TclWinConvertError(GetLastError()); + if (interp != (Tcl_Interp *) NULL) { + Tcl_AppendResult(interp, "couldn't reopen serial \"", + TclGetString(pathPtr), "\": ", + Tcl_PosixError(interp), NULL); } return NULL; } @@ -1254,10 +993,10 @@ TclpOpenFileChannel( channelPermissions); break; case FILE_TYPE_PIPE: - if (TEST_FLAG(channelPermissions, TCL_READABLE)) { + if (channelPermissions & TCL_READABLE) { readFile = TclWinMakeFile(handle); } - if (TEST_FLAG(channelPermissions, TCL_WRITABLE)) { + if (channelPermissions & TCL_WRITABLE) { writeFile = TclWinMakeFile(handle); } channel = TclpCreateCommandChannel(readFile, writeFile, NULL, 0, NULL); @@ -1265,9 +1004,8 @@ TclpOpenFileChannel( case FILE_TYPE_CHAR: case FILE_TYPE_DISK: case FILE_TYPE_UNKNOWN: - channel = OpenFileChannel(handle, channelName, - channelPermissions, - TEST_FLAG(mode, O_APPEND) ? FILE_APPEND : 0); + channel = TclWinOpenFileChannel(handle, channelName, + channelPermissions, (mode & O_APPEND) ? FILE_APPEND : 0); break; default: @@ -1277,11 +1015,8 @@ TclpOpenFileChannel( */ channel = NULL; - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "couldn't open \"%s\": bad file type", - TclGetString(pathPtr))); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "CHANNEL", "BAD_TYPE", - (char *)NULL); + Tcl_AppendResult(interp, "couldn't open \"", TclGetString(pathPtr), + "\": bad file type", NULL); break; } @@ -1306,11 +1041,11 @@ TclpOpenFileChannel( Tcl_Channel Tcl_MakeFileChannel( - void *rawHandle, /* OS level handle */ - int mode) /* OR'ed combination of TCL_READABLE and + 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) && !defined(__clang__) +#if defined(HAVE_NO_SEH) && !defined(_WIN64) TCLEXCEPTION_REGISTRATION registration; #endif char channelName[16 + TCL_INTEGER_SPACE]; @@ -1320,7 +1055,7 @@ Tcl_MakeFileChannel( TclFile readFile = NULL, writeFile = NULL; BOOL result; - if ((mode & (TCL_READABLE|TCL_WRITABLE)) == 0) { + if (mode == 0) { return NULL; } @@ -1332,10 +1067,10 @@ Tcl_MakeFileChannel( channel = TclWinOpenConsoleChannel(handle, channelName, mode); break; case FILE_TYPE_PIPE: - if (TEST_FLAG(mode, TCL_READABLE)) { + if (mode & TCL_READABLE) { readFile = TclWinMakeFile(handle); } - if (TEST_FLAG(mode, TCL_WRITABLE)) { + if (mode & TCL_WRITABLE) { writeFile = TclWinMakeFile(handle); } channel = TclpCreateCommandChannel(readFile, writeFile, NULL, 0, NULL); @@ -1343,7 +1078,7 @@ Tcl_MakeFileChannel( case FILE_TYPE_DISK: case FILE_TYPE_CHAR: - channel = OpenFileChannel(handle, channelName, mode, 0); + channel = TclWinOpenFileChannel(handle, channelName, mode, 0); break; case FILE_TYPE_UNKNOWN: @@ -1363,7 +1098,7 @@ Tcl_MakeFileChannel( if (result == 0) { /* - * Unable to make a duplicate. It's definitely invalid at this + * Unable to make a duplicate. It's definately invalid at this * point. */ @@ -1376,7 +1111,7 @@ Tcl_MakeFileChannel( */ result = 0; -#if defined(HAVE_NO_SEH) && !defined(_WIN64) && !defined(__clang__) +#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 @@ -1402,7 +1137,7 @@ Tcl_MakeFileChannel( "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 %%esp, 0xc(%%edx)" "\n\t" /* esp */ "movl $0, 0x10(%%edx)" "\n\t" /* status */ /* @@ -1442,7 +1177,7 @@ Tcl_MakeFileChannel( */ "2:" "\t" - "movl 0xC(%%edx), %%esp" "\n\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" @@ -1477,7 +1212,7 @@ Tcl_MakeFileChannel( * is valid to something. */ - channel = OpenFileChannel(handle, channelName, mode, 0); + channel = TclWinOpenFileChannel(handle, channelName, mode, 0); } return channel; @@ -1507,8 +1242,8 @@ TclpGetDefaultStdChannel( Tcl_Channel channel; HANDLE handle; int mode = -1; - const char *bufMode = NULL; - DWORD handleId = (DWORD) -1; + char *bufMode = NULL; + DWORD handleId = (DWORD)-1; /* Standard handle to retrieve. */ switch (type) { @@ -1555,7 +1290,7 @@ TclpGetDefaultStdChannel( */ if (Tcl_SetChannelOption(NULL,channel,"-translation","auto")!=TCL_OK || - Tcl_SetChannelOption(NULL,channel,"-eofchar","\x1A {}")!=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; @@ -1566,7 +1301,7 @@ TclpGetDefaultStdChannel( /* *---------------------------------------------------------------------- * - * OpenFileChannel -- + * TclWinOpenFileChannel -- * * Constructs a File channel for the specified standard OS handle. This * is a helper function to break up the construction of channels into @@ -1583,7 +1318,7 @@ TclpGetDefaultStdChannel( */ Tcl_Channel -OpenFileChannel( +TclWinOpenFileChannel( HANDLE handle, /* Win32 HANDLE to swallow */ char *channelName, /* Buffer to receive channel name */ int permissions, /* OR'ed combination of TCL_READABLE, @@ -1603,12 +1338,11 @@ OpenFileChannel( for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL; infoPtr = infoPtr->nextPtr) { if (infoPtr->handle == (HANDLE) handle) { - return ((permissions & (TCL_READABLE|TCL_WRITABLE|TCL_EXCEPTION))==infoPtr->validMask) - ? infoPtr->channel : NULL; + return (permissions==infoPtr->validMask) ? infoPtr->channel : NULL; } } - infoPtr = (FileInfo *)ckalloc(sizeof(FileInfo)); + infoPtr = (FileInfo *) ckalloc((unsigned) sizeof(FileInfo)); /* * TIP #218. Removed the code inserting the new structure into the global @@ -1617,14 +1351,15 @@ OpenFileChannel( */ infoPtr->nextPtr = NULL; - infoPtr->validMask = permissions & (TCL_READABLE|TCL_WRITABLE|TCL_EXCEPTION); + infoPtr->validMask = permissions; infoPtr->watchMask = 0; infoPtr->flags = appendMode; infoPtr->handle = handle; infoPtr->dirty = 0; - TclWinGenerateChannelName(channelName, "file", infoPtr); + sprintf(channelName, "file%" TCL_I_MODIFIER "x", (size_t)infoPtr); + infoPtr->channel = Tcl_CreateChannel(&fileChannelType, channelName, - infoPtr, permissions); + (ClientData) infoPtr, permissions); /* * Files have default translation of AUTO and ^Z eof char, which means @@ -1632,7 +1367,7 @@ OpenFileChannel( */ Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto"); - Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "\x1A {}"); + Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "\032 {}"); return infoPtr->channel; } @@ -1694,11 +1429,11 @@ TclWinFlushDirtyChannels(void) static void FileThreadActionProc( - void *instanceData, + ClientData instanceData, int action) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - FileInfo *infoPtr = (FileInfo *)instanceData; + FileInfo *infoPtr = (FileInfo *) instanceData; if (action == TCL_CHANNEL_THREAD_INSERT) { infoPtr->nextPtr = tsdPtr->firstFilePtr; @@ -1782,13 +1517,13 @@ FileGetType( * * NativeIsComPort -- * - * Determines if a path refers to a Windows serial port. A simple and - * efficient solution is to use a "name hint" to detect COM ports by - * their filename instead of resorting to a syscall to detect serialness - * after the fact. - * + * 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[1-9]:? + * //./COM[0-9]+ * \\.\COM[0-9]+ * * Results: @@ -1799,41 +1534,96 @@ FileGetType( static int NativeIsComPort( - const WCHAR *nativePath) /* Path of file to access, native encoding. */ + const TCHAR *nativePath) /* Path of file to access, native encoding. */ { - const WCHAR *p = (const WCHAR *) nativePath; - size_t i, len = wcslen(p); - /* - * 1. Look for com[1-9]:? + * Use wide-char or plain character case-insensitive comparison */ + if (tclWinProcs->useWide) { + const WCHAR *p = (const WCHAR *) nativePath; + int i, len = wcslen(p); - if ((len == 4) && (_wcsnicmp(p, L"com", 3) == 0)) { /* - * The 4th character must be a digit 1..9 + * 1. Look for com[1-9]:? */ - if ((p[3] < '1') || (p[3] > '9')) { - return 0; + if ( (len >= 4) && (len <= 5) + && (_wcsnicmp(p, L"com", 3) == 0) ) { + /* + * The 4th character must be a digit 1..9 optionally followed by a ":" + */ + + if ( (p[3] < L'1') || (p[3] > L'9') ) { + return 0; + } + if ( (len == 5) && (p[4] != L':') ) { + return 0; + } + return 1; } - return 1; - } - /* - * 2. Look for \\.\com[0-9]+ - */ + /* + * 2. Look for //./com[0-9]+ or \\.\com[0-9]+ + */ + + if ( (len >= 8) && ( + (_wcsnicmp(p, L"//./com", 7) == 0) + || (_wcsnicmp(p, L"\\\\.\\com", 7) == 0) ) ) + { + /* + * Charaters 8..end must be a digits 0..9 + */ + + for ( i=7; i<len; i++ ) { + if ( (p[i] < '0') || (p[i] > '9') ) { + return 0; + } + } + return 1; + } + + } else { + const char *p = (const char *) nativePath; + int i, len = strlen(p); - if ((len >= 8) && (_wcsnicmp(p, L"\\\\.\\com", 7) == 0)) { /* - * Charaters 8..end must be a digits 0..9 + * 1. Look for com[1-9]:? */ - for (i=7; i<len; i++) { - if ((p[i] < '0') || (p[i] > '9')) { + if ( (len >= 4) && (len <= 5) + && (strnicmp(p, "com", 3) == 0) ) { + /* + * The 4th character must be a digit 1..9 optionally followed by a ":" + */ + + if ( (p[3] < '1') || (p[3] > '9') ) { + return 0; + } + if ( (len == 5) && (p[4] != ':') ) { return 0; } + return 1; + } + + /* + * 2. Look for //./com[0-9]+ or \\.\com[0-9]+ + */ + + if ( (len >= 8) && ( + (strnicmp(p, "//./com", 7) == 0) + || (strnicmp(p, "\\\\.\\com", 7) == 0) ) ) + { + /* + * Charaters 8..end must be a digits 0..9 + */ + + for ( i=7; i<len; i++ ) { + if ( (p[i] < '0') || (p[i] > '9') ) { + return 0; + } + } + return 1; } - return 1; } return 0; } diff --git a/win/tclWinConsole.c b/win/tclWinConsole.c index c7e12ae..361fb3d 100644 --- a/win/tclWinConsole.c +++ b/win/tclWinConsole.c @@ -2,208 +2,128 @@ * tclWinConsole.c -- * * This file implements the Windows-specific console functions, and the - * "console" channel driver. Windows 7 or later required. + * "console" channel driver. * - * Copyright © 2022 Ashok P. Nadkarni + * 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. */ -#ifdef TCL_CONSOLE_DEBUG -#undef NDEBUG /* Enable asserts */ -#endif - #include "tclWinInt.h" -#include <assert.h> -#include <ctype.h> + +#include <fcntl.h> +#include <io.h> /* - * A general note on the design: The console channel driver differs from - * most other drivers in the following respects: - * - * - There can be at most 3 console handles at any time since Windows does - * support allocation of more than one console (with three handles - * corresponding to stdin, stdout, stderr) - * - * - Consoles are created / inherited at process startup. There is currently - * no way in Tcl to programmatically create a console. Even if these were - * added the above Windows limitation would still apply. - * - * - Unlike files, sockets etc. where there is a one-to-one - * correspondence between Tcl channels and operating system handles, - * std* channels are shared amongst threads which means there can be - * multiple Tcl channels corresponding to a single console handle. - * - * - Even with multiple threads, more than one file event handler is - * unlikely. It does not make sense for multiple threads to register - * handlers for stdin because the input would be randomly fragmented amongst - * the threads. - * - * Various design factors are driven by the above, e.g. use of lists instead - * of hash tables (at most 3 console handles) and use of global instead of - * per thread queues which simplifies lock management particularly because - * thread-console relation is not one-one and is likely more performant as - * well with fewer locks needing to be obtained. - * - * Some additional design notes/reminders for the future: - * - * Aligned, synchronous reads are done directly by interpreter thread. - * Unaligned or asynchronous reads are done through the reader thread. - * - * The reader thread does not read ahead. That is, it will not post a read - * until some interpreter thread is actually requesting a read. This is - * because an interpreter may (for example) turn off echo for passwords and - * the read ahead would come in the way of that. - * - * If multiple threads are reading from stdin, the input is sprayed in - * random fashion. This is not good application design and hence no plan to - * address this (not clear what should be done even in theory) - * - * For output, we do not restrict all output to the console writer threads. - * See ConsoleOutputProc for the conditions. - * - * Locks are never held when calling the ReadConsole/WriteConsole API's - * since they may block. + * The following variable is used to tell whether this module has been + * initialized. */ -static int gInitialized = 0; +static int initialized = 0; /* - * INPUT_BUFFER_SIZE is size of buffer passed to ReadConsole in bytes. - * Note that ReadConsole will only allow reading of line lengths up to the - * max of 256 and buffer size passed to it. So dropping this below 512 - * means user can type at most 256 chars. + * 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. */ -#ifndef INPUT_BUFFER_SIZE -#define INPUT_BUFFER_SIZE 8192 /* In bytes, so 4096 chars */ -#endif -/* - * CONSOLE_BUFFER_SIZE is size of storage used in ring buffers. - * In theory, at least sizeof(WCHAR) but note the Tcl channel bug - * https://core.tcl-lang.org/tcl/tktview/b3977d199b08e3979a8da970553d5209b3042e9c - * will cause failures in test suite if close to max input line in the suite. - */ -#ifndef CONSOLE_BUFFER_SIZE -#define CONSOLE_BUFFER_SIZE 8192 /* In bytes */ -#endif +TCL_DECLARE_MUTEX(consoleMutex) /* - * Ring buffer for storing data. Actual data is from bufPtr[start]:bufPtr[size-1] - * and bufPtr[0]:bufPtr[length - (size-start)]. + * Bit masks used in the flags field of the ConsoleInfo structure below. */ -typedef struct RingBuffer { - char *bufPtr; /* Pointer to buffer storage */ - Tcl_Size capacity; /* Size of the buffer in RingBufferChar */ - Tcl_Size start; /* Start of the data within the buffer. */ - Tcl_Size length; /* Number of RingBufferChar*/ -} RingBuffer; -#define RingBufferLength(ringPtr_) ((ringPtr_)->length) -#define RingBufferHasFreeSpace(ringPtr_) ((ringPtr_)->length < (ringPtr_)->capacity) -#define RINGBUFFER_ASSERT(ringPtr_) assert(RingBufferCheck(ringPtr_)) + +#define CONSOLE_PENDING (1<<0) /* Message is pending in the queue. */ +#define CONSOLE_ASYNC (1<<1) /* Channel is non-blocking. */ /* - * The Win32 console API does not support non-blocking I/O in any form. Thus - * the actual calls are made on a separate thread. Moreover, separate - * threads are needed for each handle because (for example) blocking on user - * input on stdin should not prevent output to stdout when non-blocking i/o - * is configured at the script level. - * - * In the input (e.g. stdin) case, the console stdin thread is the producer - * writing to the buffer ring buffer. The Tcl interpreter threads are the - * consumer. For the output (e.g. stdout/stderr) case, the Tcl interpreter - * are the producers while the console stdout/stderr threads are the - * consumers. - * - * Consoles are identified purely by handles and multiple threads may open - * them (as stdin/stdout/stderr are shared). - * - * Note on reference counting - a ConsoleHandleInfo instance has multiple - * references to it - one each from every channel that is attached to it - * plus one from the console thread itself which also serves as the reference - * from gConsoleHandleInfoList. + * Bit masks used in the sharedFlags field of the ConsoleInfo structure below. */ -typedef struct ConsoleHandleInfo { - struct ConsoleHandleInfo *nextPtr; /* Process-global list of consoles */ - HANDLE console; /* Console handle */ - HANDLE consoleThread; /* Handle to thread doing actual i/o on the console */ - SRWLOCK lock; /* Controls access to this structure. - * Cheaper than CRITICAL_SECTION but note does not - * support recursive locks or Try* style attempts.*/ - CONDITION_VARIABLE consoleThreadCV;/* For awakening console thread */ - CONDITION_VARIABLE interpThreadCV; /* For awakening interpthread(s) */ - RingBuffer buffer; /* Buffer for data transferred between console - * threads and Tcl threads. For input consoles, - * written by the console thread and read by Tcl - * threads. The converse for output threads */ - DWORD initMode; /* Initial console mode. */ - DWORD lastError; /* An error caused by the last background - * operation. Set to 0 if no error has been - * detected. */ - int numRefs; /* See comments above */ - int permissions; /* TCL_READABLE for input consoles, TCL_WRITABLE - * for output. Only one or the other can be set. */ - int flags; -#define CONSOLE_DATA_AWAITED 0x0001 /* An interpreter is awaiting data */ -} ConsoleHandleInfo; + +#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) /* * This structure describes per-instance data for a console based channel. - * - * Note on locking - this structure has no locks because it is accessed - * only from the thread owning channel EXCEPT when a console traverses it - * looking for a channel that is watching for events on the console. Even - * in that case, no locking is required because that access is only under - * the gConsoleLock lock which prevents the channel from being removed from - * the gWatchingChannelList which in turn means it will not be deallocated - * from under the console thread. Access to individual fields does not need - * to be controlled because - * - the console thread does not write to any fields - * - changes to the nextWatchingChannelPtr field - * - changes to other fields do not matter because after being read for - * queueing events, they are verified again when the event is received - * in the interpreter thread (since they could have changed anyways while - * the event was in-flight on the event queue) - * - * Note on reference counting - a structure instance may be referenced from - * three places: - * - the Tcl channel subsystem. This reference is created when on channel - * opening and dropped on channel close. This also covers the reference - * from gWatchingChannelList since queueing / dequeuing from that list - * happens in conjunction with channel operations. - * - the Tcl event queue entries. This reference is added when the event - * is queued and dropped on receipt. */ -typedef struct ConsoleChannelInfo { - HANDLE handle; /* Console handle */ - Tcl_ThreadId threadId; /* Id of owning thread */ - struct ConsoleChannelInfo *nextWatchingChannelPtr; - /* Pointer to next channel watching events. */ + +typedef struct ConsoleInfo { + HANDLE handle; + int type; + struct ConsoleInfo *nextPtr;/* Pointer to next registered console. */ Tcl_Channel channel; /* Pointer to channel structure. */ - DWORD initMode; /* Initial console mode. */ - int numRefs; /* See comments above */ - int permissions; /* OR'ed combination of TCL_READABLE, + 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 */ -#define CONSOLE_EVENT_QUEUED 0x0001 /* Notification event already queued */ -#define CONSOLE_ASYNC 0x0002 /* Channel is non-blocking. */ -#define CONSOLE_READ_OPS 0x0004 /* Channel supports read-related ops. */ -} ConsoleChannelInfo; + 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. */ + HANDLE writeThread; /* Handle to writer thread. */ + HANDLE readThread; /* Handle to reader thread. */ + HANDLE writable; /* Manual-reset event to signal when the + * writer thread has finished waiting for the + * current buffer to be written. */ + HANDLE readable; /* Manual-reset event to signal when the + * reader thread has finished waiting for + * input. */ + HANDLE startWriter; /* Auto-reset event used by the main thread to + * signal when the writer thread should + * attempt to write to the console. */ + HANDLE stopWriter; /* Auto-reset event used by the main thread to + * signal when the writer thread should exit */ + HANDLE startReader; /* Auto-reset event used by the main thread to + * signal when the reader thread should + * attempt to read from the console. */ + HANDLE stopReader; /* Auto-reset event used by the main thread to + * signal when the reader thread should exit */ + DWORD writeError; /* An error caused by the last background + * write. Set to 0 if no error has been + * detected. This word is shared with the + * 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 { - Tcl_Event header; /* Information that is standard for all events. */ - ConsoleChannelInfo *chanInfoPtr; - /* Pointer to console info structure. Note +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. */ @@ -213,408 +133,94 @@ typedef struct { * Declarations for functions used only in this file. */ -static int ConsoleBlockModeProc(void *instanceData, int mode); -static void ConsoleCheckProc(void *clientData, int flags); -static int ConsoleCloseProc(void *instanceData, - Tcl_Interp *interp, int flags); +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(void *clientData); -static int ConsoleGetHandleProc(void *instanceData, - int direction, void **handlePtr); -static int ConsoleGetOptionProc(void *instanceData, - Tcl_Interp *interp, const char *optionName, - Tcl_DString *dsPtr); +static void ConsoleExitHandler(ClientData clientData); +static int ConsoleGetHandleProc(ClientData instanceData, + int direction, ClientData *handlePtr); static void ConsoleInit(void); -static int ConsoleInputProc(void *instanceData, char *buf, +static int ConsoleInputProc(ClientData instanceData, char *buf, int toRead, int *errorCode); -static int ConsoleOutputProc(void *instanceData, - const char *buf, int toWrite, int *errorCode); -static int ConsoleSetOptionProc(void *instanceData, - Tcl_Interp *interp, const char *optionName, - const char *value); -static void ConsoleSetupProc(void *clientData, int flags); -static void ConsoleWatchProc(void *instanceData, int mask); -static void ProcExitHandler(void *clientData); -static void ConsoleThreadActionProc(void *instanceData, int action); -static DWORD ReadConsoleChars(HANDLE hConsole, WCHAR *lpBuffer, - Tcl_Size nChars, Tcl_Size *nCharsReadPtr); -static DWORD WriteConsoleChars(HANDLE hConsole, - const WCHAR *lpBuffer, Tcl_Size nChars, - Tcl_Size *nCharsWritten); -static void RingBufferInit(RingBuffer *ringPtr, Tcl_Size capacity); -static void RingBufferClear(RingBuffer *ringPtr); -static Tcl_Size RingBufferIn(RingBuffer *ringPtr, const char *srcPtr, - Tcl_Size srcLen, int partialCopyOk); -static Tcl_Size RingBufferOut(RingBuffer *ringPtr, char *dstPtr, - Tcl_Size dstCapacity, int partialCopyOk); -static ConsoleHandleInfo *AllocateConsoleHandleInfo(HANDLE consoleHandle, - int permissions); -static ConsoleHandleInfo *FindConsoleInfo(const ConsoleChannelInfo *); +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 NudgeWatchers(HANDLE consoleHandle); -#ifndef NDEBUG -static int RingBufferCheck(const RingBuffer *ringPtr); -#endif - -/* - * Static data. - */ - -typedef struct { - /* Currently this struct is only used to detect thread initialization */ - int notUsed; /* Dummy field */ -} ThreadSpecificData; -static Tcl_ThreadDataKey dataKey; - -/* - * All access to static data is controlled through a single process-wide - * lock. A process can have only a single console at a time, with three - * handles for stdin, stdout and stderr. Creation/destruction of consoles is - * a relatively rare event (currently only possible during process start), - * the number of consoles (as opposed to channels) is small (only stdin, - * stdout and stderr), and contention low. More finer-grained locking would - * likely not only complicate implementation but be slower due to multiple - * locks being held. Note console channels also differ from other Tcl - * channel types in that the channel<->OS descriptor mapping is not one-to-one. - */ -SRWLOCK gConsoleLock; - - -/* Process-wide list of console handles. Access control through gConsoleLock */ -static ConsoleHandleInfo *gConsoleHandleInfoList; - -/* - * Process-wide list of channels that are listening for events. Again access - * control through gConsoleLock. Common list for all threads is simplifies - * locking and bookkeeping and is workable because in practice multiple - * threads are very unlikely to be all waiting on stdin (not workable - * because input would be randomly distributed to threads) - */ -static ConsoleChannelInfo *gWatchingChannelList; +static void ProcExitHandler(ClientData clientData); +static int WaitForRead(ConsoleInfo *infoPtr, int blocking); +static void ConsoleThreadActionProc(ClientData instanceData, + int action); /* * 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 */ - TCL_CLOSE2PROC, /* Close proc. */ - ConsoleInputProc, /* Input proc. */ - ConsoleOutputProc, /* Output proc. */ - NULL, /* Seek proc. */ - ConsoleSetOptionProc, /* Set option proc. */ - ConsoleGetOptionProc, /* Get option proc. */ - ConsoleWatchProc, /* Set up notifier to watch the channel. */ - ConsoleGetHandleProc, /* Get an OS handle from channel. */ - ConsoleCloseProc, /* 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. */ +static 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 */ }; - -/* - *------------------------------------------------------------------------ - * - * RingBufferInit -- - * - * Initializes the ring buffer to a given size. - * - * Results: - * None. - * - * Side effects: - * Panics on allocation failure. - * - *------------------------------------------------------------------------ - */ -static void -RingBufferInit( - RingBuffer *ringPtr, - Tcl_Size capacity) -{ - if (capacity <= 0 || capacity > TCL_SIZE_MAX) { - Tcl_Panic("Internal error: invalid ring buffer capacity requested."); - } - ringPtr->bufPtr = (char *) ckalloc(capacity); - ringPtr->capacity = capacity; - ringPtr->start = 0; - ringPtr->length = 0; -} - -/* - *------------------------------------------------------------------------ - * - * RingBufferClear - * - * Clears the contents of a ring buffer. - * - * Results: - * None. - * - * Side effects: - * The allocated internal buffer is freed. - * - *------------------------------------------------------------------------ - */ -static void -RingBufferClear( - RingBuffer *ringPtr) -{ - if (ringPtr->bufPtr) { - ckfree(ringPtr->bufPtr); - ringPtr->bufPtr = NULL; - } - ringPtr->capacity = 0; - ringPtr->start = 0; - ringPtr->length = 0; -} /* - *------------------------------------------------------------------------ - * - * RingBufferIn -- - * - * Appends data to the ring buffer. - * - * Results: - * Returns number of bytes copied. - * - * Side effects: - * Internal buffer is updated. - * - *------------------------------------------------------------------------ - */ -static Tcl_Size -RingBufferIn( - RingBuffer *ringPtr, - const char *srcPtr, /* Source to be copied */ - Tcl_Size srcLen, /* Length of source */ - int partialCopyOk) /* If true, partial copy is permitted */ -{ - Tcl_Size freeSpace; - - RINGBUFFER_ASSERT(ringPtr); - - freeSpace = ringPtr->capacity - ringPtr->length; - if (freeSpace < srcLen) { - if (!partialCopyOk) { - return 0; - } - /* Copy only as much as free space allows */ - srcLen = freeSpace; - } - - if (ringPtr->capacity - ringPtr->start > ringPtr->length) { - /* There is room at the back */ - Tcl_Size endSpaceStart = ringPtr->start + ringPtr->length; - Tcl_Size endSpace = ringPtr->capacity - endSpaceStart; - if (endSpace >= srcLen) { - /* Everything fits at the back */ - memmove(endSpaceStart + ringPtr->bufPtr, srcPtr, srcLen); - } else { - /* srcLen > endSpace */ - memmove(endSpaceStart + ringPtr->bufPtr, srcPtr, endSpace); - memmove(ringPtr->bufPtr, endSpace + srcPtr, srcLen - endSpace); - } - } else { - /* No room at the back. Existing data wrap to front. */ - Tcl_Size wrapLen = - ringPtr->start + ringPtr->length - ringPtr->capacity; - memmove(wrapLen + ringPtr->bufPtr, srcPtr, srcLen); - } - - ringPtr->length += srcLen; - - RINGBUFFER_ASSERT(ringPtr); - - return srcLen; -} - -/* - *------------------------------------------------------------------------ - * - * RingBufferOut -- - * - * Moves data out of the ring buffer. If dstPtr is NULL, the data - * is simply removed. - * - * Results: - * Returns number of bytes copied or removed. - * - * Side effects: - * Internal buffer is updated. - * - *------------------------------------------------------------------------ - */ -static Tcl_Size -RingBufferOut( - RingBuffer *ringPtr, - char *dstPtr, /* Buffer for output data. May be NULL */ - Tcl_Size dstCapacity, /* Size of buffer */ - int partialCopyOk) /* If true, return what's available */ -{ - Tcl_Size leadLen; - - RINGBUFFER_ASSERT(ringPtr); - - if (dstCapacity > ringPtr->length) { - if (dstPtr && !partialCopyOk) { - return 0; - } - dstCapacity = ringPtr->length; - } - - if (ringPtr->start <= (ringPtr->capacity - ringPtr->length)) { - /* No content wrap around. So leadLen is entire content */ - leadLen = ringPtr->length; - } else { - /* Content wraps around so lead segment stretches to end of buffer */ - leadLen = ringPtr->capacity - ringPtr->start; - } - if (leadLen >= dstCapacity) { - if (dstPtr) { - memmove(dstPtr, ringPtr->start + ringPtr->bufPtr, dstCapacity); - } - ringPtr->start += dstCapacity; - } else { - Tcl_Size wrapLen = dstCapacity - leadLen; - if (dstPtr) { - memmove(dstPtr, - ringPtr->start + ringPtr->bufPtr, - leadLen); - memmove( - leadLen + dstPtr, ringPtr->bufPtr, wrapLen); - } - ringPtr->start = wrapLen; - } - - ringPtr->length -= dstCapacity; - if (ringPtr->start == ringPtr->capacity || ringPtr->length == 0) { - ringPtr->start = 0; - } - - RINGBUFFER_ASSERT(ringPtr); - - return dstCapacity; -} - -#ifndef NDEBUG -static int -RingBufferCheck( - const RingBuffer *ringPtr) -{ - return (ringPtr->bufPtr != NULL && ringPtr->capacity == CONSOLE_BUFFER_SIZE - && ringPtr->start < ringPtr->capacity - && ringPtr->length <= ringPtr->capacity); -} -#endif - -/* - *------------------------------------------------------------------------ - * - * ReadConsoleChars -- - * - * Wrapper for ReadConsoleW. - * - * Results: - * Returns 0 on success, else Windows error code. - * - * Side effects: - * On success the number of characters (not bytes) read is stored in - * *nCharsReadPtr. This will be 0 if the operation was interrupted by - * a Ctrl-C or a CancelIo call. + *---------------------------------------------------------------------- * - *------------------------------------------------------------------------ + * readConsoleBytes, writeConsoleBytes -- + * Wrapper for ReadConsole{A,W}, that takes and returns number of bytes + * instead of number of TCHARS */ -static DWORD -ReadConsoleChars( +static BOOL +readConsoleBytes( HANDLE hConsole, - WCHAR *lpBuffer, - Tcl_Size nChars, - Tcl_Size *nCharsReadPtr) + LPVOID lpBuffer, + DWORD nbytes, + LPDWORD nbytesread) { - DWORD nRead; + 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. - * 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. - * - * If one thread closes its channel, it calls CancelSynchronousIo on the - * console handle which results again in success being returned and - * GetLastError() being ERROR_OPERATION_ABORTED but ntchars in - * unmodified. - * - * In both cases above we will return success but with nbytesread as 0. - * This allows caller to check for thread termination etc. - * - * See https://bugs.python.org/issue30237 - * or https://github.com/microsoft/terminal/issues/12143 - */ - nRead = (DWORD)-1; - result = ReadConsoleW(hConsole, lpBuffer, nChars, &nRead, NULL); - if (result) { - if ((nRead == 0 || nRead == (DWORD)-1) - && GetLastError() == ERROR_OPERATION_ABORTED) { - nRead = 0; - } - *nCharsReadPtr = nRead; - return 0; - } else { - return GetLastError(); - } + int tcharsize; + tcharsize = tclWinProcs->useWide? 2 : 1; + result = tclWinProcs->readConsoleProc( + hConsole, lpBuffer, nbytes / tcharsize, &ntchars, NULL); + if (nbytesread) + *nbytesread = (ntchars*tcharsize); + return result; } - -/* - *------------------------------------------------------------------------ - * - * WriteConsoleChars -- - * - * Wrapper for WriteConsoleW. - * - * Results: - * Returns 0 on success, Windows error code on failure. - * - * Side effects: - * On success the number of characters (not bytes) written is stored in - * *nCharsWrittenPtr. This will be 0 if the operation was interrupted by - * a Ctrl-C or a CancelIo call. - * - *------------------------------------------------------------------------ - */ -static DWORD -WriteConsoleChars( +static BOOL +writeConsoleBytes( HANDLE hConsole, - const WCHAR *lpBuffer, - Tcl_Size nChars, - Tcl_Size *nCharsWrittenPtr) + const VOID *lpBuffer, + DWORD nbytes, + LPDWORD nbyteswritten) { - DWORD nCharsWritten; + DWORD ntchars; BOOL result; - - /* See comments in ReadConsoleChars, not sure that applies here */ - nCharsWritten = (DWORD)-1; - result = WriteConsoleW(hConsole, lpBuffer, nChars, &nCharsWritten, NULL); - if (result) { - if (nCharsWritten == (DWORD) -1) { - nCharsWritten = 0; - } - *nCharsWrittenPtr = nCharsWritten; - return 0; - } else { - return GetLastError(); - } + int tcharsize; + tcharsize = tclWinProcs->useWide? 2 : 1; + result = tclWinProcs->writeConsoleProc( + hConsole, lpBuffer, nbytes / tcharsize, &ntchars, NULL); + if (nbyteswritten) + *nbyteswritten = (ntchars*tcharsize); + return result; } /* @@ -636,24 +242,26 @@ WriteConsoleChars( static void ConsoleInit(void) { + ThreadSpecificData *tsdPtr; + /* * Check the initialized flag first, then check again in the mutex. This * is a speed enhancement. */ - if (!gInitialized) { - AcquireSRWLockExclusive(&gConsoleLock); - if (!gInitialized) { - gInitialized = 1; + if (!initialized) { + Tcl_MutexLock(&consoleMutex); + if (!initialized) { + initialized = 1; Tcl_CreateExitHandler(ProcExitHandler, NULL); } - ReleaseSRWLockExclusive(&gConsoleLock); + Tcl_MutexUnlock(&consoleMutex); } - if (TclThreadDataKeyGet(&dataKey) == NULL) { - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - - tsdPtr->notUsed = 0; + tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); + if (tsdPtr == NULL) { + tsdPtr = TCL_TSD_INIT(&dataKey); + tsdPtr->firstConsolePtr = NULL; Tcl_CreateEventSource(ConsoleSetupProc, ConsoleCheckProc, NULL); Tcl_CreateThreadExitHandler(ConsoleExitHandler, NULL); } @@ -678,7 +286,7 @@ ConsoleInit(void) static void ConsoleExitHandler( - TCL_UNUSED(void *)) + ClientData clientData) /* Old window proc */ { Tcl_DeleteEventSource(ConsoleSetupProc, ConsoleCheckProc, NULL); } @@ -702,50 +310,11 @@ ConsoleExitHandler( static void ProcExitHandler( - TCL_UNUSED(void *)) + ClientData clientData) /* Old window proc */ { - AcquireSRWLockExclusive(&gConsoleLock); - gInitialized = 0; - ReleaseSRWLockExclusive(&gConsoleLock); -} - -/* - *------------------------------------------------------------------------ - * - * NudgeWatchers -- - * - * Wakes up all threads which have file event watchers on the passed - * console handle. - * - * The function locks and releases gConsoleLock. - * Caller must not be holding locks that will violate lock hierarchy. - * - * Results: - * None. - * - * Side effects: - * As above. - *------------------------------------------------------------------------ - */ -static void -NudgeWatchers( - HANDLE consoleHandle) -{ - ConsoleChannelInfo *chanInfoPtr; - AcquireSRWLockShared(&gConsoleLock); /* Shared-read lock */ - for (chanInfoPtr = gWatchingChannelList; chanInfoPtr; - chanInfoPtr = chanInfoPtr->nextWatchingChannelPtr) { - /* - * Notify channels interested in our handle AND that have - * a thread attached. - * No lock needed for chanInfoPtr. See ConsoleChannelInfo. - */ - if (chanInfoPtr->handle == consoleHandle - && chanInfoPtr->threadId != NULL) { - Tcl_ThreadAlert(chanInfoPtr->threadId); - } - } - ReleaseSRWLockShared(&gConsoleLock); + Tcl_MutexLock(&consoleMutex); + initialized = 0; + Tcl_MutexUnlock(&consoleMutex); } /* @@ -754,9 +323,7 @@ NudgeWatchers( * ConsoleSetupProc -- * * This procedure is invoked before Tcl_DoOneEvent blocks waiting for an - * event. It walks the channel list and if any input channel has data - * available or output channel has space for data, sets the event loop - * blocking time to 0 so that it will poll immediately. + * event. * * Results: * None. @@ -769,48 +336,36 @@ NudgeWatchers( void ConsoleSetupProc( - TCL_UNUSED(void *), + ClientData data, /* Not used. */ int flags) /* Event flags as passed to Tcl_DoOneEvent. */ { - ConsoleChannelInfo *chanInfoPtr; + ConsoleInfo *infoPtr; Tcl_Time blockTime = { 0, 0 }; int block = 1; + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); if (!(flags & TCL_FILE_EVENTS)) { return; } /* - * Walk the list of channels. See general comments for struct - * ConsoleChannelInfo with regard to locking and field access. + * Look to see if any events are already pending. If they are, poll. */ - AcquireSRWLockShared(&gConsoleLock); /* READ lock - no data modification */ - - for (chanInfoPtr = gWatchingChannelList; block && chanInfoPtr != NULL; - chanInfoPtr = chanInfoPtr->nextWatchingChannelPtr) { - ConsoleHandleInfo *handleInfoPtr; - handleInfoPtr = FindConsoleInfo(chanInfoPtr); - if (handleInfoPtr != NULL) { - AcquireSRWLockShared(&handleInfoPtr->lock); - /* Remember at most one of READABLE, WRITABLE set */ - if (chanInfoPtr->watchMask & TCL_READABLE) { - if (RingBufferLength(&handleInfoPtr->buffer) > 0 - || handleInfoPtr->lastError != ERROR_SUCCESS) { - block = 0; /* Input data available */ - } - } else if (chanInfoPtr->watchMask & TCL_WRITABLE) { - if (RingBufferHasFreeSpace(&handleInfoPtr->buffer)) { - /* TCL_WRITABLE */ - block = 0; /* Output space available */ - } + + for (infoPtr = tsdPtr->firstConsolePtr; 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; } - ReleaseSRWLockShared(&handleInfoPtr->lock); } } - ReleaseSRWLockShared(&gConsoleLock); - if (!block) { - /* At least one channel is readable/writable. Set block time to 0 */ Tcl_SetMaxBlockTime(&blockTime); } } @@ -834,87 +389,57 @@ ConsoleSetupProc( static void ConsoleCheckProc( - TCL_UNUSED(void *), + ClientData data, /* Not used. */ int flags) /* Event flags as passed to Tcl_DoOneEvent. */ { - ConsoleChannelInfo *chanInfoPtr; - Tcl_ThreadId me; + ConsoleInfo *infoPtr; + ConsoleEvent *evPtr; int needEvent; + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); if (!(flags & TCL_FILE_EVENTS)) { return; } - me = Tcl_GetCurrentThread(); - /* - * Acquire a shared lock. Note this is ok even though we potentially - * modify the chanInfoPtr->flags because chanInfoPtr is only modified - * when it belongs to this thread and no other thread will write to it. - * THe shared lock is intended to protect the global gWatchingChannelList - * as we traverse it. + * Queue events for any ready consoles that don't already have events + * queued. */ - AcquireSRWLockShared(&gConsoleLock); - - for (chanInfoPtr = gWatchingChannelList; chanInfoPtr != NULL; - chanInfoPtr = chanInfoPtr->nextWatchingChannelPtr) { - ConsoleHandleInfo *handleInfoPtr; - if (chanInfoPtr->threadId != me) { - /* Some other thread owns the channel */ + for (infoPtr = tsdPtr->firstConsolePtr; infoPtr != NULL; + infoPtr = infoPtr->nextPtr) { + if (infoPtr->flags & CONSOLE_PENDING) { continue; } - if (chanInfoPtr->flags & CONSOLE_EVENT_QUEUED) { - /* A notification event already queued. No point in another. */ - continue; - } - - handleInfoPtr = FindConsoleInfo(chanInfoPtr); - /* Pointer is safe to access as we are holding gConsoleLock */ - if (handleInfoPtr == NULL) { - /* Stale event */ - continue; - } + /* + * Queue an event if the console is signaled for reading or writing. + */ needEvent = 0; - AcquireSRWLockShared(&handleInfoPtr->lock); - /* Rememeber channel is read or write, never both */ - if (chanInfoPtr->watchMask & TCL_READABLE) { - if (RingBufferLength(&handleInfoPtr->buffer) > 0 - || handleInfoPtr->lastError != ERROR_SUCCESS) { - needEvent = 1; /* Input data available or error/EOF */ + if (infoPtr->watchMask & TCL_WRITABLE) { + if (WaitForSingleObject(infoPtr->writable, 0) != WAIT_TIMEOUT) { + needEvent = 1; } - /* - * TCL_READABLE watch means someone is looking out for data being - * available, let reader thread know. Note channel need not be - * ASYNC! (Bug [baa51423c2]) - */ - handleInfoPtr->flags |= CONSOLE_DATA_AWAITED; - WakeConditionVariable(&handleInfoPtr->consoleThreadCV); - } else if (chanInfoPtr->watchMask & TCL_WRITABLE) { - if (RingBufferHasFreeSpace(&handleInfoPtr->buffer)) { - needEvent = 1; /* Output space available */ + } + + if (infoPtr->watchMask & TCL_READABLE) { + if (WaitForRead(infoPtr, 0) >= 0) { + needEvent = 1; } } - ReleaseSRWLockShared(&handleInfoPtr->lock); if (needEvent) { - ConsoleEvent *evPtr = (ConsoleEvent *)ckalloc(sizeof(ConsoleEvent)); - - /* See note above loop why this can be accessed without locks */ - chanInfoPtr->flags |= CONSOLE_EVENT_QUEUED; - chanInfoPtr->numRefs += 1; /* So it does not go away while event - is in queue */ + infoPtr->flags |= CONSOLE_PENDING; + evPtr = (ConsoleEvent *) ckalloc(sizeof(ConsoleEvent)); evPtr->header.proc = ConsoleEventProc; - evPtr->chanInfoPtr = chanInfoPtr; + evPtr->infoPtr = infoPtr; Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL); } } - - ReleaseSRWLockShared(&gConsoleLock); } - + + /* *---------------------------------------------------------------------- * @@ -933,11 +458,11 @@ ConsoleCheckProc( static int ConsoleBlockModeProc( - void *instanceData, /* Instance data for channel. */ + ClientData instanceData, /* Instance data for channel. */ int mode) /* TCL_MODE_BLOCKING or * TCL_MODE_NONBLOCKING. */ { - ConsoleChannelInfo *chanInfoPtr = (ConsoleChannelInfo *)instanceData; + ConsoleInfo *infoPtr = (ConsoleInfo *) instanceData; /* * Consoles on Windows can not be switched between blocking and @@ -948,9 +473,9 @@ ConsoleBlockModeProc( */ if (mode == TCL_MODE_NONBLOCKING) { - chanInfoPtr->flags |= CONSOLE_ASYNC; + infoPtr->flags |= CONSOLE_ASYNC; } else { - chanInfoPtr->flags &= ~CONSOLE_ASYNC; + infoPtr->flags &= ~(CONSOLE_ASYNC); } return 0; } @@ -973,102 +498,166 @@ ConsoleBlockModeProc( static int ConsoleCloseProc( - void *instanceData, /* Pointer to ConsoleChannelInfo structure. */ - TCL_UNUSED(Tcl_Interp *), - int flags) + ClientData instanceData, /* Pointer to ConsoleInfo structure. */ + Tcl_Interp *interp) /* For error reporting. */ { - ConsoleChannelInfo *chanInfoPtr = (ConsoleChannelInfo *)instanceData; - ConsoleHandleInfo *handleInfoPtr; - int errorCode = 0; - ConsoleChannelInfo **nextPtrPtr; - int closeHandle; - - if ((flags & (TCL_CLOSE_READ | TCL_CLOSE_WRITE)) != 0) { - return EINVAL; - } - /* - * 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 while exiting. Note an explicit close in script will - * still close the handle. That's historical behavior on all platforms. - */ - if (!TclInThreadExit() - || ( (GetStdHandle(STD_INPUT_HANDLE) != chanInfoPtr->handle) - && (GetStdHandle(STD_OUTPUT_HANDLE) != chanInfoPtr->handle) - && (GetStdHandle(STD_ERROR_HANDLE) != chanInfoPtr->handle))) { - closeHandle = 1; - } else { - closeHandle = 0; - } + ConsoleInfo *consolePtr = (ConsoleInfo *) instanceData; + int errorCode; + ConsoleInfo *infoPtr, **nextPtrPtr; + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + DWORD exitCode; - AcquireSRWLockExclusive(&gConsoleLock); + errorCode = 0; - /* Remove channel from watchers' list */ - for (nextPtrPtr = &gWatchingChannelList; *nextPtrPtr != NULL; - nextPtrPtr = &(*nextPtrPtr)->nextWatchingChannelPtr) { - if (*nextPtrPtr == (ConsoleChannelInfo *) chanInfoPtr) { - *nextPtrPtr = (*nextPtrPtr)->nextWatchingChannelPtr; - break; - } - } + /* + * 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. + */ - handleInfoPtr = FindConsoleInfo(chanInfoPtr); - if (handleInfoPtr) { + if (consolePtr->readThread) { /* - * Console thread may be blocked either waiting for console i/o - * or waiting on the condition variable for buffer empty/full + * The thread may already have closed on it's own. Check it's exit + * code. */ - AcquireSRWLockShared(&handleInfoPtr->lock); - if (closeHandle) { - handleInfoPtr->console = INVALID_HANDLE_VALUE; + GetExitCodeThread(consolePtr->readThread, &exitCode); + + if (exitCode == STILL_ACTIVE) { + /* + * Set the stop event so that if the reader thread is blocked in + * ConsoleReaderThread on WaitForMultipleEvents, it will exit + * cleanly. + */ + + SetEvent(consolePtr->stopReader); + + /* + * Wait at most 20 milliseconds for the reader thread to close. + */ + + if (WaitForSingleObject(consolePtr->readThread, 20) + == WAIT_TIMEOUT) { + /* + * Forcibly terminate the background thread as a last resort. + * Note that we need to guard against terminating the thread + * while it is in the middle of Tcl_ThreadAlert because it + * won't be able to release the notifier lock. + */ + + Tcl_MutexLock(&consoleMutex); + + /* BUG: this leaks memory. */ + TerminateThread(consolePtr->readThread, 0); + Tcl_MutexUnlock(&consoleMutex); + } } - /* Break the thread out of blocking console i/o */ - handleInfoPtr->numRefs -= 1; /* Remove reference from this channel */ - if (handleInfoPtr->numRefs == 1) { + CloseHandle(consolePtr->readThread); + CloseHandle(consolePtr->readable); + CloseHandle(consolePtr->startReader); + CloseHandle(consolePtr->stopReader); + consolePtr->readThread = 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->writeThread) { + if (consolePtr->toWrite) { /* - * Abort the i/o if no other threads are listening on it. - * Note without this check, an input line will be skipped on - * the cancel. + * We only need to wait if there is something to write. This may + * prevent infinite wait on exit. [python bug 216289] */ - CancelSynchronousIo(handleInfoPtr->consoleThread); + + WaitForSingleObject(consolePtr->writable, INFINITE); } /* - * Wake up the console handling thread. Note we do not explicitly - * tell it handle is closed (below). It will find out on next access + * The thread may already have closed on it's own. Check it's exit + * code. */ - WakeConditionVariable(&handleInfoPtr->consoleThreadCV); - ReleaseSRWLockShared(&handleInfoPtr->lock); + GetExitCodeThread(consolePtr->writeThread, &exitCode); + + if (exitCode == STILL_ACTIVE) { + /* + * Set the stop event so that if the reader thread is blocked in + * ConsoleWriterThread on WaitForMultipleEvents, it will exit + * cleanly. + */ + + SetEvent(consolePtr->stopWriter); + + /* + * Wait at most 20 milliseconds for the writer thread to close. + */ + + if (WaitForSingleObject(consolePtr->writeThread, 20) + == WAIT_TIMEOUT) { + /* + * Forcibly terminate the background thread as a last resort. + * Note that we need to guard against terminating the thread + * while it is in the middle of Tcl_ThreadAlert because it + * won't be able to release the notifier lock. + */ + + Tcl_MutexLock(&consoleMutex); + + /* BUG: this leaks memory. */ + TerminateThread(consolePtr->writeThread, 0); + Tcl_MutexUnlock(&consoleMutex); + } + } + + CloseHandle(consolePtr->writeThread); + CloseHandle(consolePtr->writable); + CloseHandle(consolePtr->startWriter); + CloseHandle(consolePtr->stopWriter); + consolePtr->writeThread = NULL; } + consolePtr->validMask &= ~TCL_WRITABLE; - ReleaseSRWLockExclusive(&gConsoleLock); - chanInfoPtr->channel = NULL; - chanInfoPtr->watchMask = 0; - chanInfoPtr->permissions = 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 (closeHandle && chanInfoPtr->handle != INVALID_HANDLE_VALUE) { - if (CloseHandle(chanInfoPtr->handle) == FALSE) { - Tcl_WinConvertError(GetLastError()); + 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; } - chanInfoPtr->handle = INVALID_HANDLE_VALUE; } + consolePtr->watchMask &= consolePtr->validMask; + /* - * Note, we can check and manipulate numRefs without a lock because - * we have removed it from the watch queue so the console thread cannot - * get at it. + * Remove the file from the list of watched files. */ - if (chanInfoPtr->numRefs > 1) { - /* There may be references already on the event queue */ - chanInfoPtr->numRefs -= 1; - } else { - ckfree(chanInfoPtr); + + 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((char*) consolePtr); return errorCode; } @@ -1090,143 +679,73 @@ ConsoleCloseProc( * *---------------------------------------------------------------------- */ + static int ConsoleInputProc( - void *instanceData, /* Console state. */ - char *bufPtr, /* Where to store data read. */ + 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. */ { - ConsoleChannelInfo *chanInfoPtr = (ConsoleChannelInfo *)instanceData; - ConsoleHandleInfo *handleInfoPtr; - Tcl_Size numRead; - - if (chanInfoPtr->handle == INVALID_HANDLE_VALUE) { - return 0; /* EOF */ - } + ConsoleInfo *infoPtr = (ConsoleInfo *) instanceData; + DWORD count, bytesRead = 0; + int result; *errorCode = 0; - AcquireSRWLockShared(&gConsoleLock); - handleInfoPtr = FindConsoleInfo(chanInfoPtr); - if (handleInfoPtr == NULL) { - /* Really shouldn't happen since channel is holding a reference */ - ReleaseSRWLockShared(&gConsoleLock); - return 0; /* EOF */ + /* + * 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; } - AcquireSRWLockExclusive(&handleInfoPtr->lock); - ReleaseSRWLockShared(&gConsoleLock); /* AFTER acquiring handleInfoPtr->lock */ - while (1) { - numRead = RingBufferOut(&handleInfoPtr->buffer, bufPtr, bufSize, 1); - /* - * Note: even if channel is closed or has an error, as long there is - * buffered data, we will pass it up. - */ - if (numRead != 0) { - break; - } + if (infoPtr->readFlags & CONSOLE_BUFFERED) { /* - * No data available. - * - If an error was recorded, generate that and reset it. - * - If EOF, indicate as much. It is up to the application to close - * the channel. - * - Otherwise, if non-blocking return EAGAIN or wait for more data. + * Data is stored in the buffer. */ - if (handleInfoPtr->lastError != 0) { - if (handleInfoPtr->lastError == ERROR_INVALID_HANDLE) { - numRead = 0; /* Treat as EOF */ - } else { - Tcl_WinConvertError(handleInfoPtr->lastError); - handleInfoPtr->lastError = 0; - *errorCode = Tcl_GetErrno(); - numRead = -1; - } - break; - } - if (handleInfoPtr->console == INVALID_HANDLE_VALUE) { - /* EOF - break with numRead == 0 */ - chanInfoPtr->handle = INVALID_HANDLE_VALUE; - break; - } - /* For async, tell caller we are blocked */ - if (chanInfoPtr->flags & CONSOLE_ASYNC) { - *errorCode = EWOULDBLOCK; - numRead = -1; - break; - } + 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; - /* - * Blocking read. Just get data from directly from console. There - * is a small complication in that - * 1. The destination buffer should be WCHAR aligned. - * 2. We can only read even number of bytes (wide-character API). - * 3. Caller has large enough buffer (else length of line user can - * enter will be limited) - * If any condition is not met, we defer to the - * reader thread which handles these cases rather than dealing with - * them here (which is a little trickier than it might sound.) - * - * TODO - not clear this block is a useful optimization. bufSize by - * default is 4K which is < INPUT_BUFFER_SIZE and will rarely be - * increased on stdin. - */ - if ((1 & (size_t)bufPtr) == 0 /* aligned buffer */ - && (1 & bufSize) == 0 /* Even number of bytes */ - && bufSize > INPUT_BUFFER_SIZE) { - DWORD lastError; - Tcl_Size numChars; - ReleaseSRWLockExclusive(&handleInfoPtr->lock); - lastError = ReadConsoleChars(chanInfoPtr->handle, - (WCHAR *)bufPtr, bufSize / sizeof(WCHAR), &numChars); - /* NOTE lock released so DON'T break. Return instead */ - if (lastError != ERROR_SUCCESS) { - Tcl_WinConvertError(lastError); - *errorCode = Tcl_GetErrno(); - return -1; - } else if (numChars > 0) { - /* Successfully read something. */ - return numChars * sizeof(WCHAR); - } else { - /* - * Ctrl-C/Ctrl-Brk interrupt. Loop around to retry. - * We have to reacquire the lock. No worried about handleInfoPtr - * having gone away since the channel holds a reference. - */ - AcquireSRWLockExclusive(&handleInfoPtr->lock); - continue; - } - } - /* - * Deferring blocking read to reader thread. - * Release the lock and sleep. Note that because the channel - * holds a reference count on handleInfoPtr, it will not - * be deallocated while the lock is released. - */ - handleInfoPtr->flags |= CONSOLE_DATA_AWAITED; - WakeConditionVariable(&handleInfoPtr->consoleThreadCV); - if (!SleepConditionVariableSRW(&handleInfoPtr->interpThreadCV, - &handleInfoPtr->lock, INFINITE, 0)) { - Tcl_WinConvertError(GetLastError()); - *errorCode = Tcl_GetErrno(); - numRead = -1; - break; + /* + * Reset the buffer + */ + + infoPtr->readFlags &= ~CONSOLE_BUFFERED; + infoPtr->offset = 0; } - /* Lock is reacquired, loop back to try again */ + return bytesRead; } - /* We read data. Ask for more if either async or watching for reads */ - if ((chanInfoPtr->flags & CONSOLE_ASYNC) - || (chanInfoPtr->watchMask & TCL_READABLE)) { - handleInfoPtr->flags |= CONSOLE_DATA_AWAITED; - WakeConditionVariable(&handleInfoPtr->consoleThreadCV); + /* + * 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) { + buf[count] = '\0'; + return count; } - ReleaseSRWLockExclusive(&handleInfoPtr->lock); - return numRead; + return -1; } /* @@ -1246,113 +765,79 @@ ConsoleInputProc( * *---------------------------------------------------------------------- */ + static int ConsoleOutputProc( - void *instanceData, /* Console state. */ - const char *buf, /* The data buffer. */ + ClientData instanceData, /* Console state. */ + CONST char *buf, /* The data buffer. */ int toWrite, /* How many bytes to write? */ int *errorCode) /* Where to store error code. */ { - ConsoleChannelInfo *chanInfoPtr = (ConsoleChannelInfo *)instanceData; - ConsoleHandleInfo *handleInfoPtr; - Tcl_Size numWritten; + ConsoleInfo *infoPtr = (ConsoleInfo *) instanceData; + DWORD bytesWritten, timeout; *errorCode = 0; + timeout = (infoPtr->flags & CONSOLE_ASYNC) ? 0 : INFINITE; + if (WaitForSingleObject(infoPtr->writable, timeout) == WAIT_TIMEOUT) { + /* + * The writer thread is blocked waiting for a write to complete and + * the channel is in non-blocking mode. + */ - if (chanInfoPtr->handle == INVALID_HANDLE_VALUE) { - /* Some other thread would have *previously* closed the stdio handle */ - *errorCode = EPIPE; - return -1; + errno = EAGAIN; + goto error; } - AcquireSRWLockShared(&gConsoleLock); - handleInfoPtr = FindConsoleInfo(chanInfoPtr); - if (handleInfoPtr == NULL) { - /* Really shouldn't happen since channel is holding a reference */ - *errorCode = EPIPE; - ReleaseSRWLockShared(&gConsoleLock); - return -1; - } - AcquireSRWLockExclusive(&handleInfoPtr->lock); - ReleaseSRWLockShared(&gConsoleLock); /* AFTER acquiring handleInfoPtr->lock */ + /* + * Check for a background error on the last write. + */ - /* Keep looping until all written. Break out for async and errors */ - numWritten = 0; - while (1) { - /* Check for error and closing on every loop. */ - if (handleInfoPtr->lastError != 0) { - Tcl_WinConvertError(handleInfoPtr->lastError); - *errorCode = Tcl_GetErrno(); - numWritten = -1; - break; - } - if (handleInfoPtr->console == INVALID_HANDLE_VALUE) { - *errorCode = EPIPE; - chanInfoPtr->handle = INVALID_HANDLE_VALUE; - numWritten = -1; - break; - } + if (infoPtr->writeError) { + TclWinConvertError(infoPtr->writeError); + infoPtr->writeError = 0; + goto error; + } + if (infoPtr->flags & CONSOLE_ASYNC) { /* - * We can either write directly or through the console thread's - * ring buffer. We have to do the latter when - * (1) the operation is async since WriteConsoleChars is always blocking - * (2) when there is already data in the ring buffer because we don't - * want to reorder output from within a thread - * (3) when there are an odd number of bytes since WriteConsole - * takes whole WCHARs - * (4) when the pointer is not aligned on WCHAR - * The ring buffer deals with cases (3) and (4). It would be harder - * to duplicate that here. + * The console is non-blocking, so copy the data into the output + * buffer and restart the writer thread. */ - if ((chanInfoPtr->flags & CONSOLE_ASYNC) /* Case (1) */ - || RingBufferLength(&handleInfoPtr->buffer) != 0 /* Case (2) */ - || (toWrite & 1) != 0 /* Case (3) */ - || (PTR2INT(buf) & 1) != 0) { /* Case (4) */ - numWritten += RingBufferIn(&handleInfoPtr->buffer, - numWritten + buf, toWrite - numWritten, 1); - if (numWritten == toWrite || chanInfoPtr->flags & CONSOLE_ASYNC) { - /* All done or async, just accept whatever was written */ - break; - } + + if (toWrite > infoPtr->writeBufLen) { /* - * Release the lock and sleep. Note that because the channel - * holds a reference count on handleInfoPtr, it will not - * be deallocated while the lock is released. + * Reallocate the buffer to be large enough to hold the data. */ - WakeConditionVariable(&handleInfoPtr->consoleThreadCV); - if (!SleepConditionVariableSRW(&handleInfoPtr->interpThreadCV, - &handleInfoPtr->lock, INFINITE, 0)) { - /* Report the error */ - Tcl_WinConvertError(GetLastError()); - *errorCode = Tcl_GetErrno(); - numWritten = -1; - break; - } - } else { - /* Direct output */ - DWORD winStatus; - HANDLE consoleHandle = handleInfoPtr->console; - /* Unlock before blocking in WriteConsole */ - ReleaseSRWLockExclusive(&handleInfoPtr->lock); - /* UNLOCKED so return, DON'T break out of loop as it will unlock - * again! */ - winStatus = WriteConsoleChars(consoleHandle, - (WCHAR *)buf, toWrite / sizeof(WCHAR), &numWritten); - if (winStatus == ERROR_SUCCESS) { - return numWritten * sizeof(WCHAR); - } else { - Tcl_WinConvertError(winStatus); - *errorCode = Tcl_GetErrno(); - return -1; + + if (infoPtr->writeBuf) { + ckfree(infoPtr->writeBuf); } + infoPtr->writeBufLen = toWrite; + infoPtr->writeBuf = ckalloc((size_t)toWrite); } + memcpy(infoPtr->writeBuf, buf, (size_t)toWrite); + infoPtr->toWrite = toWrite; + ResetEvent(infoPtr->writable); + SetEvent(infoPtr->startWriter); + bytesWritten = toWrite; + } else { + /* + * In the blocking case, just try to write the buffer directly. This + * avoids an unnecessary copy. + */ - /* Lock must have been reacquired before continuing loop */ + if (writeConsoleBytes(infoPtr->handle, buf, (DWORD)toWrite, + &bytesWritten) + == FALSE) { + TclWinConvertError(GetLastError()); + goto error; + } } - WakeConditionVariable(&handleInfoPtr->consoleThreadCV); - ReleaseSRWLockExclusive(&handleInfoPtr->lock); - return numWritten; + return bytesWritten; + + error: + *errorCode = errno; + return -1; } /* @@ -1382,84 +867,66 @@ ConsoleEventProc( int flags) /* Flags that indicate what events to handle, * such as TCL_FILE_EVENTS. */ { - ConsoleEvent *consoleEvPtr = (ConsoleEvent *) evPtr; - ConsoleChannelInfo *chanInfoPtr; - int freeChannel; - int mask = 0; + ConsoleEvent *consoleEvPtr = (ConsoleEvent *)evPtr; + ConsoleInfo *infoPtr; + int mask; + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); if (!(flags & TCL_FILE_EVENTS)) { return 0; } - chanInfoPtr = consoleEvPtr->chanInfoPtr; /* - * We know chanInfoPtr is valid because its reference count would have - * been incremented when the event was queued. The corresponding release - * happens in this function. + * 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; + } + } + /* - * Global lock used for chanInfoPtr. A read (shared) lock suffices - * because all access is within the channel owning thread with the - * exception of watchers which is a read-only access. See comments - * to ConsoleChannelInfo. + * Remove stale events. */ - AcquireSRWLockShared(&gConsoleLock); - chanInfoPtr->flags &= ~CONSOLE_EVENT_QUEUED; + + if (!infoPtr) { + return 1; + } /* - * Only handle the event if the Tcl channel has not gone away AND is - * still owned by this thread AND is still watching events. + * 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. */ - if (chanInfoPtr->channel && chanInfoPtr->threadId == Tcl_GetCurrentThread() - && (chanInfoPtr->watchMask & (TCL_READABLE|TCL_WRITABLE))) { - ConsoleHandleInfo *handleInfoPtr = FindConsoleInfo(chanInfoPtr); - if (handleInfoPtr == NULL) { - /* Console was closed. EOF->read event only (not write) */ - if (chanInfoPtr->watchMask & TCL_READABLE) { - mask = TCL_READABLE; - } - } else { - AcquireSRWLockShared(&handleInfoPtr->lock); - /* Remember at most one of READABLE, WRITABLE set */ - if ((chanInfoPtr->watchMask & TCL_READABLE) - && RingBufferLength(&handleInfoPtr->buffer)) { + + mask = 0; + if (infoPtr->watchMask & TCL_WRITABLE) { + if (WaitForSingleObject(infoPtr->writable, 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 if ((chanInfoPtr->watchMask & TCL_WRITABLE) - && RingBufferHasFreeSpace(&handleInfoPtr->buffer)) { - /* Generate write event space available */ - mask = TCL_WRITABLE; + } else { + mask |= TCL_READABLE; } - ReleaseSRWLockShared(&handleInfoPtr->lock); } } /* - * Tcl_NotifyChannel can recurse through the file event callback so need - * to release locks first. Our reference still holds so no danger of - * chanInfoPtr being deallocated if the callback closes the channel. + * Inform the channel of the events. */ - ReleaseSRWLockShared(&gConsoleLock); - if (mask) { - Tcl_NotifyChannel(chanInfoPtr->channel, mask); - /* Note: chanInfoPtr ref count may have changed */ - } - - /* No need to lock - see comments earlier */ - - /* Remove the reference to the channel from event record */ - if (chanInfoPtr->numRefs > 1) { - chanInfoPtr->numRefs -= 1; - freeChannel = 0; - } else { - assert(chanInfoPtr->channel == NULL); - freeChannel = 1; - } - - if (freeChannel) { - ckfree(chanInfoPtr); - } + Tcl_NotifyChannel(infoPtr->channel, infoPtr->watchMask & mask); return 1; } @@ -1481,57 +948,42 @@ ConsoleEventProc( static void ConsoleWatchProc( - void *instanceData, /* Console state. */ - int newMask) /* What events to watch for, one of - * of TCL_READABLE, TCL_WRITABLE */ + ClientData instanceData, /* Console state. */ + int mask) /* What events to watch for, OR-ed combination + * of TCL_READABLE, TCL_WRITABLE and + * TCL_EXCEPTION. */ { - ConsoleChannelInfo **nextPtrPtr, *ptr; - ConsoleChannelInfo *chanInfoPtr = (ConsoleChannelInfo *)instanceData; - int oldMask = chanInfoPtr->watchMask; + ConsoleInfo **nextPtrPtr, *ptr; + ConsoleInfo *infoPtr = (ConsoleInfo *) 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. */ - chanInfoPtr->watchMask = newMask & chanInfoPtr->permissions; - if (chanInfoPtr->watchMask) { + infoPtr->watchMask = mask & infoPtr->validMask; + if (infoPtr->watchMask) { Tcl_Time blockTime = { 0, 0 }; - if (!oldMask) { - AcquireSRWLockExclusive(&gConsoleLock); - /* Add to list of watched channels */ - chanInfoPtr->nextWatchingChannelPtr = gWatchingChannelList; - gWatchingChannelList = chanInfoPtr; - - /* - * For read channels, need to tell the console reader thread - * that we are looking for data since it will not do reads until - * it knows someone is awaiting. - */ - ConsoleHandleInfo *handleInfoPtr = FindConsoleInfo(chanInfoPtr); - if (handleInfoPtr) { - AcquireSRWLockExclusive(&handleInfoPtr->lock); - handleInfoPtr->flags |= CONSOLE_DATA_AWAITED; - WakeConditionVariable(&handleInfoPtr->consoleThreadCV); - ReleaseSRWLockExclusive(&handleInfoPtr->lock); - } - ReleaseSRWLockExclusive(&gConsoleLock); + infoPtr->nextPtr = tsdPtr->firstConsolePtr; + tsdPtr->firstConsolePtr = infoPtr; } Tcl_SetMaxBlockTime(&blockTime); } else if (oldMask) { - /* Remove from list of watched channels */ + /* + * Remove the console from the list of watched consoles. + */ - AcquireSRWLockExclusive(&gConsoleLock); - for (nextPtrPtr = &gWatchingChannelList, ptr = *nextPtrPtr; + for (nextPtrPtr = &(tsdPtr->firstConsolePtr), ptr = *nextPtrPtr; ptr != NULL; - nextPtrPtr = &ptr->nextWatchingChannelPtr, ptr = *nextPtrPtr) { - if (chanInfoPtr == ptr) { - *nextPtrPtr = ptr->nextWatchingChannelPtr; + nextPtrPtr = &ptr->nextPtr, ptr = *nextPtrPtr) { + if (infoPtr == ptr) { + *nextPtrPtr = ptr->nextPtr; break; } } - ReleaseSRWLockExclusive(&gConsoleLock); } } @@ -1555,70 +1007,117 @@ ConsoleWatchProc( static int ConsoleGetHandleProc( - void *instanceData, /* The console state. */ - TCL_UNUSED(int) /*direction*/, - void **handlePtr) /* Where to store the handle. */ + ClientData instanceData, /* The console state. */ + int direction, /* TCL_READABLE or TCL_WRITABLE */ + ClientData *handlePtr) /* Where to store the handle. */ { - ConsoleChannelInfo *chanInfoPtr = (ConsoleChannelInfo *)instanceData; + ConsoleInfo *infoPtr = (ConsoleInfo *) instanceData; - if (chanInfoPtr->handle == INVALID_HANDLE_VALUE) { - return TCL_ERROR; - } else { - *handlePtr = chanInfoPtr->handle; - return TCL_OK; - } + *handlePtr = (ClientData) infoPtr->handle; + return TCL_OK; } /* - *------------------------------------------------------------------------ + *---------------------------------------------------------------------- * - * ConsoleDataAvailable -- + * WaitForRead -- * - * Checks if there is data in the console input queue. + * 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 the input queue has data, -1 on error else 0 if empty. + * 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: - * None. + * Updates the shared state flags. If no error occurred, the reader + * thread is blocked waiting for a signal from the main thread. * - *------------------------------------------------------------------------ + *---------------------------------------------------------------------- */ - static int - ConsoleDataAvailable( - HANDLE consoleHandle) + +static int +WaitForRead( + ConsoleInfo *infoPtr, /* Console state. */ + int blocking) /* Indicates whether call should be blocking + * or not. */ { - INPUT_RECORD input[10]; - DWORD count; - DWORD i; + DWORD timeout, count; + HANDLE *handle = infoPtr->handle; + INPUT_RECORD input; - /* - * Need at least one keyboard event. - */ - if (PeekConsoleInputW(consoleHandle, input, - sizeof(input) / sizeof(input[0]), &count) == FALSE) { - return -1; - } - /* - * Even if windows size and mouse events are disabled, can still have - * events other than keyboard, like focus events. Look for at least one - * keydown event because a trailing LF keyup is always present from the - * last input. However, if our buffer is full, assume there is a key - * down somewhere in the unread buffer. I suppose we could expand the - * buffer but not worth... - */ - if (count == (sizeof(input)/sizeof(input[0]))) { - return 1; - } - for (i = 0; i < count; ++i) { - if (input[i].EventType == KEY_EVENT - && input[i].Event.KeyEvent.bKeyDown) { + while (1) { + /* + * Synchronize with the reader thread. + */ + + timeout = blocking ? INFINITE : 0; + if (WaitForSingleObject(infoPtr->readable, timeout) == WAIT_TIMEOUT) { + /* + * The reader thread is blocked waiting for data and the channel + * is in non-blocking mode. + */ + + errno = EAGAIN; + return -1; + } + + /* + * At this point, the two threads are synchronized, so it is safe to + * access shared state. + */ + + /* + * If the console has hit EOF, it is always readable. + */ + + if (infoPtr->readFlags & CONSOLE_EOF) { + return 1; + } + + if (PeekConsoleInput(handle, &input, 1, &count) == FALSE) { + /* + * Check to see if the peek failed because of EOF. + */ + + TclWinConvertError(GetLastError()); + + if (errno == EOF) { + infoPtr->readFlags |= CONSOLE_EOF; + return 1; + } + + /* + * Ignore errors if there is data in the buffer. + */ + + if (infoPtr->readFlags & CONSOLE_BUFFERED) { + return 0; + } else { + return -1; + } + } + + /* + * If there is data in the buffer, the console must be readable (since + * it is a line-oriented device). + */ + + if (infoPtr->readFlags & CONSOLE_BUFFERED) { return 1; } + + /* + * There wasn't any data available, so reset the thread and try again. + */ + + ResetEvent(infoPtr->readable); + SetEvent(infoPtr->startReader); } - return 0; } - + /* *---------------------------------------------------------------------- * @@ -1628,10 +1127,12 @@ ConsoleGetHandleProc( * available on a console. * * Results: - * Always 0. + * None. * * Side effects: - * Signals the main thread when input become available. + * 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. * *---------------------------------------------------------------------- */ @@ -1640,182 +1141,75 @@ static DWORD WINAPI ConsoleReaderThread( LPVOID arg) { - ConsoleHandleInfo *handleInfoPtr = (ConsoleHandleInfo *) arg; - ConsoleHandleInfo **iterator; - Tcl_Size inputLen = 0; - Tcl_Size inputOffset = 0; - Tcl_Size lastReadSize = 0; - DWORD sleepTime; - char inputChars[INPUT_BUFFER_SIZE]; + ConsoleInfo *infoPtr = (ConsoleInfo *)arg; + HANDLE *handle = infoPtr->handle; + DWORD waitResult; + HANDLE wEvents[2]; - /* - * Keep looping until one of the following happens. - * - there are no more channels listening on the console - * - the console handle has been closed - */ + /* The first event takes precedence. */ + wEvents[0] = infoPtr->stopReader; + wEvents[1] = infoPtr->startReader; - /* This thread is holding a reference so pointer is safe */ - AcquireSRWLockExclusive(&handleInfoPtr->lock); + for (;;) { + /* + * Wait for the main thread to signal before attempting to wait. + */ - while (1) { + waitResult = WaitForMultipleObjects(2, wEvents, FALSE, INFINITE); - if (handleInfoPtr->numRefs == 1) { + if (waitResult != (WAIT_OBJECT_0 + 1)) { /* - * Sole reference. That's this thread. Exit since no clients - * and no way for a thread to attach to a console after process - * start. + * The start event was not signaled. It must be the stop event or + * an error, so exit this thread. */ + break; } /* - * Shared buffer has no data. If we have some in our private buffer - * copy that. Else check if there has been an error. In both cases - * notify the interp threads. + * Look for data on the console, but first ignore any events that are + * not KEY_EVENTs. */ - if (inputLen > 0 || handleInfoPtr->lastError != 0) { - HANDLE consoleHandle; - if (inputLen > 0) { - /* Private buffer has data. Copy it over. */ - Tcl_Size nStored; - - assert((inputLen - inputOffset) > 0); - nStored = RingBufferIn(&handleInfoPtr->buffer, - inputOffset + inputChars, inputLen - inputOffset, - 1); - inputOffset += nStored; - if (inputOffset == inputLen) { - /* Temp buffer now empty */ - inputOffset = 0; - inputLen = 0; - } - } else { - /* - * On error, nothing but inform caller and wait - * We do not want to exit until there are no client interps. - */ - } + if (readConsoleBytes(handle, infoPtr->buffer, CONSOLE_BUFFER_SIZE, + (LPDWORD) &infoPtr->bytesRead) != FALSE) { /* - * Wake up any threads waiting either synchronously or - * asynchronously. Since we are providing data, turn off the - * AWAITED flag. If the data provided is not sufficient the - * clients will request again. Note we have to wake up ALL - * awaiting threads, not just one, so they can all reissue - * requests if needed. (In a properly designed app, at most one - * thread should be reading standard input but...) - */ - handleInfoPtr->flags &= ~CONSOLE_DATA_AWAITED; - /* Wake synchronous channels */ - WakeAllConditionVariable(&handleInfoPtr->interpThreadCV); - /* - * Wake up async channels registered for file events. Note in - * order to follow the locking hierarchy, we need to release - * handleInfoPtr->lock before calling NudgeWatchers. + * Data was stored in the buffer. */ - consoleHandle = handleInfoPtr->console; - ReleaseSRWLockExclusive(&handleInfoPtr->lock); - NudgeWatchers(consoleHandle); - AcquireSRWLockExclusive(&handleInfoPtr->lock); - - /* - * Loop back to recheck for exit conditions changes while the - * the lock was not held. - */ - continue; - } - assert(inputLen == 0); + infoPtr->readFlags |= CONSOLE_BUFFERED; + } else { + DWORD err; + err = GetLastError(); - /* - * Read more data in two cases: - * 1. The previous read filled the buffer and there could be more - * data in the console internal *text* buffer. Note - * ConsolePendingInput (checked in ConsoleDataAvailable) will NOT - * show this. It holds input events not yet translated to text. - * 2. Tcl threads want more data AND there is data in the - * ConsolePendingInput buffer. The latter check necessary because - * we do not want to read ahead because the interp thread might - * change the read mode, e.g. turning off echo for password - * input. So only do so if at least one interpreter has requested - * data. - */ - if (lastReadSize == sizeof(inputChars) - || ((handleInfoPtr->flags & CONSOLE_DATA_AWAITED) - && ConsoleDataAvailable(handleInfoPtr->console))) { - DWORD error; - /* Do not hold the lock while blocked in console */ - ReleaseSRWLockExclusive(&handleInfoPtr->lock); - error = ReadConsoleChars(handleInfoPtr->console, - (WCHAR *)inputChars, sizeof(inputChars) / sizeof(WCHAR), - &inputLen); - AcquireSRWLockExclusive(&handleInfoPtr->lock); - if (error == 0) { - inputLen *= sizeof(WCHAR); - lastReadSize = inputLen; - } else { - /* - * We only store the last error. It is up to channel - * handlers whether to close or not in case of errors. - */ - lastReadSize = 0; - handleInfoPtr->lastError = error; - if (handleInfoPtr->lastError == ERROR_INVALID_HANDLE) { - handleInfoPtr->console = INVALID_HANDLE_VALUE; - } + if (err == (DWORD)EOF) { + infoPtr->readFlags = CONSOLE_EOF; } - } else { - /* - * Either no one was asking for data, or no data was available. - * In the former case, wait until someone wakes us asking for - * data. In the latter case, there is no alternative but to - * poll since ReadConsole does not support async operation. - * So sleep for a short while and loop back to retry. - */ - sleepTime = - handleInfoPtr->flags & CONSOLE_DATA_AWAITED ? 50 : INFINITE; - SleepConditionVariableSRW(&handleInfoPtr->consoleThreadCV, - &handleInfoPtr->lock, sleepTime, 0); } - /* Loop again to check for exit or wait for readers to wake us */ - } - - /* - * Exiting: - * - remove the console from global list - * - close the handle if still valid - * - release the structure - * Note there is not need to check for any watchers because we only - * exit when there are no channels open to this console. - */ - ReleaseSRWLockExclusive(&handleInfoPtr->lock); - AcquireSRWLockExclusive(&gConsoleLock); /* Modifying - exclusive lock */ - for (iterator = &gConsoleHandleInfoList; *iterator; - iterator = &(*iterator)->nextPtr) { - if (*iterator == handleInfoPtr) { - *iterator = handleInfoPtr->nextPtr; - break; - } - } - ReleaseSRWLockExclusive(&gConsoleLock); + /* + * Signal the main thread by signalling the readable event and then + * waking up the notifier thread. + */ - /* No need for relocking - no other thread should have access to it now */ - RingBufferClear(&handleInfoPtr->buffer); + SetEvent(infoPtr->readable); - if (handleInfoPtr->console != INVALID_HANDLE_VALUE - && handleInfoPtr->lastError != ERROR_INVALID_HANDLE) { - SetConsoleMode(handleInfoPtr->console, handleInfoPtr->initMode); /* - * NOTE: we do not call CloseHandle(handleInfoPtr->console) here. - * As per the GetStdHandle documentation, it need not be closed. - * Other components may be directly using it. Note however that - * an explicit chan close script command does close the handle - * for all threads. + * 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. */ - } - ckfree(handleInfoPtr); + 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); + } return 0; } @@ -1832,255 +1226,91 @@ ConsoleReaderThread( * Always returns 0. * * Side effects: - * Signals the main thread when an output operation is completed. + + * 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) { - ConsoleHandleInfo *handleInfoPtr = (ConsoleHandleInfo *) arg; - ConsoleHandleInfo **iterator; - BOOL success; - Tcl_Size numBytes; - /* - * This buffer size has no relation really with the size of the shared - * buffer. Could be bigger or smaller. Make larger as multiple threads - * could potentially be writing to it. - */ - char buffer[2*CONSOLE_BUFFER_SIZE]; - /* - * Keep looping until one of the following happens. - * - * - there are not more channels listening on the console - * - the console handle has been closed - * - * On each iteration, - * - if the channel buffer is empty, wait for some channel writer to write - * - if there is data in our buffer, write it to the console - */ - - /* This thread is holding a reference so pointer is safe */ - AcquireSRWLockExclusive(&handleInfoPtr->lock); - while (1) { - /* handleInfoPtr->lock must be held on entry to loop */ + ConsoleInfo *infoPtr = (ConsoleInfo *)arg; + HANDLE *handle = infoPtr->handle; + DWORD count, toWrite, waitResult; + char *buf; + HANDLE wEvents[2]; - int offset; - HANDLE consoleHandle; + /* The first event takes precedence. */ + wEvents[0] = infoPtr->stopWriter; + wEvents[1] = infoPtr->startWriter; + for (;;) { /* - * Sadly, we need to do another copy because do not want to hold - * a lock on handleInfoPtr->buffer while calling WriteConsole as that - * might block. Also, we only want to copy an integral number of - * WCHAR's, i.e. even number of chars so do some length checks up - * front. + * Wait for the main thread to signal before attempting to write. */ - numBytes = RingBufferLength(&handleInfoPtr->buffer); - numBytes &= ~1; /* Copy integral number of WCHARs -> even number of bytes */ - if (numBytes == 0) { - /* No data to write */ - if (handleInfoPtr->numRefs == 1) { - /* - * Sole reference. That's this thread. Exit since no clients - * and no buffered output. - */ - break; - } - /* Wake up any threads waiting synchronously. */ - WakeConditionVariable(&handleInfoPtr->interpThreadCV); - success = SleepConditionVariableSRW(&handleInfoPtr->consoleThreadCV, - &handleInfoPtr->lock, INFINITE, 0); - /* Note: lock has been acquired again! */ - if (!success && GetLastError() != ERROR_TIMEOUT) { - /* TODO - what can be done? Should not happen */ - /* For now keep going */ - } - continue; - } - /* We have data to write */ - if ((size_t)numBytes > (sizeof(buffer) / sizeof(buffer[0]))) { - numBytes = sizeof(buffer); + waitResult = WaitForMultipleObjects(2, wEvents, FALSE, INFINITE); + + if (waitResult != (WAIT_OBJECT_0 + 1)) { + /* + * The start event was not signaled. It must be the stop event or + * an error, so exit this thread. + */ + + break; } - /* No need to check result, we already checked length bytes available */ - RingBufferOut(&handleInfoPtr->buffer, buffer, numBytes, 0); - - consoleHandle = handleInfoPtr->console; - WakeConditionVariable(&handleInfoPtr->interpThreadCV); - ReleaseSRWLockExclusive(&handleInfoPtr->lock); - offset = 0; - while (numBytes > 0) { - Tcl_Size numWChars = numBytes / sizeof(WCHAR); - DWORD status; - status = WriteConsoleChars(handleInfoPtr->console, - (WCHAR *)(offset + buffer), numWChars, &numWChars); - if (status != 0) { - /* Only overwrite if no previous error */ - if (handleInfoPtr->lastError == 0) { - handleInfoPtr->lastError = status; - } - if (status == ERROR_INVALID_HANDLE) { - handleInfoPtr->console = INVALID_HANDLE_VALUE; - } - /* Assume this write is done but keep looping in case - * it is a transient error. Not sure just closing handle - * and exiting thread is a good idea until all references - * from interp threads are gone. - */ + + 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(); break; + } else { + toWrite -= count; + buf += count; } - numBytes -= numWChars * sizeof(WCHAR); - offset += numWChars * sizeof(WCHAR); } - /* Wake up any threads waiting synchronously. */ - WakeConditionVariable(&handleInfoPtr->interpThreadCV); /* - * Wake up all channels registered for file events. Note in - * order to follow the locking hierarchy, we cannot hold any locks - * when calling NudgeWatchers. + * Signal the main thread by signalling the writable event and then + * waking up the notifier thread. */ - NudgeWatchers(consoleHandle); - - AcquireSRWLockExclusive(&handleInfoPtr->lock); - } - /* - * Exiting: - * - remove the console from global list - * - release the structure - * NOTE: we do not call CloseHandle(handleInfoPtr->console) here. - * As per the GetStdHandle documentation, it need not be closed. - * Other components may be directly using it. Note however that - * an explicit chan close script command does close the handle - * for all threads. - */ - ReleaseSRWLockExclusive(&handleInfoPtr->lock); - AcquireSRWLockExclusive(&gConsoleLock); /* Modifying - exclusive lock */ - for (iterator = &gConsoleHandleInfoList; *iterator; - iterator = &(*iterator)->nextPtr) { - if (*iterator == handleInfoPtr) { - *iterator = handleInfoPtr->nextPtr; - break; - } - } - ReleaseSRWLockExclusive(&gConsoleLock); + SetEvent(infoPtr->writable); - RingBufferClear(&handleInfoPtr->buffer); + /* + * 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. + */ - ckfree(handleInfoPtr); + Tcl_MutexLock(&consoleMutex); + if (infoPtr->threadId != NULL) { + /* + * TIP #218. When in flight ignore the event, no one will receive + * it anyway. + */ - return 0; -} - -/* - *------------------------------------------------------------------------ - * - * AllocateConsoleHandleInfo -- - * - * Allocates a ConsoleHandleInfo for the passed console handle. As - * a side effect starts a console thread to handle i/o on the handle. - * - * Important: Caller must be holding an EXCLUSIVE lock on gConsoleLock - * when calling this function. The lock continues to be held on return. - * - * Results: - * Pointer to an unlocked ConsoleHandleInfo structure. The reference - * count on the structure is 1. This corresponds to the common reference - * from the console thread and the gConsoleHandleInfoList. Returns NULL - * on error. - * - * Side effects: - * A console reader or writer thread is started. The returned structure - * is placed on the active console handler list gConsoleHandleInfoList. - * - *------------------------------------------------------------------------ - */ -static ConsoleHandleInfo * -AllocateConsoleHandleInfo( - HANDLE consoleHandle, - int permissions) /* TCL_READABLE or TCL_WRITABLE */ -{ - ConsoleHandleInfo *handleInfoPtr; - DWORD consoleMode; - - handleInfoPtr = (ConsoleHandleInfo *) ckalloc(sizeof(*handleInfoPtr)); - memset(handleInfoPtr, 0, sizeof(*handleInfoPtr)); - memset(handleInfoPtr, 0, sizeof(*handleInfoPtr)); - handleInfoPtr->console = consoleHandle; - InitializeSRWLock(&handleInfoPtr->lock); - InitializeConditionVariable(&handleInfoPtr->consoleThreadCV); - InitializeConditionVariable(&handleInfoPtr->interpThreadCV); - RingBufferInit(&handleInfoPtr->buffer, CONSOLE_BUFFER_SIZE); - handleInfoPtr->lastError = 0; - handleInfoPtr->permissions = permissions; - handleInfoPtr->numRefs = 1; /* See function header */ - if (permissions == TCL_READABLE) { - GetConsoleMode(consoleHandle, &handleInfoPtr->initMode); - consoleMode = handleInfoPtr->initMode; - consoleMode &= ~(ENABLE_WINDOW_INPUT | ENABLE_MOUSE_INPUT); - consoleMode |= ENABLE_LINE_INPUT; - SetConsoleMode(consoleHandle, consoleMode); - } - handleInfoPtr->consoleThread = CreateThread( - NULL, /* default security descriptor */ - 2*CONSOLE_BUFFER_SIZE, /* Stack size - gets rounded up to granularity */ - permissions == TCL_READABLE ? ConsoleReaderThread : ConsoleWriterThread, - handleInfoPtr, /* Pass to thread */ - 0, /* Flags - no special cases */ - NULL); /* Don't care about thread id */ - if (handleInfoPtr->consoleThread == NULL) { - /* Note - SRWLock and condition variables do not need finalization */ - RingBufferClear(&handleInfoPtr->buffer); - ckfree(handleInfoPtr); - return NULL; + Tcl_ThreadAlert(infoPtr->threadId); + } + Tcl_MutexUnlock(&consoleMutex); } - /* Chain onto global list */ - handleInfoPtr->nextPtr = gConsoleHandleInfoList; - gConsoleHandleInfoList = handleInfoPtr; - - return handleInfoPtr; + return 0; } /* - *------------------------------------------------------------------------ - * - * FindConsoleInfo -- - * - * Finds the ConsoleHandleInfo record for a given ConsoleChannelInfo. - * The found record must match the console handle. It is the caller's - * responsibility to check the permissions (read/write) in the returned - * ConsoleHandleInfo match permissions in chanInfoPtr. This function does - * not check that. - * - * Important: Caller must be holding an shared or exclusive lock on - * gConsoleMutex. That ensures the returned pointer stays valid on - * return without risk of deallocation by other threads. - * - * Results: - * Pointer to the found ConsoleHandleInfo or NULL if not found - * - * Side effects: - * None. - * - *------------------------------------------------------------------------ - */ -static ConsoleHandleInfo * -FindConsoleInfo(const ConsoleChannelInfo *chanInfoPtr) -{ - ConsoleHandleInfo *handleInfoPtr; - for (handleInfoPtr = gConsoleHandleInfoList; handleInfoPtr; handleInfoPtr = handleInfoPtr->nextPtr) { - if (handleInfoPtr->console == chanInfoPtr->handle) { - return handleInfoPtr; - } - } - return NULL; -} - -/* *---------------------------------------------------------------------- * * TclWinOpenConsoleChannel -- @@ -2093,34 +1323,37 @@ FindConsoleInfo(const ConsoleChannelInfo *chanInfoPtr) * Returns the new channel, or NULL. * * Side effects: - * May open the channel. + * May open the channel * *---------------------------------------------------------------------- */ + Tcl_Channel TclWinOpenConsoleChannel( HANDLE handle, char *channelName, int permissions) { - ConsoleChannelInfo *chanInfoPtr; - ConsoleHandleInfo *handleInfoPtr; - - /* A console handle can either be input or output, not both */ - if (permissions != TCL_READABLE && permissions != TCL_WRITABLE) { - return NULL; - } + char encoding[4 + TCL_INTEGER_SPACE]; + ConsoleInfo *infoPtr; + DWORD id, modes; ConsoleInit(); - chanInfoPtr = (ConsoleChannelInfo *)ckalloc(sizeof(*chanInfoPtr)); - memset(chanInfoPtr, 0, sizeof(*chanInfoPtr)); + /* + * See if a channel with this handle already exists. + */ + + infoPtr = (ConsoleInfo *) ckalloc((unsigned) sizeof(ConsoleInfo)); + memset(infoPtr, 0, sizeof(ConsoleInfo)); + + infoPtr->validMask = permissions; + infoPtr->handle = handle; + infoPtr->channel = (Tcl_Channel) NULL; - chanInfoPtr->permissions = permissions; - chanInfoPtr->handle = handle; - chanInfoPtr->channel = (Tcl_Channel) NULL; + wsprintfA(encoding, "cp%d", GetConsoleCP()); - chanInfoPtr->threadId = Tcl_GetCurrentThread(); + infoPtr->threadId = Tcl_GetCurrentThread(); /* * Use the pointer for the name of the result channel. This keeps the @@ -2128,7 +1361,10 @@ TclWinOpenConsoleChannel( * for instance). */ - TclWinGenerateChannelName(channelName, "file", chanInfoPtr); + sprintf(channelName, "file%" TCL_I_MODIFIER "x", (size_t)infoPtr); + + infoPtr->channel = Tcl_CreateChannel(&consoleChannelType, channelName, + (ClientData) infoPtr, permissions); if (permissions & TCL_READABLE) { /* @@ -2137,76 +1373,41 @@ TclWinOpenConsoleChannel( * we only want to catch when complete lines are ready for reading. */ - chanInfoPtr->flags |= CONSOLE_READ_OPS; - GetConsoleMode(handle, &chanInfoPtr->initMode); - -#ifdef OBSOLETE - /* Why was priority being set on console input? Code smell */ - SetThreadPriority(infoPtr->reader.thread, THREAD_PRIORITY_HIGHEST); -#endif - } else { - /* Already checked permissions is WRITABLE if not READABLE */ - /* TODO - enable ansi escape processing? */ + GetConsoleMode(infoPtr->handle, &modes); + modes &= ~(ENABLE_WINDOW_INPUT | ENABLE_MOUSE_INPUT); + modes |= ENABLE_LINE_INPUT; + SetConsoleMode(infoPtr->handle, modes); + + infoPtr->readable = CreateEvent(NULL, TRUE, TRUE, NULL); + infoPtr->startReader = CreateEvent(NULL, FALSE, FALSE, NULL); + infoPtr->stopReader = CreateEvent(NULL, FALSE, FALSE, NULL); + infoPtr->readThread = CreateThread(NULL, 256, ConsoleReaderThread, + infoPtr, 0, &id); + SetThreadPriority(infoPtr->readThread, THREAD_PRIORITY_HIGHEST); } - /* - * Global lock but that's ok. See comments top of file. Allocations - * will happen only a few times in the life of a process and that too - * generally at start up where only one thread is active. - */ - AcquireSRWLockExclusive(&gConsoleLock); /*Allocate needs exclusive lock */ - - handleInfoPtr = FindConsoleInfo(chanInfoPtr); - if (handleInfoPtr == NULL) { - /* Not found. Allocate one */ - handleInfoPtr = AllocateConsoleHandleInfo(handle, permissions); - } else { - /* Found. Its direction (read/write) better be the same */ - if (handleInfoPtr->permissions != permissions) { - handleInfoPtr = NULL; - } + if (permissions & TCL_WRITABLE) { + infoPtr->writable = CreateEvent(NULL, TRUE, TRUE, NULL); + infoPtr->startWriter = CreateEvent(NULL, FALSE, FALSE, NULL); + infoPtr->stopWriter = CreateEvent(NULL, FALSE, FALSE, NULL); + infoPtr->writeThread = CreateThread(NULL, 256, ConsoleWriterThread, + infoPtr, 0, &id); + SetThreadPriority(infoPtr->writeThread, THREAD_PRIORITY_HIGHEST); } - if (handleInfoPtr == NULL) { - ReleaseSRWLockExclusive(&gConsoleLock); - if (permissions == TCL_READABLE) { - SetConsoleMode(handle, chanInfoPtr->initMode); - } - ckfree(chanInfoPtr); - return NULL; - } - - /* - * There is effectively a reference to this structure from the Tcl - * channel subsystem. So record that. This reference will be dropped - * when the Tcl channel is closed. - */ - chanInfoPtr->numRefs = 1; - - /* - * Need to keep track of number of referencing channels for closing. - * The pointer is safe since there is a reference held to it from - * gConsoleHandleInfoList but still need to lock the structure itself - */ - AcquireSRWLockExclusive(&handleInfoPtr->lock); - handleInfoPtr->numRefs += 1; - ReleaseSRWLockExclusive(&handleInfoPtr->lock); - - ReleaseSRWLockExclusive(&gConsoleLock); - - /* Note Tcl_CreateChannel never fails other than panic on error */ - chanInfoPtr->channel = Tcl_CreateChannel(&consoleChannelType, channelName, - chanInfoPtr, permissions); - /* - * Consoles have default translation of auto and ^Z eof char, which means + * 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, chanInfoPtr->channel, "-translation", "auto"); - Tcl_SetChannelOption(NULL, chanInfoPtr->channel, "-eofchar", "\x1A {}"); - Tcl_SetChannelOption(NULL, chanInfoPtr->channel, "-encoding", "utf-16"); - return chanInfoPtr->channel; + Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto"); + Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "\032 {}"); + if (tclWinProcs->useWide) + Tcl_SetChannelOption(NULL, infoPtr->channel, "-encoding", "unicode"); + else + Tcl_SetChannelOption(NULL, infoPtr->channel, "-encoding", encoding); + + return infoPtr->channel; } /* @@ -2227,221 +1428,35 @@ TclWinOpenConsoleChannel( static void ConsoleThreadActionProc( - void *instanceData, + ClientData instanceData, int action) { - ConsoleChannelInfo *chanInfoPtr = (ConsoleChannelInfo *)instanceData; - - /* No need for any locks as no other thread will be writing to it */ - if (action == TCL_CHANNEL_THREAD_INSERT) { - ConsoleInit(); /* Needed to set up event source handlers for this thread */ - chanInfoPtr->threadId = Tcl_GetCurrentThread(); - } else { - chanInfoPtr->threadId = NULL; - } -} - -/* - *---------------------------------------------------------------------- - * - * ConsoleSetOptionProc -- - * - * 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 console. Sets Error message if needed (by - * calling Tcl_BadChannelOption). - * - *---------------------------------------------------------------------- - */ -static int -ConsoleSetOptionProc( - void *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. */ -{ - ConsoleChannelInfo *chanInfoPtr = (ConsoleChannelInfo *)instanceData; - int len = strlen(optionName); - int vlen = strlen(value); - - /* - * Option -inputmode normal|password|raw - */ - - if ((chanInfoPtr->flags & CONSOLE_READ_OPS) && (len > 1) && - (strncmp(optionName, "-inputmode", len) == 0)) { - DWORD mode; - - if (GetConsoleMode(chanInfoPtr->handle, &mode) == 0) { - Tcl_WinConvertError(GetLastError()); - if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "couldn't read console mode: %s", - Tcl_PosixError(interp))); - } - return TCL_ERROR; - } - if (strncasecmp(value, "NORMAL", vlen) == 0) { - mode |= - ENABLE_ECHO_INPUT | ENABLE_LINE_INPUT | ENABLE_PROCESSED_INPUT; - } else if (strncasecmp(value, "PASSWORD", vlen) == 0) { - mode |= ENABLE_LINE_INPUT|ENABLE_PROCESSED_INPUT; - mode &= ~ENABLE_ECHO_INPUT; - } else if (strncasecmp(value, "RAW", vlen) == 0) { - mode &= ~(ENABLE_ECHO_INPUT | ENABLE_LINE_INPUT | ENABLE_PROCESSED_INPUT); - } else if (strncasecmp(value, "RESET", vlen) == 0) { - /* - * Reset to the initial mode, whatever that is. - */ - mode = chanInfoPtr->initMode; - } else { - if (interp) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "bad mode \"%s\" for -inputmode: must be" - " normal, password, raw, or reset", value)); - Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FCONFIGURE", - "VALUE", (char *)NULL); - } - return TCL_ERROR; - } - if (SetConsoleMode(chanInfoPtr->handle, mode) == 0) { - Tcl_WinConvertError(GetLastError()); - if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "couldn't set console mode: %s", - Tcl_PosixError(interp))); - } - return TCL_ERROR; - } - - return TCL_OK; - } - - if (chanInfoPtr->flags & CONSOLE_READ_OPS) { - return Tcl_BadChannelOption(interp, optionName, "inputmode"); - } else { - return Tcl_BadChannelOption(interp, optionName, ""); - } -} - -/* - *---------------------------------------------------------------------- - * - * ConsoleGetOptionProc -- - * - * 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. Sets error message if needed - * (by calling Tcl_BadChannelOption). - * - *---------------------------------------------------------------------- - */ - -static int -ConsoleGetOptionProc( - void *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). */ -{ - ConsoleChannelInfo *chanInfoPtr = (ConsoleChannelInfo *)instanceData; - int valid = 0; /* Flag if valid option parsed. */ - unsigned int len; - char buf[TCL_INTEGER_SPACE]; - - if (optionName == NULL) { - len = 0; - } else { - len = strlen(optionName); - } + ConsoleInfo *infoPtr = (ConsoleInfo *) instanceData; - /* - * Get option -inputmode - * - * This is a great simplification of the underlying reality, but actually - * represents what almost all scripts really want to know. + /* 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. */ - if (chanInfoPtr->flags & CONSOLE_READ_OPS) { - if (len == 0) { - Tcl_DStringAppendElement(dsPtr, "-inputmode"); - } - if (len==0 || (len>1 && strncmp(optionName, "-inputmode", len)==0)) { - DWORD mode; - - valid = 1; - if (GetConsoleMode(chanInfoPtr->handle, &mode) == 0) { - Tcl_WinConvertError(GetLastError()); - if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "couldn't read console mode: %s", - Tcl_PosixError(interp))); - } - return TCL_ERROR; - } - if (mode & ENABLE_LINE_INPUT) { - if (mode & ENABLE_ECHO_INPUT) { - Tcl_DStringAppendElement(dsPtr, "normal"); - } else { - Tcl_DStringAppendElement(dsPtr, "password"); - } - } else { - Tcl_DStringAppendElement(dsPtr, "raw"); - } - } - } else { + Tcl_MutexLock(&consoleMutex); + if (action == TCL_CHANNEL_THREAD_INSERT) { /* - * Output channel. Get option -winsize - * Option is readonly and returned by [fconfigure chan -winsize] but not - * returned by [fconfigure chan] without explicit option name. + * 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. */ - if (len == 0) { - Tcl_DStringAppendElement(dsPtr, "-winsize"); - } - if (len == 0 || (len > 1 && strncmp(optionName, "-winsize", len) == 0)) { - CONSOLE_SCREEN_BUFFER_INFO consoleInfo; - - valid = 1; - if (!GetConsoleScreenBufferInfo(chanInfoPtr->handle, - &consoleInfo)) { - Tcl_WinConvertError(GetLastError()); - if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "couldn't read console size: %s", - Tcl_PosixError(interp))); - } - return TCL_ERROR; - } - Tcl_DStringStartSublist(dsPtr); - snprintf(buf, sizeof(buf), "%d", - consoleInfo.srWindow.Right - consoleInfo.srWindow.Left + 1); - Tcl_DStringAppendElement(dsPtr, buf); - snprintf(buf, sizeof(buf), "%d", - consoleInfo.srWindow.Bottom - consoleInfo.srWindow.Top + 1); - Tcl_DStringAppendElement(dsPtr, buf); - Tcl_DStringEndSublist(dsPtr); + ConsoleInit(); + if (infoPtr->channel != NULL) { + infoPtr->threadId = Tcl_GetChannelThread(infoPtr->channel); } - } - - if (valid) { - return TCL_OK; - } - if (chanInfoPtr->flags & CONSOLE_READ_OPS) { - return Tcl_BadChannelOption(interp, optionName, "inputmode"); } else { - return Tcl_BadChannelOption(interp, optionName, "winsize"); + infoPtr->threadId = NULL; } + Tcl_MutexUnlock(&consoleMutex); } /* diff --git a/win/tclWinDde.c b/win/tclWinDde.c index d883bac..eef5caa 100644 --- a/win/tclWinDde.c +++ b/win/tclWinDde.c @@ -10,20 +10,20 @@ * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ -#undef STATIC_BUILD -#ifndef USE_TCL_STUBS -# define USE_TCL_STUBS -#endif #include "tclInt.h" +#include "tclPort.h" #include <dde.h> #include <ddeml.h> -#include <tchar.h> -#if !defined(NDEBUG) - /* test POKE server Implemented for debug mode only */ -# undef CBF_FAIL_POKES -# define CBF_FAIL_POKES 0 -#endif +/* + * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the Dde_Init + * declaration is in the source file itself, which is only accessed when we + * are building a library. DO NOT MOVE BEFORE ANY #include LINES. ONLY USE + * EXTERN TO INDICATE EXPORTED FUNCTIONS FROM NOW ON. + */ + +#undef TCL_STORAGE_CLASS +#define TCL_STORAGE_CLASS DLLEXPORT /* * The following structure is used to keep track of the interpreters @@ -34,7 +34,7 @@ typedef struct RegisteredInterp { struct RegisteredInterp *nextPtr; /* The next interp this application knows * about. */ - WCHAR *name; /* Interpreter's name (malloc-ed). */ + char *name; /* Interpreter's name (malloc-ed). */ Tcl_Obj *handlerPtr; /* The server handler command */ Tcl_Interp *interp; /* The interpreter attached to this name. */ } RegisteredInterp; @@ -51,7 +51,7 @@ typedef struct Conversation { Tcl_Obj *returnPackagePtr; /* The result package for this conversation. */ } Conversation; -typedef struct { +typedef struct DdeEnumServices { Tcl_Interp *interp; int result; ATOM service; @@ -59,7 +59,7 @@ typedef struct { HWND hwnd; } DdeEnumServices; -typedef struct { +typedef struct ThreadSpecificData { Conversation *currentConversations; /* A list of conversations currently being * processed. */ @@ -79,10 +79,9 @@ static DWORD ddeInstance; /* The application instance handle given to us * by DdeInitialize. */ static int ddeIsServer = 0; -#define TCL_DDE_VERSION "1.4.5" #define TCL_DDE_PACKAGE_NAME "dde" -#define TCL_DDE_SERVICE_NAME L"TclEval" -#define TCL_DDE_EXECUTE_RESULT L"$TCLEVAL$EXECUTE$RESULT" +#define TCL_DDE_SERVICE_NAME "TclEval" +#define TCL_DDE_EXECUTE_RESULT "$TCLEVAL$EXECUTE$RESULT" #define DDE_FLAG_ASYNC 1 #define DDE_FLAG_BINARY 2 @@ -90,62 +89,35 @@ static int ddeIsServer = 0; TCL_DECLARE_MUTEX(ddeMutex) -#if (TCL_MAJOR_VERSION < 9) && defined(TCL_MINOR_VERSION) && (TCL_MINOR_VERSION < 7) -# if TCL_UTF_MAX > 3 -# define Tcl_WCharToUtfDString(a,b,c) Tcl_WinTCharToUtf((TCHAR *)(a),(b)*sizeof(WCHAR),c) -# define Tcl_UtfToWCharDString(a,b,c) (WCHAR *)Tcl_WinUtfToTChar(a,b,c) -# else -# define Tcl_WCharToUtfDString Tcl_UniCharToUtfDString -# define Tcl_UtfToWCharDString Tcl_UtfToUniCharDString -# endif -#ifndef Tcl_Size -# define Tcl_Size int -#endif -#ifndef Tcl_CreateObjCommand2 -# define Tcl_CreateObjCommand2 Tcl_CreateObjCommand -#endif -#endif - /* - * Declarations for functions defined in this file. + * 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 int DdeCreateClient(struct DdeEnumServices *es); static BOOL CALLBACK DdeEnumWindowsCallback(HWND hwndTarget, LPARAM lParam); -static void DdeExitProc(void *clientData); +static void DdeExitProc(ClientData clientData); static int DdeGetServicesList(Tcl_Interp *interp, - const WCHAR *serviceName, const WCHAR *topicName); + const char *serviceName, const char *topicName); static HDDEDATA CALLBACK DdeServerProc(UINT uType, UINT uFmt, HCONV hConv, HSZ ddeTopic, HSZ ddeItem, HDDEDATA hData, DWORD dwData1, DWORD dwData2); static LRESULT DdeServicesOnAck(HWND hwnd, WPARAM wParam, LPARAM lParam); -static void DeleteProc(void *clientData); +static void DeleteProc(ClientData clientData); static Tcl_Obj * ExecuteRemoteObject(RegisteredInterp *riPtr, Tcl_Obj *ddeObjectPtr); static int MakeDdeConnection(Tcl_Interp *interp, - const WCHAR *name, HCONV *ddeConvPtr); + const char *name, HCONV *ddeConvPtr); static void SetDdeError(Tcl_Interp *interp); -static int DdeObjCmd(void *clientData, - Tcl_Interp *interp, Tcl_Size objc, +static int DdeObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -#ifdef __cplusplus -extern "C" { -#endif -DLLEXPORT int Dde_Init(Tcl_Interp *interp); -DLLEXPORT int Dde_SafeInit(Tcl_Interp *interp); -#if TCL_MAJOR_VERSION < 9 -/* With those additional entries, "load tcldde14.dll" works without 3th argument */ -DLLEXPORT int Tcldde_Init(Tcl_Interp *interp); -DLLEXPORT int Tcldde_SafeInit(Tcl_Interp *interp); -#endif -#ifdef __cplusplus -} -#endif +EXTERN int Dde_Init(Tcl_Interp *interp); +EXTERN int Dde_SafeInit(Tcl_Interp *interp); /* *---------------------------------------------------------------------- @@ -167,22 +139,14 @@ int Dde_Init( Tcl_Interp *interp) { - if (!Tcl_InitStubs(interp, "8.5-", 0)) { + if (!Tcl_InitStubs(interp, "8.1", 0)) { return TCL_ERROR; } - Tcl_CreateObjCommand2(interp, "dde", DdeObjCmd, NULL, NULL); + Tcl_CreateObjCommand(interp, "dde", DdeObjCmd, NULL, NULL); Tcl_CreateExitHandler(DdeExitProc, NULL); - return Tcl_PkgProvideEx(interp, TCL_DDE_PACKAGE_NAME, TCL_DDE_VERSION, NULL); + return Tcl_PkgProvide(interp, TCL_DDE_PACKAGE_NAME, "1.3.3"); } -#if TCL_MAJOR_VERSION < 9 -int -Tcldde_Init( - Tcl_Interp *interp) -{ - return Dde_Init(interp); -} -#endif /* *---------------------------------------------------------------------- @@ -210,14 +174,6 @@ Dde_SafeInit( } return result; } -#if TCL_MAJOR_VERSION < 9 -int -Tcldde_SafeInit( - Tcl_Interp *interp) -{ - return Dde_SafeInit(interp); -} -#endif /* *---------------------------------------------------------------------- @@ -259,7 +215,7 @@ Initialize(void) if (ddeInstance == 0) { Tcl_MutexLock(&ddeMutex); if (ddeInstance == 0) { - if (DdeInitializeW(&ddeInstance, (PFNCALLBACK)(void *)DdeServerProc, + if (DdeInitialize(&ddeInstance, (PFNCALLBACK) DdeServerProc, CBF_SKIP_REGISTRATIONS | CBF_SKIP_UNREGISTRATIONS | CBF_FAIL_POKES, 0) != DMLERR_NO_ERROR) { ddeInstance = 0; @@ -272,8 +228,8 @@ Initialize(void) if ((ddeServiceGlobal == 0) && (nameFound != 0)) { ddeIsServer = 1; Tcl_CreateExitHandler(DdeExitProc, NULL); - ddeServiceGlobal = DdeCreateStringHandleW(ddeInstance, - TCL_DDE_SERVICE_NAME, CP_WINUNICODE); + ddeServiceGlobal = DdeCreateStringHandle(ddeInstance, + TCL_DDE_SERVICE_NAME, 0); DdeNameService(ddeInstance, ddeServiceGlobal, 0L, DNS_REGISTER); } else { ddeIsServer = 0; @@ -307,23 +263,22 @@ Initialize(void) *---------------------------------------------------------------------- */ -static const WCHAR * +static const char * DdeSetServerName( Tcl_Interp *interp, - const WCHAR *name, /* The name that will be used to refer to the + const char *name, /* The name that will be used to refer to the * interpreter in later "send" commands. Must * be globally unique. */ int flags, /* DDE_FLAG_FORCE or 0 */ Tcl_Obj *handlerPtr) /* Name of the optional proc/command to handle * incoming Dde eval's */ { - int suffix; + int suffix, offset; RegisteredInterp *riPtr, *prevPtr; Tcl_DString dString; - const WCHAR *actualName; + const char *actualName; Tcl_Obj *srvListPtr = NULL, **srvPtrPtr = NULL; - Tcl_Size n, srvCount = 0, offset; - int lastSuffix, r = TCL_OK; + int n, srvCount = 0, lastSuffix, r = TCL_OK; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); /* @@ -359,7 +314,7 @@ DdeSetServerName( * current interp, but it doesn't have a name. */ - return L""; + return ""; } /* @@ -380,9 +335,7 @@ DdeSetServerName( &srvPtrPtr); } if (r != TCL_OK) { - Tcl_DStringInit(&dString); - OutputDebugStringW(Tcl_UtfToWCharDString(Tcl_GetString(Tcl_GetObjResult(interp)), -1, &dString)); - Tcl_DStringFree(&dString); + OutputDebugString(Tcl_GetStringResult(interp)); return NULL; } @@ -399,14 +352,13 @@ DdeSetServerName( 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)); + Tcl_DStringAppend(&dString, name, -1); + Tcl_DStringAppend(&dString, " #", 2); offset = Tcl_DStringLength(&dString); - Tcl_DStringSetLength(&dString, offset + sizeof(WCHAR) * TCL_INTEGER_SPACE); - actualName = (WCHAR *) Tcl_DStringValue(&dString); + Tcl_DStringSetLength(&dString, offset + TCL_INTEGER_SPACE); + actualName = Tcl_DStringValue(&dString); } - _snwprintf((WCHAR *) (Tcl_DStringValue(&dString) + offset), - TCL_INTEGER_SPACE, L"%d", suffix); + sprintf(Tcl_DStringValue(&dString) + offset, "%d", suffix); } /* @@ -415,42 +367,39 @@ DdeSetServerName( 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) { + if (strcmp(actualName, Tcl_GetString(namePtr)) == 0) { suffix++; - Tcl_DStringFree(&ds); break; } - Tcl_DStringFree(&ds); } } + Tcl_DStringSetLength(&dString, + offset + (int)strlen(Tcl_DStringValue(&dString)+offset)); } /* * We have found a unique name. Now add it to the registry. */ - riPtr = (RegisteredInterp *) Tcl_Alloc(sizeof(RegisteredInterp)); + riPtr = (RegisteredInterp *) ckalloc(sizeof(RegisteredInterp)); riPtr->interp = interp; - riPtr->name = (WCHAR *) Tcl_Alloc((wcslen(actualName) + 1) * sizeof(WCHAR)); + riPtr->name = ckalloc((unsigned int) strlen(actualName) + 1); riPtr->nextPtr = tsdPtr->interpListPtr; riPtr->handlerPtr = handlerPtr; if (riPtr->handlerPtr != NULL) { Tcl_IncrRefCount(riPtr->handlerPtr); } tsdPtr->interpListPtr = riPtr; - wcscpy(riPtr->name, actualName); + strcpy(riPtr->name, actualName); if (Tcl_IsSafe(interp)) { Tcl_ExposeCommand(interp, "dde", "dde"); } - Tcl_CreateObjCommand2(interp, "dde", DdeObjCmd, - riPtr, DeleteProc); + Tcl_CreateObjCommand(interp, "dde", DdeObjCmd, + (ClientData) riPtr, DeleteProc); if (Tcl_IsSafe(interp)) { Tcl_HideCommand(interp, "dde", "dde"); } @@ -515,7 +464,8 @@ DdeGetRegistrationPtr( static void DeleteProc( - void *clientData) /* The interp we are deleting. */ + ClientData clientData) /* The interp we are deleting passed as + * ClientData. */ { RegisteredInterp *riPtr = (RegisteredInterp *) clientData; RegisteredInterp *searchPtr, *prevPtr; @@ -536,7 +486,7 @@ DeleteProc( prevPtr->nextPtr = searchPtr->nextPtr; } } - Tcl_Free((char *) riPtr->name); + ckfree(riPtr->name); if (riPtr->handlerPtr) { Tcl_DecrRefCount(riPtr->handlerPtr); } @@ -574,11 +524,10 @@ ExecuteRemoteObject( Tcl_Obj *returnPackagePtr; int result = TCL_OK; - if ((riPtr->handlerPtr == NULL) && Tcl_IsSafe(riPtr->interp)) { + 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", (void *)NULL); result = TCL_ERROR; } @@ -652,20 +601,18 @@ DdeServerProc( HSZ ddeTopic, HSZ ddeItem, /* String handles. Transaction-type * dependent. */ HDDEDATA hData, /* DDE data. Transaction-type dependent. */ - DWORD unused1, DWORD unused2) + DWORD dwData1, DWORD dwData2) /* Transaction-dependent data. */ { Tcl_DString dString; - Tcl_Size len; + int len; DWORD dlen; - WCHAR *utilString; + char *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: @@ -674,16 +621,16 @@ DdeServerProc( * sure we have a valid topic. */ - len = DdeQueryStringW(ddeInstance, ddeTopic, NULL, 0, CP_WINUNICODE); + len = DdeQueryString(ddeInstance, ddeTopic, NULL, 0, 0); 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); + Tcl_DStringSetLength(&dString, len); + utilString = Tcl_DStringValue(&dString); + DdeQueryString(ddeInstance, ddeTopic, utilString, (DWORD) len + 1, + CP_WINANSI); for (riPtr = tsdPtr->interpListPtr; riPtr != NULL; riPtr = riPtr->nextPtr) { - if (_wcsicmp(utilString, riPtr->name) == 0) { + if (stricmp(utilString, riPtr->name) == 0) { Tcl_DStringFree(&dString); return (HDDEDATA) TRUE; } @@ -699,16 +646,16 @@ DdeServerProc( * result to return in an XTYP_REQUEST. */ - len = DdeQueryStringW(ddeInstance, ddeTopic, NULL, 0, CP_WINUNICODE); + len = DdeQueryString(ddeInstance, ddeTopic, NULL, 0, 0); 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); + Tcl_DStringSetLength(&dString, len); + utilString = Tcl_DStringValue(&dString); + DdeQueryString(ddeInstance, ddeTopic, utilString, (DWORD) len + 1, + CP_WINANSI); for (riPtr = tsdPtr->interpListPtr; riPtr != NULL; riPtr = riPtr->nextPtr) { - if (_wcsicmp(riPtr->name, utilString) == 0) { - convPtr = (Conversation *) Tcl_Alloc(sizeof(Conversation)); + if (stricmp(riPtr->name, utilString) == 0) { + convPtr = (Conversation *) ckalloc(sizeof(Conversation)); convPtr->nextPtr = tsdPtr->currentConversations; convPtr->returnPackagePtr = NULL; convPtr->hConv = hConv; @@ -738,7 +685,7 @@ DdeServerProc( if (convPtr->returnPackagePtr != NULL) { Tcl_DecrRefCount(convPtr->returnPackagePtr); } - Tcl_Free((char *) convPtr); + ckfree((char *) convPtr); break; } } @@ -764,24 +711,22 @@ DdeServerProc( } if (convPtr != NULL) { - Tcl_DString dsBuf; char *returnString; - len = DdeQueryStringW(ddeInstance, ddeItem, NULL, 0, CP_WINUNICODE); + len = DdeQueryString(ddeInstance, ddeItem, NULL, 0, CP_WINANSI); 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_GetStringFromObj(convPtr->returnPackagePtr, &len); - if (uFmt != CF_TEXT) { - Tcl_DStringInit(&dsBuf); - Tcl_UtfToWCharDString(returnString, len, &dsBuf); - returnString = Tcl_DStringValue(&dsBuf); - len = Tcl_DStringLength(&dsBuf) + sizeof(WCHAR) - 1; + Tcl_DStringSetLength(&dString, len); + utilString = Tcl_DStringValue(&dString); + DdeQueryString(ddeInstance, ddeItem, utilString, (DWORD) len + 1, + CP_WINANSI); + if (stricmp(utilString, TCL_DDE_EXECUTE_RESULT) == 0) { + if (uFmt == CF_TEXT) { + returnString = + Tcl_GetStringFromObj(convPtr->returnPackagePtr, &len); + } else { + returnString = (char *) + Tcl_GetUnicodeFromObj(convPtr->returnPackagePtr, &len); + len = 2 * len + 1; } ddeReturn = DdeCreateDataHandle(ddeInstance, (BYTE *)returnString, (DWORD) len+1, 0, ddeItem, uFmt, 0); @@ -789,21 +734,17 @@ DdeServerProc( 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_Obj *variableObjPtr = Tcl_GetVar2Ex( + convPtr->riPtr->interp, utilString, NULL, TCL_GLOBAL_ONLY); if (variableObjPtr != NULL) { - returnString = Tcl_GetStringFromObj(variableObjPtr, &len); - if (uFmt != CF_TEXT) { - Tcl_DStringInit(&dsBuf); - Tcl_UtfToWCharDString(returnString, len, &dsBuf); - returnString = Tcl_DStringValue(&dsBuf); - len = Tcl_DStringLength(&dsBuf) + sizeof(WCHAR) - 1; + if (uFmt == CF_TEXT) { + returnString = Tcl_GetStringFromObj( + variableObjPtr, &len); + } else { + returnString = (char *) Tcl_GetUnicodeFromObj( + variableObjPtr, &len); + len = 2 * len + 1; } ddeReturn = DdeCreateDataHandle(ddeInstance, (BYTE *)returnString, (DWORD) len+1, 0, ddeItem, @@ -811,75 +752,20 @@ DdeServerProc( } 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 retrieved later. See ExecuteRemoteObject. + * which will be retreived later. See ExecuteRemoteObject. */ Tcl_Obj *returnPackagePtr; - char *string; + Tcl_UniChar *uniStr; for (convPtr = tsdPtr->currentConversations; (convPtr != NULL) && (convPtr->hConv != hConv); convPtr = convPtr->nextPtr) { @@ -892,26 +778,21 @@ DdeServerProc( return (HDDEDATA) DDE_FNOTPROCESSED; } - utilString = (WCHAR *) DdeAccessData(hData, &dlen); - string = (char *) utilString; + utilString = (char *) DdeAccessData(hData, &dlen); + uniStr = (Tcl_UniChar *) utilString; if (!dlen) { /* Empty binary array. */ ddeObjectPtr = Tcl_NewObj(); - } else if ((dlen & 1) || utilString[(dlen>>1)-1]) { - /* Cannot be Unicode, so assume utf-8 */ - if (!string[dlen-1]) { + } else if ((dlen & 1) || uniStr[(dlen>>1)-1]) { + /* Cannot be unicode, so assume utf-8 */ + if (!utilString[dlen-1]) { dlen--; } - ddeObjectPtr = Tcl_NewStringObj(string, dlen); + ddeObjectPtr = Tcl_NewStringObj(utilString, 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); + /* unicode */ + dlen >>= 1; + ddeObjectPtr = Tcl_NewUnicodeObj(uniStr, dlen - 1); } Tcl_IncrRefCount(ddeObjectPtr); DdeUnaccessData(hData); @@ -946,8 +827,8 @@ DdeServerProc( */ HSZPAIR *returnPtr; - Tcl_Size i; - DWORD numItems; + int i; + int numItems; for (i = 0, riPtr = tsdPtr->interpListPtr; riPtr != NULL; i++, riPtr = riPtr->nextPtr) { @@ -956,20 +837,17 @@ DdeServerProc( */ } - if ((size_t)i >= UINT_MAX/sizeof(HSZPAIR)) { - return NULL; - } - numItems = (DWORD)i; + numItems = i; ddeReturn = DdeCreateDataHandle(ddeInstance, NULL, - (numItems + 1) * (DWORD)sizeof(HSZPAIR), 0, 0, 0, 0); + (numItems + 1) * sizeof(HSZPAIR), 0, 0, 0, 0); returnPtr = (HSZPAIR *) DdeAccessData(ddeReturn, &dlen); len = dlen; - for (i = 0, riPtr = tsdPtr->interpListPtr; i < (Tcl_Size)numItems; + 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 = DdeCreateStringHandle(ddeInstance, + TCL_DDE_SERVICE_NAME, CP_WINANSI); + returnPtr[i].hszTopic = DdeCreateStringHandle(ddeInstance, + riPtr->name, CP_WINANSI); } returnPtr[i].hszSvc = NULL; returnPtr[i].hszTopic = NULL; @@ -1000,9 +878,8 @@ DdeServerProc( static void DdeExitProc( - void *dummy) /* Not used. */ + ClientData clientData) /* Not used in this handler. */ { - (void)dummy; DdeNameService(ddeInstance, NULL, 0, DNS_UNREGISTER); DdeUninitialize(ddeInstance); ddeInstance = 0; @@ -1028,14 +905,14 @@ DdeExitProc( static int MakeDdeConnection( Tcl_Interp *interp, /* Used to report errors. */ - const WCHAR *name, /* The connection to use. */ + const char *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); + ddeService = DdeCreateStringHandle(ddeInstance, TCL_DDE_SERVICE_NAME, 0); + ddeTopic = DdeCreateStringHandle(ddeInstance, name, 0); ddeConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL); DdeFreeStringHandle(ddeInstance, ddeService); @@ -1043,14 +920,8 @@ MakeDdeConnection( 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", (void *)NULL); + Tcl_AppendResult(interp, "no registered server named \"", + name, "\"", NULL); } return TCL_ERROR; } @@ -1081,24 +952,24 @@ MakeDdeConnection( static int DdeCreateClient( - DdeEnumServices *es) + struct DdeEnumServices *es) { - WNDCLASSEXW wc; - static const WCHAR *szDdeClientClassName = L"TclEval client class"; - static const WCHAR *szDdeClientWindowName = L"TclEval client window"; + WNDCLASSEX wc; + static const char *szDdeClientClassName = "TclEval client class"; + static const char *szDdeClientWindowName = "TclEval client window"; memset(&wc, 0, sizeof(wc)); wc.cbSize = sizeof(wc); wc.lpfnWndProc = DdeClientWindowProc; wc.lpszClassName = szDdeClientClassName; - wc.cbWndExtra = sizeof(DdeEnumServices *); + wc.cbWndExtra = sizeof(struct DdeEnumServices *); /* * Register and create the callback window. */ - RegisterClassExW(&wc); - es->hwnd = CreateWindowExW(0, szDdeClientClassName, szDdeClientWindowName, + RegisterClassEx(&wc); + es->hwnd = CreateWindowEx(0, szDdeClientClassName, szDdeClientWindowName, WS_POPUP, 0, 0, 0, 0, NULL, NULL, NULL, (LPVOID)es); return TCL_OK; } @@ -1113,20 +984,20 @@ DdeClientWindowProc( switch (uMsg) { case WM_CREATE: { LPCREATESTRUCT lpcs = (LPCREATESTRUCT) lParam; - DdeEnumServices *es = - (DdeEnumServices *) lpcs->lpCreateParams; + struct DdeEnumServices *es = + (struct DdeEnumServices *) lpcs->lpCreateParams; #ifdef _WIN64 - SetWindowLongPtrW(hwnd, GWLP_USERDATA, (LONG_PTR) es); + SetWindowLongPtr(hwnd, GWLP_USERDATA, (LONG_PTR) es); #else - SetWindowLongW(hwnd, GWL_USERDATA, (LONG) es); + SetWindowLong(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); + return DefWindowProc(hwnd, uMsg, wParam, lParam); } } @@ -1139,31 +1010,24 @@ DdeServicesOnAck( HWND hwndRemote = (HWND)wParam; ATOM service = (ATOM)LOWORD(lParam); ATOM topic = (ATOM)HIWORD(lParam); - DdeEnumServices *es; - WCHAR sz[255]; - Tcl_DString dString; + struct DdeEnumServices *es; + char sz[255]; #ifdef _WIN64 - es = (DdeEnumServices *) GetWindowLongPtrW(hwnd, GWLP_USERDATA); + es = (struct DdeEnumServices *) GetWindowLongPtr(hwnd, GWLP_USERDATA); #else - es = (DdeEnumServices *) GetWindowLongW(hwnd, GWL_USERDATA); + es = (struct DdeEnumServices *) GetWindowLong(hwnd, GWL_USERDATA); #endif - if (((es->service == (ATOM)0) || (es->service == service)) - && ((es->topic == (ATOM)0) || (es->topic == topic))) { + 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); + GlobalGetAtomName(service, sz, 255); + Tcl_ListObjAppendElement(NULL, matchPtr, Tcl_NewStringObj(sz, -1)); + GlobalGetAtomName(topic, sz, 255); + Tcl_ListObjAppendElement(NULL, matchPtr, Tcl_NewStringObj(sz, -1)); /* * Adding the hwnd as a third list element provides a unique @@ -1189,7 +1053,7 @@ DdeServicesOnAck( * Tell the server we are no longer interested. */ - PostMessageW(hwndRemote, WM_DDE_TERMINATE, (WPARAM)hwnd, 0L); + PostMessage(hwndRemote, WM_DDE_TERMINATE, (WPARAM)hwnd, 0L); return 0L; } @@ -1199,9 +1063,9 @@ DdeEnumWindowsCallback( LPARAM lParam) { DWORD_PTR dwResult = 0; - DdeEnumServices *es = (DdeEnumServices *) lParam; + struct DdeEnumServices *es = (struct DdeEnumServices *) lParam; - SendMessageTimeoutW(hwndTarget, WM_DDE_INITIATE, (WPARAM)es->hwnd, + SendMessageTimeout(hwndTarget, WM_DDE_INITIATE, (WPARAM)es->hwnd, MAKELONG(es->service, es->topic), SMTO_ABORTIFHUNG, 1000, &dwResult); return TRUE; @@ -1210,16 +1074,16 @@ DdeEnumWindowsCallback( static int DdeGetServicesList( Tcl_Interp *interp, - const WCHAR *serviceName, - const WCHAR *topicName) + const char *serviceName, + const char *topicName) { - DdeEnumServices es; + struct 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); + ? (ATOM)0 : GlobalAddAtom(serviceName); + es.topic = (topicName == NULL) ? (ATOM)0 : GlobalAddAtom(topicName); Tcl_ResetResult(interp); /* our list is to be appended to result. */ DdeCreateClient(&es); @@ -1258,30 +1122,25 @@ static void SetDdeError( Tcl_Interp *interp) /* The interp to put the message in. */ { - const char *errorMessage, *errorCode; + const char *errorMessage; switch (DdeGetLastError(ddeInstance)) { case DMLERR_DATAACKTIMEOUT: case DMLERR_EXECACKTIMEOUT: case DMLERR_POKEACKTIMEOUT: errorMessage = "remote interpreter did not respond"; - errorCode = "TIMEOUT"; break; case DMLERR_BUSY: errorMessage = "remote server is busy"; - errorCode = "BUSY"; break; case DMLERR_NOTPROCESSED: errorMessage = "remote server cannot handle this command"; - errorCode = "NOCANDO"; break; default: errorMessage = "dde command failed"; - errorCode = "FAILED"; } Tcl_SetObjResult(interp, Tcl_NewStringObj(errorMessage, -1)); - Tcl_SetErrorCode(interp, "TCL", "DDE", errorCode, (void *)NULL); } /* @@ -1303,48 +1162,39 @@ SetDdeError( static int DdeObjCmd( - void *dummy, /* Not used. */ + ClientData clientData, /* Used only for deletion */ Tcl_Interp *interp, /* The interp we are sending from */ - Tcl_Size objc, /* Number of arguments */ + int objc, /* Number of arguments */ Tcl_Obj *const *objv) /* The arguments */ { - static const char *const ddeCommands[] = { - "servername", "execute", "poke", "request", "services", "eval", NULL}; + static const char *ddeCommands[] = { + "servername", "execute", "poke", "request", "services", "eval", + (char *) NULL}; enum DdeSubcommands { DDE_SERVERNAME, DDE_EXECUTE, DDE_POKE, DDE_REQUEST, DDE_SERVICES, DDE_EVAL }; - static const char *const ddeSrvOptions[] = { + static const char *ddeSrvOptions[] = { "-force", "-handler", "--", NULL }; enum DdeSrvOptions { DDE_SERVERNAME_EXACT, DDE_SERVERNAME_HANDLER, DDE_SERVERNAME_LAST, }; - static const char *const ddeExecOptions[] = { - "-async", "-binary", NULL - }; - enum DdeExecOptions { - DDE_EXEC_ASYNC, DDE_EXEC_BINARY - }; - static const char *const ddeEvalOptions[] = { + static const char *ddeExecOptions[] = { "-async", NULL }; - static const char *const ddeReqOptions[] = { + static const char *ddeReqOptions[] = { "-binary", NULL }; - int index, argIndex; - Tcl_Size length, i; + int index, i, length, argIndex; 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; + const char *serviceName = NULL, *topicName = NULL, *string; DWORD ddeResult; Tcl_Obj *objPtr, *handlerPtr = NULL; - Tcl_DString serviceBuf, topicBuf, itemBuf; - (void)dummy; /* * Initialize DDE server/client @@ -1360,9 +1210,6 @@ DdeObjCmd( 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++) { @@ -1412,53 +1259,38 @@ DdeObjCmd( if (objc == 5) { firstArg = 2; break; - } else if ((objc >= 6) && (objc <= 7)) { - firstArg = objc - 3; - for (i = 2; i < firstArg; i++) { - if (Tcl_GetIndexFromObj(interp, objv[i], ddeExecOptions, - "option", 0, &argIndex) != TCL_OK) { - goto wrongDdeExecuteArgs; - } - if (argIndex == DDE_EXEC_ASYNC) { - flags |= DDE_FLAG_ASYNC; - } else { - flags |= DDE_FLAG_BINARY; - } + } else if (objc == 6) { + if (Tcl_GetIndexFromObj(NULL, objv[2], ddeExecOptions, "option", 0, + &argIndex) == TCL_OK) { + flags |= DDE_FLAG_ASYNC; + firstArg = 3; + break; } - break; } /* otherwise... */ - wrongDdeExecuteArgs: Tcl_WrongNumArgs(interp, 2, objv, - "?-async? ?-binary? serviceName topicName value"); + "?-async? serviceName topicName value"); return TCL_ERROR; case DDE_POKE: - if (objc == 6) { - firstArg = 2; - break; - } else if ((objc == 7) && (Tcl_GetIndexFromObj(NULL, objv[2], - ddeReqOptions, "option", 0, &argIndex) == TCL_OK)) { - flags |= DDE_FLAG_BINARY; - firstArg = 3; - break; + if (objc != 6) { + Tcl_WrongNumArgs(interp, 2, objv, + "serviceName topicName item value"); + return TCL_ERROR; } - - /* - * Otherwise... - */ - - Tcl_WrongNumArgs(interp, 2, objv, - "?-binary? serviceName topicName item value"); - return TCL_ERROR; + firstArg = 2; + break; case DDE_REQUEST: if (objc == 5) { firstArg = 2; break; - } else if ((objc == 6) && (Tcl_GetIndexFromObj(NULL, objv[2], - ddeReqOptions, "option", 0, &argIndex) == TCL_OK)) { - flags |= DDE_FLAG_BINARY; - firstArg = 3; - break; + } else if (objc == 6) { + int dummy; + if (Tcl_GetIndexFromObj(NULL, objv[2], ddeReqOptions, "option", 0, + &dummy) == TCL_OK) { + flags |= DDE_FLAG_BINARY; + firstArg = 3; + break; + } } /* @@ -1482,7 +1314,7 @@ DdeObjCmd( return TCL_ERROR; } else { firstArg = 2; - if (Tcl_GetIndexFromObj(NULL, objv[2], ddeEvalOptions, "option", + if (Tcl_GetIndexFromObj(NULL, objv[2], ddeExecOptions, "option", 0, &argIndex) == TCL_OK) { if (objc < 5) { goto wrongDdeEvalArgs; @@ -1497,12 +1329,7 @@ DdeObjCmd( Initialize(); if (firstArg != 1) { - const char *src = Tcl_GetStringFromObj(objv[firstArg], &length); - - Tcl_DStringInit(&serviceBuf); - Tcl_UtfToWCharDString(src, length, &serviceBuf); - serviceName = (WCHAR *) Tcl_DStringValue(&serviceBuf); - length = Tcl_DStringLength(&serviceBuf) / sizeof(WCHAR); + serviceName = Tcl_GetStringFromObj(objv[firstArg], &length); } else { length = 0; } @@ -1510,21 +1337,17 @@ DdeObjCmd( if (length == 0) { serviceName = NULL; } else if ((index != DDE_SERVERNAME) && (index != DDE_EVAL)) { - ddeService = DdeCreateStringHandleW(ddeInstance, serviceName, - CP_WINUNICODE); + ddeService = DdeCreateStringHandle(ddeInstance, (void *) serviceName, + CP_WINANSI); } if ((index != DDE_SERVERNAME) && (index != DDE_EVAL)) { - const char *src = Tcl_GetStringFromObj(objv[firstArg + 1], &length); - - Tcl_DStringInit(&topicBuf); - topicName = Tcl_UtfToWCharDString(src, length, &topicBuf); - length = Tcl_DStringLength(&topicBuf) / sizeof(WCHAR); + topicName = Tcl_GetStringFromObj(objv[firstArg + 1], &length); if (length == 0) { topicName = NULL; } else { - ddeTopic = DdeCreateStringHandleW(ddeInstance, topicName, - CP_WINUNICODE); + ddeTopic = DdeCreateStringHandle(ddeInstance, (void *) topicName, + CP_WINANSI); } } @@ -1533,42 +1356,20 @@ DdeObjCmd( 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); + Tcl_SetObjResult(interp, Tcl_NewStringObj(serviceName, -1)); } else { Tcl_ResetResult(interp); } break; case DDE_EXECUTE: { - Tcl_Size dataLength; - const void *dataString; - Tcl_DString dsBuf; - - Tcl_DStringInit(&dsBuf); - if (flags & DDE_FLAG_BINARY) { - dataString = - Tcl_GetByteArrayFromObj(objv[firstArg + 2], &dataLength); - } else { - const char *src; + int dataLength; + BYTE *dataString = (BYTE *) Tcl_GetStringFromObj( + objv[firstArg + 2], &dataLength); - src = Tcl_GetStringFromObj(objv[firstArg + 2], &dataLength); - Tcl_DStringInit(&dsBuf); - dataString = - Tcl_UtfToWCharDString(src, dataLength, &dsBuf); - dataLength = Tcl_DStringLength(&dsBuf) + sizeof(WCHAR); - } - - if (dataLength + 1 < 2) { + if (dataLength == 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj("cannot execute null data", -1)); - Tcl_DStringFree(&dsBuf); - Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", (void *)NULL); result = TCL_ERROR; break; } @@ -1577,22 +1378,21 @@ DdeObjCmd( 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); + ddeData = DdeCreateDataHandle(ddeInstance, dataString, + (DWORD) dataLength+1, 0, 0, CF_TEXT, 0); if (ddeData != NULL) { if (flags & DDE_FLAG_ASYNC) { DdeClientTransaction((LPBYTE) ddeData, 0xFFFFFFFF, hConv, 0, - (flags & DDE_FLAG_BINARY) ? CF_TEXT : CF_UNICODETEXT, XTYP_EXECUTE, TIMEOUT_ASYNC, &ddeResult); + CF_TEXT, XTYP_EXECUTE, TIMEOUT_ASYNC, &ddeResult); DdeAbandonTransaction(ddeInstance, hConv, ddeResult); } else { ddeReturn = DdeClientTransaction((LPBYTE) ddeData, 0xFFFFFFFF, - hConv, 0, (flags & DDE_FLAG_BINARY) ? CF_TEXT : CF_UNICODETEXT, XTYP_EXECUTE, 30000, NULL); + hConv, 0, CF_TEXT, XTYP_EXECUTE, 30000, NULL); if (ddeReturn == 0) { SetDdeError(interp); result = TCL_ERROR; @@ -1603,22 +1403,15 @@ DdeObjCmd( SetDdeError(interp); result = TCL_ERROR; } - Tcl_DStringFree(&dsBuf); break; } case DDE_REQUEST: { - const WCHAR *itemString; - const char *src; - - src = Tcl_GetStringFromObj(objv[firstArg + 2], &length); - Tcl_DStringInit(&itemBuf); - itemString = Tcl_UtfToWCharDString(src, length, &itemBuf); - length = Tcl_DStringLength(&itemBuf) / sizeof(WCHAR); + const char *itemString = Tcl_GetStringFromObj(objv[firstArg + 2], + &length); if (length == 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj("cannot request value of null data", -1)); - Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", (void *)NULL); result = TCL_ERROR; goto cleanup; } @@ -1631,34 +1424,27 @@ DdeObjCmd( result = TCL_ERROR; } else { Tcl_Obj *returnObjPtr; - ddeItem = DdeCreateStringHandleW(ddeInstance, itemString, - CP_WINUNICODE); + ddeItem = DdeCreateStringHandle(ddeInstance, (void *)itemString, + CP_WINANSI); if (ddeItem != NULL) { ddeData = DdeClientTransaction(NULL, 0, hConv, ddeItem, - (flags & DDE_FLAG_BINARY) ? CF_TEXT : CF_UNICODETEXT, XTYP_REQUEST, 5000, NULL); + CF_TEXT, XTYP_REQUEST, 5000, NULL); if (ddeData == NULL) { SetDdeError(interp); result = TCL_ERROR; } else { DWORD tmp; - WCHAR *dataString = (WCHAR *) DdeAccessData(ddeData, &tmp); + const char *dataString = (const char *) DdeAccessData(ddeData, &tmp); if (flags & DDE_FLAG_BINARY) { returnObjPtr = - Tcl_NewByteArrayObj((BYTE *) dataString, tmp); + Tcl_NewByteArrayObj((BYTE *) dataString, (int) tmp); } else { - Tcl_DString dsBuf; - - if ((tmp >= sizeof(WCHAR)) - && !dataString[tmp / sizeof(WCHAR) - 1]) { - tmp -= (DWORD)sizeof(WCHAR); + if (tmp && !dataString[tmp-1]) { + --tmp; } - Tcl_DStringInit(&dsBuf); - Tcl_WCharToUtfDString(dataString, tmp>>1, &dsBuf); - returnObjPtr = - Tcl_NewStringObj(Tcl_DStringValue(&dsBuf), - Tcl_DStringLength(&dsBuf)); - Tcl_DStringFree(&dsBuf); + returnObjPtr = Tcl_NewStringObj(dataString, + (int) tmp); } DdeUnaccessData(ddeData); DdeFreeDataHandle(ddeData); @@ -1669,37 +1455,22 @@ DdeObjCmd( result = TCL_ERROR; } } + break; } case DDE_POKE: { - Tcl_DString dsBuf; - const WCHAR *itemString; + const char *itemString = Tcl_GetStringFromObj(objv[firstArg + 2], + &length); BYTE *dataString; - const char *src; - src = Tcl_GetStringFromObj(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", (void *)NULL); result = TCL_ERROR; goto cleanup; } - Tcl_DStringInit(&dsBuf); - if (flags & DDE_FLAG_BINARY) { - dataString = (BYTE *) - Tcl_GetByteArrayFromObj(objv[firstArg + 3], &length); - } else { - const char *data = - Tcl_GetStringFromObj(objv[firstArg + 3], &length); - Tcl_DStringInit(&dsBuf); - dataString = (BYTE *) - Tcl_UtfToWCharDString(data, length, &dsBuf); - length = Tcl_DStringLength(&dsBuf) + sizeof(WCHAR); - } + dataString = (BYTE *) Tcl_GetStringFromObj(objv[firstArg + 3], + &length); hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL); DdeFreeStringHandle(ddeInstance, ddeService); @@ -1709,11 +1480,11 @@ DdeObjCmd( SetDdeError(interp); result = TCL_ERROR; } else { - ddeItem = DdeCreateStringHandleW(ddeInstance, itemString, - CP_WINUNICODE); + ddeItem = DdeCreateStringHandle(ddeInstance, (void *) itemString, + CP_WINANSI); if (ddeItem != NULL) { - ddeData = DdeClientTransaction(dataString, (DWORD) length, - hConv, ddeItem, (flags & DDE_FLAG_BINARY) ? CF_TEXT : CF_UNICODETEXT, XTYP_POKE, 5000, NULL); + ddeData = DdeClientTransaction(dataString, (DWORD) length+1, + hConv, ddeItem, CF_TEXT, XTYP_POKE, 5000, NULL); if (ddeData == NULL) { SetDdeError(interp); result = TCL_ERROR; @@ -1723,7 +1494,6 @@ DdeObjCmd( result = TCL_ERROR; } } - Tcl_DStringFree(&dsBuf); break; } @@ -1738,7 +1508,6 @@ DdeObjCmd( if (serviceName == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj("invalid service name \"\"", -1)); - Tcl_SetErrorCode(interp, "TCL", "DDE", "NO_SERVER", (void *)NULL); result = TCL_ERROR; goto cleanup; } @@ -1757,7 +1526,7 @@ DdeObjCmd( for (riPtr = tsdPtr->interpListPtr; riPtr != NULL; riPtr = riPtr->nextPtr) { - if (_wcsicmp(serviceName, riPtr->name) == 0) { + if (stricmp(serviceName, riPtr->name) == 0) { break; } } @@ -1770,9 +1539,9 @@ DdeObjCmd( * server. */ - Tcl_Preserve(riPtr); + Tcl_Preserve((ClientData) riPtr); sendInterp = riPtr->interp; - Tcl_Preserve(sendInterp); + Tcl_Preserve((ClientData) sendInterp); /* * Don't exchange objects between interps. The target interp would @@ -1782,19 +1551,17 @@ DdeObjCmd( * 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", - (void *)NULL); + if (Tcl_IsSafe(riPtr->interp) && riPtr->handlerPtr == NULL) { + Tcl_SetResult(riPtr->interp, "permission denied: " + "a handler procedure must be defined for use in " + "a safe interp", TCL_STATIC); result = TCL_ERROR; } if (result == TCL_OK) { - if (objc == 1) { + if (objc == 1) objPtr = objv[0]; - } else { + else { objPtr = Tcl_ConcatObj(objc, objv); } if (riPtr->handlerPtr != NULL) { @@ -1827,7 +1594,8 @@ DdeObjCmd( objPtr = Tcl_GetVar2Ex(sendInterp, "errorInfo", NULL, TCL_GLOBAL_ONLY); if (objPtr) { - Tcl_AppendObjToErrorInfo(interp, objPtr); + string = Tcl_GetStringFromObj(objPtr, &length); + Tcl_AddObjErrorInfo(interp, string, length); } objPtr = Tcl_GetVar2Ex(sendInterp, "errorCode", NULL, @@ -1838,11 +1606,9 @@ DdeObjCmd( } Tcl_SetObjResult(interp, Tcl_GetObjResult(sendInterp)); } - Tcl_Release(riPtr); - Tcl_Release(sendInterp); + Tcl_Release((ClientData) riPtr); + Tcl_Release((ClientData) sendInterp); } else { - Tcl_DString dsBuf; - /* * This is a non-local request. Send the script to the server and * poll it for a result. @@ -1851,36 +1617,31 @@ DdeObjCmd( if (MakeDdeConnection(interp, serviceName, &hConv) != TCL_OK) { invalidServerResponse: Tcl_SetObjResult(interp, - Tcl_NewStringObj("invalid data returned from server", -1)); - Tcl_SetErrorCode(interp, "TCL", "DDE", "BAD_RESPONSE", (void *)NULL); + Tcl_NewStringObj("invalid data returned from server", + -1)); result = TCL_ERROR; goto cleanup; } objPtr = Tcl_ConcatObj(objc, objv); string = Tcl_GetStringFromObj(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); + ddeItemData = DdeCreateDataHandle(ddeInstance, + (BYTE *) string, (DWORD) length+1, 0, 0, CF_TEXT, 0); if (flags & DDE_FLAG_ASYNC) { ddeData = DdeClientTransaction((LPBYTE) ddeItemData, 0xFFFFFFFF, hConv, 0, - CF_UNICODETEXT, XTYP_EXECUTE, TIMEOUT_ASYNC, &ddeResult); + CF_TEXT, XTYP_EXECUTE, TIMEOUT_ASYNC, &ddeResult); DdeAbandonTransaction(ddeInstance, hConv, ddeResult); } else { ddeData = DdeClientTransaction((LPBYTE) ddeItemData, 0xFFFFFFFF, hConv, 0, - CF_UNICODETEXT, XTYP_EXECUTE, 30000, NULL); + CF_TEXT, XTYP_EXECUTE, 30000, NULL); if (ddeData != 0) { - ddeCookie = DdeCreateStringHandleW(ddeInstance, - TCL_DDE_EXECUTE_RESULT, CP_WINUNICODE); + ddeCookie = DdeCreateStringHandle(ddeInstance, + TCL_DDE_EXECUTE_RESULT, CP_WINANSI); ddeData = DdeClientTransaction(NULL, 0, hConv, ddeCookie, - CF_UNICODETEXT, XTYP_REQUEST, 30000, NULL); + CF_TEXT, XTYP_REQUEST, 30000, NULL); } } @@ -1889,12 +1650,10 @@ DdeObjCmd( 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 @@ -1905,18 +1664,12 @@ DdeObjCmd( * variable "errorInfo". */ + resultPtr = Tcl_NewObj(); length = DdeGetData(ddeData, NULL, 0, 0); - ddeDataString = (WCHAR *) Tcl_Alloc(length); - DdeGetData(ddeData, (BYTE *) ddeDataString, (DWORD) length, 0); - if (length > (Tcl_Size)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); + Tcl_SetObjLength(resultPtr, length); + string = Tcl_GetString(resultPtr); + DdeGetData(ddeData, (BYTE *) string, (DWORD) length, 0); + Tcl_SetObjLength(resultPtr, (int) strlen(string)); if (Tcl_ListObjIndex(NULL, resultPtr, 0, &objPtr) != TCL_OK) { Tcl_DecrRefCount(resultPtr); @@ -1934,7 +1687,9 @@ DdeObjCmd( Tcl_DecrRefCount(resultPtr); goto invalidServerResponse; } - Tcl_AppendObjToErrorInfo(interp, objPtr); + length = -1; + string = Tcl_GetStringFromObj(objPtr, &length); + Tcl_AddObjErrorInfo(interp, string, length); Tcl_ListObjIndex(NULL, resultPtr, 2, &objPtr); Tcl_SetObjErrorCode(interp, objPtr); @@ -1966,9 +1721,6 @@ DdeObjCmd( if (hConv != NULL) { DdeDisconnect(hConv); } - Tcl_DStringFree(&itemBuf); - Tcl_DStringFree(&topicBuf); - Tcl_DStringFree(&serviceBuf); return result; } diff --git a/win/tclWinError.c b/win/tclWinError.c index 7e5898b..a74d2e2 100644 --- a/win/tclWinError.c +++ b/win/tclWinError.c @@ -4,18 +4,20 @@ * This file contains code for converting from Win32 errors to errno * errors. * - * Copyright © 1995-1996 Sun Microsystems, Inc. + * 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" +#include "tclPort.h" + /* * The following table contains the mapping from Win32 errors to errno errors. */ -static const unsigned char errorTable[] = { +static CONST unsigned char errorTable[] = { 0, EINVAL, /* ERROR_INVALID_FUNCTION 1 */ ENOENT, /* ERROR_FILE_NOT_FOUND 2 */ @@ -30,7 +32,7 @@ static const unsigned char errorTable[] = { ENOEXEC, /* ERROR_BAD_FORMAT 11 */ EACCES, /* ERROR_INVALID_ACCESS 12 */ EINVAL, /* ERROR_INVALID_DATA 13 */ - ENOMEM, /* ERROR_OUT_OF_MEMORY 14 */ + EFAULT, /* ERROR_OUT_OF_MEMORY 14 */ ENOENT, /* ERROR_INVALID_DRIVE 15 */ EACCES, /* ERROR_CURRENT_DIRECTORY 16 */ EXDEV, /* ERROR_NOT_SAME_DEVICE 17 */ @@ -291,7 +293,7 @@ static const unsigned char errorTable[] = { * errno errors. */ -static const unsigned char wsaErrorTable[] = { +static CONST int wsaErrorTable[] = { EWOULDBLOCK, /* WSAEWOULDBLOCK */ EINPROGRESS, /* WSAEINPROGRESS */ EALREADY, /* WSAEALREADY */ @@ -334,7 +336,7 @@ static const unsigned char wsaErrorTable[] = { /* *---------------------------------------------------------------------- * - * Tcl_WinConvertError -- + * TclWinConvertError -- * * This routine converts a Win32 error into an errno value. * @@ -348,8 +350,8 @@ static const unsigned char wsaErrorTable[] = { */ void -Tcl_WinConvertError( - unsigned errCode) /* Win32 error code. */ +TclWinConvertError( + DWORD errCode) /* Win32 error code. */ { if (errCode >= sizeof(errorTable)/sizeof(errorTable[0])) { errCode -= WSAEWOULDBLOCK; @@ -362,65 +364,39 @@ Tcl_WinConvertError( Tcl_SetErrno(errorTable[errCode]); } } - -#ifdef __CYGWIN__ + /* *---------------------------------------------------------------------- * - * tclWinDebugPanic -- + * TclWinConvertWSAError -- * - * Display a message. If a debugger is present, present it directly to - * the debugger, otherwise send it to stderr. + * This routine converts a WinSock error into an errno value. * * Results: * None. * * Side effects: - * None. + * Sets the errno global variable. * *---------------------------------------------------------------------- */ -TCL_NORETURN void -tclWinDebugPanic( - const char *format, ...) +void +TclWinConvertWSAError( + DWORD errCode) /* Win32 error code. */ { -#define TCL_MAX_WARN_LEN 1024 - va_list argList; - va_start(argList, format); - - if (IsDebuggerPresent()) { - WCHAR msgString[TCL_MAX_WARN_LEN]; - char buf[TCL_MAX_WARN_LEN * 3]; - - vsnprintf(buf, sizeof(buf), format, argList); - msgString[TCL_MAX_WARN_LEN-1] = '\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] != '\0') { - memcpy(msgString + (TCL_MAX_WARN_LEN - 5), L" ...", 5 * sizeof(WCHAR)); + if (errCode >= sizeof(errorTable)/sizeof(errorTable[0])) { + errCode -= WSAEWOULDBLOCK; + if (errCode >= sizeof(wsaErrorTable)/sizeof(wsaErrorTable[0])) { + Tcl_SetErrno(errorTable[1]); + } else { + Tcl_SetErrno(wsaErrorTable[errCode]); } - OutputDebugStringW(msgString); } else { - if (!isatty(fileno(stderr))) { - fprintf(stderr, "\xEF\xBB\xBF"); - } - vfprintf(stderr, format, argList); - fprintf(stderr, "\n"); - fflush(stderr); + Tcl_SetErrno(errorTable[errCode]); } -# if defined(__GNUC__) - __builtin_trap(); -# else - DebugBreak(); -# endif - abort(); } -#endif + /* * Local Variables: * mode: c diff --git a/win/tclWinFCmd.c b/win/tclWinFCmd.c index 5d45fe1..441337e 100644 --- a/win/tclWinFCmd.c +++ b/win/tclWinFCmd.c @@ -4,7 +4,7 @@ * This file implements the Windows specific portion of file manipulation * subcommands of the "file" command. * - * Copyright © 1996-1998 Sun Microsystems, Inc. + * 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. @@ -54,12 +54,12 @@ static const int attributeArray[] = {FILE_ATTRIBUTE_ARCHIVE, FILE_ATTRIBUTE_HIDD 0, FILE_ATTRIBUTE_READONLY, 0, FILE_ATTRIBUTE_SYSTEM}; -const char *const tclpFileAttrStrings[] = { +CONST char *tclpFileAttrStrings[] = { "-archive", "-hidden", "-longname", "-readonly", - "-shortname", "-system", NULL + "-shortname", "-system", (char *) NULL }; -const TclFileAttrProcs tclpFileAttrProcs[] = { +CONST TclFileAttrProcs tclpFileAttrProcs[] = { {GetWinFileAttributes, SetWinFileAttributes}, {GetWinFileAttributes, SetWinFileAttributes}, {GetWinFileLongName, CannotSetAttribute}, @@ -71,7 +71,7 @@ const TclFileAttrProcs tclpFileAttrProcs[] = { * Prototype for the TraverseWinTree callback function. */ -typedef int (TraversalProc)(const WCHAR *srcPtr, const WCHAR *dstPtr, +typedef int (TraversalProc)(CONST TCHAR *srcPtr, CONST TCHAR *dstPtr, int type, Tcl_DString *errorPtr); /* @@ -82,18 +82,18 @@ static void StatError(Tcl_Interp *interp, Tcl_Obj *fileName); static int ConvertFileNameFormat(Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, int longShort, Tcl_Obj **attributePtrPtr); -static int DoCopyFile(const WCHAR *srcPtr, const WCHAR *dstPtr); -static int DoCreateDirectory(const WCHAR *pathPtr); -static int DoRemoveJustDirectory(const WCHAR *nativeSrc, +static int DoCopyFile(CONST TCHAR *srcPtr, CONST TCHAR *dstPtr); +static int DoCreateDirectory(CONST TCHAR *pathPtr); +static int DoRemoveJustDirectory(CONST TCHAR *nativeSrc, int ignoreError, Tcl_DString *errorPtr); static int DoRemoveDirectory(Tcl_DString *pathPtr, int recursive, Tcl_DString *errorPtr); -static int DoRenameFile(const WCHAR *nativeSrc, - const WCHAR *dstPtr); -static int TraversalCopy(const WCHAR *srcPtr, const WCHAR *dstPtr, +static int DoRenameFile(CONST TCHAR *nativeSrc, + CONST TCHAR *dstPtr); +static int TraversalCopy(CONST TCHAR *srcPtr, CONST TCHAR *dstPtr, int type, Tcl_DString *errorPtr); -static int TraversalDelete(const WCHAR *srcPtr, - const WCHAR *dstPtr, int type, +static int TraversalDelete(CONST TCHAR *srcPtr, + CONST TCHAR *dstPtr, int type, Tcl_DString *errorPtr); static int TraverseWinTree(TraversalProc *traverseProc, Tcl_DString *sourcePtr, Tcl_DString *dstPtr, @@ -145,15 +145,15 @@ TclpObjRenameFile( Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr) { - return DoRenameFile((const WCHAR *)Tcl_FSGetNativePath(srcPathPtr), - (const WCHAR *)Tcl_FSGetNativePath(destPathPtr)); + return DoRenameFile(Tcl_FSGetNativePath(srcPathPtr), + Tcl_FSGetNativePath(destPathPtr)); } static int DoRenameFile( - const WCHAR *nativeSrc, /* Pathname of file or dir to be renamed + CONST TCHAR *nativeSrc, /* Pathname of file or dir to be renamed * (native). */ - const WCHAR *nativeDst) /* New pathname for file or directory + CONST TCHAR *nativeDst) /* New pathname for file or directory * (native). */ { #if defined(HAVE_NO_SEH) && !defined(_WIN64) @@ -204,7 +204,7 @@ DoRenameFile( "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 %%esp, 0xc(%%edx)" "\n\t" /* esp */ "movl $0, 0x10(%%edx)" "\n\t" /* status */ /* @@ -214,12 +214,12 @@ DoRenameFile( "movl %%edx, %%fs:0" "\n\t" /* - * Call MoveFileW(nativeSrc, nativeDst) + * Call MoveFile(nativeSrc, nativeDst) */ "pushl %%ebx" "\n\t" "pushl %%ecx" "\n\t" - "movl %[moveFileW], %%eax" "\n\t" + "movl %[moveFile], %%eax" "\n\t" "call *%%eax" "\n\t" /* @@ -245,7 +245,7 @@ DoRenameFile( */ "2:" "\t" - "movl 0xC(%%edx), %%esp" "\n\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" @@ -256,7 +256,7 @@ DoRenameFile( [registration] "m" (registration), [nativeDst] "m" (nativeDst), [nativeSrc] "m" (nativeSrc), - [moveFileW] "r" (MoveFileW) + [moveFile] "r" (tclWinProcs->moveFileProc) : "%eax", "%ebx", "%ecx", "%edx", "memory" ); @@ -267,7 +267,7 @@ DoRenameFile( #ifndef HAVE_NO_SEH __try { #endif - if ((*MoveFileW)(nativeSrc, nativeDst) != FALSE) { + if ((*tclWinProcs->moveFileProc)(nativeSrc, nativeDst) != FALSE) { retval = TCL_OK; } #ifndef HAVE_NO_SEH @@ -279,20 +279,20 @@ DoRenameFile( return retval; } - Tcl_WinConvertError(GetLastError()); + TclWinConvertError(GetLastError()); - srcAttr = GetFileAttributesW(nativeSrc); - dstAttr = GetFileAttributesW(nativeDst); - if (srcAttr == 0xFFFFFFFF) { - if (GetFullPathNameW(nativeSrc, 0, NULL, + srcAttr = (*tclWinProcs->getFileAttributesProc)(nativeSrc); + dstAttr = (*tclWinProcs->getFileAttributesProc)(nativeDst); + if (srcAttr == 0xffffffff) { + if ((*tclWinProcs->getFullPathNameProc)(nativeSrc, 0, NULL, NULL) >= MAX_PATH) { errno = ENAMETOOLONG; return TCL_ERROR; } srcAttr = 0; } - if (dstAttr == 0xFFFFFFFF) { - if (GetFullPathNameW(nativeDst, 0, NULL, + if (dstAttr == 0xffffffff) { + if ((*tclWinProcs->getFullPathNameProc)(nativeDst, 0, NULL, NULL) >= MAX_PATH) { errno = ENAMETOOLONG; return TCL_ERROR; @@ -307,31 +307,29 @@ DoRenameFile( if (errno == EACCES) { decode: if (srcAttr & FILE_ATTRIBUTE_DIRECTORY) { - WCHAR *nativeSrcRest, *nativeDstRest; - const char **srcArgv, **dstArgv; - Tcl_Size size, srcArgc, dstArgc; + TCHAR *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; + CONST char *src, *dst; - size = GetFullPathNameW(nativeSrc, MAX_PATH, + size = (*tclWinProcs->getFullPathNameProc)(nativeSrc, MAX_PATH, nativeSrcPath, &nativeSrcRest); - if ((size <= 0) || (size > MAX_PATH)) { + if ((size == 0) || (size > MAX_PATH)) { return TCL_ERROR; } - size = GetFullPathNameW(nativeDst, MAX_PATH, + size = (*tclWinProcs->getFullPathNameProc)(nativeDst, MAX_PATH, nativeDstPath, &nativeDstRest); if ((size == 0) || (size > MAX_PATH)) { return TCL_ERROR; } - CharLowerW(nativeSrcPath); - CharLowerW(nativeDstPath); + (*tclWinProcs->charLowerProc)((TCHAR *) nativeSrcPath); + (*tclWinProcs->charLowerProc)((TCHAR *) nativeDstPath); - Tcl_DStringInit(&srcString); - Tcl_DStringInit(&dstString); - src = Tcl_WCharToUtfDString(nativeSrcPath, TCL_INDEX_NONE, &srcString); - dst = Tcl_WCharToUtfDString(nativeDstPath, TCL_INDEX_NONE, &dstString); + src = Tcl_WinTCharToUtf((TCHAR *) nativeSrcPath, -1, &srcString); + dst = Tcl_WinTCharToUtf((TCHAR *) nativeDstPath, -1, &dstString); /* * Check whether the destination path is actually inside the @@ -339,7 +337,7 @@ DoRenameFile( * character is either end-of-string or a directory separator */ - if ((strncmp(src, dst, Tcl_DStringLength(&srcString))==0) + if ((strncmp(src, dst, (size_t) Tcl_DStringLength(&srcString))==0) && (dst[Tcl_DStringLength(&srcString)] == '\\' || dst[Tcl_DStringLength(&srcString)] == '/' || dst[Tcl_DStringLength(&srcString)] == '\0')) { @@ -378,8 +376,8 @@ DoRenameFile( Tcl_SetErrno(EXDEV); } - ckfree(srcArgv); - ckfree(dstArgv); + ckfree((char *) srcArgv); + ckfree((char *) dstArgv); } /* @@ -410,7 +408,8 @@ DoRenameFile( * directory back, for completeness. */ - if (MoveFileW(nativeSrc, nativeDst) != FALSE) { + if ((*tclWinProcs->moveFileProc)(nativeSrc, + nativeDst) != FALSE) { return TCL_OK; } @@ -419,9 +418,9 @@ DoRenameFile( * be, but report this one. */ - Tcl_WinConvertError(GetLastError()); - CreateDirectoryW(nativeDst, NULL); - SetFileAttributesW(nativeDst, dstAttr); + TclWinConvertError(GetLastError()); + (*tclWinProcs->createDirectoryProc)(nativeDst, NULL); + (*tclWinProcs->setFileAttributesProc)(nativeDst, dstAttr); if (Tcl_GetErrno() == EACCES) { /* * Decode the EACCES to a more meaningful error. @@ -446,22 +445,24 @@ DoRenameFile( * back to old name. */ - WCHAR *nativeRest, *nativeTmp, *nativePrefix; + TCHAR *nativeRest, *nativeTmp, *nativePrefix; int result, size; WCHAR tempBuf[MAX_PATH]; - size = GetFullPathNameW(nativeDst, MAX_PATH, + size = (*tclWinProcs->getFullPathNameProc)(nativeDst, MAX_PATH, tempBuf, &nativeRest); if ((size == 0) || (size > MAX_PATH) || (nativeRest == NULL)) { return TCL_ERROR; } - nativeTmp = (WCHAR *) tempBuf; - nativeRest[0] = '\0'; + nativeTmp = (TCHAR *) tempBuf; + ((char *) nativeRest)[0] = '\0'; + ((char *) nativeRest)[1] = '\0'; /* In case it's Unicode. */ result = TCL_ERROR; - nativePrefix = (WCHAR *)L"tclr"; - if (GetTempFileNameW(nativeTmp, nativePrefix, - 0, tempBuf) != 0) { + nativePrefix = (tclWinProcs->useWide) + ? (TCHAR *) L"tclr" : (TCHAR *) "tclr"; + if ((*tclWinProcs->getTempFileNameProc)(nativeTmp, + nativePrefix, 0, tempBuf) != 0) { /* * Strictly speaking, need the following DeleteFile and * MoveFile to be joined as an atomic operation so no @@ -469,16 +470,19 @@ DoRenameFile( * same temp file. */ - nativeTmp = tempBuf; - DeleteFileW(nativeTmp); - if (MoveFileW(nativeDst, nativeTmp) != FALSE) { - if (MoveFileW(nativeSrc, nativeDst) != FALSE) { - SetFileAttributesW(nativeTmp, FILE_ATTRIBUTE_NORMAL); - DeleteFileW(nativeTmp); + nativeTmp = (TCHAR *) tempBuf; + (*tclWinProcs->deleteFileProc)(nativeTmp); + if ((*tclWinProcs->moveFileProc)(nativeDst, + nativeTmp) != FALSE) { + if ((*tclWinProcs->moveFileProc)(nativeSrc, + nativeDst) != FALSE) { + (*tclWinProcs->setFileAttributesProc)(nativeTmp, + FILE_ATTRIBUTE_NORMAL); + (*tclWinProcs->deleteFileProc)(nativeTmp); return TCL_OK; } else { - DeleteFileW(nativeDst); - MoveFileW(nativeTmp, nativeDst); + (*tclWinProcs->deleteFileProc)(nativeDst); + (*tclWinProcs->moveFileProc)(nativeTmp, nativeDst); } } @@ -487,7 +491,7 @@ DoRenameFile( * error. Could happen if an open file refers to dst. */ - Tcl_WinConvertError(GetLastError()); + TclWinConvertError(GetLastError()); if (Tcl_GetErrno() == EACCES) { /* * Decode the EACCES to a more meaningful error. @@ -535,14 +539,14 @@ TclpObjCopyFile( Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr) { - return DoCopyFile((const WCHAR *)Tcl_FSGetNativePath(srcPathPtr), - (const WCHAR *)Tcl_FSGetNativePath(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). */ + CONST TCHAR *nativeSrc, /* Pathname of file to be copied (native). */ + CONST TCHAR *nativeDst) /* Pathname of file to copy to (native). */ { #if defined(HAVE_NO_SEH) && !defined(_WIN64) TCLEXCEPTION_REGISTRATION registration; @@ -592,7 +596,7 @@ DoCopyFile( "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 %%esp, 0xc(%%edx)" "\n\t" /* esp */ "movl $0, 0x10(%%edx)" "\n\t" /* status */ /* @@ -602,10 +606,10 @@ DoCopyFile( "movl %%edx, %%fs:0" "\n\t" /* - * Call CopyFileW(nativeSrc, nativeDst, 0) + * Call CopyFile(nativeSrc, nativeDst, 0) */ - "movl %[copyFileW], %%eax" "\n\t" + "movl %[copyFile], %%eax" "\n\t" "pushl $0" "\n\t" "pushl %%ebx" "\n\t" "pushl %%ecx" "\n\t" @@ -634,7 +638,7 @@ DoCopyFile( */ "2:" "\t" - "movl 0xC(%%edx), %%esp" "\n\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" @@ -645,7 +649,7 @@ DoCopyFile( [registration] "m" (registration), [nativeDst] "m" (nativeDst), [nativeSrc] "m" (nativeSrc), - [copyFileW] "r" (CopyFileW) + [copyFile] "r" (tclWinProcs->copyFileProc) : "%eax", "%ebx", "%ecx", "%edx", "memory" ); @@ -656,7 +660,7 @@ DoCopyFile( #ifndef HAVE_NO_SEH __try { #endif - if (CopyFileW(nativeSrc, nativeDst, 0) != FALSE) { + if ((*tclWinProcs->copyFileProc)(nativeSrc, nativeDst, 0) != FALSE) { retval = TCL_OK; } #ifndef HAVE_NO_SEH @@ -668,7 +672,7 @@ DoCopyFile( return retval; } - Tcl_WinConvertError(GetLastError()); + TclWinConvertError(GetLastError()); if (Tcl_GetErrno() == EBADF) { Tcl_SetErrno(EACCES); return TCL_ERROR; @@ -676,10 +680,10 @@ DoCopyFile( if (Tcl_GetErrno() == EACCES) { DWORD srcAttr, dstAttr; - srcAttr = GetFileAttributesW(nativeSrc); - dstAttr = GetFileAttributesW(nativeDst); - if (srcAttr != 0xFFFFFFFF) { - if (dstAttr == 0xFFFFFFFF) { + srcAttr = (*tclWinProcs->getFileAttributesProc)(nativeSrc); + dstAttr = (*tclWinProcs->getFileAttributesProc)(nativeDst); + if (srcAttr != 0xffffffff) { + if (dstAttr == 0xffffffff) { dstAttr = 0; } if ((srcAttr & FILE_ATTRIBUTE_DIRECTORY) || @@ -693,9 +697,10 @@ DoCopyFile( Tcl_SetErrno(EISDIR); } if (dstAttr & FILE_ATTRIBUTE_READONLY) { - SetFileAttributesW(nativeDst, + (*tclWinProcs->setFileAttributesProc)(nativeDst, dstAttr & ~((DWORD)FILE_ATTRIBUTE_READONLY)); - if (CopyFileW(nativeSrc, nativeDst, 0) != FALSE) { + if ((*tclWinProcs->copyFileProc)(nativeSrc, nativeDst, + 0) != FALSE) { return TCL_OK; } @@ -704,8 +709,8 @@ DoCopyFile( * attributes of dst. */ - Tcl_WinConvertError(GetLastError()); - SetFileAttributesW(nativeDst, dstAttr); + TclWinConvertError(GetLastError()); + (*tclWinProcs->setFileAttributesProc)(nativeDst, dstAttr); } } } @@ -746,35 +751,34 @@ TclpObjDeleteFile( int TclpDeleteFile( - const void *nativePath) /* Pathname of file to be removed (native). */ + CONST TCHAR *nativePath) /* Pathname of file to be removed (native). */ { DWORD attr; - const WCHAR *path = (const WCHAR *)nativePath; /* * The DeleteFile API acts differently under Win95/98 and NT WRT NULL and * "". Avoid passing these values. */ - if (path == NULL || path[0] == '\0') { + if (nativePath == NULL || nativePath[0] == '\0') { Tcl_SetErrno(ENOENT); return TCL_ERROR; } - if (DeleteFileW(path) != FALSE) { + if ((*tclWinProcs->deleteFileProc)(nativePath) != FALSE) { return TCL_OK; } - Tcl_WinConvertError(GetLastError()); + TclWinConvertError(GetLastError()); if (Tcl_GetErrno() == EACCES) { - attr = GetFileAttributesW(path); - if (attr != 0xFFFFFFFF) { + attr = (*tclWinProcs->getFileAttributesProc)(nativePath); + if (attr != 0xffffffff) { if (attr & FILE_ATTRIBUTE_DIRECTORY) { if (attr & FILE_ATTRIBUTE_REPARSE_POINT) { /* * It is a symbolic link - remove it. */ - if (TclWinSymLinkDelete(path, 0) == 0) { + if (TclWinSymLinkDelete(nativePath, 0) == 0) { return TCL_OK; } } @@ -788,21 +792,22 @@ TclpDeleteFile( Tcl_SetErrno(EISDIR); } else if (attr & FILE_ATTRIBUTE_READONLY) { - int res = SetFileAttributesW(path, - attr & ~((DWORD) FILE_ATTRIBUTE_READONLY)); + int res = (*tclWinProcs->setFileAttributesProc)(nativePath, + attr & ~((DWORD)FILE_ATTRIBUTE_READONLY)); - if ((res != 0) && (DeleteFileW(path) != FALSE)) { + if ((res != 0) && ((*tclWinProcs->deleteFileProc)(nativePath) + != FALSE)) { return TCL_OK; } - Tcl_WinConvertError(GetLastError()); + TclWinConvertError(GetLastError()); if (res != 0) { - SetFileAttributesW(path, attr); + (*tclWinProcs->setFileAttributesProc)(nativePath, attr); } } } } else if (Tcl_GetErrno() == ENOENT) { - attr = GetFileAttributesW(path); - if (attr != 0xFFFFFFFF) { + attr = (*tclWinProcs->getFileAttributesProc)(nativePath); + if (attr != 0xffffffff) { if (attr & FILE_ATTRIBUTE_DIRECTORY) { /* * Windows 95 reports removing a directory as ENOENT instead @@ -853,17 +858,17 @@ int TclpObjCreateDirectory( Tcl_Obj *pathPtr) { - return DoCreateDirectory((const WCHAR *)Tcl_FSGetNativePath(pathPtr)); + return DoCreateDirectory(Tcl_FSGetNativePath(pathPtr)); } static int DoCreateDirectory( - const WCHAR *nativePath) /* Pathname of directory to create (native). */ + CONST TCHAR *nativePath) /* Pathname of directory to create (native). */ { - if (CreateDirectoryW(nativePath, NULL) == 0) { - DWORD error = GetLastError(); - - Tcl_WinConvertError(error); + DWORD error; + if ((*tclWinProcs->createDirectoryProc)(nativePath, NULL) == 0) { + error = GetLastError(); + TclWinConvertError(error); return TCL_ERROR; } return TCL_OK; @@ -876,7 +881,7 @@ DoCreateDirectory( * * 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 empty directory. + * hierarchies, even if the target directory is an an empty directory. * * Results: * If the directory was successfully copied, returns TCL_OK. Otherwise @@ -910,10 +915,8 @@ TclpObjCopyDirectory( return TCL_ERROR; } - Tcl_DStringInit(&srcString); - Tcl_DStringInit(&dstString); - Tcl_UtfToWCharDString(TclGetString(normSrcPtr), TCL_INDEX_NONE, &srcString); - Tcl_UtfToWCharDString(TclGetString(normDestPtr), TCL_INDEX_NONE, &dstString); + Tcl_WinUtfToTChar(Tcl_GetString(normSrcPtr), -1, &srcString); + Tcl_WinUtfToTChar(Tcl_GetString(normDestPtr), -1, &dstString); ret = TraverseWinTree(TraversalCopy, &srcString, &dstString, &ds); @@ -926,7 +929,7 @@ TclpObjCopyDirectory( } else if (!strcmp(Tcl_DStringValue(&ds), TclGetString(normDestPtr))) { *errorPtr = destPathPtr; } else { - *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), TCL_INDEX_NONE); + *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1); } Tcl_DStringFree(&ds); Tcl_IncrRefCount(*errorPtr); @@ -985,21 +988,21 @@ TclpObjRemoveDirectory( if (normPtr == NULL) { return TCL_ERROR; } - Tcl_DStringInit(&native); - Tcl_UtfToWCharDString(TclGetString(normPtr), TCL_INDEX_NONE, &native); + Tcl_WinUtfToTChar(Tcl_GetString(normPtr), -1, &native); ret = DoRemoveDirectory(&native, recursive, &ds); Tcl_DStringFree(&native); } else { - ret = DoRemoveJustDirectory((const WCHAR *)Tcl_FSGetNativePath(pathPtr), 0, &ds); + ret = DoRemoveJustDirectory(Tcl_FSGetNativePath(pathPtr), 0, &ds); } if (ret != TCL_OK) { - if (Tcl_DStringLength(&ds) > 0) { + int len = Tcl_DStringLength(&ds); + if (len > 0) { if (normPtr != NULL && !strcmp(Tcl_DStringValue(&ds), TclGetString(normPtr))) { *errorPtr = pathPtr; } else { - *errorPtr = Tcl_DStringToObj(&ds); + *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1); } Tcl_IncrRefCount(*errorPtr); } @@ -1011,7 +1014,7 @@ TclpObjRemoveDirectory( static int DoRemoveJustDirectory( - const WCHAR *nativePath, /* Pathname of directory to be removed + CONST TCHAR *nativePath, /* Pathname of directory to be removed * (native). */ int ignoreError, /* If non-zero, don't initialize the errorPtr * under some circumstances on return. */ @@ -1028,11 +1031,10 @@ DoRemoveJustDirectory( if (nativePath == NULL || nativePath[0] == '\0') { Tcl_SetErrno(ENOENT); - Tcl_DStringInit(errorPtr); - return TCL_ERROR; + goto end; } - attr = GetFileAttributesW(nativePath); + attr = (*tclWinProcs->getFileAttributesProc)(nativePath); if (attr & FILE_ATTRIBUTE_REPARSE_POINT) { /* @@ -1046,16 +1048,16 @@ DoRemoveJustDirectory( * Ordinary directory. */ - if (RemoveDirectoryW(nativePath) != FALSE) { + if ((*tclWinProcs->removeDirectoryProc)(nativePath) != FALSE) { return TCL_OK; } } - Tcl_WinConvertError(GetLastError()); + TclWinConvertError(GetLastError()); if (Tcl_GetErrno() == EACCES) { - attr = GetFileAttributesW(nativePath); - if (attr != 0xFFFFFFFF) { + attr = (*tclWinProcs->getFileAttributesProc)(nativePath); + if (attr != 0xffffffff) { if ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0) { /* * Windows 95 reports calling RemoveDirectory on a file as an @@ -1078,16 +1080,60 @@ DoRemoveJustDirectory( if (attr & FILE_ATTRIBUTE_READONLY) { attr &= ~FILE_ATTRIBUTE_READONLY; - if (SetFileAttributesW(nativePath, attr) == FALSE) { + if ((*tclWinProcs->setFileAttributesProc)(nativePath, + attr) == FALSE) { goto end; } - if (RemoveDirectoryW(nativePath) != FALSE) { + if ((*tclWinProcs->removeDirectoryProc)(nativePath) != FALSE) { return TCL_OK; } - Tcl_WinConvertError(GetLastError()); - SetFileAttributesW(nativePath, + TclWinConvertError(GetLastError()); + (*tclWinProcs->setFileAttributesProc)(nativePath, attr | FILE_ATTRIBUTE_READONLY); } + + /* + * Windows 95 and Win32s report removing a non-empty directory as + * EACCES, not EEXIST. If the directory is not empty, change errno + * so caller knows what's going on. + */ + + if (TclWinGetPlatformId() != VER_PLATFORM_WIN32_NT) { + CONST char *path, *find; + HANDLE handle; + WIN32_FIND_DATAA data; + Tcl_DString buffer; + int len; + + path = (CONST char *) nativePath; + + Tcl_DStringInit(&buffer); + len = strlen(path); + find = Tcl_DStringAppend(&buffer, path, len); + if ((len > 0) && (find[len - 1] != '\\')) { + Tcl_DStringAppend(&buffer, "\\", 1); + } + find = Tcl_DStringAppend(&buffer, "*.*", 3); + handle = FindFirstFileA(find, &data); + if (handle != INVALID_HANDLE_VALUE) { + while (1) { + if ((strcmp(data.cFileName, ".") != 0) + && (strcmp(data.cFileName, "..") != 0)) { + /* + * Found something in this directory. + */ + + Tcl_SetErrno(EEXIST); + break; + } + if (FindNextFileA(handle, &data) == FALSE) { + break; + } + } + FindClose(handle); + } + Tcl_DStringFree(&buffer); + } } } @@ -1111,13 +1157,10 @@ DoRemoveJustDirectory( end: if (errorPtr != NULL) { char *p; - - Tcl_DStringInit(errorPtr); - p = Tcl_WCharToUtfDString(nativePath, TCL_INDEX_NONE, errorPtr); + Tcl_WinTCharToUtf(nativePath, -1, errorPtr); + p = Tcl_DStringValue(errorPtr); for (; *p; ++p) { - if (*p == '\\') { - *p = '/'; - } + if (*p == '\\') *p = '/'; } } return TCL_ERROR; @@ -1135,7 +1178,7 @@ DoRemoveDirectory( * filled with UTF-8 name of file causing * error. */ { - int res = DoRemoveJustDirectory((const WCHAR *)Tcl_DStringValue(pathPtr), recursive, + int res = DoRemoveJustDirectory(Tcl_DStringValue(pathPtr), recursive, errorPtr); if ((res == TCL_ERROR) && (recursive != 0) && (Tcl_GetErrno() == EEXIST)) { @@ -1186,22 +1229,22 @@ TraverseWinTree( * error. */ { DWORD sourceAttr; - WCHAR *nativeSource, *nativeTarget, *nativeErrfile; + TCHAR *nativeSource, *nativeTarget, *nativeErrfile; int result, found, sourceLen, targetLen = 0, oldSourceLen, oldTargetLen; HANDLE handle; - WIN32_FIND_DATAW data; + WIN32_FIND_DATAT data; nativeErrfile = NULL; result = TCL_OK; - oldTargetLen = 0; + oldTargetLen = 0; /* lint. */ - nativeSource = (WCHAR *) Tcl_DStringValue(sourcePtr); - nativeTarget = (WCHAR *) + nativeSource = (TCHAR *) Tcl_DStringValue(sourcePtr); + nativeTarget = (TCHAR *) (targetPtr == NULL ? NULL : Tcl_DStringValue(targetPtr)); oldSourceLen = Tcl_DStringLength(sourcePtr); - sourceAttr = GetFileAttributesW(nativeSource); - if (sourceAttr == 0xFFFFFFFF) { + sourceAttr = (*tclWinProcs->getFileAttributesProc)(nativeSource); + if (sourceAttr == 0xffffffff) { nativeErrfile = nativeSource; goto end; } @@ -1211,7 +1254,7 @@ TraverseWinTree( * Process the symbolic link */ - return traverseProc(nativeSource, nativeTarget, DOTREE_LINK, + return (*traverseProc)(nativeSource, nativeTarget, DOTREE_LINK, errorPtr); } @@ -1220,62 +1263,89 @@ TraverseWinTree( * Process the regular file */ - return traverseProc(nativeSource, nativeTarget, DOTREE_F, errorPtr); + return (*traverseProc)(nativeSource, nativeTarget, DOTREE_F, errorPtr); } - Tcl_DStringAppend(sourcePtr, (char *) L"\\*.*", 4 * sizeof(WCHAR) + 1); - Tcl_DStringSetLength(sourcePtr, Tcl_DStringLength(sourcePtr) - 1); + if (tclWinProcs->useWide) { + Tcl_DStringAppend(sourcePtr, (char *) L"\\*.*", 4 * sizeof(WCHAR) + 1); + Tcl_DStringSetLength(sourcePtr, Tcl_DStringLength(sourcePtr) - 1); + } else { + Tcl_DStringAppend(sourcePtr, "\\*.*", 4); + } - nativeSource = (WCHAR *) Tcl_DStringValue(sourcePtr); - handle = FindFirstFileW(nativeSource, &data); + nativeSource = (TCHAR *) Tcl_DStringValue(sourcePtr); + handle = (*tclWinProcs->findFirstFileProc)(nativeSource, &data); if (handle == INVALID_HANDLE_VALUE) { /* * Can't read directory. */ - Tcl_WinConvertError(GetLastError()); + TclWinConvertError(GetLastError()); nativeErrfile = nativeSource; goto end; } - Tcl_DStringSetLength(sourcePtr, oldSourceLen + 1); + nativeSource[oldSourceLen + 1] = '\0'; Tcl_DStringSetLength(sourcePtr, oldSourceLen); - result = traverseProc(nativeSource, nativeTarget, DOTREE_PRED, + result = (*traverseProc)(nativeSource, nativeTarget, DOTREE_PRED, errorPtr); if (result != TCL_OK) { FindClose(handle); return result; } - sourceLen = oldSourceLen + sizeof(WCHAR); - Tcl_DStringAppend(sourcePtr, (char *) L"\\", sizeof(WCHAR) + 1); - Tcl_DStringSetLength(sourcePtr, sourceLen); + sourceLen = oldSourceLen; + + if (tclWinProcs->useWide) { + sourceLen += sizeof(WCHAR); + Tcl_DStringAppend(sourcePtr, (char *) L"\\", sizeof(WCHAR) + 1); + Tcl_DStringSetLength(sourcePtr, sourceLen); + } else { + sourceLen += 1; + Tcl_DStringAppend(sourcePtr, "\\", 1); + } if (targetPtr != NULL) { oldTargetLen = Tcl_DStringLength(targetPtr); targetLen = oldTargetLen; - targetLen += sizeof(WCHAR); - Tcl_DStringAppend(targetPtr, (char *) L"\\", sizeof(WCHAR) + 1); - Tcl_DStringSetLength(targetPtr, targetLen); + if (tclWinProcs->useWide) { + targetLen += sizeof(WCHAR); + Tcl_DStringAppend(targetPtr, (char *) L"\\", sizeof(WCHAR) + 1); + Tcl_DStringSetLength(targetPtr, targetLen); + } else { + targetLen += 1; + Tcl_DStringAppend(targetPtr, "\\", 1); + } } found = 1; - for (; found; found = FindNextFileW(handle, &data)) { - WCHAR *nativeName; + for (; found; found = (*tclWinProcs->findNextFileProc)(handle, &data)) { + TCHAR *nativeName; int len; - WCHAR *wp = data.cFileName; - if (*wp == '.') { - wp++; + if (tclWinProcs->useWide) { + WCHAR *wp; + + wp = data.w.cFileName; if (*wp == '.') { wp++; + if (*wp == '.') { + wp++; + } + if (*wp == '\0') { + continue; + } } - if (*wp == '\0') { + nativeName = (TCHAR *) data.w.cFileName; + len = wcslen(data.w.cFileName) * sizeof(WCHAR); + } else { + if ((strcmp(data.a.cFileName, ".") == 0) + || (strcmp(data.a.cFileName, "..") == 0)) { continue; } + nativeName = (TCHAR *) data.a.cFileName; + len = strlen(data.a.cFileName); } - nativeName = (WCHAR *) data.cFileName; - len = wcslen(data.cFileName) * sizeof(WCHAR); /* * Append name after slash, and recurse on the file. @@ -1320,17 +1390,16 @@ TraverseWinTree( * files in that directory. */ - result = traverseProc((const WCHAR *)Tcl_DStringValue(sourcePtr), - (const WCHAR *)(targetPtr == NULL ? NULL : Tcl_DStringValue(targetPtr)), + result = (*traverseProc)(Tcl_DStringValue(sourcePtr), + (targetPtr == NULL ? NULL : Tcl_DStringValue(targetPtr)), DOTREE_POSTD, errorPtr); } end: if (nativeErrfile != NULL) { - Tcl_WinConvertError(GetLastError()); + TclWinConvertError(GetLastError()); if (errorPtr != NULL) { - Tcl_DStringInit(errorPtr); - Tcl_WCharToUtfDString(nativeErrfile, TCL_INDEX_NONE, errorPtr); + Tcl_WinTCharToUtf(nativeErrfile, -1, errorPtr); } result = TCL_ERROR; } @@ -1357,8 +1426,8 @@ TraverseWinTree( static int TraversalCopy( - const WCHAR *nativeSrc, /* Source pathname to copy. */ - const WCHAR *nativeDst, /* Destination pathname of copy. */ + CONST TCHAR *nativeSrc, /* Source pathname to copy. */ + CONST TCHAR *nativeDst, /* Destination pathname of copy. */ int type, /* Reason for call - see TraverseWinTree() */ Tcl_DString *errorPtr) /* If non-NULL, initialized DString filled * with UTF-8 name of file causing error. */ @@ -1376,12 +1445,13 @@ TraversalCopy( break; case DOTREE_PRED: if (DoCreateDirectory(nativeDst) == TCL_OK) { - DWORD attr = GetFileAttributesW(nativeSrc); + DWORD attr = (tclWinProcs->getFileAttributesProc)(nativeSrc); - if (SetFileAttributesW(nativeDst, attr) != FALSE) { + if ((tclWinProcs->setFileAttributesProc)(nativeDst, + attr) != FALSE) { return TCL_OK; } - Tcl_WinConvertError(GetLastError()); + TclWinConvertError(GetLastError()); } break; case DOTREE_POSTD: @@ -1394,8 +1464,7 @@ TraversalCopy( */ if (errorPtr != NULL) { - Tcl_DStringInit(errorPtr); - Tcl_WCharToUtfDString(nativeDst, TCL_INDEX_NONE, errorPtr); + Tcl_WinTCharToUtf(nativeDst, -1, errorPtr); } return TCL_ERROR; } @@ -1423,8 +1492,8 @@ TraversalCopy( static int TraversalDelete( - const WCHAR *nativeSrc, /* Source pathname to delete. */ - TCL_UNUSED(const WCHAR *) /*dstPtr*/, + CONST TCHAR *nativeSrc, /* Source pathname to delete. */ + CONST TCHAR *dstPtr, /* Not used. */ int type, /* Reason for call - see TraverseWinTree() */ Tcl_DString *errorPtr) /* If non-NULL, initialized DString filled * with UTF-8 name of file causing error. */ @@ -1450,8 +1519,7 @@ TraversalDelete( } if (errorPtr != NULL) { - Tcl_DStringInit(errorPtr); - Tcl_WCharToUtfDString(nativeSrc, TCL_INDEX_NONE, errorPtr); + Tcl_WinTCharToUtf(nativeSrc, -1, errorPtr); } return TCL_ERROR; } @@ -1479,9 +1547,9 @@ StatError( Tcl_Obj *fileName) /* The name of the file which caused the * error. */ { - Tcl_WinConvertError(GetLastError()); - Tcl_SetObjResult(interp, Tcl_ObjPrintf("could not read \"%s\": %s", - TclGetString(fileName), Tcl_PosixError(interp))); + TclWinConvertError(GetLastError()); + Tcl_AppendResult(interp, "could not read \"", TclGetString(fileName), + "\": ", Tcl_PosixError(interp), (char *) NULL); } /* @@ -1511,13 +1579,13 @@ GetWinFileAttributes( Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */ { DWORD result; - const WCHAR *nativeName; + CONST TCHAR *nativeName; int attr; - nativeName = (const WCHAR *)Tcl_FSGetNativePath(fileName); - result = GetFileAttributesW(nativeName); + nativeName = Tcl_FSGetNativePath(fileName); + result = (*tclWinProcs->getFileAttributesProc)(nativeName); - if (result == 0xFFFFFFFF) { + if (result == 0xffffffff) { StatError(interp, fileName); return TCL_ERROR; } @@ -1532,8 +1600,8 @@ GetWinFileAttributes( * We test for, and fix that case, here. */ - Tcl_Size len; - const char *str = TclGetStringFromObj(fileName, &len); + int len; + char *str = Tcl_GetStringFromObj(fileName,&len); if (len < 4) { if (len == 0) { @@ -1557,7 +1625,7 @@ GetWinFileAttributes( } } - TclNewIntObj(*attributePtrPtr, attr != 0); + *attributePtrPtr = Tcl_NewBooleanObj(attr); return TCL_OK; } @@ -1587,23 +1655,21 @@ GetWinFileAttributes( static int ConvertFileNameFormat( Tcl_Interp *interp, /* The interp we are using for errors. */ - TCL_UNUSED(int) /*objIndex*/, + 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. */ { - Tcl_Size pathc, i, length; + 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", - TclGetString(fileName))); - errno = ENOENT; - Tcl_PosixError(interp); + Tcl_AppendResult(interp, "could not read \"", + Tcl_GetString(fileName), "\": no such file or directory", + (char *) NULL); } goto cleanup; } @@ -1618,11 +1684,12 @@ ConvertFileNameFormat( for (i = 0; i < pathc; i++) { Tcl_Obj *elt; char *pathv; + int pathLen; Tcl_ListObjIndex(NULL, splitPath, i, &elt); - pathv = TclGetStringFromObj(elt, &length); - if ((pathv[0] == '/') || ((length == 3) && (pathv[1] == ':')) + 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 @@ -1643,9 +1710,10 @@ ConvertFileNameFormat( Tcl_Obj *tempPath; Tcl_DString ds; Tcl_DString dsTemp; - const WCHAR *nativeName; - const char *tempString; - WIN32_FIND_DATAW data; + TCHAR *nativeName; + char *tempString; + int tempLen; + WIN32_FIND_DATAT data; HANDLE handle; DWORD attr; @@ -1657,20 +1725,20 @@ ConvertFileNameFormat( * likely to lead to infinite loops. */ - tempString = TclGetStringFromObj(tempPath, &length); Tcl_DStringInit(&ds); - nativeName = Tcl_UtfToWCharDString(tempString, length, &ds); + tempString = Tcl_GetStringFromObj(tempPath,&tempLen); + nativeName = Tcl_WinUtfToTChar(tempString, tempLen, &ds); Tcl_DecrRefCount(tempPath); - handle = FindFirstFileW(nativeName, &data); + handle = (*tclWinProcs->findFirstFileProc)(nativeName, &data); if (handle == INVALID_HANDLE_VALUE) { /* - * FindFirstFileW() doesn't like root directories. We would + * FindFirstFile() doesn't like root directories. We would * only get a root directory here if the caller specified "c:" * or "c:." and the current directory on the drive was the * root directory */ - attr = GetFileAttributesW(nativeName); + attr = (*tclWinProcs->getFileAttributesProc)(nativeName); if ((attr!=0xFFFFFFFF) && (attr & FILE_ATTRIBUTE_DIRECTORY)) { Tcl_DStringFree(&ds); goto simple; @@ -1684,19 +1752,32 @@ ConvertFileNameFormat( } goto cleanup; } - nativeName = data.cAlternateFileName; - if (longShort) { - if (data.cFileName[0] != '\0') { - nativeName = data.cFileName; + if (tclWinProcs->useWide) { + nativeName = (TCHAR *) data.w.cAlternateFileName; + if (longShort) { + if (data.w.cFileName[0] != '\0') { + nativeName = (TCHAR *) data.w.cFileName; + } + } else { + if (data.w.cAlternateFileName[0] == '\0') { + nativeName = (TCHAR *) data.w.cFileName; + } } } else { - if (data.cAlternateFileName[0] == '\0') { - nativeName = (WCHAR *) data.cFileName; + nativeName = (TCHAR *) data.a.cAlternateFileName; + if (longShort) { + if (data.a.cFileName[0] != '\0') { + nativeName = (TCHAR *) data.a.cFileName; + } + } else { + if (data.a.cAlternateFileName[0] == '\0') { + nativeName = (TCHAR *) data.a.cFileName; + } } } /* - * Purify reports a extraneous UMR in Tcl_WCharToUtfDString() trying + * 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 @@ -1708,27 +1789,28 @@ ConvertFileNameFormat( */ Tcl_DStringInit(&dsTemp); - Tcl_WCharToUtfDString(nativeName, TCL_INDEX_NONE, &dsTemp); - Tcl_DStringFree(&ds); + Tcl_WinTCharToUtf(nativeName, -1, &dsTemp); /* * Deal with issues of tildes being absolute. */ if (Tcl_DStringValue(&dsTemp)[0] == '~') { - TclNewLiteralStringObj(tempPath, "./"); + tempPath = Tcl_NewStringObj("./",2); Tcl_AppendToObj(tempPath, Tcl_DStringValue(&dsTemp), Tcl_DStringLength(&dsTemp)); - Tcl_DStringFree(&dsTemp); } else { - tempPath = Tcl_DStringToObj(&dsTemp); + tempPath = Tcl_NewStringObj(Tcl_DStringValue(&dsTemp), + Tcl_DStringLength(&dsTemp)); } Tcl_ListObjReplace(NULL, splitPath, i, 1, 1, &tempPath); + Tcl_DStringFree(&ds); + Tcl_DStringFree(&dsTemp); FindClose(handle); } } - *attributePtrPtr = Tcl_FSJoinPath(splitPath, TCL_INDEX_NONE); + *attributePtrPtr = Tcl_FSJoinPath(splitPath, -1); if (splitPath != NULL) { /* @@ -1835,14 +1917,15 @@ SetWinFileAttributes( Tcl_Obj *fileName, /* The name of the file. */ Tcl_Obj *attributePtr) /* The new value of the attribute. */ { - DWORD fileAttributes, old; - int yesNo, result; - const WCHAR *nativeName; + DWORD fileAttributes; + int yesNo; + int result; + CONST TCHAR *nativeName; - nativeName = (const WCHAR *)Tcl_FSGetNativePath(fileName); - fileAttributes = old = GetFileAttributesW(nativeName); + nativeName = Tcl_FSGetNativePath(fileName); + fileAttributes = (*tclWinProcs->getFileAttributesProc)(nativeName); - if (fileAttributes == 0xFFFFFFFF) { + if (fileAttributes == 0xffffffff) { StatError(interp, fileName); return TCL_ERROR; } @@ -1858,8 +1941,7 @@ SetWinFileAttributes( fileAttributes &= ~(attributeArray[objIndex]); } - if ((fileAttributes != old) - && !SetFileAttributesW(nativeName, fileAttributes)) { + if (!(*tclWinProcs->setFileAttributesProc)(nativeName, fileAttributes)) { StatError(interp, fileName); return TCL_ERROR; } @@ -1888,15 +1970,15 @@ 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_UNUSED(Tcl_Obj *) /*attributePtr*/) + 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], TclGetString(fileName))); - errno = EINVAL; - Tcl_PosixError(interp); + Tcl_AppendResult(interp, "cannot set attribute \"", + tclpFileAttrStrings[objIndex], "\" for file \"", + Tcl_GetString(fileName), "\": attribute is readonly", + (char *) NULL); return TCL_ERROR; } + /* *--------------------------------------------------------------------------- @@ -1914,7 +1996,7 @@ CannotSetAttribute( *--------------------------------------------------------------------------- */ -Tcl_Obj * +Tcl_Obj* TclpObjListVolumes(void) { Tcl_Obj *resultPtr, *elemPtr; @@ -1922,7 +2004,7 @@ TclpObjListVolumes(void) int i; char *p; - TclNewObj(resultPtr); + resultPtr = Tcl_NewObj(); /* * On Win32s: @@ -1932,10 +2014,10 @@ TclpObjListVolumes(void) if (GetLogicalDriveStringsA(sizeof(buf), buf) == 0) { /* - * GetVolumeInformationW() will detects all drives, but causes + * GetVolumeInformation() will detects all drives, but causes * chattering on empty floppy drives. We only do this if * GetLogicalDriveStrings() didn't work. It has also been reported - * that on some laptops it takes a while for GetVolumeInformationW() to + * that on some laptops it takes a while for GetVolumeInformation() to * return when pinging an empty floppy drive, another reason to try to * avoid calling it. */ @@ -1948,14 +2030,14 @@ TclpObjListVolumes(void) buf[0] = (char) ('a' + i); if (GetVolumeInformationA(buf, NULL, 0, NULL, NULL, NULL, NULL, 0) || (GetLastError() == ERROR_NOT_READY)) { - elemPtr = Tcl_NewStringObj(buf, TCL_INDEX_NONE); + elemPtr = Tcl_NewStringObj(buf, -1); Tcl_ListObjAppendElement(NULL, resultPtr, elemPtr); } } } else { for (p = buf; *p != '\0'; p += 4) { p[2] = '/'; - elemPtr = Tcl_NewStringObj(p, TCL_INDEX_NONE); + elemPtr = Tcl_NewStringObj(p, -1); Tcl_ListObjAppendElement(NULL, resultPtr, elemPtr); } } @@ -1965,121 +2047,6 @@ TclpObjListVolumes(void) } /* - *---------------------------------------------------------------------- - * - * TclpCreateTemporaryDirectory -- - * - * Creates a temporary directory, possibly based on the supplied bits and - * pieces of template supplied in the arguments. - * - * Results: - * An object (refcount 0) containing the name of the newly-created - * directory, or NULL on failure. - * - * Side effects: - * Accesses the native filesystem. Makes a directory. - * - *---------------------------------------------------------------------- - */ - -Tcl_Obj * -TclpCreateTemporaryDirectory( - Tcl_Obj *dirObj, - Tcl_Obj *basenameObj) -{ - Tcl_DString base, name; /* Contains WCHARs */ - int baseLen; - DWORD error; - WCHAR tempBuf[MAX_PATH + 1]; - DWORD len = GetTempPathW(MAX_PATH, tempBuf); - - /* - * Build the path in writable memory from the user-supplied pieces and - * some defaults. First, the parent temporary directory. - */ - - if (dirObj) { - TclGetString(dirObj); - if (dirObj->length < 1) { - goto useSystemTemp; - } - Tcl_DStringInit(&base); - Tcl_UtfToWCharDString(TclGetString(dirObj), TCL_INDEX_NONE, &base); - if (dirObj->bytes[dirObj->length - 1] != '\\') { - Tcl_UtfToWCharDString("\\", TCL_INDEX_NONE, &base); - } - } else { - useSystemTemp: - Tcl_DStringInit(&base); - Tcl_DStringAppend(&base, (char *) tempBuf, len * sizeof(WCHAR)); - } - - /* - * Next, the base of the directory name. - */ - -#define DEFAULT_TEMP_DIR_PREFIX "tcl" -#define SUFFIX_LENGTH 8 - - if (basenameObj) { - Tcl_UtfToWCharDString(TclGetString(basenameObj), TCL_INDEX_NONE, &base); - } else { - Tcl_UtfToWCharDString(DEFAULT_TEMP_DIR_PREFIX, TCL_INDEX_NONE, &base); - } - Tcl_UtfToWCharDString("_", TCL_INDEX_NONE, &base); - - /* - * Now we keep on trying random suffixes until we get one that works - * (i.e., that doesn't trigger the ERROR_ALREADY_EXISTS error). Note that - * SUFFIX_LENGTH is longer than on Unix because we expect to be not on a - * case-sensitive filesystem. - */ - - baseLen = Tcl_DStringLength(&base); - do { - char tempbuf[SUFFIX_LENGTH + 1]; - int i; - static const char randChars[] = - "QWERTYUIOPASDFGHJKLZXCVBNM1234567890"; - static const int numRandChars = sizeof(randChars) - 1; - - /* - * Put a random suffix on the end. - */ - - error = ERROR_SUCCESS; - tempbuf[SUFFIX_LENGTH] = '\0'; - for (i = 0 ; i < SUFFIX_LENGTH; i++) { - tempbuf[i] = randChars[(int) (rand() % numRandChars)]; - } - Tcl_DStringSetLength(&base, baseLen); - Tcl_UtfToWCharDString(tempbuf, TCL_INDEX_NONE, &base); - } while (!CreateDirectoryW((LPCWSTR) Tcl_DStringValue(&base), NULL) - && (error = GetLastError()) == ERROR_ALREADY_EXISTS); - - /* - * Check for other errors. The big ones are ERROR_PATH_NOT_FOUND and - * ERROR_ACCESS_DENIED. - */ - - if (error != ERROR_SUCCESS) { - Tcl_WinConvertError(error); - Tcl_DStringFree(&base); - return NULL; - } - - /* - * We actually made the directory, so we're done! Report what we made back - * as a (clean) Tcl_Obj. - */ - - Tcl_DStringInit(&name); - Tcl_WCharToUtfDString((LPCWSTR) Tcl_DStringValue(&base), TCL_INDEX_NONE, &name); - Tcl_DStringFree(&base); - return Tcl_DStringToObj(&name); -} - -/* * Local Variables: * mode: c * c-basic-offset: 4 diff --git a/win/tclWinFile.c b/win/tclWinFile.c index b27487f..41de4a8 100644..100755 --- a/win/tclWinFile.c +++ b/win/tclWinFile.c @@ -6,7 +6,7 @@ * files, which can be manipulated through the Win32 console redirection * interfaces. * - * Copyright © 1995-1998 Sun Microsystems, Inc. + * 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. @@ -16,20 +16,16 @@ #include "tclFileSystem.h" #include <winioctl.h> #include <shlobj.h> -#include <lm.h> /* For TclpGetUserHome(). */ +#include <lmaccess.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 \ - ((long long) 116444736 * (long long) 1000000000) + ((Tcl_WideInt) 116444736 * (Tcl_WideInt) 1000000000) /* * Declarations for 'link' related information. This information should come @@ -145,39 +141,72 @@ typedef struct { WCHAR dummyBuf[MAX_PATH * 3]; } DUMMY_REPARSE_BUFFER; +#if defined(_MSC_VER) && (_MSC_VER <= 1100) +#undef HAVE_NO_FINDEX_ENUMS +#define HAVE_NO_FINDEX_ENUMS +#elif !defined(_WIN32_WINNT) || (_WIN32_WINNT < 0x0400) +#undef HAVE_NO_FINDEX_ENUMS +#define HAVE_NO_FINDEX_ENUMS +#endif + +#ifdef HAVE_NO_FINDEX_ENUMS +/* These two aren't in VC++ 5.2 headers */ +typedef enum _FINDEX_INFO_LEVELS { + FindExInfoStandard, + FindExInfoMaxInfoLevel +} FINDEX_INFO_LEVELS; +typedef enum _FINDEX_SEARCH_OPS { + FindExSearchNameMatch, + FindExSearchLimitToDirectories, + FindExSearchLimitToDevices, + FindExSearchMaxSearchOp +} FINDEX_SEARCH_OPS; +#endif /* HAVE_NO_FINDEX_ENUMS */ + /* * Other typedefs required by this code. */ -static __time64_t ToCTime(FILETIME fileTime); -static void FromCTime(__time64_t posixTime, FILETIME *fileTime); +static time_t ToCTime(FILETIME fileTime); +static void FromCTime(time_t posixTime, FILETIME *fileTime); + +typedef NET_API_STATUS NET_API_FUNCTION NETUSERGETINFOPROC( + LPWSTR servername, LPWSTR username, DWORD level, LPBYTE *bufptr); + +typedef NET_API_STATUS NET_API_FUNCTION NETAPIBUFFERFREEPROC(LPVOID Buffer); + +typedef NET_API_STATUS NET_API_FUNCTION NETGETDCNAMEPROC( + LPWSTR servername, LPWSTR domainname, LPBYTE *bufptr); + +typedef BOOL WINAPI GETPROFILESDIRECTORYPROC( + LPWSTR lpProfilesDir, LPDWORD lpcchSize +); /* * Declarations for local functions defined in this file: */ -static int NativeAccess(const WCHAR *path, int mode); -static int NativeDev(const WCHAR *path); -static int NativeStat(const WCHAR *path, Tcl_StatBuf *statPtr, +static int NativeAccess(const TCHAR *path, int mode); +static int NativeDev(const TCHAR *path); +static int NativeStat(const TCHAR *path, Tcl_StatBuf *statPtr, int checkLinks); static unsigned short NativeStatMode(DWORD attr, int checkLinks, int isExec); -static int NativeIsExec(const WCHAR *path); -static int NativeReadReparse(const WCHAR *LinkDirectory, +static int NativeIsExec(const TCHAR *path); +static int NativeReadReparse(const TCHAR *LinkDirectory, REPARSE_DATA_BUFFER *buffer, DWORD desiredAccess); -static int NativeWriteReparse(const WCHAR *LinkDirectory, +static int NativeWriteReparse(const TCHAR *LinkDirectory, REPARSE_DATA_BUFFER *buffer); static int NativeMatchType(int isDrive, DWORD attr, - const WCHAR *nativeName, Tcl_GlobTypeData *types); -static int WinIsDrive(const char *name, size_t nameLen); -static size_t 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, ...); + const TCHAR *nativeName, Tcl_GlobTypeData *types); +static int WinIsDrive(const char *name, int nameLen); +static int WinIsReserved(const char *path); +static Tcl_Obj * WinReadLink(const TCHAR *LinkSource); +static Tcl_Obj * WinReadLinkDirectory(const TCHAR *LinkDirectory); +static int WinLink(const TCHAR *LinkSource, + const TCHAR *LinkTarget, int linkAction); +static int WinSymLinkDirectory(const TCHAR *LinkDirectory, + const TCHAR *LinkTarget); /* *-------------------------------------------------------------------- @@ -191,25 +220,25 @@ MODULE_SCOPE TCL_NORETURN void tclWinDebugPanic(const char *format, ...); static int WinLink( - const WCHAR *linkSourcePath, - const WCHAR *linkTargetPath, + const TCHAR *linkSourcePath, + const TCHAR *linkTargetPath, int linkAction) { WCHAR tempFileName[MAX_PATH]; - WCHAR *tempFilePart; + TCHAR *tempFilePart; DWORD attr; /* * Get the full path referenced by the target. */ - if (!GetFullPathNameW(linkTargetPath, MAX_PATH, tempFileName, - &tempFilePart)) { + if (!(*tclWinProcs->getFullPathNameProc)(linkTargetPath, MAX_PATH, + tempFileName, &tempFilePart)) { /* * Invalid file. */ - Tcl_WinConvertError(GetLastError()); + TclWinConvertError(GetLastError()); return -1; } @@ -217,7 +246,7 @@ WinLink( * Make sure source file doesn't exist. */ - attr = GetFileAttributesW(linkSourcePath); + attr = (*tclWinProcs->getFileAttributesProc)(linkSourcePath); if (attr != INVALID_FILE_ATTRIBUTES) { Tcl_SetErrno(EEXIST); return -1; @@ -227,13 +256,13 @@ WinLink( * Get the full path referenced by the source file/directory. */ - if (!GetFullPathNameW(linkSourcePath, MAX_PATH, tempFileName, - &tempFilePart)) { + if (!(*tclWinProcs->getFullPathNameProc)(linkSourcePath, MAX_PATH, + tempFileName, &tempFilePart)) { /* * Invalid file. */ - Tcl_WinConvertError(GetLastError()); + TclWinConvertError(GetLastError()); return -1; } @@ -241,41 +270,43 @@ WinLink( * Check the target. */ - attr = GetFileAttributesW(linkTargetPath); + attr = (*tclWinProcs->getFileAttributesProc)(linkTargetPath); if (attr == INVALID_FILE_ATTRIBUTES) { /* * The target doesn't exist. */ - Tcl_WinConvertError(GetLastError()); + TclWinConvertError(GetLastError()); + return -1; + } else if ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0) { /* * It is a file. */ - if (linkAction & TCL_CREATE_HARD_LINK) { - if (CreateHardLinkW(linkSourcePath, linkTargetPath, NULL)) { - /* - * Success! - */ + if (tclWinProcs->createHardLinkProc == NULL) { + Tcl_SetErrno(ENOTDIR); + return -1; + } - return 0; + if (linkAction & TCL_CREATE_HARD_LINK) { + if (!(*tclWinProcs->createHardLinkProc)(linkSourcePath, + linkTargetPath, NULL)) { + TclWinConvertError(GetLastError()); + return -1; } + return 0; - Tcl_WinConvertError(GetLastError()); } else if (linkAction & TCL_CREATE_SYMBOLIC_LINK) { - if (CreateSymbolicLinkW(linkSourcePath, linkTargetPath, - 0x2 /* SYMBOLIC_LINK_FLAG_ALLOW_UNPRIVILEGED_CREATE */)) { - /* - * Success! - */ + /* + * Can't symlink files. + */ - return 0; - } else { - Tcl_WinConvertError(GetLastError()); - } + Tcl_SetErrno(ENOTDIR); + return -1; } else { Tcl_SetErrno(ENODEV); + return -1; } } else { /* @@ -292,11 +323,12 @@ WinLink( */ Tcl_SetErrno(EISDIR); + return -1; } else { Tcl_SetErrno(ENODEV); + return -1; } } - return -1; } /* @@ -311,23 +343,23 @@ WinLink( static Tcl_Obj * WinReadLink( - const WCHAR *linkSourcePath) + const TCHAR *linkSourcePath) { WCHAR tempFileName[MAX_PATH]; - WCHAR *tempFilePart; + TCHAR *tempFilePart; DWORD attr; /* * Get the full path referenced by the target. */ - if (!GetFullPathNameW(linkSourcePath, MAX_PATH, tempFileName, - &tempFilePart)) { + if (!(*tclWinProcs->getFullPathNameProc)(linkSourcePath, MAX_PATH, + tempFileName, &tempFilePart)) { /* * Invalid file. */ - Tcl_WinConvertError(GetLastError()); + TclWinConvertError(GetLastError()); return NULL; } @@ -335,13 +367,13 @@ WinReadLink( * Make sure source file does exist. */ - attr = GetFileAttributesW(linkSourcePath); + attr = (*tclWinProcs->getFileAttributesProc)(linkSourcePath); if (attr == INVALID_FILE_ATTRIBUTES) { /* * The source doesn't exist. */ - Tcl_WinConvertError(GetLastError()); + TclWinConvertError(GetLastError()); return NULL; } else if ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0) { @@ -351,9 +383,9 @@ WinReadLink( Tcl_SetErrno(ENOTDIR); return NULL; + } else { + return WinReadLinkDirectory(linkSourcePath); } - - return WinReadLinkDirectory(linkSourcePath); } /* @@ -375,8 +407,8 @@ WinReadLink( static int WinSymLinkDirectory( - const WCHAR *linkDirPath, - const WCHAR *linkTargetPath) + const TCHAR *linkDirPath, + const TCHAR *linkTargetPath) { DUMMY_REPARSE_BUFFER dummy; REPARSE_DATA_BUFFER *reparseBuffer = (REPARSE_DATA_BUFFER *) &dummy; @@ -400,11 +432,11 @@ WinSymLinkDirectory( */ for (loop = nativeTarget; *loop != 0; loop++) { - if (*loop == '/') { - *loop = '\\'; + if (*loop == L'/') { + *loop = L'\\'; } } - if ((nativeTarget[len-1] == '\\') && (nativeTarget[len-2] != ':')) { + if ((nativeTarget[len-1] == L'\\') && (nativeTarget[len-2] != L':')) { nativeTarget[len-1] = 0; } @@ -447,8 +479,8 @@ WinSymLinkDirectory( int TclWinSymLinkCopyDirectory( - const WCHAR *linkOrigPath, /* Existing junction - reparse point */ - const WCHAR *linkCopyPath) /* Will become a duplicate junction */ + const TCHAR *linkOrigPath, /* Existing junction - reparse point */ + const TCHAR *linkCopyPath) /* Will become a duplicate junction */ { DUMMY_REPARSE_BUFFER dummy; REPARSE_DATA_BUFFER *reparseBuffer = (REPARSE_DATA_BUFFER *) &dummy; @@ -478,7 +510,7 @@ TclWinSymLinkCopyDirectory( int TclWinSymLinkDelete( - const WCHAR *linkOrigPath, + const TCHAR *linkOrigPath, int linkOnly) { /* @@ -492,8 +524,9 @@ TclWinSymLinkDelete( 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); + hFile = (*tclWinProcs->createFileProc)(linkOrigPath, GENERIC_WRITE, 0, + NULL, OPEN_EXISTING, + FILE_FLAG_OPEN_REPARSE_POINT|FILE_FLAG_BACKUP_SEMANTICS, NULL); if (hFile != INVALID_HANDLE_VALUE) { if (!DeviceIoControl(hFile, FSCTL_DELETE_REPARSE_POINT, reparseBuffer, @@ -502,12 +535,12 @@ TclWinSymLinkDelete( * Error setting junction. */ - Tcl_WinConvertError(GetLastError()); + TclWinConvertError(GetLastError()); CloseHandle(hFile); } else { CloseHandle(hFile); if (!linkOnly) { - RemoveDirectoryW(linkOrigPath); + (*tclWinProcs->removeDirectoryProc)(linkOrigPath); } return 0; } @@ -536,14 +569,9 @@ TclWinSymLinkDelete( *-------------------------------------------------------------------- */ -#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) + const TCHAR *linkDirPath) { int attr, len, offset; DUMMY_REPARSE_BUFFER dummy; @@ -552,7 +580,7 @@ WinReadLinkDirectory( Tcl_DString ds; const char *copy; - attr = GetFileAttributesW(linkDirPath); + attr = (*tclWinProcs->getFileAttributesProc)(linkDirPath); if (!(attr & FILE_ATTRIBUTE_REPARSE_POINT)) { goto invalidError; } @@ -577,7 +605,7 @@ WinReadLinkDirectory( */ offset = 0; - if (reparseBuffer->MountPointReparseBuffer.PathBuffer[0] == '\\') { + if (reparseBuffer->MountPointReparseBuffer.PathBuffer[0] == L'\\') { /* * Check whether this is a mounted volume. */ @@ -591,7 +619,7 @@ WinReadLinkDirectory( * to fix here. It doesn't seem very well documented. */ - reparseBuffer->MountPointReparseBuffer.PathBuffer[1] = '\\'; + reparseBuffer->MountPointReparseBuffer.PathBuffer[1]=L'\\'; /* * Check if a corresponding drive letter exists, and use that @@ -639,11 +667,10 @@ WinReadLinkDirectory( } } - Tcl_DStringInit(&ds); - Tcl_WCharToUtfDString( + Tcl_WinTCharToUtf((const char *) reparseBuffer->MountPointReparseBuffer.PathBuffer, - reparseBuffer->MountPointReparseBuffer - .SubstituteNameLength>>1, &ds); + (int) reparseBuffer->MountPointReparseBuffer + .SubstituteNameLength, &ds); copy = Tcl_DStringValue(&ds)+offset; len = Tcl_DStringLength(&ds)-offset; @@ -657,10 +684,6 @@ WinReadLinkDirectory( Tcl_SetErrno(EINVAL); return NULL; } - -#if defined (__clang__) || ((__GNUC__) && ((__GNUC__ > 4) || ((__GNUC__ == 4) && (__GNUC_MINOR__ > 5)))) -#pragma GCC diagnostic pop -#endif /* *-------------------------------------------------------------------- @@ -679,23 +702,23 @@ WinReadLinkDirectory( static int NativeReadReparse( - const WCHAR *linkDirPath, /* The junction to read */ + const TCHAR *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); + hFile = (*tclWinProcs->createFileProc)(linkDirPath, desiredAccess, FILE_SHARE_READ, + NULL, OPEN_EXISTING, + FILE_FLAG_OPEN_REPARSE_POINT|FILE_FLAG_BACKUP_SEMANTICS, NULL); if (hFile == INVALID_HANDLE_VALUE) { /* * Error creating directory. */ - Tcl_WinConvertError(GetLastError()); + TclWinConvertError(GetLastError()); return -1; } @@ -709,7 +732,7 @@ NativeReadReparse( * Error setting junction. */ - Tcl_WinConvertError(GetLastError()); + TclWinConvertError(GetLastError()); CloseHandle(hFile); return -1; } @@ -736,7 +759,7 @@ NativeReadReparse( static int NativeWriteReparse( - const WCHAR *linkDirPath, + const TCHAR *linkDirPath, REPARSE_DATA_BUFFER *buffer) { HANDLE hFile; @@ -746,23 +769,23 @@ NativeWriteReparse( * Create the directory - it must not already exist. */ - if (CreateDirectoryW(linkDirPath, NULL) == 0) { + if ((*tclWinProcs->createDirectoryProc)(linkDirPath, NULL) == 0) { /* * Error creating directory. */ - Tcl_WinConvertError(GetLastError()); + TclWinConvertError(GetLastError()); return -1; } - hFile = CreateFileW(linkDirPath, GENERIC_WRITE, 0, NULL, - OPEN_EXISTING, FILE_FLAG_OPEN_REPARSE_POINT - | FILE_FLAG_BACKUP_SEMANTICS, NULL); + hFile = (*tclWinProcs->createFileProc)(linkDirPath, GENERIC_WRITE, 0, + NULL, OPEN_EXISTING, + FILE_FLAG_OPEN_REPARSE_POINT|FILE_FLAG_BACKUP_SEMANTICS, NULL); if (hFile == INVALID_HANDLE_VALUE) { /* * Error creating directory. */ - Tcl_WinConvertError(GetLastError()); + TclWinConvertError(GetLastError()); return -1; } @@ -777,9 +800,9 @@ NativeWriteReparse( * Error setting junction. */ - Tcl_WinConvertError(GetLastError()); + TclWinConvertError(GetLastError()); CloseHandle(hFile); - RemoveDirectoryW(linkDirPath); + (*tclWinProcs->removeDirectoryProc)(linkDirPath); return -1; } CloseHandle(hFile); @@ -792,65 +815,6 @@ NativeWriteReparse( } /* - *---------------------------------------------------------------------- - * - * tclWinDebugPanic -- - * - * Display a message. If a debugger is present, present it directly to - * the debugger, otherwise use a MessageBox. - * - * Results: - * None. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -TCL_NORETURN void -tclWinDebugPanic( - const char *format, ...) -{ -#define TCL_MAX_WARN_LEN 1024 - va_list argList; - char buf[TCL_MAX_WARN_LEN * 3]; - WCHAR msgString[TCL_MAX_WARN_LEN]; - - va_start(argList, format); - vsnprintf(buf, sizeof(buf), format, argList); - - msgString[TCL_MAX_WARN_LEN-1] = '\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] != '\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 -- @@ -869,26 +833,30 @@ tclWinDebugPanic( void TclpFindExecutable( - const char *argv0) /* If NULL, install PanicMessageBox, otherwise - * ignore. */ + const char *argv0) /* The value of the application's argv[0] + * (native). */ { WCHAR wName[MAX_PATH]; - char name[MAX_PATH * 3]; + char name[MAX_PATH * TCL_UTF_MAX]; /* * Under Windows we ignore argv0, and return the path for the file used to - * create this process. Only if it is NULL, install a new panic handler. + * create this process. */ - if (argv0 == NULL) { -# undef Tcl_SetPanicProc - Tcl_SetPanicProc(tclWinDebugPanic); + if (GetModuleFileNameW(NULL, wName, MAX_PATH) == 0) { + GetModuleFileNameA(NULL, name, sizeof(name)); + + /* + * Convert to WCHAR to get out of ANSI codepage + */ + + MultiByteToWideChar(CP_ACP, 0, name, -1, wName, MAX_PATH); } - GetModuleFileNameW(NULL, wName, sizeof(wName)/sizeof(WCHAR)); - WideCharToMultiByte(CP_UTF8, 0, wName, -1, name, sizeof(name), NULL, NULL); + WideCharToMultiByte(CP_UTF8, 0, wName, -1, name, sizeof(name), NULL,NULL); TclWinNoBackslash(name); - TclSetObjNameOfExecutable(Tcl_NewStringObj(name, TCL_INDEX_NONE), NULL); + TclSetObjNameOfExecutable(Tcl_NewStringObj(name, -1), NULL); } /* @@ -920,7 +888,7 @@ TclpMatchInDirectory( * May be NULL. In particular the directory * flag is very important. */ { - const WCHAR *native; + const TCHAR *native; if (types != NULL && types->type == TCL_GLOB_TYPE_MOUNT) { /* @@ -932,26 +900,32 @@ TclpMatchInDirectory( 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; - Tcl_Size len = 0; - const char *str = TclGetStringFromObj(norm, &len); + const char *str = Tcl_GetStringFromObj(norm,&len); - native = (const WCHAR *)Tcl_FSGetNativePath(pathPtr); + native = (const TCHAR *) Tcl_FSGetNativePath(pathPtr); - if (GetFileAttributesExW(native, - GetFileExInfoStandard, &data) != TRUE) { - return TCL_OK; + if (tclWinProcs->getFileAttributesExProc == NULL) { + attr = (*tclWinProcs->getFileAttributesProc)(native); + if (attr == 0xffffffff) { + return TCL_OK; + } + } else { + WIN32_FILE_ATTRIBUTE_DATA data; + if ((*tclWinProcs->getFileAttributesExProc)(native, + GetFileExInfoStandard, &data) != TRUE) { + return TCL_OK; + } + attr = data.dwFileAttributes; } - attr = data.dwFileAttributes; - if (NativeMatchType(WinIsDrive(str, len), attr, native, types)) { + if (NativeMatchType(WinIsDrive(str,len), attr, native, types)) { Tcl_ListObjAppendElement(interp, resultPtr, pathPtr); } } @@ -959,10 +933,10 @@ TclpMatchInDirectory( } else { DWORD attr; HANDLE handle; - WIN32_FIND_DATAW data; + WIN32_FIND_DATAT data; const char *dirName; /* UTF-8 dir name, later with pattern * appended. */ - Tcl_Size dirLength; + int dirLength; int matchSpecialDots; Tcl_DString ds; /* Native encoding of dir, also used * temporarily for other things. */ @@ -984,14 +958,13 @@ TclpMatchInDirectory( * Verify that the specified path exists and is actually a directory. */ - native = (const WCHAR *)Tcl_FSGetNativePath(pathPtr); + native = Tcl_FSGetNativePath(pathPtr); if (native == NULL) { return TCL_OK; } - attr = GetFileAttributesW(native); + attr = (*tclWinProcs->getFileAttributesProc)(native); - if ((attr == INVALID_FILE_ATTRIBUTES) - || ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0)) { + if ((attr == 0xffffffff) || ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0)) { return TCL_OK; } @@ -1001,12 +974,12 @@ TclpMatchInDirectory( */ Tcl_DStringInit(&dsOrig); - dirName = TclGetStringFromObj(fileNamePtr, &dirLength); + dirName = Tcl_GetStringFromObj(fileNamePtr, &dirLength); Tcl_DStringAppend(&dsOrig, dirName, dirLength); lastChar = dirName[dirLength -1]; if ((lastChar != '\\') && (lastChar != '/') && (lastChar != ':')) { - TclDStringAppendLiteral(&dsOrig, "/"); + Tcl_DStringAppend(&dsOrig, "/", 1); dirLength++; } dirName = Tcl_DStringValue(&dsOrig); @@ -1024,28 +997,27 @@ TclpMatchInDirectory( * pattern. */ - dirName = Tcl_DStringAppend(&dsOrig, pattern, TCL_INDEX_NONE); + dirName = Tcl_DStringAppend(&dsOrig, pattern, -1); } else { - dirName = TclDStringAppendLiteral(&dsOrig, "*.*"); + dirName = Tcl_DStringAppend(&dsOrig, "*.*", 3); } - Tcl_DStringInit(&ds); - native = Tcl_UtfToWCharDString(dirName, TCL_INDEX_NONE, &ds); - if ((types == NULL) || (types->type != TCL_GLOB_TYPE_DIR)) { - handle = FindFirstFileW(native, &data); + native = Tcl_WinUtfToTChar(dirName, -1, &ds); + if (tclWinProcs->findFirstFileExProc == NULL || (types == NULL) + || (types->type != TCL_GLOB_TYPE_DIR)) { + handle = (*tclWinProcs->findFirstFileProc)(native, &data); } else { /* * We can be more efficient, for pure directory requests. */ - handle = FindFirstFileExW(native, + handle = (*tclWinProcs->findFirstFileExProc)(native, FindExInfoStandard, &data, FindExSearchLimitToDirectories, NULL, 0); } if (handle == INVALID_HANDLE_VALUE) { DWORD err = GetLastError(); - Tcl_DStringFree(&ds); if (err == ERROR_FILE_NOT_FOUND) { /* @@ -1057,11 +1029,12 @@ TclpMatchInDirectory( return TCL_OK; } - Tcl_WinConvertError(err); + TclWinConvertError(err); if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "couldn't read directory \"%s\": %s", - Tcl_DStringValue(&dsOrig), Tcl_PosixError(interp))); + Tcl_ResetResult(interp); + Tcl_AppendResult(interp, "couldn't read directory \"", + Tcl_DStringValue(&dsOrig), "\": ", + Tcl_PosixError(interp), NULL); } Tcl_DStringFree(&dsOrig); return TCL_ERROR; @@ -1099,11 +1072,17 @@ TclpMatchInDirectory( do { const char *utfname; int checkDrive = 0, isDrive; + DWORD attr; + + if (tclWinProcs->useWide) { + native = (const TCHAR *) data.w.cFileName; + attr = data.w.dwFileAttributes; + } else { + native = (const TCHAR *) data.a.cFileName; + attr = data.a.dwFileAttributes; + } - native = data.cFileName; - attr = data.dwFileAttributes; - Tcl_DStringInit(&ds); - utfname = Tcl_WCharToUtfDString(native, TCL_INDEX_NONE, &ds); + utfname = Tcl_WinTCharToUtf(native, -1, &ds); if (!matchSpecialDots) { /* @@ -1145,7 +1124,6 @@ TclpMatchInDirectory( if (checkDrive) { const char *fullname = Tcl_DStringAppend(&dsOrig, utfname, Tcl_DStringLength(&ds)); - isDrive = WinIsDrive(fullname, Tcl_DStringLength(&dsOrig)); Tcl_DStringSetLength(&dsOrig, dirLength); } else { @@ -1163,7 +1141,7 @@ TclpMatchInDirectory( */ Tcl_DStringFree(&ds); - } while (FindNextFileW(handle, &data) == TRUE); + } while ((*tclWinProcs->findNextFileProc)(handle, &data) == TRUE); FindClose(handle); Tcl_DStringFree(&dsOrig); @@ -1180,7 +1158,7 @@ TclpMatchInDirectory( static int WinIsDrive( const char *name, /* Name (UTF-8) */ - size_t len) /* Length of name */ + int len) /* Length of name */ { int remove = 0; @@ -1245,7 +1223,7 @@ WinIsDrive( * (not any trailing :). */ -static size_t +static int WinIsReserved( const char *path) /* Path in UTF-8 */ { @@ -1259,7 +1237,7 @@ WinIsReserved( if (path[4] == '\0') { return 4; - } else if (path[4] == ':' && path[5] == '\0') { + } else if (path [4] == ':' && path[5] == '\0') { return 4; } } else if ((path[2] == 'n' || path[2] == 'N') && path[3] == '\0') { @@ -1280,7 +1258,7 @@ WinIsReserved( if (path[4] == '\0') { return 4; - } else if (path[4] == ':' && path[5] == '\0') { + } else if (path [4] == ':' && path[5] == '\0') { return 4; } } @@ -1321,7 +1299,7 @@ NativeMatchType( int isDrive, /* Is this a drive. */ DWORD attr, /* We already know the attributes for the * file. */ - const WCHAR *nativeName, /* Native path to check. */ + const TCHAR *nativeName, /* Native path to check. */ Tcl_GlobTypeData *types) /* Type description to match against. */ { /* @@ -1336,80 +1314,81 @@ NativeMatchType( * If invisible, don't return the file. */ - return !(attr & FILE_ATTRIBUTE_HIDDEN && !isDrive); - } - - if (attr & FILE_ATTRIBUTE_HIDDEN && !isDrive) { - /* - * If invisible. - */ - - if ((types->perm == 0) || !(types->perm & TCL_GLOB_PERM_HIDDEN)) { + if (attr & FILE_ATTRIBUTE_HIDDEN && !isDrive) { return 0; } } else { - /* - * Visible. - */ + if (attr & FILE_ATTRIBUTE_HIDDEN && !isDrive) { + /* + * If invisible. + */ - if (types->perm & TCL_GLOB_PERM_HIDDEN) { - return 0; - } - } + if ((types->perm == 0) || !(types->perm & TCL_GLOB_PERM_HIDDEN)) { + return 0; + } + } else { + /* + * Visible. + */ - if (types->perm != 0) { - if (((types->perm & TCL_GLOB_PERM_RONLY) && - !(attr & FILE_ATTRIBUTE_READONLY)) || - ((types->perm & TCL_GLOB_PERM_R) && - (0 /* File exists => R_OK on Windows */)) || - ((types->perm & TCL_GLOB_PERM_W) && - (attr & FILE_ATTRIBUTE_READONLY)) || - ((types->perm & TCL_GLOB_PERM_X) && - (!(attr & FILE_ATTRIBUTE_DIRECTORY) - && !NativeIsExec(nativeName)))) { - return 0; + if (types->perm & TCL_GLOB_PERM_HIDDEN) { + return 0; + } } - } - if ((types->type & TCL_GLOB_TYPE_DIR) - && (attr & FILE_ATTRIBUTE_DIRECTORY)) { - /* - * Quicker test for directory, which is a common case. - */ + if (types->perm != 0) { + if (((types->perm & TCL_GLOB_PERM_RONLY) && + !(attr & FILE_ATTRIBUTE_READONLY)) || + ((types->perm & TCL_GLOB_PERM_R) && + (0 /* File exists => R_OK on Windows */)) || + ((types->perm & TCL_GLOB_PERM_W) && + (attr & FILE_ATTRIBUTE_READONLY)) || + ((types->perm & TCL_GLOB_PERM_X) && + (!(attr & FILE_ATTRIBUTE_DIRECTORY) + && !NativeIsExec(nativeName)))) { + return 0; + } + } + if ((types->type & TCL_GLOB_TYPE_DIR) + && (attr & FILE_ATTRIBUTE_DIRECTORY)) { + /* + * Quicker test for directory, which is a common case. + */ - return 1; + return 1; - } else if (types->type != 0) { - unsigned short st_mode; - int isExec = NativeIsExec(nativeName); + } else if (types->type != 0) { + unsigned short st_mode; + int isExec = NativeIsExec(nativeName); - st_mode = NativeStatMode(attr, 0, isExec); + st_mode = NativeStatMode(attr, 0, isExec); - /* - * In order bcdpfls as in 'find -t' - */ + /* + * In order bcdpfls as in 'find -t' + */ - if (((types->type&TCL_GLOB_TYPE_BLOCK) && S_ISBLK(st_mode)) || - ((types->type&TCL_GLOB_TYPE_CHAR) && S_ISCHR(st_mode)) || - ((types->type&TCL_GLOB_TYPE_DIR) && S_ISDIR(st_mode)) || - ((types->type&TCL_GLOB_TYPE_PIPE) && S_ISFIFO(st_mode)) || + if (((types->type&TCL_GLOB_TYPE_BLOCK) && S_ISBLK(st_mode)) || + ((types->type&TCL_GLOB_TYPE_CHAR) && S_ISCHR(st_mode)) || + ((types->type&TCL_GLOB_TYPE_DIR) && S_ISDIR(st_mode)) || + ((types->type&TCL_GLOB_TYPE_PIPE) && S_ISFIFO(st_mode)) || #ifdef S_ISSOCK - ((types->type&TCL_GLOB_TYPE_SOCK) && S_ISSOCK(st_mode)) || + ((types->type&TCL_GLOB_TYPE_SOCK) && S_ISSOCK(st_mode)) || #endif - ((types->type&TCL_GLOB_TYPE_FILE) && S_ISREG(st_mode))) { - /* - * Do nothing - this file is ok. - */ - } else { + ((types->type&TCL_GLOB_TYPE_FILE) && S_ISREG(st_mode))) { + /* + * Do nothing - this file is ok. + */ + } else { #ifdef S_ISLNK - if (types->type & TCL_GLOB_TYPE_LINK) { - st_mode = NativeStatMode(attr, 1, isExec); - if (S_ISLNK(st_mode)) { - return 1; + if (types->type & TCL_GLOB_TYPE_LINK) { + st_mode = NativeStatMode(attr, 1, isExec); + if (S_ISLNK(st_mode)) { + return 1; + } } +#endif + return 0; } -#endif /* S_ISLNK */ - return 0; } } return 1; @@ -1436,130 +1415,114 @@ NativeMatchType( *---------------------------------------------------------------------- */ -const char * +char * TclpGetUserHome( const char *name, /* User name for desired home directory. */ Tcl_DString *bufferPtr) /* Uninitialized or free DString filled with * name of user's home directory. */ { - char *result = NULL; - USER_INFO_1 *uiPtr; - Tcl_DString ds; - int nameLen = -1; - int rc = 0; - const char *domain; - WCHAR *wName, *wHomeDir, *wDomain; + char *result; + HINSTANCE netapiInst; + HINSTANCE userenvInst; + result = NULL; Tcl_DStringInit(bufferPtr); - wDomain = NULL; - domain = Tcl_UtfFindFirst(name, '@'); - if (domain == NULL) { - const char *ptr; - - /* - * Treat the current user as a special case because the general case - * below does not properly retrieve the path. The NetUserGetInfo - * call returns an empty path and the code defaults to the user's - * name in the profiles directory. On modern Windows systems, this - * is generally wrong as when the account is a Microsoft account, - * for example abcdefghi@outlook.com, the directory name is - * abcde and not abcdefghi. - * - * Note we could have just used env(USERPROFILE) here but - * the intent is to retrieve (as on Unix) the system's view - * of the home irrespective of environment settings of HOME - * and USERPROFILE. - * - * Fixing this for the general user needs more investigating but - * at least for the current user we can use a direct call. - */ - ptr = TclpGetUserName(&ds); - if (ptr != NULL && strcasecmp(name, ptr) == 0) { - HANDLE hProcess; + netapiInst = LoadLibraryA("netapi32.dll"); + userenvInst = LoadLibraryA("userenv.dll"); + if (netapiInst != NULL && userenvInst != NULL) { + NETAPIBUFFERFREEPROC *netApiBufferFreeProc; + NETGETDCNAMEPROC *netGetDCNameProc; + NETUSERGETINFOPROC *netUserGetInfoProc; + GETPROFILESDIRECTORYPROC *getProfilesDirectoryProc; + + netApiBufferFreeProc = (NETAPIBUFFERFREEPROC *) + GetProcAddress(netapiInst, "NetApiBufferFree"); + netGetDCNameProc = (NETGETDCNAMEPROC *) + GetProcAddress(netapiInst, "NetGetDCName"); + netUserGetInfoProc = (NETUSERGETINFOPROC *) + GetProcAddress(netapiInst, "NetUserGetInfo"); + getProfilesDirectoryProc = (GETPROFILESDIRECTORYPROC *) + GetProcAddress(userenvInst, "GetProfilesDirectoryW"); + if ((netUserGetInfoProc != NULL) && (netGetDCNameProc != NULL) + && (netApiBufferFreeProc != NULL) && (getProfilesDirectoryProc != NULL)) { + USER_INFO_1 *uiPtr, **uiPtrPtr = &uiPtr; + Tcl_DString ds; + int nameLen, badDomain; + char *domain; + WCHAR *wName, *wHomeDir, *wDomain, **wDomainPtr = &wDomain; WCHAR buf[MAX_PATH]; - DWORD nChars = sizeof(buf) / sizeof(buf[0]); - /* Sadly GetCurrentProcessToken not in Win 7 so slightly longer */ - hProcess = GetCurrentProcess(); /* Need not be closed */ - if (hProcess) { - HANDLE hToken; - if (OpenProcessToken(hProcess, TOKEN_QUERY, &hToken)) { - if (GetUserProfileDirectoryW(hToken, buf, &nChars)) { - result = Tcl_WCharToUtfDString(buf, nChars-1, (bufferPtr)); - rc = 1; + + badDomain = 0; + nameLen = -1; + wDomain = NULL; + domain = strchr(name, '@'); + if (domain != NULL) { + Tcl_DStringInit(&ds); + wName = Tcl_UtfToUniCharDString(domain + 1, -1, &ds); + badDomain = (netGetDCNameProc)(NULL, wName, + (LPBYTE *) wDomainPtr); + Tcl_DStringFree(&ds); + nameLen = domain - name; + } + if (badDomain == 0) { + Tcl_DStringInit(&ds); + wName = Tcl_UtfToUniCharDString(name, nameLen, &ds); + if ((netUserGetInfoProc)(wDomain, wName, 1, + (LPBYTE *) uiPtrPtr) == 0) { + wHomeDir = uiPtr->usri1_home_dir; + if ((wHomeDir != NULL) && (wHomeDir[0] != L'\0')) { + Tcl_UniCharToUtfDString(wHomeDir, lstrlenW(wHomeDir), + bufferPtr); + } else { + /* + * User exists but has no home dir. Return + * "{GetProfilesDirectory}/<user>". + */ + DWORD i, size = MAX_PATH; + getProfilesDirectoryProc(buf, &size); + for (i = 0; i < size; ++i){ + if (buf[i] == '\\') buf[i] = '/'; + } + Tcl_UniCharToUtfDString(buf, size-1, bufferPtr); + Tcl_DStringAppend(bufferPtr, "/", -1); + Tcl_DStringAppend(bufferPtr, name, -1); } - CloseHandle(hToken); + result = Tcl_DStringValue(bufferPtr); + (*netApiBufferFreeProc)((void *) uiPtr); } + Tcl_DStringFree(&ds); + } + if (wDomain != NULL) { + (*netApiBufferFreeProc)((void *) wDomain); } } - Tcl_DStringFree(&ds); - } else { - Tcl_DStringInit(&ds); - wName = Tcl_UtfToWCharDString(domain + 1, TCL_INDEX_NONE, &ds); - rc = NetGetDCName(NULL, wName, (LPBYTE *) &wDomain); - Tcl_DStringFree(&ds); - nameLen = domain - name; + FreeLibrary(userenvInst); + FreeLibrary(netapiInst); } - if (rc == 0) { - Tcl_DStringInit(&ds); - wName = Tcl_UtfToWCharDString(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 - */ + 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 "*". + */ - rc = NetGetDCName(NULL, NULL, (LPBYTE *) &wDomain); - if (rc != 0) { - break; - } - domain = (const char *)INT2PTR(-1); /* repeat once */ - } - if (rc == 0) { - DWORD i, size = MAX_PATH; + char buf[MAX_PATH]; - wHomeDir = uiPtr->usri1_home_dir; - if ((wHomeDir != NULL) && (wHomeDir[0] != '\0')) { - size = lstrlenW(wHomeDir); - Tcl_WCharToUtfDString(wHomeDir, size, bufferPtr); - } else { - WCHAR buf[MAX_PATH]; + if (name[0] != '*') { + if (GetPrivateProfileStringA("Password Lists", name, "", buf, + MAX_PATH, "system.ini") > 0) { /* - * User exists but has no home dir. Return - * "{GetProfilesDirectory}/<user>". + * User exists, but there is no such thing as a home directory + * in system.ini. Return "{Windows drive}:/". */ - GetProfilesDirectoryW(buf, &size); - Tcl_WCharToUtfDString(buf, size-1, bufferPtr); - Tcl_DStringAppend(bufferPtr, "/", 1); - Tcl_DStringAppend(bufferPtr, name, nameLen); - } - result = Tcl_DStringValue(bufferPtr); - - /* - * Be sure we return normalized path - */ - - for (i = 0; i < size; ++i) { - if (result[i] == '\\') { - result[i] = '/'; - } + GetWindowsDirectoryA(buf, MAX_PATH); + Tcl_DStringAppend(bufferPtr, buf, 3); + result = Tcl_DStringValue(bufferPtr); } - NetApiBufferFree((void *) uiPtr); } - Tcl_DStringFree(&ds); - } - if (wDomain != NULL) { - NetApiBufferFree((void *) wDomain); } return result; @@ -1586,21 +1549,21 @@ TclpGetUserHome( static int NativeAccess( - const WCHAR *nativePath, /* Path of file to access, native encoding. */ + const TCHAR *nativePath, /* Path of file to access, native encoding. */ int mode) /* Permission setting. */ { DWORD attr; - attr = GetFileAttributesW(nativePath); + attr = (*tclWinProcs->getFileAttributesProc)(nativePath); - if (attr == INVALID_FILE_ATTRIBUTES) { + if (attr == 0xffffffff) { /* * File might not exist. */ DWORD lasterror = GetLastError(); if (lasterror != ERROR_SHARING_VIOLATION) { - Tcl_WinConvertError(lasterror); + TclWinConvertError(lasterror); return -1; } } @@ -1613,75 +1576,33 @@ NativeAccess( return 0; } - /* - * If it's not a directory (assume file), do several fast checks: - */ - - if (!(attr & FILE_ATTRIBUTE_DIRECTORY)) { + if ((mode & W_OK) + && (attr & FILE_ATTRIBUTE_READONLY) + && !(attr & FILE_ATTRIBUTE_DIRECTORY)) { /* - * If the attributes say this is not writable at all. The file is a + * The attributes say the file is not writable. If 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 + * 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 + * advanced 'getFileSecurityProc', then more robust ACL checks + * will be done below. */ - 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; - } + Tcl_SetErrno(EACCES); + return -1; + } + if (mode & X_OK) { + if (!(attr & FILE_ATTRIBUTE_DIRECTORY) && !NativeIsExec(nativePath)) { /* - * Fast exit if access was denied + * It's not a directory and doesn't have the correct extension. + * Therefore it can't be executable */ - if (GetLastError() == ERROR_ACCESS_DENIED) { - Tcl_SetErrno(EACCES); - return -1; - } + Tcl_SetErrno(EACCES); + return -1; } - - /* - * We cannot verify the access fast, check it below using security - * info. - */ } /* @@ -1691,7 +1612,7 @@ NativeAccess( * what permissions the OS has set for a file. */ - { + if (tclWinProcs->getFileSecurityProc != NULL) { SECURITY_DESCRIPTOR *sdPtr = NULL; unsigned long size; PSID pSid = 0; @@ -1706,11 +1627,11 @@ NativeAccess( int error; /* - * First find out how big the buffer needs to be. + * First find out how big the buffer needs to be */ size = 0; - GetFileSecurityW(nativePath, + (*tclWinProcs->getFileSecurityProc)(nativePath, OWNER_SECURITY_INFORMATION | GROUP_SECURITY_INFORMATION | DACL_SECURITY_INFORMATION | LABEL_SECURITY_INFORMATION, 0, 0, &size); @@ -1726,7 +1647,7 @@ NativeAccess( * to EACCES - just what we want! */ - Tcl_WinConvertError((DWORD) error); + TclWinConvertError((DWORD) error); return -1; } @@ -1741,10 +1662,10 @@ NativeAccess( } /* - * Call GetFileSecurityW() for real. + * Call GetFileSecurity() for real. */ - if (!GetFileSecurityW(nativePath, + if (!(*tclWinProcs->getFileSecurityProc)(nativePath, OWNER_SECURITY_INFORMATION | GROUP_SECURITY_INFORMATION | DACL_SECURITY_INFORMATION | LABEL_SECURITY_INFORMATION, sdPtr, size, &size)) { @@ -1780,14 +1701,14 @@ NativeAccess( * thread token. */ - if (!ImpersonateSelf(SecurityImpersonation)) { + if (!(*tclWinProcs->impersonateSelfProc)(SecurityImpersonation)) { /* * Unable to perform security impersonation. */ goto accessError; } - if (!OpenThreadToken(GetCurrentThread(), + if (!(*tclWinProcs->openThreadTokenProc)(GetCurrentThread(), TOKEN_DUPLICATE | TOKEN_QUERY, FALSE, &hToken)) { /* * Unable to get current thread's token. @@ -1796,10 +1717,10 @@ NativeAccess( goto accessError; } - RevertToSelf(); + (*tclWinProcs->revertToSelfProc)(); /* - * Setup desiredAccess according to the access privileges we are + * Setup desiredAccess according to the access priveleges we are * checking. */ @@ -1823,7 +1744,7 @@ NativeAccess( * Perform access check using the token. */ - if (!AccessCheck(sdPtr, hToken, desiredAccess, + if (!(*tclWinProcs->accessCheckProc)(sdPtr, hToken, desiredAccess, &genMap, &privSet, &privSetSize, &grantedAccess, &accessYesNo)) { /* @@ -1831,7 +1752,7 @@ NativeAccess( */ accessError: - Tcl_WinConvertError(GetLastError()); + TclWinConvertError(GetLastError()); if (sdPtr != NULL) { HeapFree(GetProcessHeap(), 0, sdPtr); } @@ -1862,7 +1783,7 @@ NativeAccess( * NativeIsExec -- * * Determines if a path is executable. On windows this is simply defined - * by whether the path ends in a standard executable extension. + * by whether the path ends in any of ".exe", ".com", or ".bat" * * Results: * 1 = executable, 0 = not. @@ -1872,24 +1793,55 @@ NativeAccess( static int NativeIsExec( - const WCHAR *path) + const TCHAR *nativePath) { - int len = wcslen(path); + if (tclWinProcs->useWide) { + const WCHAR *path = (const WCHAR *) nativePath; + int len = wcslen(path); - if (len < 5) { - return 0; - } + if (len < 5) { + return 0; + } - if (path[len-4] != '.') { - return 0; - } + if (path[len-4] != L'.') { + return 0; + } + + /* + * Use wide-char case-insensitive comparison + */ + + if ((_wcsicmp(path+len-3, L"exe") == 0) + || (_wcsicmp(path+len-3, L"com") == 0) + || (_wcsicmp(path+len-3, L"bat") == 0)) { + return 1; + } + } else { + const char *p; + + /* + * We are only looking for pure ascii. + */ + + p = strrchr((const char *) nativePath, '.'); + if (p != NULL) { + p++; + + /* + * Note: in the old code, stat considered '.pif' files as + * executable, whereas access did not. + */ - path += len-3; - if ((_wcsicmp(path, L"exe") == 0) - || (_wcsicmp(path, L"com") == 0) - || (_wcsicmp(path, L"cmd") == 0) - || (_wcsicmp(path, L"bat") == 0)) { - return 1; + if ((strcasecmp(p, "exe") == 0) + || (strcasecmp(p, "com") == 0) + || (strcasecmp(p, "bat") == 0)) { + /* + * File that ends with .exe, .com, or .bat is executable. + */ + + return 1; + } + } } return 0; } @@ -1915,17 +1867,17 @@ TclpObjChdir( Tcl_Obj *pathPtr) /* Path to new working directory. */ { int result; - const WCHAR *nativePath; + const TCHAR *nativePath; - nativePath = (const WCHAR *)Tcl_FSGetNativePath(pathPtr); + nativePath = (const TCHAR *) Tcl_FSGetNativePath(pathPtr); if (!nativePath) { return -1; } - result = SetCurrentDirectoryW(nativePath); + result = (*tclWinProcs->setCurrentDirectoryProc)(nativePath); if (result == 0) { - Tcl_WinConvertError(GetLastError()); + TclWinConvertError(GetLastError()); return -1; } return 0; @@ -1961,14 +1913,12 @@ TclpGetCwd( { WCHAR buffer[MAX_PATH]; char *p; - WCHAR *native; - if (GetCurrentDirectoryW(MAX_PATH, buffer) == 0) { - Tcl_WinConvertError(GetLastError()); + if ((*tclWinProcs->getCurrentDirectoryProc)(MAX_PATH, buffer) == 0) { + TclWinConvertError(GetLastError()); if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "error getting working directory name: %s", - Tcl_PosixError(interp))); + Tcl_AppendResult(interp, "error getting working directory name: ", + Tcl_PosixError(interp), NULL); } return NULL; } @@ -1977,13 +1927,25 @@ TclpGetCwd( * Watch for the weird Windows c:\\UNC syntax. */ - native = (WCHAR *) buffer; - if ((native[0] != '\0') && (native[1] == ':') - && (native[2] == '\\') && (native[3] == '\\')) { - native += 2; + if (tclWinProcs->useWide) { + WCHAR *native; + + native = (WCHAR *) buffer; + if ((native[0] != '\0') && (native[1] == ':') + && (native[2] == '\\') && (native[3] == '\\')) { + native += 2; + } + Tcl_WinTCharToUtf((TCHAR *) native, -1, bufferPtr); + } else { + char *native; + + native = (char *) buffer; + if ((native[0] != '\0') && (native[1] == ':') + && (native[2] == '\\') && (native[3] == '\\')) { + native += 2; + } + Tcl_WinTCharToUtf((TCHAR *) native, -1, bufferPtr); } - Tcl_DStringInit(bufferPtr); - Tcl_WCharToUtfDString(native, TCL_INDEX_NONE, bufferPtr); /* * Convert to forward slashes for easier use in scripts. @@ -2010,7 +1972,8 @@ TclpObjStat( TclWinFlushDirtyChannels(); - return NativeStat((const WCHAR *)Tcl_FSGetNativePath(pathPtr), statPtr, 0); + return NativeStat((const TCHAR *) Tcl_FSGetNativePath(pathPtr), + statPtr, 0); } /* @@ -2038,7 +2001,7 @@ TclpObjStat( static int NativeStat( - const WCHAR *nativePath, /* Path of file to stat */ + const TCHAR *nativePath, /* Path of file to stat */ Tcl_StatBuf *statPtr, /* Filled with results of stat call. */ int checkLinks) /* If non-zero, behave like 'lstat' */ { @@ -2047,7 +2010,6 @@ NativeStat( 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 @@ -2055,48 +2017,29 @@ NativeStat( * 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 hard-coded 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, + fileHandle = (tclWinProcs->createFileProc)(nativePath, GENERIC_READ, + FILE_SHARE_READ | FILE_SHARE_WRITE, NULL, OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS | FILE_FLAG_OPEN_REPARSE_POINT, NULL); if (fileHandle != INVALID_HANDLE_VALUE) { BY_HANDLE_FILE_INFORMATION data; if (GetFileInformationByHandle(fileHandle,&data) != TRUE) { - fileType = GetFileType(fileHandle); - CloseHandle(fileHandle); - if (fileType != FILE_TYPE_CHAR && fileType != FILE_TYPE_DISK) { - Tcl_SetErrno(ENOENT); - return -1; - } - - /* - * Mock up the expected structure - */ + CloseHandle(fileHandle); + Tcl_SetErrno(ENOENT); + return -1; + } + CloseHandle(fileHandle); - 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 = ((long long) data.nFileSizeLow) | - (((long long) data.nFileSizeHigh) << 32); + + statPtr->st_size = ((Tcl_WideInt) data.nFileSizeLow) | + (((Tcl_WideInt) data.nFileSizeHigh) << 32); + statPtr->st_atime = ToCTime(data.ftLastAccessTime); + statPtr->st_mtime = ToCTime(data.ftLastWriteTime); + statPtr->st_ctime = ToCTime(data.ftCreationTime); /* * On Unix, for directories, nlink apparently depends on the number of @@ -2115,26 +2058,26 @@ NativeStat( */ inode = data.nFileIndexHigh | data.nFileIndexLow; - } else { + } else if (tclWinProcs->getFileAttributesExProc != NULL) { /* * Fall back on the less capable routines. This means no nlink or ino. */ WIN32_FILE_ATTRIBUTE_DATA data; - if (GetFileAttributesExW(nativePath, + if ((*tclWinProcs->getFileAttributesExProc)(nativePath, GetFileExInfoStandard, &data) != TRUE) { HANDLE hFind; - WIN32_FIND_DATAW ffd; + WIN32_FIND_DATAT ffd; DWORD lasterror = GetLastError(); if (lasterror != ERROR_SHARING_VIOLATION) { - Tcl_WinConvertError(lasterror); + TclWinConvertError(lasterror); return -1; } - hFind = FindFirstFileW(nativePath, &ffd); + hFind = (*tclWinProcs->findFirstFileProc)(nativePath, &ffd); if (hFind == INVALID_HANDLE_VALUE) { - Tcl_WinConvertError(GetLastError()); + TclWinConvertError(GetLastError()); return -1; } memcpy(&data, &ffd, sizeof(data)); @@ -2143,22 +2086,55 @@ NativeStat( attr = data.dwFileAttributes; - statPtr->st_size = ((long long) data.nFileSizeLow) | - (((long long) data.nFileSizeHigh) << 32); + statPtr->st_size = ((Tcl_WideInt) data.nFileSizeLow) | + (((Tcl_WideInt) data.nFileSizeHigh) << 32); statPtr->st_atime = ToCTime(data.ftLastAccessTime); statPtr->st_mtime = ToCTime(data.ftLastWriteTime); statPtr->st_ctime = ToCTime(data.ftCreationTime); + } else { + /* + * We don't have the faster attributes proc, so we're probably running + * on Win95. + */ + + WIN32_FIND_DATAT data; + HANDLE handle; + + handle = (*tclWinProcs->findFirstFileProc)(nativePath, &data); + if (handle == INVALID_HANDLE_VALUE) { + /* + * FindFirstFile() doesn't work on root directories, so call + * GetFileAttributes() to see if the specified file exists. + */ + + attr = (*tclWinProcs->getFileAttributesProc)(nativePath); + if (attr == INVALID_FILE_ATTRIBUTES) { + Tcl_SetErrno(ENOENT); + return -1; + } + + /* + * Make up some fake information for this file. It has the correct + * file attributes and a time of 0. + */ + + memset(&data, 0, sizeof(data)); + data.a.dwFileAttributes = attr; + } else { + FindClose(handle); + } + + attr = data.a.dwFileAttributes; + + statPtr->st_size = ((Tcl_WideInt) data.a.nFileSizeLow) | + (((Tcl_WideInt) data.a.nFileSizeHigh) << 32); + statPtr->st_atime = ToCTime(data.a.ftLastAccessTime); + statPtr->st_mtime = ToCTime(data.a.ftLastWriteTime); + statPtr->st_ctime = ToCTime(data.a.ftCreationTime); } dev = NativeDev(nativePath); 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; @@ -2182,45 +2158,46 @@ NativeStat( static int NativeDev( - const WCHAR *nativePath) /* Full path of file to stat */ + const TCHAR *nativePath) /* Full path of file to stat */ { int dev; Tcl_DString ds; WCHAR nativeFullPath[MAX_PATH]; - WCHAR *nativePart; + TCHAR *nativePart; const char *fullPath; - GetFullPathNameW(nativePath, MAX_PATH, nativeFullPath, &nativePart); - Tcl_DStringInit(&ds); - fullPath = Tcl_WCharToUtfDString(nativeFullPath, TCL_INDEX_NONE, &ds); + (*tclWinProcs->getFullPathNameProc)(nativePath, MAX_PATH, + nativeFullPath, &nativePart); + + fullPath = Tcl_WinTCharToUtf((TCHAR *) nativeFullPath, -1, &ds); if ((fullPath[0] == '\\') && (fullPath[1] == '\\')) { const char *p; DWORD dw; - const WCHAR *nativeVol; + const TCHAR *nativeVol; Tcl_DString volString; p = strchr(fullPath + 2, '\\'); p = strchr(p + 1, '\\'); if (p == NULL) { /* - * Add terminating backslash to fullpath or GetVolumeInformationW() + * Add terminating backslash to fullpath or GetVolumeInformation() * won't work. */ - fullPath = TclDStringAppendLiteral(&ds, "\\"); + fullPath = Tcl_DStringAppend(&ds, "\\", 1); p = fullPath + Tcl_DStringLength(&ds); } else { p++; } - Tcl_DStringInit(&volString); - nativeVol = Tcl_UtfToWCharDString(fullPath, p - fullPath, &volString); + nativeVol = Tcl_WinUtfToTChar(fullPath, p - fullPath, &volString); dw = (DWORD) -1; - GetVolumeInformationW(nativeVol, NULL, 0, &dw, NULL, NULL, NULL, 0); + (*tclWinProcs->getVolumeInformationProc)(nativeVol, NULL, 0, &dw, + NULL, NULL, NULL, 0); /* - * GetFullPathNameW() turns special devices like "NUL" into "\\.\NUL", - * but GetVolumeInformationW() returns failure for "\\.\NUL". This will + * GetFullPathName() turns special devices like "NUL" into "\\.\NUL", + * but GetVolumeInformation() returns failure for "\\.\NUL". This will * cause "NUL" to get a drive number of -1, which makes about as much * sense as anything since the special devices don't live on any * drive. @@ -2288,7 +2265,7 @@ NativeStatMode( * * ToCTime -- * - * Converts a Windows FILETIME to a __time64_t in UTC. + * Converts a Windows FILETIME to a time_t in UTC. * * Results: * Returns the count of seconds from the Posix epoch. @@ -2296,7 +2273,7 @@ NativeStatMode( *------------------------------------------------------------------------ */ -static __time64_t +static time_t ToCTime( FILETIME fileTime) /* UTC time */ { @@ -2305,8 +2282,8 @@ ToCTime( convertedTime.LowPart = fileTime.dwLowDateTime; convertedTime.HighPart = (LONG) fileTime.dwHighDateTime; - return (__time64_t) ((convertedTime.QuadPart - - (long long) POSIX_EPOCH_AS_FILETIME) / (long long) 10000000); + return (time_t) ((convertedTime.QuadPart - + (Tcl_WideInt) POSIX_EPOCH_AS_FILETIME) / (Tcl_WideInt) 10000000); } /* @@ -2314,7 +2291,7 @@ ToCTime( * * FromCTime -- * - * Converts a __time64_t to a Windows FILETIME + * Converts a time_t to a Windows FILETIME * * Results: * Returns the count of 100-ns ticks seconds from the Windows epoch. @@ -2324,13 +2301,12 @@ ToCTime( static void FromCTime( - __time64_t posixTime, + time_t posixTime, FILETIME *fileTime) /* UTC Time */ { LARGE_INTEGER convertedTime; - convertedTime.QuadPart = ((LONGLONG) posixTime) * 10000000 - + POSIX_EPOCH_AS_FILETIME; + + POSIX_EPOCH_AS_FILETIME; fileTime->dwLowDateTime = convertedTime.LowPart; fileTime->dwHighDateTime = convertedTime.HighPart; } @@ -2347,7 +2323,7 @@ FromCTime( * 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 + * If NULL is returned, the caller can examine the standard posix error * codes to determine the cause of the problem. * * Side effects: @@ -2356,24 +2332,38 @@ FromCTime( *---------------------------------------------------------------------- */ -void * +ClientData TclpGetNativeCwd( - void *clientData) + ClientData clientData) { WCHAR buffer[MAX_PATH]; - if (GetCurrentDirectoryW(MAX_PATH, buffer) == 0) { - Tcl_WinConvertError(GetLastError()); + if ((*tclWinProcs->getCurrentDirectoryProc)(MAX_PATH, buffer) == 0) { + TclWinConvertError(GetLastError()); return NULL; } if (clientData != NULL) { - if (wcscmp((const WCHAR *) clientData, buffer) == 0) { - return clientData; + if (tclWinProcs->useWide) { + /* + * Unicode representation when running on NT/2K/XP. + */ + + if (wcscmp((const WCHAR*)clientData, (const WCHAR*)buffer) == 0) { + return clientData; + } + } else { + /* + * ANSI representation when running on 95/98/ME. + */ + + if (strcmp((const char*) clientData, (const char*) buffer) == 0) { + return clientData; + } } } - return TclNativeDupInternalRep(buffer); + return TclNativeDupInternalRep((ClientData) buffer); } int @@ -2381,7 +2371,7 @@ TclpObjAccess( Tcl_Obj *pathPtr, int mode) { - return NativeAccess((const WCHAR *)Tcl_FSGetNativePath(pathPtr), mode); + return NativeAccess((const TCHAR *) Tcl_FSGetNativePath(pathPtr), mode); } int @@ -2397,7 +2387,8 @@ TclpObjLstat( TclWinFlushDirtyChannels(); - return NativeStat((const WCHAR *)Tcl_FSGetNativePath(pathPtr), statPtr, 1); + return NativeStat((const TCHAR *) Tcl_FSGetNativePath(pathPtr), + statPtr, 1); } #ifdef S_IFLNK @@ -2409,15 +2400,15 @@ TclpObjLink( { if (toPtr != NULL) { int res; - const WCHAR *LinkTarget; - const WCHAR *LinkSource = (const WCHAR *)Tcl_FSGetNativePath(pathPtr); + TCHAR *LinkTarget; + TCHAR *LinkSource = (TCHAR *) Tcl_FSGetNativePath(pathPtr); Tcl_Obj *normalizedToPtr = Tcl_FSGetNormalizedPath(NULL, toPtr); if (normalizedToPtr == NULL) { return NULL; } - LinkTarget = (const WCHAR *)Tcl_FSGetNativePath(normalizedToPtr); + LinkTarget = (TCHAR *) Tcl_FSGetNativePath(normalizedToPtr); if (LinkSource == NULL || LinkTarget == NULL) { return NULL; @@ -2429,7 +2420,7 @@ TclpObjLink( return NULL; } } else { - const WCHAR *LinkSource = (const WCHAR *)Tcl_FSGetNativePath(pathPtr); + TCHAR *LinkSource = (TCHAR *) Tcl_FSGetNativePath(pathPtr); if (LinkSource == NULL) { return NULL; @@ -2437,7 +2428,7 @@ TclpObjLink( return WinReadLink(LinkSource); } } -#endif /* S_IFLNK */ +#endif /* *--------------------------------------------------------------------------- @@ -2471,21 +2462,23 @@ TclpFilesystemPathType( if (normPath == NULL) { return NULL; } - path = TclGetString(normPath); + path = Tcl_GetString(normPath); if (path == NULL) { return NULL; } - firstSeparator = strchr((char *)path, '/'); + firstSeparator = strchr(path, '/'); if (firstSeparator == NULL) { - found = GetVolumeInformationW((const WCHAR *)Tcl_FSGetNativePath(pathPtr), - NULL, 0, NULL, NULL, NULL, volType, VOL_BUF_SIZE); + found = tclWinProcs->getVolumeInformationProc( + Tcl_FSGetNativePath(pathPtr), NULL, 0, NULL, NULL, NULL, + (WCHAR *) volType, VOL_BUF_SIZE); } else { Tcl_Obj *driveName = Tcl_NewStringObj(path, firstSeparator - path+1); Tcl_IncrRefCount(driveName); - found = GetVolumeInformationW((const WCHAR *)Tcl_FSGetNativePath(driveName), - NULL, 0, NULL, NULL, NULL, volType, VOL_BUF_SIZE); + found = tclWinProcs->getVolumeInformationProc( + Tcl_FSGetNativePath(driveName), NULL, 0, NULL, NULL, NULL, + (WCHAR *) volType, VOL_BUF_SIZE); Tcl_DecrRefCount(driveName); } @@ -2493,10 +2486,13 @@ TclpFilesystemPathType( return NULL; } else { Tcl_DString ds; + Tcl_Obj *objPtr; - Tcl_DStringInit(&ds); - Tcl_WCharToUtfDString(volType, TCL_INDEX_NONE, &ds); - return Tcl_DStringToObj(&ds); + Tcl_WinTCharToUtf((const char *) volType, -1, &ds); + objPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), + Tcl_DStringLength(&ds)); + Tcl_DStringFree(&ds); + return objPtr; } #undef VOL_BUF_SIZE } @@ -2538,257 +2534,409 @@ TclpFilesystemPathType( int TclpObjNormalizePath( - TCL_UNUSED(Tcl_Interp *), - Tcl_Obj *pathPtr, /* An unshared object containing the path to - * normalize */ - int nextCheckpoint) /* offset to start at in pathPtr */ + 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 = TclGetString(pathPtr); + path = Tcl_GetString(pathPtr); - currentPathEndPosition = path + nextCheckpoint; - if (*currentPathEndPosition == '/') { - currentPathEndPosition++; - } - while (1) { - char cur = *currentPathEndPosition; + if (TclWinGetPlatformId() == VER_PLATFORM_WIN32_WINDOWS) { + /* + * We're on Win95, 98 or ME. There are two assumptions in this block + * of code. First that the native (NULL) encoding is basically ascii, + * and second that symbolic links are not possible. Both of these + * assumptions appear to be true of these operating systems. + */ - if ((cur=='/' || cur==0) && (path != currentPathEndPosition)) { - /* - * Reached directory separator, or end of string. - */ + int isDrive = 1; + Tcl_DString ds; - WIN32_FILE_ATTRIBUTE_DATA data; - const WCHAR *nativePath; + currentPathEndPosition = path + nextCheckpoint; + if (*currentPathEndPosition == '/') { + currentPathEndPosition++; + } - Tcl_DStringInit(&ds); - nativePath = Tcl_UtfToWCharDString(path, - currentPathEndPosition - path, &ds); + while (1) { + char cur = *currentPathEndPosition; - if (GetFileAttributesExW(nativePath, - GetFileExInfoStandard, &data) != TRUE) { + if ((cur=='/' || cur==0) && (path != currentPathEndPosition)) { /* - * File doesn't exist. + * Reached directory separator, or end of string. */ - if (isDrive) { - size_t len = WinIsReserved(path); + const char *nativePath = Tcl_UtfToExternalDString(NULL, path, + currentPathEndPosition - path, &ds); - if (len > 0) { + /* + * Now we convert the tail of the current path to its 'long + * form', and append it to 'dsNorm' which holds the current + * normalized path, if the file exists. + */ + + if (isDrive) { + if (GetFileAttributesA(nativePath) + == INVALID_FILE_ATTRIBUTES) { /* - * Actually it does exist - COM1, etc. + * File doesn't exist. */ - size_t i; - - for (i=0 ; i<len ; i++) { - WCHAR wc = ((WCHAR *)nativePath)[i]; - - if (wc >= 'a') { - wc -= ('a' - 'A'); - ((WCHAR *) nativePath)[i] = wc; + if (isDrive) { + int len = WinIsReserved(path); + + if (len > 0) { + /* + * Actually it does exist - COM1, etc. + */ + + int i; + + for (i=0 ; i<len ; i++) { + if (nativePath[i] >= 'a') { + ((char *) nativePath)[i] -= ('a'-'A'); + } + } + Tcl_DStringAppend(&dsNorm, nativePath, len); + lastValidPathEnd = currentPathEndPosition; + } else if (nextCheckpoint == 0) { + /* Path starts with a drive designation + * that's not actually on the system. + * We still must normalize up past the + * first separator. [Bug 3603434] */ + currentPathEndPosition++; + } + } + Tcl_DStringFree(&ds); + break; + } + if (nativePath[0] >= 'a') { + ((char *) nativePath)[0] -= ('a' - 'A'); + } + Tcl_DStringAppend(&dsNorm, nativePath, + Tcl_DStringLength(&ds)); + } else { + char *checkDots = NULL; + + if (lastValidPathEnd[1] == '.') { + checkDots = lastValidPathEnd + 1; + while (checkDots < currentPathEndPosition) { + if (*checkDots != '.') { + checkDots = NULL; + break; } + checkDots++; } - Tcl_DStringAppend(&dsNorm, - (const char *)nativePath, - sizeof(WCHAR) * len); - lastValidPathEnd = currentPathEndPosition; - } else if (nextCheckpoint == 0) { + } + if (checkDots != NULL) { + int dotLen = currentPathEndPosition-lastValidPathEnd; + + /* + * Path is just dots. We shouldn't really ever see a + * path like that. However, to be nice we at least + * don't mangle the path - we just add the dots as a + * path segment and continue + */ + + Tcl_DStringAppend(&dsNorm, (TCHAR *) + (nativePath + Tcl_DStringLength(&ds)-dotLen), + dotLen); + } else { /* - * Path starts with a drive designation that's not - * actually on the system. We still must normalize up - * past the first separator. [Bug 3603434] + * Normal path. */ - currentPathEndPosition++; + WIN32_FIND_DATA fData; + HANDLE handle; + + handle = FindFirstFileA(nativePath, &fData); + if (handle == INVALID_HANDLE_VALUE) { + if (GetFileAttributesA(nativePath) + == INVALID_FILE_ATTRIBUTES) { + /* + * File doesn't exist. + */ + + Tcl_DStringFree(&ds); + break; + } + + /* + * This is usually the '/' in 'c:/' at end of + * string. + */ + + Tcl_DStringAppend(&dsNorm,"/", 1); + } else { + char *nativeName; + + if (fData.cFileName[0] != '\0') { + nativeName = fData.cFileName; + } else { + nativeName = fData.cAlternateFileName; + } + FindClose(handle); + Tcl_DStringAppend(&dsNorm,"/", 1); + Tcl_DStringAppend(&dsNorm,nativeName,-1); + } } } Tcl_DStringFree(&ds); - break; + lastValidPathEnd = currentPathEndPosition; + if (cur == 0) { + break; + } + + /* + * If we get here, we've got past one directory delimiter, so + * we know it is no longer a drive. + */ + + isDrive = 0; } + currentPathEndPosition++; + } + } else { + /* + * We're on WinNT (or 2000 or XP; something with an NT core). + */ - /* - * File 'nativePath' does exist if we get here. We now want to - * check if it is a symlink and otherwise continue with the - * rest of the path. - */ + int isDrive = 1; + Tcl_DString ds; - /* - * Check for symlinks, except at last component of path (we don't - * follow final symlinks). Also a drive (C:/) for example, may - * sometimes have the reparse flag set for some reason I don't - * understand. We therefore don't perform this check for drives. - */ + currentPathEndPosition = path + nextCheckpoint; + if (*currentPathEndPosition == '/') { + currentPathEndPosition++; + } + while (1) { + char cur = *currentPathEndPosition; - if (cur != 0 && !isDrive && - data.dwFileAttributes & FILE_ATTRIBUTE_REPARSE_POINT){ - Tcl_Obj *to = WinReadLinkDirectory(nativePath); + if ((cur=='/' || cur==0) && (path != currentPathEndPosition)) { + /* + * Reached directory separator, or end of string. + */ - if (to != NULL) { + WIN32_FILE_ATTRIBUTE_DATA data; + const char *nativePath = Tcl_WinUtfToTChar(path, + currentPathEndPosition - path, &ds); + + if ((*tclWinProcs->getFileAttributesExProc)(nativePath, + GetFileExInfoStandard, &data) != TRUE) { /* - * Read the reparse point ok. Now, reparse points need not - * be normalized, otherwise we could use: - * - * Tcl_GetStringFromObj(to, &pathLen); - * nextCheckpoint = pathLen; - * - * So, instead we have to start from the beginning. + * File doesn't exist. */ - nextCheckpoint = 0; - Tcl_AppendToObj(to, currentPathEndPosition, TCL_INDEX_NONE); + if (isDrive) { + int len = WinIsReserved(path); - /* - * Convert link to forward slashes. - */ + if (len > 0) { + /* + * Actually it does exist - COM1, etc. + */ - for (path = TclGetString(to); *path != 0; path++) { - if (*path == '\\') { - *path = '/'; - } - } - path = TclGetString(to); - currentPathEndPosition = path + nextCheckpoint; - if (temp != NULL) { - Tcl_DecrRefCount(temp); - } - temp = to; + int i; - /* - * Reset variables so we can restart normalization. - */ + for (i=0 ; i<len ; i++) { + WCHAR wc = ((WCHAR *) nativePath)[i]; - isDrive = 1; - Tcl_DStringFree(&dsNorm); + if (wc >= L'a') { + wc -= (L'a' - L'A'); + ((WCHAR *) nativePath)[i] = wc; + } + } + Tcl_DStringAppend(&dsNorm, nativePath, + (int)(sizeof(WCHAR) * len)); + lastValidPathEnd = currentPathEndPosition; + } else if (nextCheckpoint == 0) { + /* Path starts with a drive designation + * that's not actually on the system. + * We still must normalize up past the + * first separator. [Bug 3603434] */ + currentPathEndPosition++; + } + } Tcl_DStringFree(&ds); - continue; + break; } - } -#ifndef TclNORM_LONG_PATH - /* - * Now we convert the tail of the current path to its 'long form', - * and append it to 'dsNorm' which holds the current normalized - * path - */ + /* + * File 'nativePath' does exist if we get here. We now want to + * check if it is a symlink and otherwise continue with the + * rest of the path. + */ - if (isDrive) { - WCHAR drive = ((WCHAR *) nativePath)[0]; + /* + * Check for symlinks, except at last component of path (we + * don't follow final symlinks). Also a drive (C:/) for + * example, may sometimes have the reparse flag set for some + * reason I don't understand. We therefore don't perform this + * check for drives. + */ - if (drive >= 'a') { - drive -= ('a' - 'A'); - ((WCHAR *) nativePath)[0] = drive; - } - Tcl_DStringAppend(&dsNorm, (const char *)nativePath, - Tcl_DStringLength(&ds)); - } else { - char *checkDots = NULL; - - if (lastValidPathEnd[1] == '.') { - checkDots = lastValidPathEnd + 1; - while (checkDots < currentPathEndPosition) { - if (*checkDots != '.') { - checkDots = NULL; - break; + if (cur != 0 && !isDrive && + data.dwFileAttributes & FILE_ATTRIBUTE_REPARSE_POINT){ + Tcl_Obj *to = WinReadLinkDirectory(nativePath); + + if (to != NULL) { + /* + * Read the reparse point ok. Now, reparse points need + * not be normalized, otherwise we could use: + * + * Tcl_GetStringFromObj(to, &pathLen); + * nextCheckpoint = pathLen + * + * So, instead we have to start from the beginning. + */ + + nextCheckpoint = 0; + Tcl_AppendToObj(to, currentPathEndPosition, -1); + + /* + * Convert link to forward slashes. + */ + + for (path = Tcl_GetString(to); *path != 0; path++) { + if (*path == '\\') { + *path = '/'; + } } - checkDots++; + 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_DStringInit(&dsNorm); + Tcl_DStringFree(&ds); + continue; } } - if (checkDots != NULL) { - int dotLen = currentPathEndPosition-lastValidPathEnd; - /* - * Path is just dots. We shouldn't really ever see a path - * like that. However, to be nice we at least don't mangle - * the path - we just add the dots as a path segment and - * continue. - */ +#ifndef TclNORM_LONG_PATH + /* + * Now we convert the tail of the current path to its 'long + * form', and append it to 'dsNorm' which holds the current + * normalized path + */ - Tcl_DStringAppend(&dsNorm, ((const char *)nativePath) - + Tcl_DStringLength(&ds) - - (dotLen * sizeof(WCHAR)), - dotLen * sizeof(WCHAR)); + if (isDrive) { + WCHAR drive = ((WCHAR *) nativePath)[0]; + if (drive >= L'a') { + drive -= (L'a' - L'A'); + ((WCHAR *) nativePath)[0] = drive; + } + Tcl_DStringAppend(&dsNorm, nativePath, + Tcl_DStringLength(&ds)); } else { - /* - * Normal path. - */ - - WIN32_FIND_DATAW fData; - HANDLE handle; + char *checkDots = NULL; + + if (lastValidPathEnd[1] == '.') { + checkDots = lastValidPathEnd + 1; + while (checkDots < currentPathEndPosition) { + if (*checkDots != '.') { + checkDots = NULL; + break; + } + checkDots++; + } + } + if (checkDots != NULL) { + int dotLen = currentPathEndPosition-lastValidPathEnd; - handle = FindFirstFileW((WCHAR *) nativePath, &fData); - if (handle == INVALID_HANDLE_VALUE) { /* - * This is usually the '/' in 'c:/' at end of string. + * Path is just dots. We shouldn't really ever see a + * path like that. However, to be nice we at least + * don't mangle the path - we just add the dots as a + * path segment and continue. */ - Tcl_DStringAppend(&dsNorm, (const char *) L"/", - sizeof(WCHAR)); + Tcl_DStringAppend(&dsNorm, (TCHAR *) + ((WCHAR*)(nativePath + Tcl_DStringLength(&ds)) + - dotLen), (int)(dotLen * sizeof(WCHAR))); } else { - WCHAR *nativeName; + /* + * Normal path. + */ - if (fData.cFileName[0] != '\0') { - nativeName = fData.cFileName; + 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 { - nativeName = fData.cAlternateFileName; + WCHAR *nativeName; + + if (fData.cFileName[0] != '\0') { + nativeName = fData.cFileName; + } else { + nativeName = fData.cAlternateFileName; + } + FindClose(handle); + Tcl_DStringAppend(&dsNorm, (const char *) L"/", + sizeof(WCHAR)); + Tcl_DStringAppend(&dsNorm, (TCHAR *) nativeName, + (int) (wcslen(nativeName)*sizeof(WCHAR))); } - FindClose(handle); - Tcl_DStringAppend(&dsNorm, (const char *) L"/", - sizeof(WCHAR)); - Tcl_DStringAppend(&dsNorm, - (const char *) nativeName, - wcslen(nativeName)*sizeof(WCHAR)); } } - } -#endif /* !TclNORM_LONG_PATH */ - Tcl_DStringFree(&ds); - lastValidPathEnd = currentPathEndPosition; - if (cur == 0) { - break; - } +#endif + Tcl_DStringFree(&ds); + lastValidPathEnd = currentPathEndPosition; + if (cur == 0) { + break; + } - /* - * If we get here, we've got past one directory delimiter, so we - * know it is no longer a drive. - */ + /* + * If we get here, we've got past one directory delimiter, so + * we know it is no longer a drive. + */ - isDrive = 0; + isDrive = 0; + } + currentPathEndPosition++; } - currentPathEndPosition++; #ifdef TclNORM_LONG_PATH /* * Convert the entire known path to long form. */ - WCHAR wpath[MAX_PATH]; - const WCHAR *nativePath; - DWORD wpathlen; + if (1) { + WCHAR wpath[MAX_PATH]; + const char *nativePath = + Tcl_WinUtfToTChar(path, lastValidPathEnd - path, &ds); + DWORD wpathlen = (*tclWinProcs->getLongPathNameProc)( + nativePath, (TCHAR *) wpath, MAX_PATH); - Tcl_DStringInit(&ds); - nativePath = - Tcl_UtfToWCharDString(path, lastValidPathEnd - path, &ds); - wpathlen = GetLongPathNameProc(nativePath, - (WCHAR *) wpath, MAX_PATH); - /* - * We have to make the drive letter uppercase. - */ + /* + * We have to make the drive letter uppercase. + */ - if (wpath[0] >= 'a') { - wpath[0] -= ('a' - 'A'); + if (wpath[0] >= L'a') { + wpath[0] -= (L'a' - L'A'); + } + Tcl_DStringAppend(&dsNorm, (TCHAR*)wpath, wpathlen*sizeof(WCHAR)); + Tcl_DStringFree(&ds); } - Tcl_DStringAppend(&dsNorm, (const char *) wpath, - wpathlen * sizeof(WCHAR)); - Tcl_DStringFree(&ds); -#endif /* TclNORM_LONG_PATH */ +#endif } /* @@ -2803,22 +2951,24 @@ TclpObjNormalizePath( * native encoding, so we have to convert it to Utf. */ - Tcl_DStringInit(&ds); - Tcl_WCharToUtfDString((const WCHAR *) Tcl_DStringValue(&dsNorm), - Tcl_DStringLength(&dsNorm)>>1, &ds); - nextCheckpoint = Tcl_DStringLength(&ds); + Tcl_DString dsTemp; + + Tcl_WinTCharToUtf(Tcl_DStringValue(&dsNorm), + Tcl_DStringLength(&dsNorm), &dsTemp); + nextCheckpoint = Tcl_DStringLength(&dsTemp); if (*lastValidPathEnd != 0) { /* * Not the end of the string. */ + int len; + char *path; Tcl_Obj *tmpPathPtr; - Tcl_Size len; - tmpPathPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), + tmpPathPtr = Tcl_NewStringObj(Tcl_DStringValue(&dsTemp), nextCheckpoint); - Tcl_AppendToObj(tmpPathPtr, lastValidPathEnd, TCL_INDEX_NONE); - path = TclGetStringFromObj(tmpPathPtr, &len); + Tcl_AppendToObj(tmpPathPtr, lastValidPathEnd, -1); + path = Tcl_GetStringFromObj(tmpPathPtr, &len); Tcl_SetStringObj(pathPtr, path, len); Tcl_DecrRefCount(tmpPathPtr); } else { @@ -2826,9 +2976,10 @@ TclpObjNormalizePath( * End of string was reached above. */ - Tcl_SetStringObj(pathPtr, Tcl_DStringValue(&ds), nextCheckpoint); + Tcl_SetStringObj(pathPtr, Tcl_DStringValue(&dsTemp), + nextCheckpoint); } - Tcl_DStringFree(&ds); + Tcl_DStringFree(&dsTemp); } Tcl_DStringFree(&dsNorm); @@ -2840,7 +2991,6 @@ TclpObjNormalizePath( if (temp != NULL) { Tcl_DecrRefCount(temp); } - return nextCheckpoint; } @@ -2887,10 +3037,10 @@ TclWinVolumeRelativeNormalize( * current volume. */ - const char *drive = TclGetString(useThisCwd); + const char *drive = Tcl_GetString(useThisCwd); absolutePath = Tcl_NewStringObj(drive,2); - Tcl_AppendToObj(absolutePath, path, TCL_INDEX_NONE); + Tcl_AppendToObj(absolutePath, path, -1); Tcl_IncrRefCount(absolutePath); /* @@ -2902,8 +3052,9 @@ TclWinVolumeRelativeNormalize( * also on drive C. */ - Tcl_Size cwdLen; - const char *drive = TclGetStringFromObj(useThisCwd, &cwdLen); + int cwdLen; + const char *drive = + Tcl_GetStringFromObj(useThisCwd, &cwdLen); char drive_cur = path[0]; if (drive_cur >= 'a') { @@ -2943,7 +3094,7 @@ TclWinVolumeRelativeNormalize( Tcl_AppendToObj(absolutePath, "/", 1); } Tcl_IncrRefCount(absolutePath); - Tcl_AppendToObj(absolutePath, path+2, TCL_INDEX_NONE); + Tcl_AppendToObj(absolutePath, path+2, -1); } *useThisCwdPtr = useThisCwd; return absolutePath; @@ -2972,15 +3123,14 @@ TclWinVolumeRelativeNormalize( Tcl_Obj * TclpNativeToNormalized( - void *clientData) + ClientData clientData) { Tcl_DString ds; Tcl_Obj *objPtr; - Tcl_Size len; + int len; char *copy, *p; - Tcl_DStringInit(&ds); - Tcl_WCharToUtfDString((const WCHAR *) clientData, TCL_INDEX_NONE, &ds); + Tcl_WinTCharToUtf((const char *) clientData, -1, &ds); copy = Tcl_DStringValue(&ds); len = Tcl_DStringLength(&ds); @@ -3027,20 +3177,19 @@ TclpNativeToNormalized( * The nativePath representation. * * Side effects: - * Memory will be allocated. The path might be normalized. + * Memory will be allocated. The path may need to be normalized. * *--------------------------------------------------------------------------- */ -void * +ClientData TclNativeCreateNativeRep( Tcl_Obj *pathPtr) { - WCHAR *nativePathPtr = NULL; - const char *str; + char *nativePathPtr, *str; + Tcl_DString ds; Tcl_Obj *validPathPtr; - Tcl_Size len; - WCHAR *wp; + int len; if (TclFSCwdIsNative()) { /* @@ -3053,11 +3202,6 @@ TclNativeCreateNativeRep( if (validPathPtr == NULL) { return NULL; } - - /* - * refCount of validPathPtr was already incremented in - * Tcl_FSGetTranslatedPath - */ } else { /* * Make sure the normalized path is set. @@ -3067,113 +3211,87 @@ TclNativeCreateNativeRep( if (validPathPtr == NULL) { return NULL; } - - /* - * validPathPtr returned from Tcl_FSGetNormalizedPath is owned by Tcl, - * so incr refCount here - */ - Tcl_IncrRefCount(validPathPtr); } - str = TclGetStringFromObj(validPathPtr, &len); - - if (strlen(str) != (size_t)len) { + str = Tcl_GetStringFromObj(validPathPtr, &len); + Tcl_WinUtfToTChar(str, len, &ds); + if (tclWinProcs->useWide) { + WCHAR *wp = (WCHAR *) Tcl_DStringValue(&ds); + /* For a reserved device, strip a possible postfix ':' */ + len = WinIsReserved(str); + /* For normal devices */ + if (len == 0) len = Tcl_DStringLength(&ds)>>1; /* - * String contains NUL-bytes. This is invalid. - */ - - goto done; - } - - /* - * For a reserved device, strip a possible postfix ':' - */ - - len = WinIsReserved(str); - if (len == 0) { + ** If path starts with "//?/" or "\\?\" (extended path), translate + ** any slashes to backslashes but accept the '?' as being valid. + */ + if ((str[0]=='\\' || str[0]=='/') && (str[1]=='\\' || str[1]=='/') + && str[2]=='?' && (str[3]=='\\' || str[3]=='/')) { + wp[0] = wp[1] = wp[3] = '\\'; + str += 4; + wp += 4; + len -= 4; + } /* - * 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; + ** If there is a drive prefix, the ':' must be considered valid. + **/ + if (((str[0]>='A'&&str[0]<='Z') || (str[0]>='a'&&str[0]<='z')) + && str[1]==':') { + wp += 2; + len -= 2; } - } - - /* - * Overallocate 6 chars, making some room for extended paths - */ - - wp = nativePathPtr = (WCHAR *)ckalloc((len + 6) * sizeof(WCHAR)); - if (nativePathPtr==0) { - goto done; - } - MultiByteToWideChar(CP_UTF8, MB_ERR_INVALID_CHARS, str, -1, nativePathPtr, - len + 2); - nativePathPtr[len] = 0; - - /* - * 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: - * <https://docs.microsoft.com/en-us/windows/win32/fileio/naming-a-file#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; + while (len-->0) { + if ((*wp < ' ') || wcschr(L"\"*:<>?|", *wp)) { + Tcl_DecrRefCount(validPathPtr); + Tcl_DStringFree(&ds); + return NULL; + } else if (*wp=='/') { + *wp = '\\'; + } + ++wp; } - + len = Tcl_DStringLength(&ds) + sizeof(WCHAR); + } else { + char *p = Tcl_DStringValue(&ds); + len = Tcl_DStringLength(&ds); /* - * If (remainder of) path starts with "<drive>:", leave the ':' - * intact. - */ - - wp += 2; - } else if (wp == nativePathPtr && len > MAX_PATH - && (str[0] == '\\' || str[0] == '/') - && (str[1] == '\\' || str[1] == '/') && str[2] != '?') { - memmove(wp + 6, wp, len * sizeof(WCHAR)); - memcpy(wp, L"\\\\?\\UNC", 7 * sizeof(WCHAR)); - wp += 7; - } - - /* - * In the remainder of the path, translate invalid characters to - * characters in the Unicode private use area. - */ - - while (*wp != '\0') { - if ((*wp < ' ') || wcschr(L"\"*:<>?|", *wp)) { - *wp |= 0xF000; - } else if (*wp == '/') { - *wp = '\\'; + ** If path starts with "//?/" or "\\?\" (extended path), translate + ** any slashes to backslashes but accept the '?' as being valid. + */ + if ((str[0]=='\\' || str[0]=='/') && (str[1]=='\\' || str[1]=='/') + && str[2]=='?' && (str[3]=='\\' || str[3]=='/')) { + p[0] = p[1] = p[3] = '\\'; + str += 4; + p += 4; + len -= 4; + } + /* + ** If there is a drive prefix, the ':' must be considered valid. + **/ + if (((str[0]>='A'&&str[0]<='Z') || (str[0]>='a'&&str[0]<='z')) + && str[1]==':') { + p += 2; + len -= 2; + } + while (len-->0) { + if ((*p < ' ') || strchr("\"*:<>?|", *p)) { + Tcl_DecrRefCount(validPathPtr); + Tcl_DStringFree(&ds); + return NULL; + } else if (*p=='/') { + *p = '\\'; + } + ++p; } - ++wp; + len = Tcl_DStringLength(&ds) + sizeof(char); } + Tcl_DecrRefCount(validPathPtr); + nativePathPtr = ckalloc((unsigned) len); + memcpy(nativePathPtr, Tcl_DStringValue(&ds), (size_t) len); - done: - TclDecrRefCount(validPathPtr); - return nativePathPtr; + Tcl_DStringFree(&ds); + return (ClientData) nativePathPtr; } /* @@ -3193,9 +3311,9 @@ TclNativeCreateNativeRep( *--------------------------------------------------------------------------- */ -void * +ClientData TclNativeDupInternalRep( - void *clientData) + ClientData clientData) { char *copy; size_t len; @@ -3204,11 +3322,23 @@ TclNativeDupInternalRep( return NULL; } - len = sizeof(WCHAR) * (wcslen((const WCHAR *) clientData) + 1); + if (tclWinProcs->useWide) { + /* + * Unicode representation when running on NT/2K/XP. + */ + + len = sizeof(WCHAR) * (wcslen((const WCHAR *) clientData) + 1); + } else { + /* + * ANSI representation when running on 95/98/ME. + */ - copy = (char *)ckalloc(len); + len = sizeof(char) * (strlen((const char *) clientData) + 1); + } + + copy = (char *) ckalloc(len); memcpy(copy, clientData, len); - return copy; + return (ClientData) copy; } /* @@ -3235,7 +3365,7 @@ TclpUtime( { int res = 0; HANDLE fileHandle; - const WCHAR *native; + const TCHAR *native; DWORD attr = 0; DWORD flags = FILE_ATTRIBUTE_NORMAL; FILETIME lastAccessTime, lastModTime; @@ -3243,9 +3373,9 @@ TclpUtime( FromCTime(tval->actime, &lastAccessTime); FromCTime(tval->modtime, &lastModTime); - native = (const WCHAR *)Tcl_FSGetNativePath(pathPtr); + native = (const TCHAR *) Tcl_FSGetNativePath(pathPtr); - attr = GetFileAttributesW(native); + attr = (*tclWinProcs->getFileAttributesProc)(native); if (attr != INVALID_FILE_ATTRIBUTES && attr & FILE_ATTRIBUTE_DIRECTORY) { flags = FILE_FLAG_BACKUP_SEMANTICS; @@ -3256,12 +3386,12 @@ TclpUtime( * savings complications that utime gets wrong. */ - fileHandle = CreateFileW(native, FILE_WRITE_ATTRIBUTES, 0, NULL, - OPEN_EXISTING, flags, NULL); + fileHandle = (tclWinProcs->createFileProc)(native, FILE_WRITE_ATTRIBUTES, + 0, NULL, OPEN_EXISTING, flags, NULL); if (fileHandle == INVALID_HANDLE_VALUE || !SetFileTime(fileHandle, NULL, &lastAccessTime, &lastModTime)) { - Tcl_WinConvertError(GetLastError()); + TclWinConvertError(GetLastError()); res = -1; } if (fileHandle != INVALID_HANDLE_VALUE) { @@ -3271,80 +3401,6 @@ TclpUtime( } /* - *--------------------------------------------------------------------------- - * - * 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 = (const WCHAR *)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 = (LPBYTE)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 diff --git a/win/tclWinInit.c b/win/tclWinInit.c index 3764a79..4e860b2 100644 --- a/win/tclWinInit.c +++ b/win/tclWinInit.c @@ -3,8 +3,8 @@ * * Contains the Windows-specific interpreter initialization functions. * - * Copyright © 1994-1997 Sun Microsystems, Inc. - * Copyright © 1998-1999 Scriptics Corporation. + * 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 @@ -17,7 +17,7 @@ #include <lmcons.h> /* - * GetUserNameW() is found in advapi32.dll + * GetUserName() is found in advapi32.dll */ #ifdef _MSC_VER # pragma comment(lib, "advapi32.lib") @@ -36,14 +36,61 @@ typedef struct { } OemId; /* - * The following arrays contain the human readable strings for the - * processor values. + * The following macros are missing from some versions of winnt.h. */ -#define NUMPROCESSORS 15 -static const char *const processors[NUMPROCESSORS] = { +#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 + +/* + * The following arrays contain the human readable strings for the Windows + * platform and processor values. + */ + + +#define NUMPLATFORMS 4 +static char* platforms[NUMPLATFORMS] = { + "Win32s", "Windows 95", "Windows NT", "Windows CE" +}; + +#define NUMPROCESSORS 11 +static char* processors[NUMPROCESSORS] = { "intel", "mips", "alpha", "ppc", "shx", "arm", "ia64", "alpha64", "msil", - "amd64", "ia32_on_win64", "neutral", "arm64", "arm32_on_win64", "ia32_on_arm64" + "amd64", "ia32_on_win64" }; /* @@ -58,14 +105,15 @@ static TclInitProcessGlobalValueProc InitializeSourceLibraryDir; static ProcessGlobalValue sourceLibraryDir = {0, 0, NULL, NULL, InitializeSourceLibraryDir, NULL, NULL}; -static void AppendEnvironment(Tcl_Obj *listPtr, const char *lib); +static void AppendEnvironment(Tcl_Obj *listPtr, CONST char *lib); +static int ToUtf(CONST WCHAR *wSrc, char *dst); /* *--------------------------------------------------------------------------- * * TclpInitPlatform -- * - * Initialize all the platform-dependent things like signals, + * Initialize all the platform-dependant things like signals, * floating-point error handling and sockets. * * Called at process initialization time. @@ -87,11 +135,11 @@ TclpInitPlatform(void) tclPlatform = TCL_PLATFORM_WINDOWS; - /* - * Initialize the winsock library. On Windows XP and higher this - * can never fail. - */ - WSAStartup(wVersionRequested, &wsaData); + /* + * Initialize the winsock library. On Windows XP and higher this + * can never fail. + */ + WSAStartup(wVersionRequested, &wsaData); #ifdef STATIC_BUILD /* @@ -100,7 +148,7 @@ TclpInitPlatform(void) * invoked. */ - TclWinInit(GetModuleHandleW(NULL)); + TclWinInit(GetModuleHandle(NULL)); #endif } @@ -124,16 +172,15 @@ TclpInitPlatform(void) void TclpInitLibraryPath( char **valuePtr, - TCL_HASH_TYPE *lengthPtr, + int *lengthPtr, Tcl_Encoding *encodingPtr) { #define LIBRARY_SIZE 64 Tcl_Obj *pathPtr; char installLib[LIBRARY_SIZE]; - const char *bytes; - Tcl_Size length; + char *bytes; - TclNewObj(pathPtr); + pathPtr = Tcl_NewObj(); /* * Initialize the substring used when locating the script library. The @@ -141,13 +188,13 @@ TclpInitLibraryPath( * installed DLL. */ - snprintf(installLib, sizeof(installLib), "lib/tcl%s", TCL_VERSION); + 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 original TCL_LIBRARY path. + * addition to the orginal TCL_LIBRARY path. */ AppendEnvironment(pathPtr, installLib); @@ -167,10 +214,9 @@ TclpInitLibraryPath( TclGetProcessGlobalValue(&sourceLibraryDir)); *encodingPtr = NULL; - bytes = TclGetStringFromObj(pathPtr, &length); - *lengthPtr = length++; - *valuePtr = (char *)ckalloc(length); - memcpy(*valuePtr, bytes, length); + bytes = Tcl_GetStringFromObj(pathPtr, lengthPtr); + *valuePtr = ckalloc((unsigned int)(*lengthPtr)+1); + memcpy(*valuePtr, bytes, (size_t)(*lengthPtr)+1); Tcl_DecrRefCount(pathPtr); } @@ -196,14 +242,14 @@ TclpInitLibraryPath( static void AppendEnvironment( Tcl_Obj *pathPtr, - const char *lib) + CONST char *lib) { - Tcl_Size pathc; + int pathc; WCHAR wBuf[MAX_PATH]; - char buf[MAX_PATH * 3]; + char buf[MAX_PATH * TCL_UTF_MAX]; Tcl_Obj *objPtr; Tcl_DString ds; - const char **pathv; + CONST char **pathv; char *shortlib; /* @@ -213,7 +259,7 @@ AppendEnvironment( for (shortlib = (char *) &lib[strlen(lib)-1]; shortlib>lib ; shortlib--) { if (*shortlib == '/') { - if ((size_t)(shortlib - lib) == strlen(lib) - 1) { + if ((unsigned)(shortlib - lib) == strlen(lib) - 1) { Tcl_Panic("last character in lib cannot be '/'"); } shortlib++; @@ -225,26 +271,32 @@ AppendEnvironment( } /* - * The "L" preceding the TCL_LIBRARY string is used to tell VC++ that - * this is a Unicode string. + * The "L" preceeding the TCL_LIBRARY string is used to tell VC++ that + * this is a unicode string. */ - GetEnvironmentVariableW(L"TCL_LIBRARY", wBuf, MAX_PATH); - WideCharToMultiByte(CP_UTF8, 0, wBuf, -1, buf, MAX_PATH * 3, NULL, NULL); + 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, TCL_INDEX_NONE); + 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 + * The lstrcmpi() will work even if pathv[pathc-1] is random UTF-8 * chars because I know shortlib is ascii. */ if ((pathc > 0) && (lstrcmpiA(shortlib, pathv[pathc - 1]) != 0)) { + CONST char *str; + /* * TCL_LIBRARY is set but refers to a different tcl installation * than the current version. Try fiddling with the specified @@ -254,13 +306,14 @@ AppendEnvironment( pathv[pathc - 1] = shortlib; Tcl_DStringInit(&ds); - (void) Tcl_JoinPath(pathc, pathv, &ds); - objPtr = Tcl_DStringToObj(&ds); + str = Tcl_JoinPath(pathc, pathv, &ds); + objPtr = Tcl_NewStringObj(str, Tcl_DStringLength(&ds)); + Tcl_DStringFree(&ds); } else { - objPtr = Tcl_NewStringObj(buf, TCL_INDEX_NONE); + objPtr = Tcl_NewStringObj(buf, -1); } Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); - ckfree(pathv); + ckfree((char *) pathv); } } @@ -284,16 +337,19 @@ AppendEnvironment( static void InitializeDefaultLibraryDir( char **valuePtr, - TCL_HASH_TYPE *lengthPtr, + int *lengthPtr, Tcl_Encoding *encodingPtr) { - HMODULE hModule = (HMODULE)TclWinGetTclInstance(); + HMODULE hModule = TclWinGetTclInstance(); WCHAR wName[MAX_PATH + LIBRARY_SIZE]; - char name[(MAX_PATH + LIBRARY_SIZE) * 3]; + char name[(MAX_PATH + LIBRARY_SIZE) * TCL_UTF_MAX]; char *end, *p; - GetModuleFileNameW(hModule, wName, sizeof(wName)/sizeof(WCHAR)); - WideCharToMultiByte(CP_UTF8, 0, wName, -1, name, sizeof(name), NULL, NULL); + if (GetModuleFileNameW(hModule, wName, MAX_PATH) == 0) { + GetModuleFileNameA(hModule, name, MAX_PATH); + } else { + ToUtf(wName, name); + } end = strrchr(name, '\\'); *end = '\0'; @@ -304,11 +360,11 @@ InitializeDefaultLibraryDir( *end = '\\'; TclWinNoBackslash(name); - snprintf(end + 1, LIBRARY_SIZE, "lib/tcl%s", TCL_VERSION); + sprintf(end + 1, "lib/tcl%s", TCL_VERSION); *lengthPtr = strlen(name); - *valuePtr = (char *)ckalloc(*lengthPtr + 1); + *valuePtr = ckalloc(*lengthPtr + 1); *encodingPtr = NULL; - memcpy(*valuePtr, name, *lengthPtr + 1); + memcpy(*valuePtr, name, (size_t) *lengthPtr + 1); } /* @@ -332,16 +388,19 @@ InitializeDefaultLibraryDir( static void InitializeSourceLibraryDir( char **valuePtr, - TCL_HASH_TYPE *lengthPtr, + int *lengthPtr, Tcl_Encoding *encodingPtr) { - HMODULE hModule = (HMODULE)TclWinGetTclInstance(); + HMODULE hModule = TclWinGetTclInstance(); WCHAR wName[MAX_PATH + LIBRARY_SIZE]; - char name[(MAX_PATH + LIBRARY_SIZE) * 3]; + char name[(MAX_PATH + LIBRARY_SIZE) * TCL_UTF_MAX]; char *end, *p; - GetModuleFileNameW(hModule, wName, sizeof(wName)/sizeof(WCHAR)); - WideCharToMultiByte(CP_UTF8, 0, wName, -1, name, sizeof(name), NULL, NULL); + if (GetModuleFileNameW(hModule, wName, MAX_PATH) == 0) { + GetModuleFileNameA(hModule, name, MAX_PATH); + } else { + ToUtf(wName, name); + } end = strrchr(name, '\\'); *end = '\0'; @@ -352,11 +411,68 @@ InitializeSourceLibraryDir( *end = '\\'; TclWinNoBackslash(name); - snprintf(end + 1, LIBRARY_SIZE, "../library"); + sprintf(end + 1, "../library"); *lengthPtr = strlen(name); - *valuePtr = (char *)ckalloc(*lengthPtr + 1); + *valuePtr = ckalloc((unsigned int) *lengthPtr + 1); *encodingPtr = NULL; - memcpy(*valuePtr, name, *lengthPtr + 1); + memcpy(*valuePtr, name, (size_t) *lengthPtr + 1); +} + +/* + *--------------------------------------------------------------------------- + * + * ToUtf -- + * + * Convert a char string to a UTF string. + * + * Results: + * None. + * + * Side effects: + * None. + * + *--------------------------------------------------------------------------- + */ + +static int +ToUtf( + CONST WCHAR *wSrc, + char *dst) +{ + char *start; + + start = dst; + while (*wSrc != '\0') { + dst += Tcl_UniCharToUtf(*wSrc, dst); + wSrc++; + } + *dst = '\0'; + return (int) (dst - start); +} + +/* + *--------------------------------------------------------------------------- + * + * TclWinEncodingsCleanup -- + * + * Reset information to its original state in finalization to allow for + * reinitialization to be possible. This must not be called until after + * the filesystem has been finalised, or exit crashes may occur when + * using virtual filesystems. + * + * Results: + * None. + * + * Side effects: + * Static information reset to startup state. + * + *--------------------------------------------------------------------------- + */ + +void +TclWinEncodingsCleanup(void) +{ + TclWinResetInterfaceEncodings(); } /* @@ -388,49 +504,34 @@ TclpSetInitialEncodings(void) { Tcl_DString encodingName; + TclpSetInterfaces(); Tcl_SetSystemEncoding(NULL, Tcl_GetEncodingNameFromEnvironment(&encodingName)); Tcl_DStringFree(&encodingName); } -const char * +void +TclpSetInterfaces(void) +{ + int platformId, useWide; + + platformId = TclWinGetPlatformId(); + useWide = ((platformId == VER_PLATFORM_WIN32_NT) + || (platformId == VER_PLATFORM_WIN32_CE)); + TclWinSetInterfaces(useWide); +} + +CONST char * Tcl_GetEncodingNameFromEnvironment( Tcl_DString *bufPtr) { - UINT acp = GetACP(); - Tcl_DStringInit(bufPtr); - if (acp == CP_UTF8) { - Tcl_DStringAppend(bufPtr, "utf-8", 5); - } else { - Tcl_DStringSetLength(bufPtr, 2+TCL_INTEGER_SPACE); - snprintf(Tcl_DStringValue(bufPtr), 2+TCL_INTEGER_SPACE, "cp%d", GetACP()); - Tcl_DStringSetLength(bufPtr, strlen(Tcl_DStringValue(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--; - Tcl_DStringInit(bufferPtr); - Tcl_WCharToUtfDString(szUserName, cchUserNameLen, bufferPtr); - } - return Tcl_DStringValue(bufferPtr); -} - /* *--------------------------------------------------------------------------- * @@ -452,7 +553,7 @@ void TclpSetVariables( Tcl_Interp *interp) /* Interp to initialize. */ { - const char *ptr; + CONST char *ptr; char buffer[TCL_INTEGER_SPACE * 2]; union { SYSTEM_INFO info; @@ -461,18 +562,23 @@ TclpSetVariables( static OSVERSIONINFOW osInfo; static int osInfoInitialized = 0; Tcl_DString ds; + WCHAR szUserName[UNLEN+1]; + DWORD cchUserNameLen = UNLEN; Tcl_SetVar2Ex(interp, "tclDefaultLibrary", NULL, TclGetProcessGlobalValue(&defaultLibraryDir), TCL_GLOBAL_ONLY); if (!osInfoInitialized) { - HMODULE handle = GetModuleHandleW(L"NTDLL"); + HANDLE handle = LoadLibraryW(L"NTDLL"); int(__stdcall *getversion)(void *) = - (int(__stdcall *)(void *))(void *)GetProcAddress(handle, "RtlGetVersion"); + (int(__stdcall *)(void *)) GetProcAddress(handle, "RtlGetVersion"); osInfo.dwOSVersionInfoSize = sizeof(OSVERSIONINFOW); if (!getversion || getversion(&osInfo)) { GetVersionExW(&osInfo); } + if (handle) { + FreeLibrary(handle); + } osInfoInitialized = 1; } GetSystemInfo(&sys.info); @@ -483,12 +589,11 @@ TclpSetVariables( Tcl_SetVar2(interp, "tcl_platform", "platform", "windows", TCL_GLOBAL_ONLY); - Tcl_SetVar2(interp, "tcl_platform", "os", - "Windows NT", TCL_GLOBAL_ONLY); - if (osInfo.dwMajorVersion == 10 && osInfo.dwBuildNumber >= 22000) { - osInfo.dwMajorVersion = 11; + if (osInfo.dwPlatformId < NUMPLATFORMS) { + Tcl_SetVar2(interp, "tcl_platform", "os", + platforms[osInfo.dwPlatformId], TCL_GLOBAL_ONLY); } - snprintf(buffer, sizeof(buffer), "%ld.%ld", osInfo.dwMajorVersion, osInfo.dwMinorVersion); + 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", @@ -496,8 +601,7 @@ TclpSetVariables( TCL_GLOBAL_ONLY); } -#if !defined(NDEBUG) && !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 - +#ifndef NDEBUG /* * The existence of the "debug" element of the tcl_platform array * indicates that this particular Tcl shell has been compiled with debug @@ -520,24 +624,17 @@ TclpSetVariables( if (ptr == NULL) { ptr = Tcl_GetVar2(interp, "env", "HOMEDRIVE", TCL_GLOBAL_ONLY); if (ptr != NULL) { - Tcl_DStringAppend(&ds, ptr, TCL_INDEX_NONE); + Tcl_DStringAppend(&ds, ptr, -1); } ptr = Tcl_GetVar2(interp, "env", "HOMEPATH", TCL_GLOBAL_ONLY); if (ptr != NULL) { - Tcl_DStringAppend(&ds, ptr, TCL_INDEX_NONE); + Tcl_DStringAppend(&ds, ptr, -1); } if (Tcl_DStringLength(&ds) > 0) { Tcl_SetVar2(interp, "env", "HOME", Tcl_DStringValue(&ds), TCL_GLOBAL_ONLY); } else { - /* None of HOME, HOMEDRIVE, HOMEPATH exists. Try USERPROFILE */ - ptr = Tcl_GetVar2(interp, "env", "USERPROFILE", TCL_GLOBAL_ONLY); - if (ptr != NULL && ptr[0]) { - Tcl_SetVar2(interp, "env", "HOME", ptr, TCL_GLOBAL_ONLY); - } else { - /* Last resort */ - Tcl_SetVar2(interp, "env", "HOME", "c:\\", TCL_GLOBAL_ONLY); - } + Tcl_SetVar2(interp, "env", "HOME", "c:\\", TCL_GLOBAL_ONLY); } } @@ -547,16 +644,17 @@ TclpSetVariables( * Note: cchUserNameLen is number of characters including nul terminator. */ - ptr = TclpGetUserName(&ds); - Tcl_SetVar2(interp, "tcl_platform", "user", ptr ? ptr : "", + Tcl_DStringInit(&ds); + if (TclGetEnv("USERNAME", &ds) == NULL) { + if (tclWinProcs->getUserName((LPTSTR)szUserName, &cchUserNameLen) != 0) { + int cbUserNameLen = cchUserNameLen - 1; + if (tclWinProcs->useWide) cbUserNameLen *= sizeof(WCHAR); + Tcl_WinTCharToUtf((LPTSTR)szUserName, cbUserNameLen, &ds); + } + } + Tcl_SetVar2(interp, "tcl_platform", "user", Tcl_DStringValue(&ds), TCL_GLOBAL_ONLY); Tcl_DStringFree(&ds); - - /* - * Define what the platform PATH separator is. [TIP #315] - */ - - Tcl_SetVar2(interp, "tcl_platform","pathSeparator", ";", TCL_GLOBAL_ONLY); } /* @@ -565,7 +663,7 @@ TclpSetVariables( * TclpFindVariable -- * * Locate the entry in environ for a given name. On Unix this routine is - * case sensitive, on Windows this matches mixed case. + * case sensitive, on Windows this matches mioxed case. * * Results: * The return value is the index in environ of an entry with the name @@ -579,18 +677,17 @@ TclpSetVariables( *---------------------------------------------------------------------- */ -Tcl_Size +int TclpFindVariable( - const char *name, /* Name of desired environment variable + CONST char *name, /* Name of desired environment variable * (UTF-8). */ - Tcl_Size *lengthPtr) /* Used to return length of name (for + int *lengthPtr) /* Used to return length of name (for * successful searches) or number of non-NULL * entries in environ (for unsuccessful * searches). */ { - Tcl_Size i, length, result = TCL_INDEX_NONE; - const WCHAR *env; - const char *p1, *p2; + int i, length, result = -1; + register CONST char *env, *p1, *p2; char *envUpper, *nameUpper; Tcl_DString envString; @@ -599,25 +696,24 @@ TclpFindVariable( */ length = strlen(name); - nameUpper = (char *)ckalloc(length + 1); - memcpy(nameUpper, name, length+1); + nameUpper = (char *) ckalloc((unsigned) length+1); + memcpy(nameUpper, name, (size_t) length+1); Tcl_UtfToUpper(nameUpper); Tcl_DStringInit(&envString); - for (i = 0, env = _wenviron[i]; env != NULL; i++, env = _wenviron[i]) { + 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. */ - Tcl_DStringInit(&envString); - envUpper = Tcl_WCharToUtfDString(env, TCL_INDEX_NONE, &envString); + envUpper = Tcl_ExternalToUtfDString(NULL, env, -1, &envString); p1 = strchr(envUpper, '='); if (p1 == NULL) { continue; } - length = p1 - envUpper; + length = (int) (p1 - envUpper); Tcl_DStringSetLength(&envString, length+1); Tcl_UtfToUpper(envUpper); diff --git a/win/tclWinInt.h b/win/tclWinInt.h index dfe4d10..ccf48bb 100644 --- a/win/tclWinInt.h +++ b/win/tclWinInt.h @@ -32,99 +32,178 @@ typedef struct TCLEXCEPTION_REGISTRATION { #endif /* + * The following specifies how much stack space TclpCheckStackSpace() + * ensures is available. TclpCheckStackSpace() is called by Tcl_EvalObj() + * to help avoid overflowing the stack in the case of infinite recursion. + */ + +#define TCL_WIN_STACK_THRESHOLD 0x8000 + +/* + * Some versions of Borland C have a define for the OSVERSIONINFO for + * Win32s and for NT, but not for Windows 95. + * Define VER_PLATFORM_WIN32_CE for those without newer headers. + */ + +#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 + +/* + * The following structure keeps track of whether we are using the + * multi-byte or the wide-character interfaces to the operating system. + * System calls should be made through the following function table. + */ + +typedef union { + WIN32_FIND_DATAA a; + WIN32_FIND_DATAW w; +} WIN32_FIND_DATAT; + +typedef struct TclWinProcs { + int useWide; + + BOOL (WINAPI *buildCommDCBProc)(CONST TCHAR *, LPDCB); + TCHAR *(WINAPI *charLowerProc)(TCHAR *); + BOOL (WINAPI *copyFileProc)(CONST TCHAR *, CONST TCHAR *, BOOL); + BOOL (WINAPI *createDirectoryProc)(CONST TCHAR *, LPSECURITY_ATTRIBUTES); + HANDLE (WINAPI *createFileProc)(CONST TCHAR *, DWORD, DWORD, + LPSECURITY_ATTRIBUTES, DWORD, DWORD, HANDLE); + BOOL (WINAPI *createProcessProc)(CONST TCHAR *, TCHAR *, + LPSECURITY_ATTRIBUTES, LPSECURITY_ATTRIBUTES, BOOL, DWORD, + LPVOID, CONST TCHAR *, LPSTARTUPINFOA, LPPROCESS_INFORMATION); + BOOL (WINAPI *deleteFileProc)(CONST TCHAR *); + HANDLE (WINAPI *findFirstFileProc)(CONST TCHAR *, WIN32_FIND_DATAT *); + BOOL (WINAPI *findNextFileProc)(HANDLE, WIN32_FIND_DATAT *); + BOOL (WINAPI *getComputerNameProc)(WCHAR *, LPDWORD); + DWORD (WINAPI *getCurrentDirectoryProc)(DWORD, WCHAR *); + DWORD (WINAPI *getFileAttributesProc)(CONST TCHAR *); + DWORD (WINAPI *getFullPathNameProc)(CONST TCHAR *, DWORD nBufferLength, + WCHAR *, TCHAR **); + DWORD (WINAPI *getModuleFileNameProc)(HMODULE, WCHAR *, int); + DWORD (WINAPI *getShortPathNameProc)(CONST TCHAR *, WCHAR *, DWORD); + UINT (WINAPI *getTempFileNameProc)(CONST TCHAR *, CONST TCHAR *, UINT, + WCHAR *); + DWORD (WINAPI *getTempPathProc)(DWORD, WCHAR *); + BOOL (WINAPI *getVolumeInformationProc)(CONST TCHAR *, WCHAR *, DWORD, + LPDWORD, LPDWORD, LPDWORD, WCHAR *, DWORD); + HINSTANCE (WINAPI *loadLibraryExProc)(CONST TCHAR *, HANDLE, DWORD); + TCHAR (WINAPI *lstrcpyProc)(WCHAR *, CONST TCHAR *); + BOOL (WINAPI *moveFileProc)(CONST TCHAR *, CONST TCHAR *); + BOOL (WINAPI *removeDirectoryProc)(CONST TCHAR *); + DWORD (WINAPI *searchPathProc)(CONST TCHAR *, CONST TCHAR *, + CONST TCHAR *, DWORD, WCHAR *, TCHAR **); + BOOL (WINAPI *setCurrentDirectoryProc)(CONST TCHAR *); + BOOL (WINAPI *setFileAttributesProc)(CONST TCHAR *, DWORD); + /* + * These two function pointers will only be set when + * Tcl_FindExecutable is called. If you don't ever call that + * function, the application will crash whenever WinTcl tries to call + * functions through these null pointers. That is not a bug in Tcl + * -- Tcl_FindExecutable is obligatory in recent Tcl releases. + */ + BOOL (WINAPI *getFileAttributesExProc)(CONST TCHAR *, + GET_FILEEX_INFO_LEVELS, LPVOID); + BOOL (WINAPI *createHardLinkProc)(CONST TCHAR*, CONST TCHAR*, + LPSECURITY_ATTRIBUTES); + + /* deleted INT (__cdecl *utimeProc)(CONST TCHAR*, struct _utimbuf *); */ + /* These two are also NULL at start; see comment above */ + HANDLE (WINAPI *findFirstFileExProc)(CONST TCHAR*, UINT, + LPVOID, UINT, + LPVOID, DWORD); + BOOL (WINAPI *getVolumeNameForVMPProc)(CONST TCHAR*, TCHAR*, DWORD); + DWORD (WINAPI *getLongPathNameProc)(CONST TCHAR*, TCHAR*, DWORD); + /* + * These six are for the security sdk to get correct file + * permissions on NT, 2000, XP, etc. On 95,98,ME they are + * always null. + */ + BOOL (WINAPI *getFileSecurityProc)(LPCTSTR lpFileName, + SECURITY_INFORMATION RequestedInformation, + PSECURITY_DESCRIPTOR pSecurityDescriptor, + DWORD nLength, + LPDWORD lpnLengthNeeded); + BOOL (WINAPI *impersonateSelfProc) (SECURITY_IMPERSONATION_LEVEL + ImpersonationLevel); + BOOL (WINAPI *openThreadTokenProc) (HANDLE ThreadHandle, + DWORD DesiredAccess, BOOL OpenAsSelf, + PHANDLE TokenHandle); + BOOL (WINAPI *revertToSelfProc) (void); + VOID (WINAPI *mapGenericMaskProc) (PDWORD AccessMask, + PGENERIC_MAPPING GenericMapping); + BOOL (WINAPI *accessCheckProc)(PSECURITY_DESCRIPTOR pSecurityDescriptor, + HANDLE ClientToken, DWORD DesiredAccess, + PGENERIC_MAPPING GenericMapping, + PPRIVILEGE_SET PrivilegeSet, + LPDWORD PrivilegeSetLength, + LPDWORD GrantedAccess, + LPBOOL AccessStatus); + /* + * Unicode console support. WriteConsole and ReadConsole + */ + BOOL (WINAPI *readConsoleProc)( + HANDLE hConsoleInput, + LPVOID lpBuffer, + DWORD nNumberOfCharsToRead, + LPDWORD lpNumberOfCharsRead, + LPVOID lpReserved + ); + BOOL (WINAPI *writeConsoleProc)( + HANDLE hConsoleOutput, + const VOID* lpBuffer, + DWORD nNumberOfCharsToWrite, + LPDWORD lpNumberOfCharsWritten, + LPVOID lpReserved + ); + BOOL (WINAPI *getUserName)(LPTSTR lpBuffer, LPDWORD lpnSize); +} TclWinProcs; + +MODULE_SCOPE TclWinProcs *tclWinProcs; + +/* * Declarations of functions that are not accessible by way of the * stubs table. */ MODULE_SCOPE char TclWinDriveLetterForVolMountPoint( - const WCHAR *mountPoint); -MODULE_SCOPE void TclWinEncodingsCleanup(void); + 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, +MODULE_SCOPE void TclWinResetInterfaceEncodings(); +MODULE_SCOPE HANDLE TclWinSerialOpen(HANDLE handle, CONST TCHAR *name, DWORD access); -MODULE_SCOPE int TclWinSymLinkCopyDirectory(const WCHAR *LinkOriginal, - const WCHAR *LinkCopy); -MODULE_SCOPE int TclWinSymLinkDelete(const WCHAR *LinkOriginal, +MODULE_SCOPE int TclWinSymLinkCopyDirectory(CONST TCHAR* LinkOriginal, + CONST TCHAR* LinkCopy); +MODULE_SCOPE int TclWinSymLinkDelete(CONST TCHAR* LinkOriginal, int linkOnly); -MODULE_SCOPE int TclWinFileOwned(Tcl_Obj *); -MODULE_SCOPE void TclWinGenerateChannelName(char channelName[], - const char *channelTypeName, void *channelImpl); -MODULE_SCOPE const char*TclpGetUserName(Tcl_DString *bufferPtr); +#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 */ /* 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 */ - void *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, - void *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/win/tclWinLoad.c b/win/tclWinLoad.c index a03132f..c4d08e8 100644 --- a/win/tclWinLoad.c +++ b/win/tclWinLoad.c @@ -5,7 +5,7 @@ * the Windows "LoadLibrary" and "GetProcAddress" API for dynamic * loading. * - * Copyright © 1995-1997 Sun Microsystems, Inc. + * 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. @@ -13,25 +13,6 @@ #include "tclWinInt.h" -/* - * Native name of the directory in the native filesystem where DLLs used in - * this process are copied prior to loading, and mutex used to protect its - * allocation. - */ - -static WCHAR *dllDirectoryName = NULL; -#if TCL_THREADS -static Tcl_Mutex dllDirectoryNameMutex; -#endif - -/* - * 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); /* *---------------------------------------------------------------------- @@ -59,16 +40,13 @@ TclpDlopen( Tcl_LoadHandle *loadHandle, /* Filled with token for dynamically loaded * file which will be passed back to * (*unloadProcPtr)() to unload the file. */ - Tcl_FSUnloadFileProc **unloadProcPtr, + Tcl_FSUnloadFileProc **unloadProcPtr) /* Filled with address of Tcl_FSUnloadFileProc * function which should be used for this * file. */ - TCL_UNUSED(int) /*flags*/) { - HINSTANCE hInstance = NULL; - const WCHAR *nativeName; - Tcl_LoadHandle handlePtr; - DWORD firstError; + HINSTANCE handle; + CONST TCHAR *nativeName; /* * First try the full path the user gave us. This is particularly @@ -76,12 +54,10 @@ TclpDlopen( * relative path. */ - nativeName = (const WCHAR *)Tcl_FSGetNativePath(pathPtr); - if (nativeName != NULL) { - hInstance = LoadLibraryExW(nativeName, NULL, - LOAD_WITH_ALTERED_SEARCH_PATH); - } - if (hInstance == NULL) { + nativeName = Tcl_FSGetNativePath(pathPtr); + handle = (*tclWinProcs->loadLibraryExProc)(nativeName, NULL, + LOAD_WITH_ALTERED_SEARCH_PATH); + if (handle == NULL) { /* * Let the OS loader examine the binary search path for whatever * string the user gave us which hopefully refers to a file on the @@ -89,39 +65,38 @@ TclpDlopen( */ Tcl_DString ds; + char *fileName = Tcl_GetString(pathPtr); - /* - * 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(); - - Tcl_DStringInit(&ds); - nativeName = Tcl_UtfToWCharDString(TclGetString(pathPtr), TCL_INDEX_NONE, &ds); - hInstance = LoadLibraryExW(nativeName, NULL, + nativeName = Tcl_WinUtfToTChar(fileName, -1, &ds); + handle = (*tclWinProcs->loadLibraryExProc)(nativeName, NULL, LOAD_WITH_ALTERED_SEARCH_PATH); Tcl_DStringFree(&ds); } - if (hInstance == NULL) { - DWORD lastError; - Tcl_Obj *errMsg; + *loadHandle = (Tcl_LoadHandle) handle; - /* - * 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; - } + if (handle == NULL) { + DWORD lastError = GetLastError(); + +#if 0 + /* + * It would be ideal if the FormatMessage stuff worked better, but + * unfortunately it doesn't seem to want to... + */ + + LPTSTR lpMsgBuf; + char *buf; + int size; + + size = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM | + FORMAT_MESSAGE_ALLOCATE_BUFFER, NULL, lastError, 0, + (LPTSTR) &lpMsgBuf, 0, NULL); + buf = (char *) ckalloc((unsigned) TCL_INTEGER_SPACE + size + 1); + sprintf(buf, "%d %s", lastError, (char *)lpMsgBuf); +#endif - errMsg = Tcl_ObjPrintf("couldn't load library \"%s\": ", - TclGetString(pathPtr)); + Tcl_AppendResult(interp, "couldn't load library \"", + Tcl_GetString(pathPtr), "\": ", NULL); /* * Check for possible DLL errors. This doesn't work quite right, @@ -130,63 +105,40 @@ TclpDlopen( * better if there was a way to get what DLLs */ - if (interp) { - switch (lastError) { - case ERROR_MOD_NOT_FOUND: - Tcl_SetErrorCode(interp, "WIN_LOAD", "MOD_NOT_FOUND", (void *)NULL); - goto notFoundMsg; - case ERROR_DLL_NOT_FOUND: - Tcl_SetErrorCode(interp, "WIN_LOAD", "DLL_NOT_FOUND", (void *)NULL); - notFoundMsg: - Tcl_AppendToObj(errMsg, "this library or a dependent library" - " could not be found in library path", TCL_INDEX_NONE); - break; - case ERROR_PROC_NOT_FOUND: - Tcl_SetErrorCode(interp, "WIN_LOAD", "PROC_NOT_FOUND", (void *)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.", TCL_INDEX_NONE); - break; - case ERROR_INVALID_DLL: - Tcl_SetErrorCode(interp, "WIN_LOAD", "INVALID_DLL", (void *)NULL); - Tcl_AppendToObj(errMsg, "this library or a dependent library" - " is damaged", TCL_INDEX_NONE); - break; - case ERROR_DLL_INIT_FAILED: - Tcl_SetErrorCode(interp, "WIN_LOAD", "DLL_INIT_FAILED", (void *)NULL); - Tcl_AppendToObj(errMsg, "the library initialization" - " routine failed", TCL_INDEX_NONE); - break; - case ERROR_BAD_EXE_FORMAT: - Tcl_SetErrorCode(interp, "WIN_LOAD", "BAD_EXE_FORMAT", (void *)NULL); - Tcl_AppendToObj(errMsg, "Bad exe format. Possibly a 32/64-bit mismatch.", TCL_INDEX_NONE); - break; - default: - Tcl_WinConvertError(lastError); - Tcl_AppendToObj(errMsg, Tcl_PosixError(interp), TCL_INDEX_NONE); - } - Tcl_SetObjResult(interp, errMsg); + switch (lastError) { + case ERROR_MOD_NOT_FOUND: + case ERROR_DLL_NOT_FOUND: + Tcl_AppendResult(interp, "this library or a dependent library" + " could not be found in library path", NULL); + break; + case ERROR_PROC_NOT_FOUND: + Tcl_AppendResult(interp, "A function specified in the import" + " table could not be resolved by the system. Windows" + " is not telling which one, I'm sorry.", NULL); + break; + case ERROR_INVALID_DLL: + Tcl_AppendResult(interp, "this library or a dependent library" + " is damaged", NULL); + break; + case ERROR_DLL_INIT_FAILED: + Tcl_AppendResult(interp, "the library initialization" + " routine failed", NULL); + break; + default: + TclWinConvertError(lastError); + Tcl_AppendResult(interp, Tcl_PosixError(interp), NULL); } return TCL_ERROR; + } else { + *unloadProcPtr = &TclpUnloadFile; } - - /* - * Succeded; package everything up for Tcl. - */ - - handlePtr = (Tcl_LoadHandle)ckalloc(sizeof(struct Tcl_LoadHandle_)); - handlePtr->clientData = (void *) hInstance; - handlePtr->findSymbolProcPtr = &FindSymbol; - handlePtr->unloadFileProcPtr = &UnloadFile; - *loadHandle = handlePtr; - *unloadProcPtr = &UnloadFile; return TCL_OK; } /* *---------------------------------------------------------------------- * - * FindSymbol -- + * TclpFindSymbol -- * * Looks up a symbol, by name, through a handle associated with a * previously loaded piece of code (shared library). @@ -199,43 +151,37 @@ TclpDlopen( *---------------------------------------------------------------------- */ -static void * -FindSymbol( +Tcl_PackageInitProc * +TclpFindSymbol( Tcl_Interp *interp, Tcl_LoadHandle loadHandle, - const char *symbol) + CONST char *symbol) { - HINSTANCE hInstance = (HINSTANCE) loadHandle->clientData; - void *proc = NULL; + Tcl_PackageInitProc *proc = NULL; + HINSTANCE handle = (HINSTANCE)loadHandle; /* * For each symbol, check for both Symbol and _Symbol, since Borland * generates C symbols with a leading '_' by default. */ - proc = (void *)GetProcAddress(hInstance, symbol); + proc = (Tcl_PackageInitProc *) GetProcAddress(handle, symbol); if (proc == NULL) { Tcl_DString ds; - const char *sym2; Tcl_DStringInit(&ds); - TclDStringAppendLiteral(&ds, "_"); - sym2 = Tcl_DStringAppend(&ds, symbol, TCL_INDEX_NONE); - proc = (void *)GetProcAddress(hInstance, sym2); + Tcl_DStringAppend(&ds, "_", 1); + symbol = Tcl_DStringAppend(&ds, symbol, -1); + proc = (Tcl_PackageInitProc *) GetProcAddress(handle, symbol); Tcl_DStringFree(&ds); } - if (proc == NULL && interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "cannot find symbol \"%s\"", symbol)); - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LOAD_SYMBOL", symbol, (void *)NULL); - } return proc; } /* *---------------------------------------------------------------------- * - * UnloadFile -- + * TclpUnloadFile -- * * Unloads a dynamically loaded binary code file from memory. Code * pointers in the formerly loaded file are no longer valid after calling @@ -250,149 +196,46 @@ FindSymbol( *---------------------------------------------------------------------- */ -static void -UnloadFile( +void +TclpUnloadFile( Tcl_LoadHandle loadHandle) /* loadHandle returned by a previous call to * TclpDlopen(). The loadHandle is a token * that represents the loaded file. */ { - HINSTANCE hInstance = (HINSTANCE) loadHandle->clientData; - - FreeLibrary(hInstance); - ckfree(loadHandle); -} - -/* - *---------------------------------------------------------------------- - * - * 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); + HINSTANCE handle; - /* - * 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; + handle = (HINSTANCE) loadHandle; + FreeLibrary(handle); } /* *---------------------------------------------------------------------- * - * InitDLLDirectoryName -- + * TclGuessPackageName -- * - * 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. + * If the "load" command is invoked without providing a package name, + * this function is invoked to try to figure it out. * * Results: - * Tcl result code. + * 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: - * Creates temp directory. - * Allocates memory pointed to by dllDirectoryName. + * Side effects: + * None. * *---------------------------------------------------------------------- - * [Candidate for process global?] */ -static int -InitDLLDirectoryName(void) +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. */ { - 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; - } - - Tcl_WinConvertError(lastError); - return TCL_ERROR; - - /* - * Store our computed value in the global. - */ - - copyToGlobalBuffer: - dllDirectoryName = (WCHAR *)ckalloc((nameLen+1) * sizeof(WCHAR)); - wcscpy(dllDirectoryName, name); - return TCL_OK; + return 0; } /* diff --git a/win/tclWinNotify.c b/win/tclWinNotify.c index 795db74..1cd5823 100644 --- a/win/tclWinNotify.c +++ b/win/tclWinNotify.c @@ -5,7 +5,7 @@ * is the lowest-level part of the Tcl event loop. This file works * together with ../generic/tclNotify.c. * - * Copyright © 1995-1997 Sun Microsystems, Inc. + * 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. @@ -14,7 +14,7 @@ #include "tclInt.h" /* - * The following static indicates whether this module has been initialized. + * The follwing static indicates whether this module has been initialized. */ #define INTERVAL_TIMER 1 /* Handle of interval timer. */ @@ -27,7 +27,7 @@ * created for each thread that is using the notifier. */ -typedef struct { +typedef struct ThreadSpecificData { CRITICAL_SECTION crit; /* Monitor for this notifier. */ DWORD thread; /* Identifier for thread associated with this * notifier. */ @@ -36,11 +36,15 @@ typedef struct { 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; +extern TclStubs tclStubs; +extern Tcl_NotifierProcs tclOriginalNotifier; + /* * The following static indicates the number of threads that have initialized * notifiers. It controls the lifetime of the TclNotifier window class. @@ -49,16 +53,14 @@ static Tcl_ThreadDataKey dataKey; */ static int notifierCount = 0; -static const WCHAR className[] = L"TclNotifier"; -static int initialized = 0; -static CRITICAL_SECTION notifierMutex; +TCL_DECLARE_MUTEX(notifierMutex) /* * Static routines defined in this file. */ -static LRESULT CALLBACK NotifierProc(HWND hwnd, UINT message, - WPARAM wParam, LPARAM lParam); +static LRESULT CALLBACK NotifierProc(HWND hwnd, UINT message, + WPARAM wParam, LPARAM lParam); /* *---------------------------------------------------------------------- @@ -76,45 +78,36 @@ static LRESULT CALLBACK NotifierProc(HWND hwnd, UINT message, *---------------------------------------------------------------------- */ -void * -TclpInitNotifier(void) +ClientData +Tcl_InitNotifier(void) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - - TclpGlobalLock(); - if (!initialized) { - initialized = 1; - InitializeCriticalSection(¬ifierMutex); - } - TclpGlobalUnlock(); + WNDCLASS class; /* * Register Notifier window class if this is the first thread to use this * module. */ - EnterCriticalSection(¬ifierMutex); + Tcl_MutexLock(¬ifierMutex); if (notifierCount == 0) { - WNDCLASSW clazz; - - clazz.style = 0; - clazz.cbClsExtra = 0; - clazz.cbWndExtra = 0; - clazz.hInstance = TclWinGetTclInstance(); - clazz.hbrBackground = NULL; - clazz.lpszMenuName = NULL; - clazz.lpszClassName = className; - clazz.lpfnWndProc = NotifierProc; - clazz.hIcon = NULL; - clazz.hCursor = NULL; - - if (!RegisterClassW(&clazz)) { - Tcl_Panic("Tcl_InitNotifier: %s", - "unable to register TclNotifier window class"); + class.style = 0; + class.cbClsExtra = 0; + class.cbWndExtra = 0; + class.hInstance = TclWinGetTclInstance(); + class.hbrBackground = NULL; + class.lpszMenuName = NULL; + class.lpszClassName = "TclNotifier"; + class.lpfnWndProc = NotifierProc; + class.hIcon = NULL; + class.hCursor = NULL; + + if (!RegisterClassA(&class)) { + Tcl_Panic("Unable to register TclNotifier window class"); } } notifierCount++; - LeaveCriticalSection(¬ifierMutex); + Tcl_MutexUnlock(¬ifierMutex); tsdPtr->pending = 0; tsdPtr->timerActive = 0; @@ -123,16 +116,16 @@ TclpInitNotifier(void) tsdPtr->hwnd = NULL; tsdPtr->thread = GetCurrentThreadId(); - tsdPtr->event = CreateEventW(NULL, TRUE /* manual */, + tsdPtr->event = CreateEvent(NULL, TRUE /* manual */, FALSE /* !signaled */, NULL); - return tsdPtr; + return (ClientData) tsdPtr; } /* *---------------------------------------------------------------------- * - * TclpFinalizeNotifier -- + * Tcl_FinalizeNotifier -- * * This function is called to cleanup the notifier state before a thread * is terminated. @@ -147,8 +140,8 @@ TclpInitNotifier(void) */ void -TclpFinalizeNotifier( - void *clientData) /* Pointer to notifier data. */ +Tcl_FinalizeNotifier( + ClientData clientData) /* Pointer to notifier data. */ { ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData; @@ -184,20 +177,18 @@ TclpFinalizeNotifier( * window class. */ - EnterCriticalSection(¬ifierMutex); - if (notifierCount) { - notifierCount--; - if (notifierCount == 0) { - UnregisterClassW(className, TclWinGetTclInstance()); - } + Tcl_MutexLock(¬ifierMutex); + notifierCount--; + if (notifierCount == 0) { + UnregisterClassA("TclNotifier", TclWinGetTclInstance()); } - LeaveCriticalSection(¬ifierMutex); + Tcl_MutexUnlock(¬ifierMutex); } /* *---------------------------------------------------------------------- * - * TclpAlertNotifier -- + * Tcl_AlertNotifier -- * * Wake up the specified notifier from any thread. This routine is called * by the platform independent notifier code whenever the Tcl_ThreadAlert @@ -217,8 +208,8 @@ TclpFinalizeNotifier( */ void -TclpAlertNotifier( - void *clientData) /* Pointer to thread data. */ +Tcl_AlertNotifier( + ClientData clientData) /* Pointer to thread data. */ { ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData; @@ -235,7 +226,7 @@ TclpAlertNotifier( EnterCriticalSection(&tsdPtr->crit); if (!tsdPtr->pending) { - PostMessageW(tsdPtr->hwnd, WM_WAKEUP, 0, 0); + PostMessage(tsdPtr->hwnd, WM_WAKEUP, 0, 0); } tsdPtr->pending = 1; LeaveCriticalSection(&tsdPtr->crit); @@ -247,7 +238,7 @@ TclpAlertNotifier( /* *---------------------------------------------------------------------- * - * TclpSetTimer -- + * Tcl_SetTimer -- * * This procedure sets the current notifier timer value. The notifier * will ensure that Tcl_ServiceAll() is called after the specified @@ -263,13 +254,23 @@ TclpAlertNotifier( */ void -TclpSetTimer( - const Tcl_Time *timePtr) /* Maximum block time, or NULL. */ +Tcl_SetTimer( + Tcl_Time *timePtr) /* Maximum block time, or NULL. */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); UINT timeout; /* + * Allow the notifier to be hooked. This may not make sense on Windows, + * but mirrors the UNIX hook. + */ + + if (tclStubs.tcl_SetTimer != tclOriginalNotifier.setTimerProc) { + tclStubs.tcl_SetTimer(timePtr); + return; + } + + /* * We only need to set up an interval timer if we're being called from an * external event loop. If we don't have a window handle then we just * return immediately and let Tcl_WaitForEvent handle timeouts. @@ -292,10 +293,11 @@ TclpSetTimer( timeout = 1; } } - + tsdPtr->timeout = timeout; if (timeout != 0) { tsdPtr->timerActive = 1; - SetTimer(tsdPtr->hwnd, INTERVAL_TIMER, timeout, NULL); + SetTimer(tsdPtr->hwnd, INTERVAL_TIMER, (unsigned long) tsdPtr->timeout, + NULL); } else { tsdPtr->timerActive = 0; KillTimer(tsdPtr->hwnd, INTERVAL_TIMER); @@ -305,7 +307,7 @@ TclpSetTimer( /* *---------------------------------------------------------------------- * - * TclpServiceModeHook -- + * Tcl_ServiceModeHook -- * * This function is invoked whenever the service mode changes. * @@ -320,7 +322,7 @@ TclpSetTimer( */ void -TclpServiceModeHook( +Tcl_ServiceModeHook( int mode) /* Either TCL_SERVICE_ALL, or * TCL_SERVICE_NONE. */ { @@ -336,7 +338,7 @@ TclpServiceModeHook( */ if (mode == TCL_SERVICE_ALL && !tsdPtr->hwnd) { - tsdPtr->hwnd = CreateWindowW(className, className, WS_TILED, + tsdPtr->hwnd = CreateWindowA("TclNotifier", "TclNotifier", WS_TILED, 0, 0, 0, 0, NULL, NULL, TclWinGetTclInstance(), NULL); /* @@ -346,39 +348,13 @@ TclpServiceModeHook( * is needed. */ - Tcl_AlertNotifier(tsdPtr); + Tcl_AlertNotifier((ClientData)tsdPtr); } } /* *---------------------------------------------------------------------- * - * TclAsyncNotifier -- - * - * This procedure is a no-op on Windows. - * - * Result: - * Always true. - * - * Side effetcs: - * None. - *---------------------------------------------------------------------- - */ - -int -TclAsyncNotifier( - TCL_UNUSED(int), /* Signal number. */ - TCL_UNUSED(Tcl_ThreadId), /* Target thread. */ - TCL_UNUSED(void *), /* Notifier data. */ - TCL_UNUSED(int *), /* Flag to mark. */ - TCL_UNUSED(int)) /* Value of mark. */ -{ - return 0; -} - -/* - *---------------------------------------------------------------------- - * * NotifierProc -- * * This procedure is invoked by Windows to process events on the notifier @@ -408,7 +384,7 @@ NotifierProc( tsdPtr->pending = 0; LeaveCriticalSection(&tsdPtr->crit); } else if (message != WM_TIMER) { - return DefWindowProcW(hwnd, message, wParam, lParam); + return DefWindowProc(hwnd, message, wParam, lParam); } /* @@ -422,30 +398,7 @@ NotifierProc( /* *---------------------------------------------------------------------- * - * TclpNotifierData -- - * - * This function returns a void pointer to be associated - * with a Tcl_AsyncHandler. - * - * Results: - * On Windows, returns always NULL. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -void * -TclpNotifierData(void) -{ - return NULL; -} - -/* - *---------------------------------------------------------------------- - * - * TclpWaitForEvent -- + * 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 @@ -462,8 +415,8 @@ TclpNotifierData(void) */ int -TclpWaitForEvent( - const Tcl_Time *timePtr) /* Maximum block time, or NULL. */ +Tcl_WaitForEvent( + Tcl_Time *timePtr) /* Maximum block time, or NULL. */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); MSG msg; @@ -471,6 +424,15 @@ TclpWaitForEvent( int status; /* + * Allow the notifier to be hooked. This may not make sense on windows, + * but mirrors the UNIX hook. + */ + + if (tclStubs.tcl_WaitForEvent != tclOriginalNotifier.waitForEventProc) { + return tclStubs.tcl_WaitForEvent(timePtr); + } + + /* * Compute the timeout in milliseconds. */ @@ -486,7 +448,7 @@ TclpWaitForEvent( myTime.usec = timePtr->usec; if (myTime.sec != 0 || myTime.usec != 0) { - TclScaleTime(&myTime); + (*tclScaleTimeProcPtr) (&myTime, tclTimeClientData); } timeout = myTime.sec * 1000 + myTime.usec / 1000; @@ -500,19 +462,19 @@ TclpWaitForEvent( * currently sitting in the queue. */ - if (!PeekMessageW(&msg, NULL, 0, 0, PM_NOREMOVE)) { + if (!PeekMessage(&msg, NULL, 0, 0, PM_NOREMOVE)) { /* * Wait for something to happen (a signal from another thread, a * message, or timeout) or loop servicing asynchronous procedure calls * queued to this thread. */ - do { - result = MsgWaitForMultipleObjectsEx(1, &tsdPtr->event, timeout, - QS_ALLINPUT, MWMO_ALERTABLE); - } while (result == WAIT_IO_COMPLETION); - - if (result == WAIT_FAILED) { + 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; } @@ -522,12 +484,12 @@ TclpWaitForEvent( * Check to see if there are any messages to process. */ - if (PeekMessageW(&msg, NULL, 0, 0, PM_NOREMOVE)) { + if (PeekMessage(&msg, NULL, 0, 0, PM_NOREMOVE)) { /* * Retrieve and dispatch the first message. */ - result = GetMessageW(&msg, NULL, 0, 0); + result = GetMessage(&msg, NULL, 0, 0); if (result == 0) { /* * We received a request to exit this thread (WM_QUIT), so @@ -536,7 +498,7 @@ TclpWaitForEvent( PostQuitMessage((int) msg.wParam); status = -1; - } else if (result == (DWORD) -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. @@ -545,7 +507,7 @@ TclpWaitForEvent( status = -1; } else { TranslateMessage(&msg); - DispatchMessageW(&msg); + DispatchMessage(&msg); status = 1; } } else { @@ -608,11 +570,11 @@ Tcl_Sleep( * TIP #233: Scale delay from virtual to real-time. */ - TclScaleTime(&vdelay); + (*tclScaleTimeProcPtr) (&vdelay, tclTimeClientData); sleepTime = vdelay.sec * 1000 + vdelay.usec / 1000; for (;;) { - SleepEx(sleepTime, TRUE); + Sleep(sleepTime); Tcl_GetTime(&now); if (now.sec > desired.sec) { break; @@ -623,7 +585,7 @@ Tcl_Sleep( vdelay.sec = desired.sec - now.sec; vdelay.usec = desired.usec - now.usec; - TclScaleTime(&vdelay); + (*tclScaleTimeProcPtr) (&vdelay, tclTimeClientData); sleepTime = vdelay.sec * 1000 + vdelay.usec / 1000; } } diff --git a/win/tclWinPanic.c b/win/tclWinPanic.c deleted file mode 100644 index 3131286..0000000 --- a/win/tclWinPanic.c +++ /dev/null @@ -1,88 +0,0 @@ -/* - * tclWinPanic.c -- - * - * Contains the Windows-specific command-line panic proc. - * - * Copyright © 2013 Jan Nijtmans. - * 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 "tclInt.h" -/* - *---------------------------------------------------------------------- - * - * Tcl_ConsolePanic -- - * - * Display a message. If a debugger is present, present it directly to - * the debugger, otherwise send it to stderr. - * - * Results: - * None. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -void -Tcl_ConsolePanic( - const char *format, ...) -{ -#define TCL_MAX_WARN_LEN 26000 - va_list argList; - WCHAR msgString[TCL_MAX_WARN_LEN]; - char buf[TCL_MAX_WARN_LEN * 3]; - HANDLE handle = GetStdHandle(STD_ERROR_HANDLE); - DWORD dummy; - - va_start(argList, format); - vsnprintf(buf+3, sizeof(buf)-3, format, argList); - buf[sizeof(buf)-1] = 0; - msgString[TCL_MAX_WARN_LEN-1] = '\0'; - MultiByteToWideChar(CP_UTF8, 0, buf+3, -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] != '\0') { - memcpy(msgString + (TCL_MAX_WARN_LEN - 5), L" ...", 5 * sizeof(WCHAR)); - } - - if (IsDebuggerPresent()) { - OutputDebugStringW(msgString); - } else if (_isatty(2)) { - WriteConsoleW(handle, msgString, (DWORD)wcslen(msgString), &dummy, 0); - } else { - buf[0] = '\xEF'; buf[1] = '\xBB'; buf[2] = '\xBF'; /* UTF-8 bom */ - WriteFile(handle, buf, (DWORD)strlen(buf), &dummy, 0); - WriteFile(handle, "\n", 1, &dummy, 0); - FlushFileBuffers(handle); - } -# if defined(__GNUC__) - __builtin_trap(); -# elif defined(_WIN64) - __debugbreak(); -# elif defined(_MSC_VER) - _asm {int 3} -# else - DebugBreak(); -# endif -#if defined(_WIN32) - ExitProcess(1); -#else - abort(); -#endif -} -/* - * Local Variables: - * mode: c - * c-basic-offset: 4 - * fill-column: 78 - * tab-width: 8 - * End: - */ diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c index bb4983e..ee088a5 100644 --- a/win/tclWinPipe.c +++ b/win/tclWinPipe.c @@ -4,7 +4,7 @@ * This file implements the Windows-specific exec pipeline functions, the * "pipe" channel driver, and the "pid" Tcl command. * - * Copyright © 1996-1997 Sun Microsystems, Inc. + * 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. @@ -50,7 +50,7 @@ TCL_DECLARE_MUTEX(pipeMutex) * used in a pipeline. */ -typedef struct { +typedef struct WinFile { int type; /* One of the file types defined above. */ HANDLE handle; /* Open file handle. */ } WinFile; @@ -61,7 +61,7 @@ typedef struct { typedef struct ProcInfo { HANDLE hProcess; - TCL_HASH_TYPE dwProcessId; + DWORD dwProcessId; struct ProcInfo *nextPtr; } ProcInfo; @@ -82,12 +82,6 @@ static ProcInfo *procList; #define PIPE_EXTRABYTE (1<<3) /* The reader thread has consumed one byte. */ /* - * TODO: It appears the whole EXTRABYTE machinery is in place to support - * outdated Win 95 systems. If this can be confirmed, much code can be - * deleted. - */ - -/* * This structure describes per-instance data for a pipe based channel. */ @@ -104,27 +98,35 @@ typedef struct PipeInfo { TclFile readFile; /* Output from pipe. */ TclFile writeFile; /* Input from pipe. */ TclFile errorFile; /* Error output from pipe. */ - TCL_HASH_TYPE numPids; /* Number of processes attached to 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. */ + HANDLE startWriter; /* Auto-reset event used by the main thread to + * signal when the writer thread should + * attempt to write to the pipe. */ + HANDLE stopWriter; /* Manual-reset event used to alert the reader + * thread to fall-out and exit */ + HANDLE startReader; /* Auto-reset event used by the main thread to + * signal when the reader thread should + * attempt to read from the pipe. */ + HANDLE stopReader; /* Manual-reset event used to alert the reader + * thread to fall-out and exit */ DWORD writeError; /* An error caused by the last background * write. Set to 0 if no error has been * detected. This word is shared with the * writer thread so access must be - * synchronized with the writable object. */ + * 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 @@ -140,7 +142,7 @@ typedef struct PipeInfo { * synchronized with the readable object. */ } PipeInfo; -typedef struct { +typedef struct ThreadSpecificData { /* * The following pointer refers to the head of the list of pipes that are * being watched for file events. @@ -156,7 +158,7 @@ static Tcl_ThreadDataKey dataKey; * events are generated. */ -typedef struct { +typedef struct PipeEvent { Tcl_Event header; /* Information that is standard for all * events. */ PipeInfo *infoPtr; /* Pointer to pipe info structure. Note that @@ -171,28 +173,28 @@ typedef struct { static int ApplicationType(Tcl_Interp *interp, const char *fileName, char *fullName); -static void BuildCommandLine(const char *executable, Tcl_Size argc, +static void BuildCommandLine(const char *executable, int argc, const char **argv, Tcl_DString *linePtr); static BOOL HasConsole(void); -static int PipeBlockModeProc(void *instanceData, int mode); -static void PipeCheckProc(void *clientData, int flags); -static int PipeClose2Proc(void *instanceData, +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(void *instanceData, - int direction, void **handlePtr); +static int PipeGetHandleProc(ClientData instanceData, + int direction, ClientData *handlePtr); static void PipeInit(void); -static int PipeInputProc(void *instanceData, char *buf, +static int PipeInputProc(ClientData instanceData, char *buf, int toRead, int *errorCode); -static int PipeOutputProc(void *instanceData, +static int PipeOutputProc(ClientData instanceData, const char *buf, int toWrite, int *errorCode); static DWORD WINAPI PipeReaderThread(LPVOID arg); -static void PipeSetupProc(void *clientData, int flags); -static void PipeWatchProc(void *instanceData, int mask); +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(void *instanceData, +static void PipeThreadActionProc(ClientData instanceData, int action); /* @@ -200,7 +202,7 @@ static void PipeThreadActionProc(void *instanceData, * I/O. */ -static const Tcl_ChannelType pipeChannelType = { +static Tcl_ChannelType pipeChannelType = { "pipe", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ TCL_CLOSE2PROC, /* Close proc. */ @@ -217,7 +219,7 @@ static const Tcl_ChannelType pipeChannelType = { NULL, /* handler proc. */ NULL, /* wide seek proc */ PipeThreadActionProc, /* thread action proc */ - NULL /* truncate */ + NULL, /* truncate */ }; /* @@ -310,7 +312,7 @@ TclpFinalizePipes(void) void PipeSetupProc( - TCL_UNUSED(void *), + ClientData data, /* Not used. */ int flags) /* Event flags as passed to Tcl_DoOneEvent. */ { PipeInfo *infoPtr; @@ -363,7 +365,7 @@ PipeSetupProc( static void PipeCheckProc( - TCL_UNUSED(void *), + ClientData data, /* Not used. */ int flags) /* Event flags as passed to Tcl_DoOneEvent. */ { PipeInfo *infoPtr; @@ -402,7 +404,7 @@ PipeCheckProc( if (needEvent) { infoPtr->flags |= PIPE_PENDING; - evPtr = (PipeEvent *)ckalloc(sizeof(PipeEvent)); + evPtr = (PipeEvent *) ckalloc(sizeof(PipeEvent)); evPtr->header.proc = PipeEventProc; evPtr->infoPtr = infoPtr; Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL); @@ -433,7 +435,7 @@ TclWinMakeFile( { WinFile *filePtr; - filePtr = (WinFile *)ckalloc(sizeof(WinFile)); + filePtr = (WinFile *) ckalloc(sizeof(WinFile)); filePtr->type = WIN_FILE; filePtr->handle = handle; @@ -465,15 +467,24 @@ 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) { + TCHAR *prefix; + + prefix = (tclWinProcs->useWide) ? (TCHAR *) L"TCL" : (TCHAR *) "TCL"; + if ((*tclWinProcs->getTempPathProc)(MAX_PATH, name) != 0) { + if ((*tclWinProcs->getTempFileNameProc)((TCHAR *) name, prefix, 0, + name) != 0) { return 1; } } - name[0] = '.'; - name[1] = '\0'; - return GetTempFileNameW(name, prefix, 0, name); + if (tclWinProcs->useWide) { + ((WCHAR *) name)[0] = '.'; + ((WCHAR *) name)[1] = '\0'; + } else { + ((char *) name)[0] = '.'; + ((char *) name)[1] = '\0'; + } + return (*tclWinProcs->getTempFileNameProc)((TCHAR *) name, prefix, 0, + name); } /* @@ -500,7 +511,7 @@ TclpMakeFile( HANDLE handle; if (Tcl_GetChannelHandle(channel, direction, - (void **) &handle) == TCL_OK) { + (ClientData *) &handle) == TCL_OK) { return TclWinMakeFile(handle); } else { return (TclFile) NULL; @@ -532,7 +543,7 @@ TclpOpenFile( HANDLE handle; DWORD accessMode, createMode, shareMode, flags; Tcl_DString ds; - const WCHAR *nativePath; + const TCHAR *nativePath; /* * Map the access bits to the NT access mode. @@ -549,7 +560,7 @@ TclpOpenFile( accessMode = (GENERIC_READ | GENERIC_WRITE); break; default: - Tcl_WinConvertError(ERROR_INVALID_FUNCTION); + TclWinConvertError(ERROR_INVALID_FUNCTION); return NULL; } @@ -577,8 +588,7 @@ TclpOpenFile( break; } - Tcl_DStringInit(&ds); - nativePath = Tcl_UtfToWCharDString(path, TCL_INDEX_NONE, &ds); + nativePath = Tcl_WinUtfToTChar(path, -1, &ds); /* * If the file is not being created, use the existing file attributes. @@ -586,7 +596,7 @@ TclpOpenFile( flags = 0; if (!(mode & O_CREAT)) { - flags = GetFileAttributesW(nativePath); + flags = (*tclWinProcs->getFileAttributesProc)(nativePath); if (flags == 0xFFFFFFFF) { flags = 0; } @@ -602,18 +612,18 @@ TclpOpenFile( * Now we get to create the file. */ - handle = CreateFileW(nativePath, accessMode, shareMode, - NULL, createMode, flags, NULL); + handle = (*tclWinProcs->createFileProc)(nativePath, accessMode, + shareMode, NULL, createMode, flags, NULL); Tcl_DStringFree(&ds); if (handle == INVALID_HANDLE_VALUE) { DWORD err; err = GetLastError(); - if ((err & 0xFFFFL) == ERROR_OPEN_FAILED) { + if ((err & 0xffffL) == ERROR_OPEN_FAILED) { err = (mode & O_CREAT) ? ERROR_FILE_EXISTS : ERROR_FILE_NOT_FOUND; } - Tcl_WinConvertError(err); + TclWinConvertError(err); return NULL; } @@ -659,7 +669,7 @@ TclpCreateTempFile( return NULL; } - handle = CreateFileW(name, + handle = (*tclWinProcs->createFileProc)((TCHAR *) name, GENERIC_READ | GENERIC_WRITE, 0, NULL, CREATE_ALWAYS, FILE_ATTRIBUTE_TEMPORARY|FILE_FLAG_DELETE_ON_CLOSE, NULL); if (handle == INVALID_HANDLE_VALUE) { @@ -679,7 +689,7 @@ TclpCreateTempFile( * Convert the contents from UTF to native encoding */ - native = Tcl_UtfToExternalDString(NULL, contents, TCL_INDEX_NONE, &dstring); + native = Tcl_UtfToExternalDString(NULL, contents, -1, &dstring); toCopy = Tcl_DStringLength(&dstring); for (p = native; toCopy > 0; p++, toCopy--) { @@ -719,9 +729,9 @@ TclpCreateTempFile( Tcl_DStringFree(&dstring); } - Tcl_WinConvertError(GetLastError()); + TclWinConvertError(GetLastError()); CloseHandle(handle); - DeleteFileW(name); + (*tclWinProcs->deleteFileProc)((TCHAR *) name); return NULL; } @@ -750,7 +760,7 @@ TclpTempFileName(void) return NULL; } - return TclpNativeToNormalized(fileName); + return TclpNativeToNormalized((ClientData) fileName); } /* @@ -784,7 +794,7 @@ TclpCreatePipe( return 1; } - Tcl_WinConvertError(GetLastError()); + TclWinConvertError(GetLastError()); return 0; } @@ -825,8 +835,8 @@ TclpCloseFile( && (GetStdHandle(STD_ERROR_HANDLE) != filePtr->handle))) { if (filePtr->handle != NULL && CloseHandle(filePtr->handle) == FALSE) { - Tcl_WinConvertError(GetLastError()); - ckfree(filePtr); + TclWinConvertError(GetLastError()); + ckfree((char *) filePtr); return -1; } } @@ -836,7 +846,7 @@ TclpCloseFile( Tcl_Panic("TclpCloseFile: unexpected file type"); } - ckfree(filePtr); + ckfree((char *) filePtr); return 0; } @@ -851,7 +861,7 @@ TclpCloseFile( * 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, TCL_INDEX_NONE is returned. + * process has already been reaped, -1 is returned. * * Side effects: * None. @@ -859,7 +869,7 @@ TclpCloseFile( *-------------------------------------------------------------------------- */ -Tcl_Size +int TclpGetPid( Tcl_Pid pid) /* The HANDLE of the child process. */ { @@ -869,13 +879,13 @@ TclpGetPid( Tcl_MutexLock(&pipeMutex); for (infoPtr = procList; infoPtr != NULL; infoPtr = infoPtr->nextPtr) { - if (infoPtr->dwProcessId == PTR2UINT(pid)) { + if (infoPtr->hProcess == (HANDLE) pid) { Tcl_MutexUnlock(&pipeMutex); return infoPtr->dwProcessId; } } Tcl_MutexUnlock(&pipeMutex); - return TCL_INDEX_NONE; + return (unsigned long) -1; } /* @@ -890,7 +900,7 @@ TclpGetPid( * * 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 + * automatically tries appending ".com", ".exe", and ".bat" to the * executable name. * * Results: @@ -911,7 +921,7 @@ TclpCreateProcess( * occurred when creating the child process. * Error messages from the child process * itself are sent to errorFile. */ - Tcl_Size argc, /* Number of arguments in following array. */ + 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 @@ -923,12 +933,12 @@ TclpCreateProcess( * receive no standard input. */ TclFile outputFile, /* If non-NULL, gives the file that receives * output from the child process. If - * outputFile file is not writable or is + * 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 writable or is NULL, errors + * 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 @@ -936,12 +946,12 @@ TclpCreateProcess( * process. */ { int result, applType, createFlags; - Tcl_DString cmdLine; /* Complete command line (WCHAR). */ - STARTUPINFOW startInfo; + Tcl_DString cmdLine; /* Complete command line (TCHAR). */ + STARTUPINFOA startInfo; PROCESS_INFORMATION procInfo; SECURITY_ATTRIBUTES secAtts; HANDLE hProcess, h, inputHandle, outputHandle, errorHandle; - char execPath[MAX_PATH * 3]; + char execPath[MAX_PATH * TCL_UTF_MAX]; WinFile *filePtr; PipeInit(); @@ -1026,10 +1036,9 @@ TclpCreateProcess( 0, TRUE, DUPLICATE_SAME_ACCESS); } if (startInfo.hStdInput == INVALID_HANDLE_VALUE) { - Tcl_WinConvertError(GetLastError()); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "couldn't duplicate input handle: %s", - Tcl_PosixError(interp))); + TclWinConvertError(GetLastError()); + Tcl_AppendResult(interp, "couldn't duplicate input handle: ", + Tcl_PosixError(interp), (char *) NULL); goto end; } @@ -1048,17 +1057,23 @@ TclpCreateProcess( * sink. */ - startInfo.hStdOutput = CreateFileW(L"NUL:", GENERIC_WRITE, 0, - &secAtts, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, NULL); + if ((TclWinGetPlatformId() == VER_PLATFORM_WIN32_WINDOWS) + && (applType == APPL_DOS)) { + if (CreatePipe(&h, &startInfo.hStdOutput, &secAtts, 0) != FALSE) { + CloseHandle(h); + } + } else { + startInfo.hStdOutput = CreateFileA("NUL:", GENERIC_WRITE, 0, + &secAtts, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, NULL); + } } else { DuplicateHandle(hProcess, outputHandle, hProcess, &startInfo.hStdOutput, 0, TRUE, DUPLICATE_SAME_ACCESS); } if (startInfo.hStdOutput == INVALID_HANDLE_VALUE) { - Tcl_WinConvertError(GetLastError()); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "couldn't duplicate output handle: %s", - Tcl_PosixError(interp))); + TclWinConvertError(GetLastError()); + Tcl_AppendResult(interp, "couldn't duplicate output handle: ", + Tcl_PosixError(interp), (char *) NULL); goto end; } @@ -1068,17 +1083,16 @@ TclpCreateProcess( * sink. */ - startInfo.hStdError = CreateFileW(L"NUL:", GENERIC_WRITE, 0, + startInfo.hStdError = CreateFileA("NUL:", GENERIC_WRITE, 0, &secAtts, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL); } else { DuplicateHandle(hProcess, errorHandle, hProcess, &startInfo.hStdError, 0, TRUE, DUPLICATE_SAME_ACCESS); } if (startInfo.hStdError == INVALID_HANDLE_VALUE) { - Tcl_WinConvertError(GetLastError()); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "couldn't duplicate error handle: %s", - Tcl_PosixError(interp))); + TclWinConvertError(GetLastError()); + Tcl_AppendResult(interp, "couldn't duplicate error handle: ", + Tcl_PosixError(interp), (char *) NULL); goto end; } @@ -1095,23 +1109,110 @@ TclpCreateProcess( * detached processes. The GUI window will still pop up to the foreground. */ - 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. - */ + 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"); + startInfo.wShowWindow = SW_HIDE; + startInfo.dwFlags |= STARTF_USESHOWWINDOW; + createFlags = CREATE_NEW_CONSOLE; + Tcl_DStringAppend(&cmdLine, "cmd.exe /c", -1); + } else { + createFlags = DETACHED_PROCESS; + } } else { - createFlags = DETACHED_PROCESS; + if (HasConsole()) { + createFlags = 0; + } else { + createFlags = DETACHED_PROCESS; + } + + if (applType == APPL_DOS) { + /* + * Under Windows 95, 16-bit DOS applications do not work well with + * pipes: + * + * 1. EOF on a pipe between a detached 16-bit DOS application and + * another application is not seen at the other end of the pipe, + * so the listening process blocks forever on reads. This inablity + * to detect EOF happens when either a 16-bit app or the 32-bit + * app is the listener. + * + * 2. If a 16-bit DOS application (detached or not) blocks when + * writing to a pipe, it will never wake up again, and it + * eventually brings the whole system down around it. + * + * The 16-bit application is run as a normal process inside of a + * hidden helper console app, and this helper may be run as a + * detached process. If any of the stdio handles is a pipe, the + * helper application accumulates information into temp files and + * forwards it to or from the DOS application as appropriate. + * This means that DOS apps must receive EOF from a stdin pipe + * before they will actually begin, and must finish generating + * stdout or stderr before the data will be sent to the next stage + * of the pipe. + * + * The helper app should be located in the same directory as the + * tcl dll. + */ + Tcl_Obj *tclExePtr, *pipeDllPtr; + char *start, *end; + int i, fileExists; + Tcl_DString pipeDll; + + if (createFlags != 0) { + startInfo.wShowWindow = SW_HIDE; + startInfo.dwFlags |= STARTF_USESHOWWINDOW; + createFlags = CREATE_NEW_CONSOLE; + } + + Tcl_DStringInit(&pipeDll); + Tcl_DStringAppend(&pipeDll, TCL_PIPE_DLL, -1); + tclExePtr = TclGetObjNameOfExecutable(); + Tcl_IncrRefCount(tclExePtr); + start = Tcl_GetStringFromObj(tclExePtr, &i); + for (end = start + (i-1); end > start; end--) { + if (*end == '/') { + break; + } + } + if (*end != '/') { + Tcl_AppendResult(interp, "no / in executable path name \"", + start, "\"", (char *) NULL); + Tcl_DecrRefCount(tclExePtr); + Tcl_DStringFree(&pipeDll); + goto end; + } + i = (end - start) + 1; + pipeDllPtr = Tcl_NewStringObj(start, i); + Tcl_AppendToObj(pipeDllPtr, Tcl_DStringValue(&pipeDll), -1); + Tcl_IncrRefCount(pipeDllPtr); + if (Tcl_FSConvertToPathType(interp, pipeDllPtr) != TCL_OK) { + Tcl_Panic("Tcl_FSConvertToPathType failed"); + } + fileExists = (Tcl_FSAccess(pipeDllPtr, F_OK) == 0); + if (!fileExists) { + Tcl_AppendResult(interp, "Tcl pipe dll \"", + Tcl_DStringValue(&pipeDll), "\" not found", + (char *) NULL); + Tcl_DecrRefCount(tclExePtr); + Tcl_DecrRefCount(pipeDllPtr); + Tcl_DStringFree(&pipeDll); + goto end; + } + Tcl_DStringAppend(&cmdLine, Tcl_DStringValue(&pipeDll), -1); + Tcl_DecrRefCount(tclExePtr); + Tcl_DecrRefCount(pipeDllPtr); + Tcl_DStringFree(&pipeDll); + } } /* @@ -1134,12 +1235,12 @@ TclpCreateProcess( BuildCommandLine(execPath, argc, argv, &cmdLine); - if (CreateProcessW(NULL, (WCHAR *) Tcl_DStringValue(&cmdLine), - NULL, NULL, TRUE, (DWORD) createFlags, NULL, NULL, &startInfo, - &procInfo) == 0) { - Tcl_WinConvertError(GetLastError()); - Tcl_SetObjResult(interp, Tcl_ObjPrintf("couldn't execute \"%s\": %s", - argv[0], Tcl_PosixError(interp))); + if ((*tclWinProcs->createProcessProc)(NULL, + (TCHAR *) Tcl_DStringValue(&cmdLine), NULL, NULL, TRUE, + (DWORD) createFlags, NULL, NULL, &startInfo, &procInfo) == 0) { + TclWinConvertError(GetLastError()); + Tcl_AppendResult(interp, "couldn't execute \"", argv[0], + "\": ", Tcl_PosixError(interp), (char *) NULL); goto end; } @@ -1156,14 +1257,14 @@ TclpCreateProcess( * 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 - * CreateProcessW() and CloseHandle(), the problem does not occur." PSS ID + * CreateProcess() and CloseHandle(), the problem does not occur." PSS ID * Number: Q124121 */ WaitForInputIdle(procInfo.hProcess, 5000); CloseHandle(procInfo.hThread); - *pidPtr = (Tcl_Pid)INT2PTR(procInfo.dwProcessId); + *pidPtr = (Tcl_Pid) procInfo.hProcess; if (*pidPtr != 0) { TclWinAddProcess(procInfo.hProcess, procInfo.dwProcessId); } @@ -1205,7 +1306,7 @@ HasConsole(void) { HANDLE handle; - handle = CreateFileW(L"CONOUT$", GENERIC_WRITE, FILE_SHARE_WRITE, + handle = CreateFileA("CONOUT$", GENERIC_WRITE, FILE_SHARE_WRITE, NULL, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL); if (handle != INVALID_HANDLE_VALUE) { @@ -1260,22 +1361,22 @@ ApplicationType( { int applType, i, nameLen, found; HANDLE hFile; - WCHAR *rest; + TCHAR *rest; char *ext; char buf[2]; DWORD attr, read; IMAGE_DOS_HEADER header; Tcl_DString nameBuf, ds; - const WCHAR *nativeName; + const TCHAR *nativeName; WCHAR nativeFullPath[MAX_PATH]; - static const char extensions[][5] = {"", ".com", ".exe", ".bat", ".cmd"}; + static const char extensions[][5] = {"", ".com", ".exe", ".bat"}; /* * Look for the program as an external program. First try the name as it - * is, then try adding .com, .exe, .bat and .cmd, in that order, to the name, + * is, then try adding .com, .exe, and .bat, in that order, to the name, * looking for an executable. * - * Using the raw SearchPathW() function doesn't do quite what is necessary. + * Using the raw SearchPath() function doesn't do quite what is necessary. * If the name of the executable already contains a '.' character, it will * not try appending the specified extension when searching (in other * words, SearchPath will not find the program "a.b.exe" if the arguments @@ -1285,17 +1386,16 @@ ApplicationType( applType = APPL_NONE; Tcl_DStringInit(&nameBuf); - Tcl_DStringAppend(&nameBuf, originalName, TCL_INDEX_NONE); + 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], TCL_INDEX_NONE); - Tcl_DStringInit(&ds); - nativeName = Tcl_UtfToWCharDString(Tcl_DStringValue(&nameBuf), + Tcl_DStringAppend(&nameBuf, extensions[i], -1); + nativeName = Tcl_WinUtfToTChar(Tcl_DStringValue(&nameBuf), Tcl_DStringLength(&nameBuf), &ds); - found = SearchPathW(NULL, nativeName, NULL, MAX_PATH, - nativeFullPath, &rest); + found = (*tclWinProcs->searchPathProc)(NULL, nativeName, NULL, + MAX_PATH, nativeFullPath, &rest); Tcl_DStringFree(&ds); if (found == 0) { continue; @@ -1306,22 +1406,20 @@ ApplicationType( * known type. */ - attr = GetFileAttributesW(nativeFullPath); - if ((attr == 0xFFFFFFFF) || (attr & FILE_ATTRIBUTE_DIRECTORY)) { + attr = (*tclWinProcs->getFileAttributesProc)((TCHAR *) nativeFullPath); + if ((attr == 0xffffffff) || (attr & FILE_ATTRIBUTE_DIRECTORY)) { continue; } - Tcl_DStringInit(&ds); - strcpy(fullName, Tcl_WCharToUtfDString(nativeFullPath, TCL_INDEX_NONE, &ds)); + 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)) { + if ((ext != NULL) && (strcasecmp(ext, ".bat") == 0)) { applType = APPL_DOS; break; } - hFile = CreateFileW(nativeFullPath, + hFile = (*tclWinProcs->createFileProc)((TCHAR *) nativeFullPath, GENERIC_READ, FILE_SHARE_READ, NULL, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL); if (hFile == INVALID_HANDLE_VALUE) { @@ -1387,13 +1485,13 @@ ApplicationType( Tcl_DStringFree(&nameBuf); if (applType == APPL_NONE) { - Tcl_WinConvertError(GetLastError()); - Tcl_SetObjResult(interp, Tcl_ObjPrintf("couldn't execute \"%s\": %s", - originalName, Tcl_PosixError(interp))); + TclWinConvertError(GetLastError()); + Tcl_AppendResult(interp, "couldn't execute \"", originalName, + "\": ", Tcl_PosixError(interp), (char *) NULL); return APPL_NONE; } - if (applType == APPL_WIN3X) { + if ((applType == APPL_DOS) || (applType == APPL_WIN3X)) { /* * Replace long path name of executable with short path name for * 16-bit applications. Otherwise the application may not be able to @@ -1401,9 +1499,9 @@ ApplicationType( * application name from the arguments. */ - GetShortPathNameW(nativeFullPath, nativeFullPath, MAX_PATH); - Tcl_DStringInit(&ds); - strcpy(fullName, Tcl_WCharToUtfDString(nativeFullPath, TCL_INDEX_NONE, &ds)); + (*tclWinProcs->getShortPathNameProc)((TCHAR *) nativeFullPath, + nativeFullPath, MAX_PATH); + strcpy(fullName, Tcl_WinTCharToUtf((TCHAR *) nativeFullPath, -1, &ds)); Tcl_DStringFree(&ds); } return applType; @@ -1415,7 +1513,7 @@ ApplicationType( * BuildCommandLine -- * * The command line arguments are stored in linePtr separated by spaces, - * in a form that CreateProcessW() understands. Special characters in + * in a form that CreateProcess() understands. Special characters in * individual arguments from argv[] must be quoted when being stored in * cmdLine. * @@ -1428,144 +1526,18 @@ ApplicationType( *---------------------------------------------------------------------- */ -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]. */ - Tcl_Size argc, /* Number of arguments. */ + int argc, /* Number of arguments. */ const char **argv, /* Argument strings in UTF. */ Tcl_DString *linePtr) /* Initialized Tcl_DString that receives the - * command line (WCHAR). */ + * command line (TCHAR). */ { - const char *arg, *start, *special, *bspos; - int quote = 0; - Tcl_Size i; + const char *arg, *start, *special; + int quote, i; Tcl_DString ds; -#ifdef TCL_WIN_PIPE_FULLESC - /* full escape inclusive %-subst avoidance */ - 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). */ -#else - /* escape considering quotation only (no %-subst avoidance) */ - static const char specMetaChars[] = "&|^<>!()"; - /* Characters to enclose in quotes if unpaired - * quote flag set. */ -#endif - /* - * 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); @@ -1573,9 +1545,9 @@ BuildCommandLine( * Prime the path. Add a space separator if we were primed with something. */ - TclDStringAppendDString(&ds, linePtr); + Tcl_DStringAppend(&ds, Tcl_DStringValue(linePtr), -1); if (Tcl_DStringLength(linePtr) > 0) { - TclDStringAppendLiteral(&ds, " "); + Tcl_DStringAppend(&ds, " ", 1); } for (i = 0; i < argc; i++) { @@ -1583,166 +1555,68 @@ BuildCommandLine( arg = executable; } else { arg = argv[i]; - TclDStringAppendLiteral(&ds, " "); + Tcl_DStringAppend(&ds, " ", 1); } - quote &= ~(CL_ESCAPE|CL_QUOTE); /* reset escape flags */ - bspos = NULL; + quote = 0; if (arg[0] == '\0') { - quote = CL_QUOTE; + quote = 1; } 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 */ + int count; + Tcl_UniChar ch; + for (start = arg; *start != '\0'; start += count) { + count = Tcl_UtfToUniChar(start, &ch); + if (Tcl_UniCharIsSpace(ch)) { /* INTL: ISO space. */ + quote = 1; 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, TCL_INDEX_NONE); - } 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) - */ + if (quote) { + Tcl_DStringAppend(&ds, "\"", 1); + } + start = arg; + for (special = arg; ; ) { + if ((*special == '\\') && (special[1] == '\\' || + special[1] == '"' || (quote && special[1] == '\0'))) { + Tcl_DStringAppend(&ds, start, (int) (special - start)); + start = special; + while (1) { + special++; + if (*special == '"' || (quote && *special == '\0')) { + /* + * N backslashes followed a quote -> insert N * 2 + 1 + * backslashes then a quote. + */ - special = BuildCmdLineBypassBS(special, &bspos); - if (*special == '\0') { + Tcl_DStringAppend(&ds, start, + (int) (special - start)); + break; + } + if (*special != '\\') { 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; - } -#ifdef TCL_WIN_PIPE_FULLESC - /* - * 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; - } -#endif - - /* - * Other not special (and not meta) character - */ - - bspos = NULL; /* reset last backslash position (not - * interesting) */ - special++; + Tcl_DStringAppend(&ds, start, (int) (special - start)); + start = special; } - - /* - * Rest of argument (and escape backslashes before closing main - * quote) - */ - - QuoteCmdLineBackslash(&ds, start, special, - (quote & CL_QUOTE) ? bspos : NULL); + if (*special == '"') { + Tcl_DStringAppend(&ds, start, (int) (special - start)); + Tcl_DStringAppend(&ds, "\\\"", 2); + start = special + 1; + } + if (*special == '\0') { + break; + } + special++; } - if (quote & CL_QUOTE) { - /* - * End of argument (main closing quote-char) - */ - - TclDStringAppendLiteral(&ds, "\""); + Tcl_DStringAppend(&ds, start, (int) (special - start)); + if (quote) { + Tcl_DStringAppend(&ds, "\"", 1); } } Tcl_DStringFree(linePtr); - Tcl_DStringInit(linePtr); - Tcl_UtfToWCharDString(Tcl_DStringValue(&ds), Tcl_DStringLength(&ds), linePtr); + Tcl_WinUtfToTChar(Tcl_DStringValue(&ds), Tcl_DStringLength(&ds), linePtr); Tcl_DStringFree(&ds); } @@ -1769,11 +1643,12 @@ TclpCreateCommandChannel( TclFile writeFile, /* If non-null, gives the file for writing. */ TclFile errorFile, /* If non-null, gives the file where errors * can be read. */ - Tcl_Size numPids, /* The number of pids in the pid array. */ + 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 = (PipeInfo *)ckalloc(sizeof(PipeInfo)); + DWORD id; + PipeInfo *infoPtr = (PipeInfo *) ckalloc((unsigned) sizeof(PipeInfo)); PipeInit(); @@ -1788,7 +1663,7 @@ TclpCreateCommandChannel( infoPtr->writeBuf = 0; infoPtr->writeBufLen = 0; infoPtr->writeError = 0; - infoPtr->channel = NULL; + infoPtr->channel = (Tcl_Channel) NULL; infoPtr->validMask = 0; @@ -1799,14 +1674,14 @@ TclpCreateCommandChannel( * Start the background reader thread. */ - infoPtr->readable = CreateEventW(NULL, TRUE, TRUE, NULL); + infoPtr->readable = CreateEvent(NULL, TRUE, TRUE, NULL); + infoPtr->startReader = CreateEvent(NULL, FALSE, FALSE, NULL); + infoPtr->stopReader = CreateEvent(NULL, TRUE, FALSE, NULL); infoPtr->readThread = CreateThread(NULL, 256, PipeReaderThread, - TclPipeThreadCreateTI(&infoPtr->readTI, infoPtr, infoPtr->readable), - 0, NULL); + infoPtr, 0, &id); SetThreadPriority(infoPtr->readThread, THREAD_PRIORITY_HIGHEST); infoPtr->validMask |= TCL_READABLE; } else { - infoPtr->readTI = NULL; infoPtr->readThread = 0; } if (writeFile != NULL) { @@ -1814,15 +1689,13 @@ TclpCreateCommandChannel( * Start the background writer thread. */ - infoPtr->writable = CreateEventW(NULL, TRUE, TRUE, NULL); + infoPtr->writable = CreateEvent(NULL, TRUE, TRUE, NULL); + infoPtr->startWriter = CreateEvent(NULL, FALSE, FALSE, NULL); + infoPtr->stopWriter = CreateEvent(NULL, TRUE, FALSE, NULL); infoPtr->writeThread = CreateThread(NULL, 256, PipeWriterThread, - TclPipeThreadCreateTI(&infoPtr->writeTI, infoPtr, infoPtr->writable), - 0, NULL); - SetThreadPriority(infoPtr->writeThread, THREAD_PRIORITY_HIGHEST); + infoPtr, 0, &id); + SetThreadPriority(infoPtr->readThread, THREAD_PRIORITY_HIGHEST); infoPtr->validMask |= TCL_WRITABLE; - } else { - infoPtr->writeTI = NULL; - infoPtr->writeThread = 0; } /* @@ -1832,9 +1705,9 @@ TclpCreateCommandChannel( * unique, in case channels share handles (stdin/stdout). */ - TclWinGenerateChannelName(channelName, "file", infoPtr); + sprintf(channelName, "file%" TCL_I_MODIFIER "x", (size_t)infoPtr); infoPtr->channel = Tcl_CreateChannel(&pipeChannelType, channelName, - infoPtr, infoPtr->validMask); + (ClientData) infoPtr, infoPtr->validMask); /* * Pipes have AUTO translation mode on Windows and ^Z eof char, which @@ -1842,58 +1715,16 @@ TclpCreateCommandChannel( * Windows programs that expect a ^Z at EOF. */ - Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto"); - Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "\x1A {}"); + Tcl_SetChannelOption((Tcl_Interp *) NULL, infoPtr->channel, + "-translation", "auto"); + Tcl_SetChannelOption((Tcl_Interp *) NULL, infoPtr->channel, + "-eofchar", "\032 {}"); return infoPtr->channel; } /* *---------------------------------------------------------------------- * - * Tcl_CreatePipe -- - * - * System dependent interface to create a pipe for the [chan pipe] - * command. Stolen from TclX. - * - * Results: - * TCL_OK or TCL_ERROR. - * - *---------------------------------------------------------------------- - */ - -int -Tcl_CreatePipe( - Tcl_Interp *interp, /* Errors returned in result.*/ - Tcl_Channel *rchan, /* Where to return the read side. */ - Tcl_Channel *wchan, /* Where to return the write side. */ - TCL_UNUSED(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)) { - Tcl_WinConvertError(GetLastError()); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "pipe creation failed: %s", Tcl_PosixError(interp))); - return TCL_ERROR; - } - - *rchan = Tcl_MakeFileChannel((void *) readHandle, TCL_READABLE); - Tcl_RegisterChannel(interp, *rchan); - - *wchan = Tcl_MakeFileChannel((void *) writeHandle, TCL_WRITABLE); - Tcl_RegisterChannel(interp, *wchan); - - return TCL_OK; -} - -/* - *---------------------------------------------------------------------- - * * TclGetAndDetachPids -- * * Stores a list of the command PIDs for a command channel in the @@ -1915,8 +1746,8 @@ TclGetAndDetachPids( { PipeInfo *pipePtr; const Tcl_ChannelType *chanTypePtr; - Tcl_Obj *pidsObj, *elemPtr; - TCL_HASH_TYPE i; + int i; + char buf[TCL_INTEGER_SPACE]; /* * Punt if the channel is not a command channel. @@ -1927,16 +1758,14 @@ TclGetAndDetachPids( return; } - pipePtr = (PipeInfo *)Tcl_GetChannelInstanceData(chan); - TclNewObj(pidsObj); + pipePtr = (PipeInfo *) Tcl_GetChannelInstanceData(chan); for (i = 0; i < pipePtr->numPids; i++) { - TclNewIntObj(elemPtr, TclpGetPid(pipePtr->pidPtr[i])); - Tcl_ListObjAppendElement(NULL, pidsObj, elemPtr); - Tcl_DetachPids(1, &pipePtr->pidPtr[i]); + wsprintfA(buf, "%lu", TclpGetPid(pipePtr->pidPtr[i])); + Tcl_AppendElement(interp, buf); + Tcl_DetachPids(1, &(pipePtr->pidPtr[i])); } - Tcl_SetObjResult(interp, pidsObj); if (pipePtr->numPids > 0) { - ckfree(pipePtr->pidPtr); + ckfree((char *) pipePtr->pidPtr); pipePtr->numPids = 0; } } @@ -1959,7 +1788,7 @@ TclGetAndDetachPids( static int PipeBlockModeProc( - void *instanceData, /* Instance data for channel. */ + ClientData instanceData, /* Instance data for channel. */ int mode) /* TCL_MODE_BLOCKING or * TCL_MODE_NONBLOCKING. */ { @@ -1998,7 +1827,7 @@ PipeBlockModeProc( static int PipeClose2Proc( - void *instanceData, /* Pointer to PipeInfo structure. */ + ClientData instanceData, /* Pointer to PipeInfo structure. */ Tcl_Interp *interp, /* For error reporting. */ int flags) /* Flags that indicate which side to close. */ { @@ -2007,12 +1836,12 @@ PipeClose2Proc( int errorCode, result; PipeInfo *infoPtr, **nextPtrPtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - int inExit = (TclInExit() || TclInThreadExit()); + DWORD exitCode; errorCode = 0; result = 0; - if ((!flags || flags & TCL_CLOSE_READ) && (pipePtr->readFile != NULL)) { + 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 @@ -2020,10 +1849,55 @@ PipeClose2Proc( */ if (pipePtr->readThread) { + /* + * The thread may already have closed on its own. Check its exit + * code. + */ + + GetExitCodeThread(pipePtr->readThread, &exitCode); + + if (exitCode == STILL_ACTIVE) { + /* + * Set the stop event so that if the reader thread is blocked + * in PipeReaderThread on WaitForMultipleEvents, it will exit + * cleanly. + */ + + SetEvent(pipePtr->stopReader); + + /* + * Wait at most 20 milliseconds for the reader thread to + * close. + */ + + if (WaitForSingleObject(pipePtr->readThread, + 20) == WAIT_TIMEOUT) { + /* + * The thread must be blocked waiting for the pipe to + * become readable in ReadFile(). There isn't a clean way + * to exit the thread from this condition. We should + * 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. + */ + + Tcl_MutexLock(&pipeMutex); + + /* BUG: this leaks memory */ + TerminateThread(pipePtr->readThread, 0); + Tcl_MutexUnlock(&pipeMutex); + } + } - TclPipeThreadStop(&pipePtr->readTI, pipePtr->readThread); CloseHandle(pipePtr->readThread); CloseHandle(pipePtr->readable); + CloseHandle(pipePtr->startReader); + CloseHandle(pipePtr->stopReader); pipePtr->readThread = NULL; } if (TclpCloseFile(pipePtr->readFile) != 0) { @@ -2032,34 +1906,66 @@ PipeClose2Proc( pipePtr->validMask &= ~TCL_READABLE; pipePtr->readFile = NULL; } - if ((!flags || flags & TCL_CLOSE_WRITE) && (pipePtr->writeFile != NULL)) { + if ((!flags || flags & TCL_CLOSE_WRITE) + && (pipePtr->writeFile != NULL)) { if (pipePtr->writeThread) { + /* + * Wait for the writer thread to finish the current buffer, then + * terminate the thread and close the handles. If the channel is + * nonblocking, there should be no pending write operations. + */ + + WaitForSingleObject(pipePtr->writable, INFINITE); /* - * 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. + * The thread may already have closed on it's own. Check its exit + * code. */ - if ((pipePtr->flags & PIPE_ASYNC) && inExit) { - /* give it a chance to leave honorably */ - TclPipeThreadStopSignal(&pipePtr->writeTI, pipePtr->writable); + GetExitCodeThread(pipePtr->writeThread, &exitCode); - if (WaitForSingleObject(pipePtr->writable, 20) == WAIT_TIMEOUT) { - return EWOULDBLOCK; - } + if (exitCode == STILL_ACTIVE) { + /* + * Set the stop event so that if the reader thread is blocked + * in PipeReaderThread on WaitForMultipleEvents, it will exit + * cleanly. + */ - } else { + SetEvent(pipePtr->stopWriter); - WaitForSingleObject(pipePtr->writable, inExit ? 5000 : INFINITE); + /* + * Wait at most 20 milliseconds for the reader thread to + * close. + */ - } + if (WaitForSingleObject(pipePtr->writeThread, + 20) == WAIT_TIMEOUT) { + /* + * The thread must be blocked waiting for the pipe to + * consume input in WriteFile(). There isn't a clean way + * to exit the thread from this condition. We should + * terminate the child process instead to get the writer + * thread to fall out of WriteFile with a FALSE. (below) + * is not the correct way to do this, but will stay here + * until a better solution is found. + * + * 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. + */ - TclPipeThreadStop(&pipePtr->writeTI, pipePtr->writeThread); + Tcl_MutexLock(&pipeMutex); + + /* BUG: this leaks memory */ + TerminateThread(pipePtr->writeThread, 0); + Tcl_MutexUnlock(&pipeMutex); + } + } - CloseHandle(pipePtr->writable); CloseHandle(pipePtr->writeThread); + CloseHandle(pipePtr->writable); + CloseHandle(pipePtr->startWriter); + CloseHandle(pipePtr->stopWriter); pipePtr->writeThread = NULL; } if (TclpCloseFile(pipePtr->writeFile) != 0) { @@ -2094,7 +2000,7 @@ PipeClose2Proc( } } - if ((pipePtr->flags & PIPE_ASYNC) || inExit) { + if ((pipePtr->flags & PIPE_ASYNC) || TclInExit()) { /* * If the channel is non-blocking or Tcl is being cleaned up, just * detach the children PIDs, reap them (important if we are in a @@ -2119,11 +2025,12 @@ PipeClose2Proc( */ if (pipePtr->errorFile) { - WinFile *filePtr = (WinFile *) pipePtr->errorFile; + WinFile *filePtr; - errChan = Tcl_MakeFileChannel((void *)filePtr->handle, + filePtr = (WinFile*)pipePtr->errorFile; + errChan = Tcl_MakeFileChannel((ClientData) filePtr->handle, TCL_READABLE); - ckfree(filePtr); + ckfree((char *) filePtr); } else { errChan = NULL; } @@ -2133,14 +2040,14 @@ PipeClose2Proc( } if (pipePtr->numPids > 0) { - ckfree(pipePtr->pidPtr); + ckfree((char *) pipePtr->pidPtr); } if (pipePtr->writeBuf != NULL) { ckfree(pipePtr->writeBuf); } - ckfree(pipePtr); + ckfree((char*) pipePtr); if (errorCode == 0) { return result; @@ -2168,7 +2075,7 @@ PipeClose2Proc( static int PipeInputProc( - void *instanceData, /* Pipe state. */ + ClientData instanceData, /* Pipe state. */ char *buf, /* Where to store data read. */ int bufSize, /* How much space is available in the * buffer? */ @@ -2233,7 +2140,7 @@ PipeInputProc( return bytesRead; } - Tcl_WinConvertError(GetLastError()); + TclWinConvertError(GetLastError()); if (errno == EPIPE) { infoPtr->readFlags |= PIPE_EOF; return 0; @@ -2262,7 +2169,7 @@ PipeInputProc( static int PipeOutputProc( - void *instanceData, /* Pipe state. */ + ClientData instanceData, /* Pipe state. */ const char *buf, /* The data buffer. */ int toWrite, /* How many bytes to write? */ int *errorCode) /* Where to store error code. */ @@ -2272,18 +2179,14 @@ PipeOutputProc( DWORD bytesWritten, timeout; *errorCode = 0; - - /* avoid blocking if pipe-thread exited */ - timeout = ((infoPtr->flags & PIPE_ASYNC) - || !TclPipeThreadIsAlive(&infoPtr->writeTI) - || TclInExit() || TclInThreadExit()) ? 0 : INFINITE; + timeout = (infoPtr->flags & PIPE_ASYNC) ? 0 : INFINITE; if (WaitForSingleObject(infoPtr->writable, timeout) == WAIT_TIMEOUT) { /* * The writer thread is blocked waiting for a write to complete and * the channel is in non-blocking mode. */ - errno = EWOULDBLOCK; + errno = EAGAIN; goto error; } @@ -2292,7 +2195,7 @@ PipeOutputProc( */ if (infoPtr->writeError) { - Tcl_WinConvertError(infoPtr->writeError); + TclWinConvertError(infoPtr->writeError); infoPtr->writeError = 0; goto error; } @@ -2312,12 +2215,12 @@ PipeOutputProc( ckfree(infoPtr->writeBuf); } infoPtr->writeBufLen = toWrite; - infoPtr->writeBuf = (char *)ckalloc(toWrite); + infoPtr->writeBuf = ckalloc((unsigned int) toWrite); } - memcpy(infoPtr->writeBuf, buf, toWrite); + memcpy(infoPtr->writeBuf, buf, (size_t) toWrite); infoPtr->toWrite = toWrite; ResetEvent(infoPtr->writable); - TclPipeThreadSignal(&infoPtr->writeTI); + SetEvent(infoPtr->startWriter); bytesWritten = toWrite; } else { /* @@ -2327,7 +2230,7 @@ PipeOutputProc( if (WriteFile(filePtr->handle, (LPVOID) buf, (DWORD) toWrite, &bytesWritten, (LPOVERLAPPED) NULL) == FALSE) { - Tcl_WinConvertError(GetLastError()); + TclWinConvertError(GetLastError()); goto error; } } @@ -2444,7 +2347,7 @@ PipeEventProc( static void PipeWatchProc( - void *instanceData, /* Pipe state. */ + ClientData instanceData, /* Pipe state. */ int mask) /* What events to watch for, OR-ed combination * of TCL_READABLE, TCL_WRITABLE and * TCL_EXCEPTION. */ @@ -2462,7 +2365,6 @@ PipeWatchProc( infoPtr->watchMask = mask & infoPtr->validMask; if (infoPtr->watchMask) { Tcl_Time blockTime = { 0, 0 }; - if (!oldMask) { infoPtr->nextPtr = tsdPtr->firstPipePtr; tsdPtr->firstPipePtr = infoPtr; @@ -2506,21 +2408,21 @@ PipeWatchProc( static int PipeGetHandleProc( - void *instanceData, /* The pipe state. */ + ClientData instanceData, /* The pipe state. */ int direction, /* TCL_READABLE or TCL_WRITABLE */ - void **handlePtr) /* Where to store the handle. */ + ClientData *handlePtr) /* Where to store the handle. */ { PipeInfo *infoPtr = (PipeInfo *) instanceData; WinFile *filePtr; if (direction == TCL_READABLE && infoPtr->readFile) { filePtr = (WinFile*) infoPtr->readFile; - *handlePtr = (void *) filePtr->handle; + *handlePtr = (ClientData) filePtr->handle; return TCL_OK; } if (direction == TCL_WRITABLE && infoPtr->writeFile) { filePtr = (WinFile*) infoPtr->writeFile; - *handlePtr = (void *) filePtr->handle; + *handlePtr = (ClientData) filePtr->handle; return TCL_OK; } return TCL_ERROR; @@ -2574,7 +2476,7 @@ Tcl_WaitPid( prevPtrPtr = &procList; for (infoPtr = procList; infoPtr != NULL; prevPtrPtr = &infoPtr->nextPtr, infoPtr = infoPtr->nextPtr) { - if (infoPtr->dwProcessId == PTR2UINT(pid)) { + if (infoPtr->hProcess == (HANDLE) pid) { *prevPtrPtr = infoPtr->nextPtr; break; } @@ -2692,7 +2594,7 @@ Tcl_WaitPid( */ CloseHandle(infoPtr->hProcess); - ckfree(infoPtr); + ckfree((char*)infoPtr); return result; } @@ -2718,9 +2620,9 @@ Tcl_WaitPid( void TclWinAddProcess( void *hProcess, /* Handle to process */ - Tcl_Size id) /* Global process identifier */ + unsigned long id) /* Global process identifier */ { - ProcInfo *procPtr = (ProcInfo *)ckalloc(sizeof(ProcInfo)); + ProcInfo *procPtr = (ProcInfo *) ckalloc(sizeof(ProcInfo)); PipeInit(); @@ -2749,9 +2651,10 @@ TclWinAddProcess( *---------------------------------------------------------------------- */ + /* ARGSUSED */ int Tcl_PidObjCmd( - TCL_UNUSED(void *), + ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* Argument strings. */ @@ -2759,18 +2662,19 @@ Tcl_PidObjCmd( Tcl_Channel chan; const Tcl_ChannelType *chanTypePtr; PipeInfo *pipePtr; - TCL_HASH_TYPE i; - Tcl_Obj *resultPtr, *elemPtr; + int i; + Tcl_Obj *resultPtr; + char buf[TCL_INTEGER_SPACE]; if (objc > 2) { Tcl_WrongNumArgs(interp, 1, objv, "?channelId?"); return TCL_ERROR; } if (objc == 1) { - TclNewIntObj(elemPtr, getpid()); - Tcl_SetObjResult(interp, elemPtr); + wsprintfA(buf, "%lu", (unsigned long) getpid()); + Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, -1)); } else { - chan = Tcl_GetChannel(interp, TclGetString(objv[1]), + chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], NULL), NULL); if (chan == (Tcl_Channel) NULL) { return TCL_ERROR; @@ -2781,10 +2685,11 @@ Tcl_PidObjCmd( } pipePtr = (PipeInfo *) Tcl_GetChannelInstanceData(chan); - TclNewObj(resultPtr); + resultPtr = Tcl_NewObj(); for (i = 0; i < pipePtr->numPids; i++) { - TclNewIntObj(elemPtr, TclpGetPid(pipePtr->pidPtr[i])); - Tcl_ListObjAppendElement(/*interp*/ NULL, resultPtr, elemPtr); + wsprintfA(buf, "%lu", TclpGetPid(pipePtr->pidPtr[i])); + Tcl_ListObjAppendElement(/*interp*/ NULL, resultPtr, + Tcl_NewStringObj(buf, -1)); } Tcl_SetObjResult(interp, resultPtr); } @@ -2820,23 +2725,21 @@ WaitForRead( * or not. */ { DWORD timeout, count; - HANDLE handle = ((WinFile *) infoPtr->readFile)->handle; + 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; + timeout = blocking ? INFINITE : 0; if (WaitForSingleObject(infoPtr->readable, timeout) == WAIT_TIMEOUT) { /* * The reader thread is blocked waiting for data and the channel * is in non-blocking mode. */ - errno = EWOULDBLOCK; + errno = EAGAIN; return -1; } @@ -2859,7 +2762,7 @@ WaitForRead( if (PeekNamedPipe(handle, (LPVOID) NULL, (DWORD) 0, (LPDWORD) NULL, &count, (LPDWORD) NULL) != TRUE) { - Tcl_WinConvertError(GetLastError()); + TclWinConvertError(GetLastError()); /* * Check to see if the peek failed because of EOF. @@ -2903,7 +2806,7 @@ WaitForRead( */ ResetEvent(infoPtr->readable); - TclPipeThreadSignal(&infoPtr->readTI); + SetEvent(infoPtr->startReader); } } @@ -2931,11 +2834,15 @@ static DWORD WINAPI PipeReaderThread( LPVOID arg) { - TclPipeThreadInfo *pipeTI = (TclPipeThreadInfo *) arg; - PipeInfo *infoPtr = NULL; /* access info only after success init/wait */ - HANDLE handle = NULL; + PipeInfo *infoPtr = (PipeInfo *)arg; + HANDLE *handle = ((WinFile *) infoPtr->readFile)->handle; DWORD count, err; int done = 0; + HANDLE wEvents[2]; + DWORD waitResult; + + wEvents[0] = infoPtr->stopReader; + wEvents[1] = infoPtr->startReader; while (!done) { /* @@ -2943,14 +2850,15 @@ PipeReaderThread( * pipe becoming readable. */ - if (!TclPipeThreadWaitForSignal(&pipeTI)) { - /* exit */ - break; - } + waitResult = WaitForMultipleObjects(2, wEvents, FALSE, INFINITE); + + if (waitResult != (WAIT_OBJECT_0 + 1)) { + /* + * The start event was not signaled. It might be the stop event or + * an error, so exit. + */ - if (!infoPtr) { - infoPtr = (PipeInfo *) pipeTI->clientData; - handle = ((WinFile *) infoPtr->readFile)->handle; + break; } /* @@ -2972,7 +2880,7 @@ PipeReaderThread( infoPtr->readFlags |= PIPE_EOF; done = 1; } else if (err == ERROR_INVALID_HANDLE) { - done = 1; + break; } } else if (count == 0) { if (ReadFile(handle, &(infoPtr->extraByte), 1, &count, NULL) @@ -2994,11 +2902,12 @@ PipeReaderThread( infoPtr->readFlags |= PIPE_EOF; done = 1; } else if (err == ERROR_INVALID_HANDLE) { - done = 1; + break; } } } + /* * Signal the main thread by signalling the readable event and then * waking up the notifier thread. @@ -3024,12 +2933,6 @@ PipeReaderThread( 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; } @@ -3054,25 +2957,31 @@ static DWORD WINAPI PipeWriterThread( LPVOID arg) { - TclPipeThreadInfo *pipeTI = (TclPipeThreadInfo *)arg; - PipeInfo *infoPtr = NULL; /* access info only after success init/wait */ - HANDLE handle = NULL; + PipeInfo *infoPtr = (PipeInfo *)arg; + HANDLE *handle = ((WinFile *) infoPtr->writeFile)->handle; DWORD count, toWrite; char *buf; int done = 0; + HANDLE wEvents[2]; + DWORD waitResult; + + wEvents[0] = infoPtr->stopWriter; + wEvents[1] = infoPtr->startWriter; 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; + waitResult = WaitForMultipleObjects(2, wEvents, FALSE, INFINITE); + + if (waitResult != (WAIT_OBJECT_0 + 1)) { + /* + * The start event was not signaled. It might be the stop event or + * an error, so exit. + */ + + break; } buf = infoPtr->writeBuf; @@ -3118,12 +3027,6 @@ PipeWriterThread( 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; } @@ -3145,7 +3048,7 @@ PipeWriterThread( static void PipeThreadActionProc( - void *instanceData, + ClientData instanceData, int action) { PipeInfo *infoPtr = (PipeInfo *) instanceData; @@ -3153,7 +3056,7 @@ PipeThreadActionProc( /* * 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 fileevent handlers before transfer thus takes care of + * Removal of the filevent handlers before transfer thus takes care of * this structure. */ @@ -3178,544 +3081,6 @@ PipeThreadActionProc( } /* - *---------------------------------------------------------------------- - * - * TclpOpenTemporaryFile -- - * - * Creates a temporary file, possibly based on the supplied bits and - * pieces of template supplied in the first three arguments. If the - * fourth argument is non-NULL, it contains a Tcl_Obj to store the name - * of the temporary file in (and it is caller's responsibility to clean - * up). If the fourth argument is NULL, try to arrange for the temporary - * file to go away once it is no longer needed. - * - * Results: - * A read-write Tcl Channel open on the file. - * - *---------------------------------------------------------------------- - */ - -Tcl_Channel -TclpOpenTemporaryFile( - TCL_UNUSED(Tcl_Obj *) /*dirObj*/, - Tcl_Obj *basenameObj, - TCL_UNUSED(Tcl_Obj *) /*extensionObj*/, - Tcl_Obj *resultingNameObj) -{ - WCHAR name[MAX_PATH]; - char *namePtr; - HANDLE handle; - DWORD flags = FILE_ATTRIBUTE_TEMPORARY; - Tcl_Size length; - int 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 = TclGetStringFromObj(basenameObj, &length); - - Tcl_DStringInit(&buf); - Tcl_UtfToWCharDString(string, length, &buf); - memcpy(namePtr, Tcl_DStringValue(&buf), Tcl_DStringLength(&buf)); - namePtr += Tcl_DStringLength(&buf); - Tcl_DStringFree(&buf); - } else { - const WCHAR *baseStr = L"TCL"; - 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]; - - snprintf(number, sizeof(number), "%d.TMP", counter); - counter = (unsigned short) (counter + 1); - Tcl_DStringInit(&buf); - Tcl_UtfToWCharDString(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((void *) handle, - TCL_READABLE|TCL_WRITABLE); - - gotError: - Tcl_WinConvertError(GetLastError()); - return NULL; -} - -/* - *---------------------------------------------------------------------- - * - * TclPipeThreadCreateTI -- - * - * Creates a thread info structure, can be owned by worker. - * - * Results: - * Pointer to created TI structure. - * - *---------------------------------------------------------------------- - */ - -TclPipeThreadInfo * -TclPipeThreadCreateTI( - TclPipeThreadInfo **pipeTIPtr, - void *clientData, - HANDLE wakeEvent) -{ - TclPipeThreadInfo *pipeTI; -#ifndef _PTI_USE_CKALLOC - pipeTI = (TclPipeThreadInfo *)malloc(sizeof(TclPipeThreadInfo)); -#else - pipeTI = (TclPipeThreadInfo *)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). - */ - - 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 diff --git a/win/tclWinPort.h b/win/tclWinPort.h index 9eb949b..b2bf1d7 100644 --- a/win/tclWinPort.h +++ b/win/tclWinPort.h @@ -14,26 +14,9 @@ #ifndef _TCLWINPORT #define _TCLWINPORT -#if !defined(_WIN64) && !defined(__MINGW_USE_VC2005_COMPAT) +#ifndef _WIN64 /* See [Bug 3354324]: file mtime sets wrong time */ -# define __MINGW_USE_VC2005_COMPAT -#endif -#if defined(_MSC_VER) && defined(_WIN64) && !defined(STATIC_BUILD) \ - && !defined(MP_32BIT) && !defined(MP_64BIT) -# define MP_64BIT -#endif - -/* - * We must specify the lower version we intend to support. - * - * WINVER = 0x0601 means Windows 7 and above - */ - -#ifndef WINVER -# define WINVER 0x0601 -#endif -#ifndef _WIN32_WINNT -# define _WIN32_WINNT 0x0601 +# define _USE_32BIT_TIME_T #endif #define WIN32_LEAN_AND_MEAN @@ -49,28 +32,17 @@ typedef DWORD_PTR * PDWORD_PTR; /* * Ask for the winsock function typedefs, also. */ -#ifndef INCL_WINSOCK_API_TYPEDEFS -# define INCL_WINSOCK_API_TYPEDEFS 1 -#endif +#define INCL_WINSOCK_API_TYPEDEFS 1 #include <winsock2.h> -#include <ws2tcpip.h> -#ifdef HAVE_WSPIAPI_H -# include <wspiapi.h> -#endif -/* - * Pull in the typedef of TCHAR for windows. - */ -#include <tchar.h> -#ifndef _TCHAR_DEFINED - /* Borland seems to forget to set this. */ - typedef _TCHAR TCHAR; +#ifdef CHECK_UNICODE_CALLS +# define _UNICODE +# define UNICODE +# define __TCHAR_DEFINED + typedef float *_TCHAR; # define _TCHAR_DEFINED -#endif -#if defined(_MSC_VER) && defined(__STDC__) - /* VS2005 SP1 misses this. See [Bug #3110161] */ - typedef _TCHAR TCHAR; -#endif + typedef float *TCHAR; +#endif /* CHECK_UNICODE_CALLS */ /* *--------------------------------------------------------------------------- @@ -80,18 +52,18 @@ typedef DWORD_PTR * PDWORD_PTR; */ #include <time.h> -#include <wchar.h> #include <io.h> +#include <stdio.h> +#include <stdlib.h> #include <errno.h> #include <fcntl.h> #include <float.h> #include <malloc.h> #include <process.h> #include <signal.h> -#ifdef HAVE_INTTYPES_H -# include <inttypes.h> -#endif +#include <string.h> #include <limits.h> + #ifndef __GNUC__ # define strncasecmp _strnicmp # define strcasecmp _stricmp @@ -105,170 +77,116 @@ typedef DWORD_PTR * PDWORD_PTR; #ifndef __MWERKS__ #include <sys/stat.h> #include <sys/timeb.h> -#include <sys/utime.h> +# ifdef __BORLANDC__ +# include <utime.h> +# else +# include <sys/utime.h> +# endif /* __BORLANDC__ */ #endif /* __MWERKS__ */ /* + * Define EINPROGRESS in terms of WSAEINPROGRESS. + */ + +#undef EINPROGRESS +#define EINPROGRESS WSAEINPROGRESS + +/* + * Define ENOTSUP to a value that will never occur. + */ + +#undef ENOTSUP +#define ENOTSUP -1030507 + +/* Those codes, from Visual Studio 2010, conflict with other values */ +#undef ENODATA +#undef ENOMSG +#undef ENOSR +#undef ENOSTR +#undef EPROTO + +/* * The following defines redefine the Windows Socket errors as * BSD errors so Tcl_PosixError can do the right thing. */ -#ifndef ENOTEMPTY -# define ENOTEMPTY 41 /* Directory not empty */ -#endif -#ifndef EREMOTE -# define EREMOTE 66 /* The object is remote */ -#endif -#ifndef EPFNOSUPPORT -# define EPFNOSUPPORT 96 /* Protocol family not supported */ -#endif -#ifndef EADDRINUSE -# define EADDRINUSE 100 /* Address already in use */ -#endif -#ifndef EADDRNOTAVAIL -# define EADDRNOTAVAIL 101 /* Can't assign requested address */ -#endif -#ifndef EAFNOSUPPORT -# define EAFNOSUPPORT 102 /* Address family not supported */ -#endif -#ifndef EALREADY -# define EALREADY 103 /* Operation already in progress */ -#endif -#ifndef EBADMSG -# define EBADMSG 104 /* Not a data message */ -#endif -#ifndef ECANCELED -# define ECANCELED 105 /* Canceled */ -#endif -#ifndef ECONNABORTED -# define ECONNABORTED 106 /* Software caused connection abort */ -#endif -#ifndef ECONNREFUSED -# define ECONNREFUSED 107 /* Connection refused */ -#endif -#ifndef ECONNRESET -# define ECONNRESET 108 /* Connection reset by peer */ -#endif -#ifndef EDESTADDRREQ -# define EDESTADDRREQ 109 /* Destination address required */ -#endif -#ifndef EHOSTUNREACH -# define EHOSTUNREACH 110 /* No route to host */ -#endif -#ifndef EIDRM -# define EIDRM 111 /* Identifier removed */ -#endif -#ifndef EINPROGRESS -# define EINPROGRESS 112 /* Operation now in progress */ -#endif -#ifndef EISCONN -# define EISCONN 113 /* Socket is already connected */ -#endif -#ifndef ELOOP -# define ELOOP 114 /* Symbolic link loop */ -#endif -#ifndef EMSGSIZE -# define EMSGSIZE 115 /* Message too long */ -#endif -#ifndef ENETDOWN -# define ENETDOWN 116 /* Network is down */ -#endif -#ifndef ENETRESET -# define ENETRESET 117 /* Network dropped connection on reset */ -#endif -#ifndef ENETUNREACH -# define ENETUNREACH 118 /* Network is unreachable */ -#endif -#ifndef ENOBUFS -# define ENOBUFS 119 /* No buffer space available */ -#endif -#ifndef ENODATA -# define ENODATA 120 /* No data available */ -#endif -#ifndef ENOLINK -# define ENOLINK 121 /* Link has be severed */ -#endif -#ifndef ENOMSG -# define ENOMSG 122 /* No message of desired type */ -#endif -#ifndef ENOPROTOOPT -# define ENOPROTOOPT 123 /* Protocol not available */ -#endif -#ifndef ENOSR -# define ENOSR 124 /* Out of stream resources */ -#endif -#ifndef ENOSTR -# define ENOSTR 125 /* Not a stream device */ -#endif -#ifndef ENOTCONN -# define ENOTCONN 126 /* Socket is not connected */ -#endif -#ifndef ENOTRECOVERABLE -# define ENOTRECOVERABLE 127 /* Not recoverable */ -#endif -#ifndef ENOTSOCK -# define ENOTSOCK 128 /* Socket operation on non-socket */ -#endif -#ifndef ENOTSUP -# define ENOTSUP 129 /* Operation not supported */ -#endif -#ifndef EOPNOTSUPP -# define EOPNOTSUPP 130 /* Operation not supported on socket */ -#endif -#ifndef EOTHER -# define EOTHER 131 /* Other error */ -#endif -#ifndef EOVERFLOW -# define EOVERFLOW 132 /* File too big */ -#endif -#ifndef EOWNERDEAD -# define EOWNERDEAD 133 /* Owner dead */ -#endif -#ifndef EPROTO -# define EPROTO 134 /* Protocol error */ -#endif -#ifndef EPROTONOSUPPORT -# define EPROTONOSUPPORT 135 /* Protocol not supported */ -#endif -#ifndef EPROTOTYPE -# define EPROTOTYPE 136 /* Protocol wrong type for socket */ -#endif -#ifndef ETIME -# define ETIME 137 /* Timer expired */ -#endif -#ifndef ETIMEDOUT -# define ETIMEDOUT 138 /* Connection timed out */ -#endif -#ifndef ETXTBSY -# define ETXTBSY 139 /* Text file or pseudo-device busy */ -#endif -#ifndef EWOULDBLOCK -# define EWOULDBLOCK 140 /* Operation would block */ -#endif +#undef EWOULDBLOCK +#define EWOULDBLOCK EAGAIN +#undef EALREADY +#define EALREADY 149 /* operation already in progress */ +#undef ENOTSOCK +#define ENOTSOCK 95 /* Socket operation on non-socket */ +#undef EDESTADDRREQ +#define EDESTADDRREQ 96 /* Destination address required */ +#undef EMSGSIZE +#define EMSGSIZE 97 /* Message too long */ +#undef EPROTOTYPE +#define EPROTOTYPE 98 /* Protocol wrong type for socket */ +#undef ENOPROTOOPT +#define ENOPROTOOPT 99 /* Protocol not available */ +#undef EPROTONOSUPPORT +#define EPROTONOSUPPORT 120 /* Protocol not supported */ +#undef ESOCKTNOSUPPORT +#define ESOCKTNOSUPPORT 121 /* Socket type not supported */ +#undef EOPNOTSUPP +#define EOPNOTSUPP 122 /* Operation not supported on socket */ +#undef EPFNOSUPPORT +#define EPFNOSUPPORT 123 /* Protocol family not supported */ +#undef EAFNOSUPPORT +#define EAFNOSUPPORT 124 /* Address family not supported */ +#undef EADDRINUSE +#define EADDRINUSE 125 /* Address already in use */ +#undef EADDRNOTAVAIL +#define EADDRNOTAVAIL 126 /* Can't assign requested address */ +#undef ENETDOWN +#define ENETDOWN 127 /* Network is down */ +#undef ENETUNREACH +#define ENETUNREACH 128 /* Network is unreachable */ +#undef ENETRESET +#define ENETRESET 129 /* Network dropped connection on reset */ +#undef ECONNABORTED +#define ECONNABORTED 130 /* Software caused connection abort */ +#undef ECONNRESET +#define ECONNRESET 131 /* Connection reset by peer */ +#undef ENOBUFS +#define ENOBUFS 132 /* No buffer space available */ +#undef EISCONN +#define EISCONN 133 /* Socket is already connected */ +#undef ENOTCONN +#define ENOTCONN 134 /* Socket is not connected */ +#undef ESHUTDOWN +#define ESHUTDOWN 143 /* Can't send after socket shutdown */ +#undef ETOOMANYREFS +#define ETOOMANYREFS 144 /* Too many references: can't splice */ +#undef ETIMEDOUT +#define ETIMEDOUT 145 /* Connection timed out */ +#undef ECONNREFUSED +#define ECONNREFUSED 146 /* Connection refused */ +#undef ELOOP +#define ELOOP 90 /* Symbolic link loop */ +#undef EHOSTDOWN +#define EHOSTDOWN 147 /* Host is down */ +#undef EHOSTUNREACH +#define EHOSTUNREACH 148 /* No route to host */ +#undef ENOTEMPTY +#define ENOTEMPTY 93 /* directory not empty */ +#undef EUSERS +#define EUSERS 94 /* Too many users (for UFS) */ +#undef EDQUOT +#define EDQUOT 69 /* Disc quota exceeded */ +#undef ESTALE +#define ESTALE 151 /* Stale NFS file handle */ +#undef EREMOTE +#define EREMOTE 66 /* The object is remote */ +/* + * It is very hard to determine how Windows reacts to attempting to + * set a file pointer outside the input datatype's representable + * region. So we fake the error code ourselves. + */ -/* Visual Studio doesn't have these, so just choose some high numbers */ -#ifndef ESOCKTNOSUPPORT -# define ESOCKTNOSUPPORT 240 /* Socket type not supported */ -#endif -#ifndef ESHUTDOWN -# define ESHUTDOWN 241 /* Can't send after socket shutdown */ -#endif -#ifndef ETOOMANYREFS -# define ETOOMANYREFS 242 /* Too many references: can't splice */ -#endif -#ifndef EHOSTDOWN -# define EHOSTDOWN 243 /* Host is down */ -#endif -#ifndef EUSERS -# define EUSERS 244 /* Too many users (for UFS) */ -#endif -#ifndef EDQUOT -# define EDQUOT 245 /* Disc quota exceeded */ -#endif -#ifndef ESTALE -# define ESTALE 246 /* Stale NFS file handle */ -#endif +#undef EOVERFLOW +#define EOVERFLOW EFBIG /* The object couldn't fit in the datatype */ /* * Signals not known to the standard ANSI signal.h. These are used @@ -287,7 +205,7 @@ typedef DWORD_PTR * PDWORD_PTR; * defined in header files above. */ -#ifdef TCL_UNION_WAIT +#if TCL_UNION_WAIT # define WAIT_STATUS_TYPE union wait #else # define WAIT_STATUS_TYPE int @@ -306,7 +224,7 @@ typedef DWORD_PTR * PDWORD_PTR; #endif #ifndef WTERMSIG -# define WTERMSIG(stat) ((*((int *) &(stat))) & 0x7F) +# define WTERMSIG(stat) ((*((int *) &(stat))) & 0x7f) #endif #ifndef WIFSTOPPED @@ -314,7 +232,7 @@ typedef DWORD_PTR * PDWORD_PTR; #endif #ifndef WSTOPSIG -# define WSTOPSIG(stat) (((*((int *) &(stat))) >> 8) & 0xFF) +# define WSTOPSIG(stat) (((*((int *) &(stat))) >> 8) & 0xff) #endif /* @@ -355,20 +273,6 @@ typedef DWORD_PTR * PDWORD_PTR; # 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) @@ -429,10 +333,10 @@ typedef DWORD_PTR * PDWORD_PTR; * Define pid_t and uid_t if they're not already defined. */ -#if !defined(TCL_PID_T) +#if ! TCL_PID_T # define pid_t int #endif /* !TCL_PID_T */ -#if !defined(TCL_UID_T) +#if ! TCL_UID_T # define uid_t int #endif /* !TCL_UID_T */ @@ -444,24 +348,50 @@ typedef DWORD_PTR * PDWORD_PTR; #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) +# if defined(_MSC_VER) && (_MSC_VER >= 1700) # define timezone _timezone # endif #endif /* _MSC_VER || __MSVCRT__ */ -#if defined(_MSC_VER) -# pragma warning(disable:4090) /* see: https://developercommunity.visualstudio.com/t/c-compiler-incorrect-propagation-of-const-qualifie/390711 */ -# pragma warning(disable:4146) -# pragma warning(disable:4244) -#if !defined(_WIN64) -# pragma warning(disable:4305) +/* + * Borland's timezone and environ functions. + */ + +#ifdef __BORLANDC__ +# define timezone _timezone +# define environ _environ +#endif /* __BORLANDC__ */ + +#ifdef __WATCOMC__ +# if !defined(__CHAR_SIGNED__) +# error "You must use the -j switch to ensure char is signed." +# endif #endif + + +/* + * MSVC 8.0 started to mark many standard C library functions depreciated + * including the *printf family and others. Tell it to shut up. + * (_MSC_VER is 1200 for VC6, 1300 or 1310 for vc7.net, 1400 for 8.0) + */ +#if defined(_MSC_VER) && (_MSC_VER >= 1400) +# pragma warning(disable:4244) # pragma warning(disable:4267) # pragma warning(disable:4996) #endif + +/* + * There is no platform-specific panic routine for Windows in the Tcl internals. + */ + +#define TclpPanic ((Tcl_PanicProc *) NULL) + /* *--------------------------------------------------------------------------- * The following macros and declarations represent the interface between @@ -527,7 +457,7 @@ typedef DWORD_PTR * PDWORD_PTR; * address platform-specific issues. */ -#define TclpReleaseFile(file) ckfree(file) +#define TclpReleaseFile(file) ckfree((char *) file) /* * The following macros and declarations wrap the C runtime library @@ -544,7 +474,4 @@ typedef DWORD_PTR * PDWORD_PTR; # define LABEL_SECURITY_INFORMATION (0x00000010L) #endif -#define Tcl_DirEntry void -#define TclDIR void - #endif /* _TCLWINPORT */ diff --git a/win/tclWinReg.c b/win/tclWinReg.c index a0b4e90..a6ce2ce 100644 --- a/win/tclWinReg.c +++ b/win/tclWinReg.c @@ -12,41 +12,36 @@ * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ -#undef STATIC_BUILD -#ifndef USE_TCL_STUBS -# define USE_TCL_STUBS -#endif #include "tclInt.h" +#include "tclPort.h" #ifdef _MSC_VER # pragma comment (lib, "advapi32.lib") #endif #include <stdlib.h> /* - * Ensure that we can say which registry is being accessed. + * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the + * Registry_Init declaration is in the source file itself, which is only + * accessed when we are building a library. */ -#ifndef KEY_WOW64_64KEY -# define KEY_WOW64_64KEY (0x0100) -#endif -#ifndef KEY_WOW64_32KEY -# define KEY_WOW64_32KEY (0x0200) -#endif +#undef TCL_STORAGE_CLASS +#define TCL_STORAGE_CLASS DLLEXPORT /* * The maximum length of a sub-key name. */ #ifndef MAX_KEY_LENGTH -# define MAX_KEY_LENGTH 256 +#define MAX_KEY_LENGTH 256 #endif /* * The following macros convert between different endian ints. */ -#define SWAPWORD(x) MAKEWORD(HIBYTE(x), LOBYTE(x)) -#define SWAPLONG(x) MAKELONG(SWAPWORD(HIWORD(x)), SWAPWORD(LOWORD(x))) +#define SWAPWORD(x) MAKEWORD(HIBYTE(x), LOBYTE(x)) +#define SWAPLONG(x) MAKELONG(SWAPWORD(HIWORD(x)), SWAPWORD(LOWORD(x))) /* * The following flag is used in OpenKeys to indicate that the specified key @@ -60,7 +55,7 @@ * system predefined keys. */ -static const char *const rootKeyNames[] = { +static CONST char *rootKeyNames[] = { "HKEY_LOCAL_MACHINE", "HKEY_USERS", "HKEY_CLASSES_ROOT", "HKEY_CURRENT_USER", "HKEY_CURRENT_CONFIG", "HKEY_PERFORMANCE_DATA", "HKEY_DYN_DATA", NULL @@ -71,7 +66,7 @@ static const HKEY rootKeys[] = { HKEY_CURRENT_CONFIG, HKEY_PERFORMANCE_DATA, HKEY_DYN_DATA }; -static const char REGISTRY_ASSOC_KEY[] = "registry::command"; +static CONST char REGISTRY_ASSOC_KEY[] = "registry::command"; /* * The following table maps from registry types to strings. Note that the @@ -79,50 +74,108 @@ static const char REGISTRY_ASSOC_KEY[] = "registry::command"; * types so we don't need a separate table to hold the mapping. */ -static const char *const typeNames[] = { +static CONST char *typeNames[] = { "none", "sz", "expand_sz", "binary", "dword", "dword_big_endian", "link", "multi_sz", "resource_list", NULL }; static DWORD lastType = REG_RESOURCE_LIST; -#if (TCL_MAJOR_VERSION < 9) && defined(TCL_MINOR_VERSION) && (TCL_MINOR_VERSION < 7) -# if TCL_UTF_MAX > 3 -# define Tcl_WCharToUtfDString(a,b,c) Tcl_WinTCharToUtf((TCHAR *)(a),(b)*sizeof(WCHAR),c) -# define Tcl_UtfToWCharDString(a,b,c) (WCHAR *)Tcl_WinUtfToTChar(a,b,c) -# else -# define Tcl_WCharToUtfDString Tcl_UniCharToUtfDString -# define Tcl_UtfToWCharDString Tcl_UtfToUniCharDString -# endif -#ifndef Tcl_Size -# define Tcl_Size int -#endif -#ifndef Tcl_CreateObjCommand2 -# define Tcl_CreateObjCommand2 Tcl_CreateObjCommand -#endif -#endif +/* + * The following structures allow us to select between the Unicode and ASCII + * interfaces at run time based on whether Unicode APIs are available. The + * Unicode APIs are preferable because they will handle characters outside of + * the current code page. + */ + +typedef struct RegWinProcs { + int useWide; + + LONG (WINAPI *regConnectRegistryProc)(CONST TCHAR *, HKEY, PHKEY); + LONG (WINAPI *regCreateKeyExProc)(HKEY, CONST TCHAR *, DWORD, TCHAR *, + DWORD, REGSAM, SECURITY_ATTRIBUTES *, HKEY *, DWORD *); + LONG (WINAPI *regDeleteKeyProc)(HKEY, CONST TCHAR *); + LONG (WINAPI *regDeleteValueProc)(HKEY, CONST TCHAR *); + LONG (WINAPI *regEnumKeyProc)(HKEY, DWORD, TCHAR *, DWORD); + LONG (WINAPI *regEnumKeyExProc)(HKEY, DWORD, TCHAR *, DWORD *, DWORD *, + TCHAR *, DWORD *, FILETIME *); + LONG (WINAPI *regEnumValueProc)(HKEY, DWORD, TCHAR *, DWORD *, DWORD *, + DWORD *, BYTE *, DWORD *); + LONG (WINAPI *regOpenKeyExProc)(HKEY, CONST TCHAR *, DWORD, REGSAM, + HKEY *); + LONG (WINAPI *regQueryValueExProc)(HKEY, CONST TCHAR *, DWORD *, DWORD *, + BYTE *, DWORD *); + LONG (WINAPI *regSetValueExProc)(HKEY, CONST TCHAR *, DWORD, DWORD, + CONST BYTE*, DWORD); +} RegWinProcs; + +static RegWinProcs *regWinProcs; + +static RegWinProcs asciiProcs = { + 0, + + (LONG (WINAPI *)(CONST TCHAR *, HKEY, PHKEY)) RegConnectRegistryA, + (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD, TCHAR *, + DWORD, REGSAM, SECURITY_ATTRIBUTES *, HKEY *, + DWORD *)) RegCreateKeyExA, + (LONG (WINAPI *)(HKEY, CONST TCHAR *)) RegDeleteKeyA, + (LONG (WINAPI *)(HKEY, CONST TCHAR *)) RegDeleteValueA, + (LONG (WINAPI *)(HKEY, DWORD, TCHAR *, DWORD)) RegEnumKeyA, + (LONG (WINAPI *)(HKEY, DWORD, TCHAR *, DWORD *, DWORD *, + TCHAR *, DWORD *, FILETIME *)) RegEnumKeyExA, + (LONG (WINAPI *)(HKEY, DWORD, TCHAR *, DWORD *, DWORD *, + DWORD *, BYTE *, DWORD *)) RegEnumValueA, + (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD, REGSAM, + HKEY *)) RegOpenKeyExA, + (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD *, DWORD *, + BYTE *, DWORD *)) RegQueryValueExA, + (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD, DWORD, + CONST BYTE*, DWORD)) RegSetValueExA, +}; + +static RegWinProcs unicodeProcs = { + 1, + + (LONG (WINAPI *)(CONST TCHAR *, HKEY, PHKEY)) RegConnectRegistryW, + (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD, TCHAR *, + DWORD, REGSAM, SECURITY_ATTRIBUTES *, HKEY *, + DWORD *)) RegCreateKeyExW, + (LONG (WINAPI *)(HKEY, CONST TCHAR *)) RegDeleteKeyW, + (LONG (WINAPI *)(HKEY, CONST TCHAR *)) RegDeleteValueW, + (LONG (WINAPI *)(HKEY, DWORD, TCHAR *, DWORD)) RegEnumKeyW, + (LONG (WINAPI *)(HKEY, DWORD, TCHAR *, DWORD *, DWORD *, + TCHAR *, DWORD *, FILETIME *)) RegEnumKeyExW, + (LONG (WINAPI *)(HKEY, DWORD, TCHAR *, DWORD *, DWORD *, + DWORD *, BYTE *, DWORD *)) RegEnumValueW, + (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD, REGSAM, + HKEY *)) RegOpenKeyExW, + (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD *, DWORD *, + BYTE *, DWORD *)) RegQueryValueExW, + (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD, DWORD, + CONST BYTE*, DWORD)) RegSetValueExW, +}; + /* * Declarations for functions defined in this file. */ static void AppendSystemError(Tcl_Interp *interp, DWORD error); -static int BroadcastValue(Tcl_Interp *interp, Tcl_Size objc, - Tcl_Obj *const objv[]); +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 void DeleteCmd(ClientData clientData); +static int DeleteKey(Tcl_Interp *interp, Tcl_Obj *keyNameObj); static int DeleteValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj, - Tcl_Obj *valueNameObj, REGSAM mode); + Tcl_Obj *valueNameObj); static int GetKeyNames(Tcl_Interp *interp, Tcl_Obj *keyNameObj, - Tcl_Obj *patternObj, REGSAM mode); + Tcl_Obj *patternObj); static int GetType(Tcl_Interp *interp, Tcl_Obj *keyNameObj, - Tcl_Obj *valueNameObj, REGSAM mode); + Tcl_Obj *valueNameObj); static int GetValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj, - Tcl_Obj *valueNameObj, REGSAM mode); + Tcl_Obj *valueNameObj); static int GetValueNames(Tcl_Interp *interp, Tcl_Obj *keyNameObj, - Tcl_Obj *patternObj, REGSAM mode); + Tcl_Obj *patternObj); static int OpenKey(Tcl_Interp *interp, Tcl_Obj *keyNameObj, REGSAM mode, int flags, HKEY *keyPtr); static DWORD OpenSubKey(char *hostName, HKEY rootKey, @@ -132,27 +185,16 @@ 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, Tcl_Size objc, - Tcl_Obj *const objv[]); + CONST TCHAR * pKeyName); +static int RegistryObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj * CONST objv[]); static int SetValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj, Tcl_Obj *valueNameObj, Tcl_Obj *dataObj, - Tcl_Obj *typeObj, REGSAM mode); + Tcl_Obj *typeObj); -#ifdef __cplusplus -extern "C" { -#endif -DLLEXPORT int Registry_Init(Tcl_Interp *interp); -DLLEXPORT int Registry_Unload(Tcl_Interp *interp, int flags); -#if TCL_MAJOR_VERSION < 9 -/* With those additional entries, "load tclregistry13.dll" works without 3th argument */ -DLLEXPORT int Tclregistry_Init(Tcl_Interp *interp); -DLLEXPORT int Tclregistry_Unload(Tcl_Interp *interp, int flags); -#endif -#ifdef __cplusplus -} -#endif +EXTERN int Registry_Init(Tcl_Interp *interp); +EXTERN int Registry_Unload(Tcl_Interp *interp, int flags); /* *---------------------------------------------------------------------- @@ -176,23 +218,26 @@ Registry_Init( { Tcl_Command cmd; - if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) { + if (Tcl_InitStubs(interp, "8.1", 0) == NULL) { return TCL_ERROR; } - cmd = Tcl_CreateObjCommand2(interp, "registry", RegistryObjCmd, - interp, DeleteCmd); - Tcl_SetAssocData(interp, REGISTRY_ASSOC_KEY, NULL, cmd); - return Tcl_PkgProvideEx(interp, "registry", "1.3.7", NULL); -} -#if TCL_MAJOR_VERSION < 9 -int -Tclregistry_Init( - Tcl_Interp *interp) -{ - return Registry_Init(interp); + /* + * Determine if the unicode interfaces are available and select the + * appropriate registry function table. + */ + + if (TclWinGetPlatformId() == VER_PLATFORM_WIN32_NT) { + regWinProcs = &unicodeProcs; + } else { + regWinProcs = &asciiProcs; + } + + cmd = Tcl_CreateObjCommand(interp, "registry", RegistryObjCmd, + (ClientData)interp, DeleteCmd); + Tcl_SetAssocData(interp, REGISTRY_ASSOC_KEY, NULL, (ClientData)cmd); + return Tcl_PkgProvide(interp, "registry", "1.2.2"); } -#endif /* *---------------------------------------------------------------------- @@ -217,7 +262,6 @@ Registry_Unload( { Tcl_Command cmd; Tcl_Obj *objv[3]; - (void)flags; /* * Unregister the registry package. There is no Tcl_PkgForget() @@ -239,15 +283,6 @@ Registry_Unload( return TCL_OK; } -#if TCL_MAJOR_VERSION < 9 -int -Tclregistry_Unload( - Tcl_Interp *interp, - int flags) -{ - return Registry_Unload(interp, flags); -} -#endif /* *---------------------------------------------------------------------- @@ -268,11 +303,10 @@ Tclregistry_Unload( static void DeleteCmd( - void *clientData) + ClientData clientData) { - Tcl_Interp *interp = (Tcl_Interp *)clientData; - - Tcl_SetAssocData(interp, REGISTRY_ASSOC_KEY, NULL, NULL); + Tcl_Interp *interp = clientData; + Tcl_SetAssocData(interp, REGISTRY_ASSOC_KEY, NULL, (ClientData)NULL); } /* @@ -293,129 +327,92 @@ DeleteCmd( static int RegistryObjCmd( - void *dummy, /* Not used. */ + ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - Tcl_Size objc, /* Number of arguments. */ - Tcl_Obj *const objv[]) /* Argument values. */ + int objc, /* Number of arguments. */ + Tcl_Obj * CONST objv[]) /* Argument values. */ { - Tcl_Size n = 1, argc; int index; - REGSAM mode = 0; - const char *errString = NULL; + char *errString = NULL; - static const char *const subcommands[] = { + static CONST char *subcommands[] = { "broadcast", "delete", "get", "keys", "set", "type", "values", NULL }; enum SubCmdIdx { BroadcastIdx, DeleteIdx, GetIdx, KeysIdx, SetIdx, TypeIdx, ValuesIdx }; - static const char *const modes[] = { - "-32bit", "-64bit", NULL - }; - (void)dummy; if (objc < 2) { - wrongArgs: - Tcl_WrongNumArgs(interp, 1, objv, "?-32bit|-64bit? option ?arg ...?"); + Tcl_WrongNumArgs(interp, objc, objv, "option ?arg arg ...?"); return TCL_ERROR; } - if (Tcl_GetString(objv[n])[0] == '-') { - if (Tcl_GetIndexFromObj(interp, objv[n++], modes, "mode", 0, - &index) != TCL_OK) { - return TCL_ERROR; - } - switch (index) { - case 0: /* -32bit */ - mode |= KEY_WOW64_32KEY; - break; - case 1: /* -64bit */ - mode |= KEY_WOW64_64KEY; - break; - } - if (objc < 3) { - goto wrongArgs; - } - } - - if (Tcl_GetIndexFromObj(interp, objv[n++], subcommands, "option", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObj(interp, objv[1], subcommands, "option", 0, &index) + != TCL_OK) { return TCL_ERROR; } - argc = (objc - n); switch (index) { case BroadcastIdx: /* broadcast */ - if (argc == 1 || argc == 3) { - int res = BroadcastValue(interp, argc, objv + n); - - if (res != TCL_BREAK) { - return res; - } - } - errString = "keyName ?-timeout milliseconds?"; + return BroadcastValue(interp, objc, objv); break; case DeleteIdx: /* delete */ - if (argc == 1) { - return DeleteKey(interp, objv[n], mode); - } else if (argc == 2) { - return DeleteValue(interp, objv[n], objv[n+1], mode); + if (objc == 3) { + return DeleteKey(interp, objv[2]); + } else if (objc == 4) { + return DeleteValue(interp, objv[2], objv[3]); } errString = "keyName ?valueName?"; break; case GetIdx: /* get */ - if (argc == 2) { - return GetValue(interp, objv[n], objv[n+1], mode); + if (objc == 4) { + return GetValue(interp, objv[2], objv[3]); } errString = "keyName valueName"; break; case KeysIdx: /* keys */ - if (argc == 1) { - return GetKeyNames(interp, objv[n], NULL, mode); - } else if (argc == 2) { - return GetKeyNames(interp, objv[n], objv[n+1], mode); + if (objc == 3) { + return GetKeyNames(interp, objv[2], NULL); + } else if (objc == 4) { + return GetKeyNames(interp, objv[2], objv[3]); } errString = "keyName ?pattern?"; break; case SetIdx: /* set */ - if (argc == 1) { + if (objc == 3) { HKEY key; /* * Create the key and then close it immediately. */ - mode |= KEY_ALL_ACCESS; - if (OpenKey(interp, objv[n], mode, 1, &key) != TCL_OK) { + if (OpenKey(interp, objv[2], KEY_ALL_ACCESS, 1, &key) != TCL_OK) { return TCL_ERROR; } RegCloseKey(key); return TCL_OK; - } else if (argc == 3) { - return SetValue(interp, objv[n], objv[n+1], objv[n+2], NULL, - mode); - } else if (argc == 4) { - return SetValue(interp, objv[n], objv[n+1], objv[n+2], objv[n+3], - mode); + } else if (objc == 5 || objc == 6) { + Tcl_Obj *typeObj = (objc == 5) ? NULL : objv[5]; + return SetValue(interp, objv[2], objv[3], objv[4], typeObj); } errString = "keyName ?valueName data ?type??"; break; case TypeIdx: /* type */ - if (argc == 2) { - return GetType(interp, objv[n], objv[n+1], mode); + if (objc == 4) { + return GetType(interp, objv[2], objv[3]); } errString = "keyName valueName"; break; case ValuesIdx: /* values */ - if (argc == 1) { - return GetValueNames(interp, objv[n], NULL, mode); - } else if (argc == 2) { - return GetValueNames(interp, objv[n], objv[n+1], mode); + if (objc == 3) { + return GetValueNames(interp, objv[2], NULL); + } else if (objc == 4) { + return GetValueNames(interp, objv[2], objv[3]); } errString = "keyName ?pattern?"; break; } - Tcl_WrongNumArgs(interp, (mode ? 3 : 2), objv, errString); + Tcl_WrongNumArgs(interp, 2, objv, errString); return TCL_ERROR; } @@ -438,36 +435,33 @@ RegistryObjCmd( static int DeleteKey( Tcl_Interp *interp, /* Current interpreter. */ - Tcl_Obj *keyNameObj, /* Name of key to delete. */ - REGSAM mode) /* Mode flags to pass. */ + Tcl_Obj *keyNameObj) /* Name of key to delete. */ { char *tail, *buffer, *hostName, *keyName; - const WCHAR *nativeTail; + CONST char *nativeTail; HKEY rootKey, subkey; DWORD result; + int length; Tcl_DString buf; - REGSAM saveMode = mode; - Tcl_Size len; /* * Find the parent of the key being deleted and open it. */ - keyName = Tcl_GetStringFromObj(keyNameObj, &len); - buffer = (char *)Tcl_Alloc(len + 1); + keyName = Tcl_GetStringFromObj(keyNameObj, &length); + buffer = ckalloc((unsigned int) length + 1); strcpy(buffer, keyName); if (ParseKeyName(interp, buffer, &hostName, &rootKey, &keyName) != TCL_OK) { - Tcl_Free(buffer); + ckfree(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", (void *)NULL); - Tcl_Free(buffer); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "bad key: cannot delete root keys", -1)); + ckfree(buffer); return TCL_ERROR; } @@ -479,15 +473,15 @@ DeleteKey( keyName = NULL; } - mode |= KEY_ENUMERATE_SUB_KEYS | DELETE; - result = OpenSubKey(hostName, rootKey, keyName, mode, 0, &subkey); + result = OpenSubKey(hostName, rootKey, keyName, + KEY_ENUMERATE_SUB_KEYS | DELETE, 0, &subkey); if (result != ERROR_SUCCESS) { - Tcl_Free(buffer); + ckfree(buffer); if (result == ERROR_FILE_NOT_FOUND) { return TCL_OK; } - Tcl_SetObjResult(interp, - Tcl_NewStringObj("unable to delete key: ", -1)); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "unable to delete key: ", -1)); AppendSystemError(interp, result); return TCL_ERROR; } @@ -496,9 +490,8 @@ DeleteKey( * Now we recursively delete the key and everything below it. */ - Tcl_DStringInit(&buf); - nativeTail = Tcl_UtfToWCharDString(tail, -1, &buf); - result = RecursiveDeleteKey(subkey, nativeTail, saveMode); + nativeTail = Tcl_WinUtfToTChar(tail, -1, &buf); + result = RecursiveDeleteKey(subkey, nativeTail); Tcl_DStringFree(&buf); if (result != ERROR_SUCCESS && result != ERROR_FILE_NOT_FOUND) { @@ -511,7 +504,7 @@ DeleteKey( } RegCloseKey(subkey); - Tcl_Free(buffer); + ckfree(buffer); return result; } @@ -535,33 +528,31 @@ static int DeleteValue( Tcl_Interp *interp, /* Current interpreter. */ Tcl_Obj *keyNameObj, /* Name of key. */ - Tcl_Obj *valueNameObj, /* Name of value to delete. */ - REGSAM mode) /* Mode flags to pass. */ + Tcl_Obj *valueNameObj) /* Name of value to delete. */ { HKEY key; char *valueName; + int length; DWORD result; Tcl_DString ds; - Tcl_Size len; /* * Attempt to open the key for deletion. */ - mode |= KEY_SET_VALUE; - if (OpenKey(interp, keyNameObj, mode, 0, &key) != TCL_OK) { + if (OpenKey(interp, keyNameObj, KEY_SET_VALUE, 0, &key) + != TCL_OK) { return TCL_ERROR; } - valueName = Tcl_GetStringFromObj(valueNameObj, &len); - Tcl_DStringInit(&ds); - Tcl_UtfToWCharDString(valueName, len, &ds); - result = RegDeleteValueW(key, (const WCHAR *)Tcl_DStringValue(&ds)); + valueName = Tcl_GetStringFromObj(valueNameObj, &length); + Tcl_WinUtfToTChar(valueName, length, &ds); + result = (*regWinProcs->regDeleteValueProc)(key, Tcl_DStringValue(&ds)); Tcl_DStringFree(&ds); if (result != ERROR_SUCCESS) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "unable to delete value \"%s\" from key \"%s\": ", - Tcl_GetString(valueNameObj), Tcl_GetString(keyNameObj))); + Tcl_AppendResult(interp, "unable to delete value \"", + Tcl_GetString(valueNameObj), "\" from key \"", + Tcl_GetString(keyNameObj), "\": ", NULL); AppendSystemError(interp, result); result = TCL_ERROR; } else { @@ -594,13 +585,11 @@ static int GetKeyNames( Tcl_Interp *interp, /* Current interpreter. */ Tcl_Obj *keyNameObj, /* Key to enumerate. */ - Tcl_Obj *patternObj, /* Optional match pattern. */ - REGSAM mode) /* Mode flags to pass. */ + Tcl_Obj *patternObj) /* Optional match pattern. */ { - const char *pattern; /* Pattern being matched against subkeys */ + char *pattern; /* Pattern being matched against subkeys */ HKEY key; /* Handle to the key being examined */ - WCHAR buffer[MAX_KEY_LENGTH]; - /* Buffer to hold the subkey name */ + TCHAR buffer[MAX_KEY_LENGTH*2]; /* Buffer to hold the subkey name */ DWORD bufSize; /* Size of the buffer */ DWORD index; /* Position of the current subkey */ char *name; /* Subkey name */ @@ -614,38 +603,40 @@ GetKeyNames( pattern = NULL; } - /* - * Attempt to open the key for enumeration. - */ + /* Attempt to open the key for enumeration. */ - mode |= KEY_QUERY_VALUE | KEY_ENUMERATE_SUB_KEYS; - if (OpenKey(interp, keyNameObj, mode, 0, &key) != TCL_OK) { + if (OpenKey(interp, keyNameObj, + KEY_QUERY_VALUE | KEY_ENUMERATE_SUB_KEYS, + 0, &key) != TCL_OK) { return TCL_ERROR; } - /* - * Enumerate the subkeys. - */ + /* Enumerate the subkeys */ resultPtr = Tcl_NewObj(); for (index = 0;; ++index) { bufSize = MAX_KEY_LENGTH; - result = RegEnumKeyExW(key, index, buffer, &bufSize, - NULL, NULL, NULL, NULL); + result = (*regWinProcs->regEnumKeyExProc) + (key, index, buffer, &bufSize, NULL, NULL, NULL, NULL); if (result != ERROR_SUCCESS) { if (result == ERROR_NO_MORE_ITEMS) { result = TCL_OK; } else { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "unable to enumerate subkeys of \"%s\": ", - Tcl_GetString(keyNameObj))); + Tcl_SetObjResult(interp, Tcl_NewObj()); + Tcl_AppendResult(interp, + "unable to enumerate subkeys of \"", + Tcl_GetString(keyNameObj), "\": ", NULL); AppendSystemError(interp, result); result = TCL_ERROR; } break; } - Tcl_DStringInit(&ds); - name = Tcl_WCharToUtfDString(buffer, bufSize, &ds); + if (regWinProcs->useWide) { + Tcl_WinTCharToUtf((TCHAR *) buffer, bufSize * sizeof(WCHAR), &ds); + } else { + Tcl_WinTCharToUtf((TCHAR *) buffer, bufSize, &ds); + } + name = Tcl_DStringValue(&ds); if (pattern && !Tcl_StringMatch(name, pattern)) { Tcl_DStringFree(&ds); continue; @@ -688,22 +679,22 @@ static int GetType( Tcl_Interp *interp, /* Current interpreter. */ Tcl_Obj *keyNameObj, /* Name of key. */ - Tcl_Obj *valueNameObj, /* Name of value to get. */ - REGSAM mode) /* Mode flags to pass. */ + Tcl_Obj *valueNameObj) /* Name of value to get. */ { HKEY key; - DWORD result, type; + DWORD result; + DWORD type; Tcl_DString ds; - const char *valueName; - const WCHAR *nativeValue; - Tcl_Size len; + char *valueName; + CONST char *nativeValue; + int length; /* * Attempt to open the key for reading. */ - mode |= KEY_QUERY_VALUE; - if (OpenKey(interp, keyNameObj, mode, 0, &key) != TCL_OK) { + if (OpenKey(interp, keyNameObj, KEY_QUERY_VALUE, 0, &key) + != TCL_OK) { return TCL_ERROR; } @@ -711,18 +702,17 @@ GetType( * Get the type of the value. */ - valueName = Tcl_GetStringFromObj(valueNameObj, &len); - Tcl_DStringInit(&ds); - nativeValue = Tcl_UtfToWCharDString(valueName, len, &ds); - result = RegQueryValueExW(key, nativeValue, NULL, &type, + valueName = Tcl_GetStringFromObj(valueNameObj, &length); + nativeValue = Tcl_WinUtfToTChar(valueName, length, &ds); + result = (*regWinProcs->regQueryValueExProc)(key, nativeValue, NULL, &type, NULL, NULL); Tcl_DStringFree(&ds); RegCloseKey(key); if (result != ERROR_SUCCESS) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "unable to get type of value \"%s\" from key \"%s\": ", - Tcl_GetString(valueNameObj), Tcl_GetString(keyNameObj))); + Tcl_AppendResult(interp, "unable to get type of value \"", + Tcl_GetString(valueNameObj), "\" from key \"", + Tcl_GetString(keyNameObj), "\": ", NULL); AppendSystemError(interp, result); return TCL_ERROR; } @@ -761,22 +751,20 @@ static int GetValue( Tcl_Interp *interp, /* Current interpreter. */ Tcl_Obj *keyNameObj, /* Name of key. */ - Tcl_Obj *valueNameObj, /* Name of value to get. */ - REGSAM mode) /* Mode flags to pass. */ + Tcl_Obj *valueNameObj) /* Name of value to get. */ { HKEY key; - const char *valueName; - const WCHAR *nativeValue; + char *valueName; + CONST char *nativeValue; DWORD result, length, type; Tcl_DString data, buf; - Tcl_Size len; + int nameLen; /* * Attempt to open the key for reading. */ - mode |= KEY_QUERY_VALUE; - if (OpenKey(interp, keyNameObj, mode, 0, &key) != TCL_OK) { + if (OpenKey(interp, keyNameObj, KEY_QUERY_VALUE, 0, &key) != TCL_OK) { return TCL_ERROR; } @@ -786,19 +774,18 @@ GetValue( * 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 registry in one call. + * 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; + length = TCL_DSTRING_STATIC_SIZE / (regWinProcs->useWide ? 2 : 1) - 1; - valueName = Tcl_GetStringFromObj(valueNameObj, &len); - Tcl_DStringInit(&buf); - nativeValue = Tcl_UtfToWCharDString(valueName, len, &buf); + valueName = Tcl_GetStringFromObj(valueNameObj, &nameLen); + nativeValue = Tcl_WinUtfToTChar(valueName, nameLen, &buf); - result = RegQueryValueExW(key, nativeValue, NULL, &type, + result = (*regWinProcs->regQueryValueExProc)(key, nativeValue, NULL, &type, (BYTE *) Tcl_DStringValue(&data), &length); while (result == ERROR_MORE_DATA) { /* @@ -807,17 +794,17 @@ GetValue( * HKEY_PERFORMANCE_DATA */ - length = Tcl_DStringLength(&data) * (2 / sizeof(WCHAR)); - Tcl_DStringSetLength(&data, length * sizeof(WCHAR)); - result = RegQueryValueExW(key, nativeValue, + length = Tcl_DStringLength(&data) * (regWinProcs->useWide ? 1 : 2); + Tcl_DStringSetLength(&data, (int) length * (regWinProcs->useWide ? 2 : 1)); + result = (*regWinProcs->regQueryValueExProc)(key, (char *) nativeValue, NULL, &type, (BYTE *) Tcl_DStringValue(&data), &length); } Tcl_DStringFree(&buf); RegCloseKey(key); if (result != ERROR_SUCCESS) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "unable to get value \"%s\" from key \"%s\": ", - Tcl_GetString(valueNameObj), Tcl_GetString(keyNameObj))); + Tcl_AppendResult(interp, "unable to get value \"", + Tcl_GetString(valueNameObj), "\" from key \"", + Tcl_GetString(keyNameObj), "\": ", NULL); AppendSystemError(interp, result); Tcl_DStringFree(&data); return TCL_ERROR; @@ -832,7 +819,7 @@ GetValue( if (type == REG_DWORD || type == REG_DWORD_BIG_ENDIAN) { Tcl_SetObjResult(interp, Tcl_NewIntObj((int) ConvertDWORD(type, - *((DWORD *) Tcl_DStringValue(&data))))); + *((DWORD*) Tcl_DStringValue(&data))))); } else if (type == REG_MULTI_SZ) { char *p = Tcl_DStringValue(&data); char *end = Tcl_DStringValue(&data) + length; @@ -844,24 +831,24 @@ GetValue( * we get bogus data. */ - while ((p < end) && *((WCHAR *) p) != 0) { - WCHAR *wp = (WCHAR *) p; - - Tcl_DStringInit(&buf); - Tcl_WCharToUtfDString(wp, wcslen(wp), &buf); + while (p < end && ((regWinProcs->useWide) + ? *((Tcl_UniChar *)p) : *p) != 0) { + Tcl_WinTCharToUtf((TCHAR *) p, -1, &buf); Tcl_ListObjAppendElement(interp, resultPtr, Tcl_NewStringObj(Tcl_DStringValue(&buf), Tcl_DStringLength(&buf))); - - while (*wp++ != 0); /* empty loop body */ - p = (char *) wp; + if (regWinProcs->useWide) { + Tcl_UniChar* up = (Tcl_UniChar*) p; + while (*up++ != 0) {} + p = (char*) up; + } else { + while (*p++ != '\0') {} + } Tcl_DStringFree(&buf); } Tcl_SetObjResult(interp, resultPtr); } 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_WinTCharToUtf((TCHAR *) Tcl_DStringValue(&data), -1, &buf); Tcl_DStringResult(interp, &buf); } else { /* @@ -869,7 +856,7 @@ GetValue( */ Tcl_SetObjResult(interp, Tcl_NewByteArrayObj( - (BYTE *) Tcl_DStringValue(&data), length)); + (BYTE *) Tcl_DStringValue(&data), (int) length)); } Tcl_DStringFree(&data); return result; @@ -880,7 +867,7 @@ GetValue( * * GetValueNames -- * - * This function enumerates the values of the given key. If the + * 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. * @@ -898,27 +885,27 @@ static int GetValueNames( Tcl_Interp *interp, /* Current interpreter. */ Tcl_Obj *keyNameObj, /* Key to enumerate. */ - Tcl_Obj *patternObj, /* Optional match pattern. */ - REGSAM mode) /* Mode flags to pass. */ + Tcl_Obj *patternObj) /* Optional match pattern. */ { HKEY key; Tcl_Obj *resultPtr; DWORD index, size, result; Tcl_DString buffer, ds; - const char *pattern, *name; + char *pattern, *name; /* * Attempt to open the key for enumeration. */ - mode |= KEY_QUERY_VALUE; - if (OpenKey(interp, keyNameObj, mode, 0, &key) != TCL_OK) { + if (OpenKey(interp, keyNameObj, KEY_QUERY_VALUE, 0, &key) + != TCL_OK) { return TCL_ERROR; } resultPtr = Tcl_NewObj(); Tcl_DStringInit(&buffer); - Tcl_DStringSetLength(&buffer, MAX_KEY_LENGTH * sizeof(WCHAR)); + Tcl_DStringSetLength(&buffer, + (int) ((regWinProcs->useWide) ? MAX_KEY_LENGTH*2 : MAX_KEY_LENGTH)); index = 0; result = TCL_OK; @@ -935,10 +922,16 @@ GetValueNames( */ 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); + while ((*regWinProcs->regEnumValueProc)(key, index, + Tcl_DStringValue(&buffer), &size, NULL, NULL, NULL, NULL) + == ERROR_SUCCESS) { + + if (regWinProcs->useWide) { + size *= 2; + } + + Tcl_WinTCharToUtf((TCHAR *) Tcl_DStringValue(&buffer), (int) size, + &ds); name = Tcl_DStringValue(&ds); if (!pattern || Tcl_StringMatch(name, pattern)) { result = Tcl_ListObjAppendElement(interp, resultPtr, @@ -985,12 +978,12 @@ OpenKey( HKEY *keyPtr) /* Returned HKEY. */ { char *keyName, *buffer, *hostName; + int length; HKEY rootKey; DWORD result; - Tcl_Size len; - keyName = Tcl_GetStringFromObj(keyNameObj, &len); - buffer = (char *)Tcl_Alloc(len + 1); + keyName = Tcl_GetStringFromObj(keyNameObj, &length); + buffer = ckalloc((unsigned int) length + 1); strcpy(buffer, keyName); result = ParseKeyName(interp, buffer, &hostName, &rootKey, &keyName); @@ -1006,7 +999,7 @@ OpenKey( } } - Tcl_Free(buffer); + ckfree(buffer); return result; } @@ -1015,7 +1008,7 @@ OpenKey( * * OpenSubKey -- * - * Opens a given subkey of the given root key on the specified + * This function opens a given subkey of a root key on the specified * host. * * Results: @@ -1045,9 +1038,8 @@ OpenSubKey( */ if (hostName) { - Tcl_DStringInit(&buf); - hostName = (char *) Tcl_UtfToWCharDString(hostName, -1, &buf); - result = RegConnectRegistryW((WCHAR *)hostName, rootKey, + hostName = (char *) Tcl_WinUtfToTChar(hostName, -1, &buf); + result = (*regWinProcs->regConnectRegistryProc)(hostName, rootKey, &rootKey); Tcl_DStringFree(&buf); if (result != ERROR_SUCCESS) { @@ -1060,30 +1052,23 @@ OpenSubKey( * this key must be closed by the caller. */ - if (keyName) { - Tcl_DStringInit(&buf); - keyName = (char *) Tcl_UtfToWCharDString(keyName, -1, &buf); - } + keyName = (char *) Tcl_WinUtfToTChar(keyName, -1, &buf); if (flags & REG_CREATE) { DWORD create; - - result = RegCreateKeyExW(rootKey, (WCHAR *)keyName, 0, NULL, + result = (*regWinProcs->regCreateKeyExProc)(rootKey, keyName, 0, NULL, REG_OPTION_NON_VOLATILE, mode, NULL, keyPtr, &create); } else if (rootKey == HKEY_PERFORMANCE_DATA) { /* * Here we fudge it for this special root key. See MSDN for more info * on HKEY_PERFORMANCE_DATA and the peculiarities surrounding it. */ - *keyPtr = HKEY_PERFORMANCE_DATA; result = ERROR_SUCCESS; } else { - result = RegOpenKeyExW(rootKey, (WCHAR *)keyName, 0, mode, + result = (*regWinProcs->regOpenKeyExProc)(rootKey, keyName, 0, mode, keyPtr); } - if (keyName) { - Tcl_DStringFree(&buf); - } + Tcl_DStringFree(&buf); /* * Be sure to close the root key since we are done with it now. @@ -1100,7 +1085,7 @@ OpenSubKey( * * ParseKeyName -- * - * Parses a key name into the host, root, and subkey parts. + * This function parses a key name into the host, root, and subkey parts. * * Results: * The pointers to the start of the host and subkey names are returned in @@ -1144,9 +1129,8 @@ ParseKeyName( rootName = name; } if (!rootName) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "bad key \"%s\": must start with a valid root", name)); - Tcl_SetErrorCode(interp, "WIN_REG", "NO_ROOT_KEY", (void *)NULL); + Tcl_AppendResult(interp, "bad key \"", name, + "\": must start with a valid root", NULL); return TCL_ERROR; } @@ -1198,16 +1182,12 @@ ParseKeyName( static DWORD RecursiveDeleteKey( HKEY startKey, /* Parent of key to be deleted. */ - const WCHAR *keyName, /* Name of key to be deleted in external + CONST char *keyName) /* Name of key to be deleted in external * encoding, not UTF. */ - REGSAM mode) /* Mode flags to pass. */ { DWORD result, size; Tcl_DString subkey; HKEY hKey; - REGSAM saveMode = mode; - static int checkExProc = 0; - static LONG (* regDeleteKeyExProc) (HKEY, LPCWSTR, REGSAM, DWORD) = (LONG (*) (HKEY, LPCWSTR, REGSAM, DWORD)) NULL; /* * Do not allow NULL or empty key name. @@ -1217,48 +1197,29 @@ RecursiveDeleteKey( return ERROR_BADKEY; } - mode |= KEY_ENUMERATE_SUB_KEYS | DELETE | KEY_QUERY_VALUE; - result = RegOpenKeyExW(startKey, keyName, 0, mode, &hKey); + result = (*regWinProcs->regOpenKeyExProc)(startKey, keyName, 0, + KEY_ENUMERATE_SUB_KEYS | DELETE | KEY_QUERY_VALUE, &hKey); if (result != ERROR_SUCCESS) { return result; } Tcl_DStringInit(&subkey); - Tcl_DStringSetLength(&subkey, MAX_KEY_LENGTH * sizeof(WCHAR)); + Tcl_DStringSetLength(&subkey, + (int) ((regWinProcs->useWide) ? MAX_KEY_LENGTH * 2 : MAX_KEY_LENGTH)); - mode = saveMode; while (result == ERROR_SUCCESS) { /* * Always get index 0 because key deletion changes ordering. */ size = MAX_KEY_LENGTH; - result = RegEnumKeyExW(hKey, 0, (WCHAR *)Tcl_DStringValue(&subkey), - &size, NULL, NULL, NULL, NULL); + result=(*regWinProcs->regEnumKeyExProc)(hKey, 0, + Tcl_DStringValue(&subkey), &size, NULL, NULL, NULL, NULL); if (result == ERROR_NO_MORE_ITEMS) { - /* - * RegDeleteKeyEx doesn't exist on non-64bit XP platforms, so we - * can't compile with it in. We need to check for it at runtime - * and use it if we find it. - */ - - if (mode && !checkExProc) { - HMODULE handle; - - checkExProc = 1; - handle = GetModuleHandleW(L"ADVAPI32"); - regDeleteKeyExProc = (LONG (*) (HKEY, LPCWSTR, REGSAM, DWORD)) - (void *)GetProcAddress(handle, "RegDeleteKeyExW"); - } - if (mode && regDeleteKeyExProc) { - result = regDeleteKeyExProc(startKey, keyName, mode, 0); - } else { - result = RegDeleteKeyW(startKey, keyName); - } + result = (*regWinProcs->regDeleteKeyProc)(startKey, keyName); break; } else if (result == ERROR_SUCCESS) { - result = RecursiveDeleteKey(hKey, - (const WCHAR *) Tcl_DStringValue(&subkey), mode); + result = RecursiveDeleteKey(hKey, Tcl_DStringValue(&subkey)); } } Tcl_DStringFree(&subkey); @@ -1290,33 +1251,30 @@ SetValue( Tcl_Obj *keyNameObj, /* Name of key. */ Tcl_Obj *valueNameObj, /* Name of value to set. */ Tcl_Obj *dataObj, /* Data to be written. */ - Tcl_Obj *typeObj, /* Type of data to be written. */ - REGSAM mode) /* Mode flags to pass. */ + Tcl_Obj *typeObj) /* Type of data to be written. */ { int type; DWORD result; HKEY key; - const char *valueName; + int length; + char *valueName; Tcl_DString nameBuf; - Tcl_Size len; if (typeObj == NULL) { type = REG_SZ; } else if (Tcl_GetIndexFromObj(interp, typeObj, typeNames, "type", 0, (int *) &type) != TCL_OK) { - if (Tcl_GetIntFromObj(NULL, typeObj, (int *) &type) != TCL_OK) { + if (Tcl_GetIntFromObj(NULL, typeObj, (int*) &type) != TCL_OK) { return TCL_ERROR; } Tcl_ResetResult(interp); } - mode |= KEY_ALL_ACCESS; - if (OpenKey(interp, keyNameObj, mode, 1, &key) != TCL_OK) { + if (OpenKey(interp, keyNameObj, KEY_ALL_ACCESS, 1, &key) != TCL_OK) { return TCL_ERROR; } - valueName = Tcl_GetStringFromObj(valueNameObj, &len); - Tcl_DStringInit(&nameBuf); - valueName = (char *) Tcl_UtfToWCharDString(valueName, len, &nameBuf); + valueName = Tcl_GetStringFromObj(valueNameObj, &length); + valueName = (char *) Tcl_WinUtfToTChar(valueName, length, &nameBuf); if (type == REG_DWORD || type == REG_DWORD_BIG_ENDIAN) { int value; @@ -1327,12 +1285,12 @@ SetValue( return TCL_ERROR; } - value = ConvertDWORD((DWORD) type, (DWORD) value); - result = RegSetValueExW(key, (WCHAR *) valueName, 0, + value = ConvertDWORD((DWORD)type, (DWORD)value); + result = (*regWinProcs->regSetValueExProc)(key, valueName, 0, (DWORD) type, (BYTE *) &value, sizeof(DWORD)); } else if (type == REG_MULTI_SZ) { Tcl_DString data, buf; - Tcl_Size objc, i; + int objc, i; Tcl_Obj **objv; if (Tcl_ListObjGetElements(interp, dataObj, &objc, &objv) != TCL_OK) { @@ -1349,52 +1307,53 @@ SetValue( Tcl_DStringInit(&data); for (i = 0; i < objc; i++) { - const char *bytes = Tcl_GetStringFromObj(objv[i], &len); - - Tcl_DStringAppend(&data, bytes, len); + Tcl_DStringAppend(&data, Tcl_GetString(objv[i]), -1); /* - * Add a null character to separate this value from the next. + * Add a null character to separate this value from the next. We + * accomplish this by growing the string by one byte. Since the + * DString always tacks on an extra null byte, the new byte will + * already be set to null. */ - Tcl_DStringAppend(&data, "", 1); /* NUL-terminated string */ + Tcl_DStringSetLength(&data, Tcl_DStringLength(&data)+1); } - Tcl_DStringInit(&buf); - Tcl_UtfToWCharDString(Tcl_DStringValue(&data), Tcl_DStringLength(&data)+1, + Tcl_WinUtfToTChar(Tcl_DStringValue(&data), Tcl_DStringLength(&data)+1, &buf); - result = RegSetValueExW(key, (WCHAR *) valueName, 0, - (DWORD) type, (BYTE *) Tcl_DStringValue(&buf), + result = (*regWinProcs->regSetValueExProc)(key, valueName, 0, + (DWORD) type, (BYTE *) Tcl_DStringValue(&buf), (DWORD) Tcl_DStringLength(&buf)); Tcl_DStringFree(&data); Tcl_DStringFree(&buf); } else if (type == REG_SZ || type == REG_EXPAND_SZ) { Tcl_DString buf; - const char *data = Tcl_GetStringFromObj(dataObj, &len); + CONST char *data = Tcl_GetStringFromObj(dataObj, &length); - Tcl_DStringInit(&buf); - data = (char *) Tcl_UtfToWCharDString(data, len, &buf); + data = Tcl_WinUtfToTChar(data, length, &buf); /* - * Include the null in the length, padding if needed for WCHAR. + * Include the null in the length, padding if needed for Unicode. */ - Tcl_DStringSetLength(&buf, Tcl_DStringLength(&buf)+1); + if (regWinProcs->useWide) { + Tcl_DStringSetLength(&buf, Tcl_DStringLength(&buf)+1); + } + length = Tcl_DStringLength(&buf) + 1; - result = RegSetValueExW(key, (WCHAR *) valueName, 0, - (DWORD) type, (BYTE *) data, (DWORD) Tcl_DStringLength(&buf) + 1); + result = (*regWinProcs->regSetValueExProc)(key, valueName, 0, + (DWORD) type, (BYTE *) data, (DWORD) length); Tcl_DStringFree(&buf); } else { BYTE *data; - Tcl_Size bytelength; /* * Store binary data in the registry. */ - data = (BYTE *) Tcl_GetByteArrayFromObj(dataObj, &bytelength); - result = RegSetValueExW(key, (WCHAR *) valueName, 0, - (DWORD) type, data, (DWORD) bytelength); + data = (BYTE *) Tcl_GetByteArrayFromObj(dataObj, &length); + result = (*regWinProcs->regSetValueExProc)(key, valueName, 0, + (DWORD) type, data, (DWORD) length); } Tcl_DStringFree(&nameBuf); @@ -1429,46 +1388,48 @@ SetValue( static int BroadcastValue( Tcl_Interp *interp, /* Current interpreter. */ - Tcl_Size objc, /* Number of arguments. */ - Tcl_Obj *const objv[]) /* Argument values. */ + int objc, /* Number of arguments. */ + Tcl_Obj *CONST objv[]) /* Argument values. */ { LRESULT result; DWORD_PTR sendResult; - int timeout = 3000; - Tcl_Size len; - const char *str; + UINT timeout = 3000; + int len; + CONST char *str; Tcl_Obj *objPtr; - WCHAR *wstr; - Tcl_DString ds; - if (objc == 3) { - str = Tcl_GetStringFromObj(objv[1], &len); - if ((len < 2) || (*str != '-') || strncmp(str, "-timeout", len)) { - return TCL_BREAK; + if ((objc != 3) && (objc != 5)) { + Tcl_WrongNumArgs(interp, 2, objv, "keyName ?-timeout millisecs?"); + return TCL_ERROR; + } + + if (objc > 3) { + str = Tcl_GetStringFromObj(objv[3], &len); + if ((len < 2) || (*str != '-') + || strncmp(str, "-timeout", (size_t) len)) { + Tcl_WrongNumArgs(interp, 2, objv, "keyName ?-timeout millisecs?"); + return TCL_ERROR; } - if (Tcl_GetIntFromObj(interp, objv[2], &timeout) != TCL_OK) { + if (Tcl_GetIntFromObj(interp, objv[4], (int *) &timeout) != TCL_OK) { return TCL_ERROR; } } - str = Tcl_GetStringFromObj(objv[0], &len); - Tcl_DStringInit(&ds); - wstr = Tcl_UtfToWCharDString(str, len, &ds); - if (Tcl_DStringLength(&ds) == 0) { - wstr = NULL; + str = Tcl_GetStringFromObj(objv[2], &len); + if (len == 0) { + str = NULL; } /* * Use the ignore the result. */ - result = SendMessageTimeoutW(HWND_BROADCAST, WM_SETTINGCHANGE, - (WPARAM) 0, (LPARAM) wstr, SMTO_ABORTIFHUNG, (UINT) timeout, &sendResult); - Tcl_DStringFree(&ds); + result = SendMessageTimeout(HWND_BROADCAST, WM_SETTINGCHANGE, + (WPARAM) 0, (LPARAM) str, SMTO_ABORTIFHUNG, timeout, &sendResult); objPtr = Tcl_NewObj(); - Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewWideIntObj((Tcl_WideInt) result)); - Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewWideIntObj((Tcl_WideInt) sendResult)); + Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewLongObj((long) result)); + Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewLongObj((long) sendResult)); Tcl_SetObjResult(interp, objPtr); return TCL_OK; @@ -1479,7 +1440,7 @@ BroadcastValue( * * AppendSystemError -- * - * Formats a Windows system error message and places it into + * This routine formats a Windows system error message and places it into * the interpreter result. * * Results: @@ -1497,8 +1458,8 @@ AppendSystemError( DWORD error) /* Result code from error. */ { int length; - WCHAR *tMsgPtr, **tMsgPtrPtr = &tMsgPtr; - const char *msg; + WCHAR *wMsgPtr, **wMsgPtrPtr = &wMsgPtr; + char *msg; char id[TCL_INTEGER_SPACE], msgBuf[24 + TCL_INTEGER_SPACE]; Tcl_DString ds; Tcl_Obj *resultPtr = Tcl_GetObjResult(interp); @@ -1508,37 +1469,54 @@ AppendSystemError( } length = FormatMessageW(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_ALLOCATE_BUFFER, NULL, error, - MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (WCHAR *) tMsgPtrPtr, + MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (WCHAR *) wMsgPtrPtr, 0, NULL); if (length == 0) { - snprintf(msgBuf, sizeof(msgBuf), "unknown error: %ld", error); - msg = msgBuf; - } else { char *msgPtr; - Tcl_DStringInit(&ds); - Tcl_WCharToUtfDString(tMsgPtr, wcslen(tMsgPtr), &ds); - LocalFree(tMsgPtr); + length = FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM + | FORMAT_MESSAGE_ALLOCATE_BUFFER, NULL, error, + MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (char *) &msgPtr, + 0, NULL); + if (length > 0) { + wMsgPtr = (WCHAR *) LocalAlloc(LPTR, (length + 1) * sizeof(WCHAR)); + MultiByteToWideChar(CP_ACP, 0, msgPtr, length + 1, wMsgPtr, + length + 1); + LocalFree(msgPtr); + } + } + if (length == 0) { + if (error == ERROR_CALL_NOT_IMPLEMENTED) { + msg = "function not supported under Win32s"; + } else { + sprintf(msgBuf, "unknown error: %ld", error); + msg = msgBuf; + } + } else { + Tcl_Encoding encoding; + + encoding = Tcl_GetEncoding(NULL, "unicode"); + Tcl_ExternalToUtfDString(encoding, (char *) wMsgPtr, -1, &ds); + Tcl_FreeEncoding(encoding); + LocalFree(wMsgPtr); - msgPtr = Tcl_DStringValue(&ds); + msg = Tcl_DStringValue(&ds); length = Tcl_DStringLength(&ds); /* * Trim the trailing CR/LF from the system message. */ - if (msgPtr[length-1] == '\n') { - --length; + if (msg[length-1] == '\n') { + msg[--length] = 0; } - if (msgPtr[length-1] == '\r') { - --length; + if (msg[length-1] == '\r') { + msg[--length] = 0; } - msgPtr[length] = 0; - msg = msgPtr; } - snprintf(id, sizeof(id), "%ld", error); - Tcl_SetErrorCode(interp, "WINDOWS", id, msg, (void *)NULL); + sprintf(id, "%ld", error); + Tcl_SetErrorCode(interp, "WINDOWS", id, msg, NULL); Tcl_AppendToObj(resultPtr, msg, length); Tcl_SetObjResult(interp, resultPtr); @@ -1552,7 +1530,7 @@ AppendSystemError( * * ConvertDWORD -- * - * Determines whether a DWORD needs to be byte swapped, and + * This function determines whether a DWORD needs to be byte swapped, and * returns the appropriately swapped value. * * Results: @@ -1569,15 +1547,14 @@ ConvertDWORD( DWORD type, /* Either REG_DWORD or REG_DWORD_BIG_ENDIAN */ DWORD value) /* The value to be converted. */ { - const DWORD order = 1; + DWORD order = 1; DWORD localType; /* * Check to see if the low bit is in the first byte. */ - localType = (*((const char *) &order) == 1) - ? REG_DWORD : REG_DWORD_BIG_ENDIAN; + localType = (*((char*) &order) == 1) ? REG_DWORD : REG_DWORD_BIG_ENDIAN; return (type != localType) ? (DWORD) SWAPLONG(value) : value; } diff --git a/win/tclWinSerial.c b/win/tclWinSerial.c index 635e978..83f1866 100644 --- a/win/tclWinSerial.c +++ b/win/tclWinSerial.c @@ -4,7 +4,7 @@ * This file implements the Windows-specific serial port functions, and * the "serial" channel driver. * - * Copyright © 1999 Scriptics Corp. + * 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. @@ -44,15 +44,6 @@ TCL_DECLARE_MUTEX(serialMutex) #define SERIAL_ERROR (1<<4) /* - * Bit masks used for noting whether to drain or discard output on close. They - * are disjoint from each other; at most one may be set at a time. - */ - -#define SERIAL_CLOSE_DRAIN (1<<6) /* Drain all output on close. */ -#define SERIAL_CLOSE_DISCARD (1<<7) /* Discard all output on close. */ -#define SERIAL_CLOSE_MASK (3<<6) /* Both two bits above. */ - -/* * Default time to block between checking status on the serial port. */ @@ -85,7 +76,7 @@ typedef struct SerialInfo { int readable; /* Flag that the channel is readable. */ int writable; /* Flag that the channel is writable. */ int blockTime; /* Maximum blocktime in msec. */ - unsigned long long lastEventTime; /* Time in milliseconds since last readable + unsigned int lastEventTime; /* Time in milliseconds since last readable * event. */ /* Next readable event only after blockTime */ DWORD error; /* pending error code returned by @@ -102,12 +93,17 @@ typedef struct SerialInfo { * 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. */ + HANDLE evStartWriter; /* Auto-reset event used by the main thread to + * signal when the writer thread should + * attempt to write to the serial. */ + HANDLE evStopWriter; /* Auto-reset event used by the main thread to + * signal when the writer thread should close. + */ 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 @@ -124,7 +120,7 @@ typedef struct SerialInfo { * [fconfigure -queue] */ } SerialInfo; -typedef struct { +typedef struct ThreadSpecificData { /* * The following pointer refers to the head of the list of serials that * are being watched for file events. @@ -140,7 +136,7 @@ static Tcl_ThreadDataKey dataKey; * events are generated. */ -typedef struct { +typedef struct SerialEvent { Tcl_Event header; /* Information that is standard for all * events. */ SerialInfo *infoPtr; /* Pointer to serial info structure. Note that @@ -165,30 +161,30 @@ static COMMTIMEOUTS no_timeout = { * Declarations for functions used only in this file. */ -static int SerialBlockProc(void *instanceData, int mode); -static void SerialCheckProc(void *clientData, int flags); -static int SerialCloseProc(void *instanceData, - Tcl_Interp *interp, int flags); +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(void *clientData); -static int SerialGetHandleProc(void *instanceData, - int direction, void **handlePtr); +static void SerialExitHandler(ClientData clientData); +static int SerialGetHandleProc(ClientData instanceData, + int direction, ClientData *handlePtr); static ThreadSpecificData *SerialInit(void); -static int SerialInputProc(void *instanceData, char *buf, +static int SerialInputProc(ClientData instanceData, char *buf, int toRead, int *errorCode); -static int SerialOutputProc(void *instanceData, - const char *buf, int toWrite, int *errorCode); -static void SerialSetupProc(void *clientData, int flags); -static void SerialWatchProc(void *instanceData, int mask); -static void ProcExitHandler(void *clientData); -static int SerialGetOptionProc(void *instanceData, - Tcl_Interp *interp, const char *optionName, +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(void *instanceData, - Tcl_Interp *interp, const char *optionName, - const char *value); +static int SerialSetOptionProc(ClientData instanceData, + Tcl_Interp *interp, CONST char *optionName, + CONST char *value); static DWORD WINAPI SerialWriterThread(LPVOID arg); -static void SerialThreadActionProc(void *instanceData, +static void SerialThreadActionProc(ClientData instanceData, int action); static int SerialBlockingRead(SerialInfo *infoPtr, LPVOID buf, DWORD bufSize, LPDWORD lpRead, LPOVERLAPPED osPtr); @@ -201,10 +197,10 @@ static int SerialBlockingWrite(SerialInfo *infoPtr, LPVOID buf, * based IO. */ -static const Tcl_ChannelType serialChannelType = { +static Tcl_ChannelType serialChannelType = { "serial", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ - TCL_CLOSE2PROC, /* Close proc. */ + SerialCloseProc, /* Close proc. */ SerialInputProc, /* Input proc. */ SerialOutputProc, /* Output proc. */ NULL, /* Seek proc. */ @@ -212,13 +208,13 @@ static const Tcl_ChannelType serialChannelType = { SerialGetOptionProc, /* Get option proc. */ SerialWatchProc, /* Set up notifier to watch the channel. */ SerialGetHandleProc, /* Get an OS handle from channel. */ - SerialCloseProc, /* close2proc. */ + 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 */ + NULL, /* truncate */ }; /* @@ -285,7 +281,7 @@ SerialInit(void) static void SerialExitHandler( - TCL_UNUSED(void *)) + ClientData clientData) /* Old window proc */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); SerialInfo *infoPtr; @@ -323,7 +319,7 @@ SerialExitHandler( static void ProcExitHandler( - TCL_UNUSED(void *)) + ClientData clientData) /* Old window proc */ { Tcl_MutexLock(&serialMutex); initialized = 0; @@ -335,7 +331,7 @@ ProcExitHandler( * * SerialBlockTime -- * - * Wrapper to set Tcl's block time in msec. + * Wrapper to set Tcl's block time in msec * * Results: * None. @@ -373,14 +369,14 @@ SerialBlockTime( *---------------------------------------------------------------------- */ -static unsigned long long +static unsigned int SerialGetMilliseconds(void) { Tcl_Time time; - Tcl_GetTime(&time); + TclpGetTime(&time); - return ((unsigned long long)time.sec * 1000 + (unsigned long)time.usec / 1000); + return (time.sec * 1000 + time.usec / 1000); } /* @@ -400,13 +396,9 @@ SerialGetMilliseconds(void) *---------------------------------------------------------------------- */ -#ifdef __cplusplus -#define min(a, b) (((a) < (b)) ? (a) : (b)) -#endif - void SerialSetupProc( - TCL_UNUSED(void *), + ClientData data, /* Not used. */ int flags) /* Event flags as passed to Tcl_DoOneEvent. */ { SerialInfo *infoPtr; @@ -461,7 +453,7 @@ SerialSetupProc( static void SerialCheckProc( - TCL_UNUSED(void *), + ClientData data, /* Not used. */ int flags) /* Event flags as passed to Tcl_DoOneEvent. */ { SerialInfo *infoPtr; @@ -469,7 +461,7 @@ SerialCheckProc( int needEvent; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); COMSTAT cStat; - unsigned long long time; + unsigned int time; if (!(flags & TCL_FILE_EVENTS)) { return; @@ -519,8 +511,8 @@ SerialCheckProc( (infoPtr->error & SERIAL_READ_ERRORS)) { infoPtr->readable = 1; time = SerialGetMilliseconds(); - if ((time - infoPtr->lastEventTime) - >= (unsigned long long) infoPtr->blockTime) { + if ((unsigned int) (time - infoPtr->lastEventTime) + >= (unsigned int) infoPtr->blockTime) { needEvent = 1; infoPtr->lastEventTime = time; } @@ -535,7 +527,7 @@ SerialCheckProc( if (needEvent) { infoPtr->flags |= SERIAL_PENDING; - evPtr = (SerialEvent *)ckalloc(sizeof(SerialEvent)); + evPtr = (SerialEvent *) ckalloc(sizeof(SerialEvent)); evPtr->header.proc = SerialEventProc; evPtr->infoPtr = infoPtr; Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL); @@ -561,7 +553,7 @@ SerialCheckProc( static int SerialBlockProc( - void *instanceData, /* Instance data for channel. */ + ClientData instanceData, /* Instance data for channel. */ int mode) /* TCL_MODE_BLOCKING or * TCL_MODE_NONBLOCKING. */ { @@ -600,19 +592,16 @@ SerialBlockProc( static int SerialCloseProc( - void *instanceData, /* Pointer to SerialInfo structure. */ - TCL_UNUSED(Tcl_Interp *), - int flags) + ClientData instanceData, /* Pointer to SerialInfo structure. */ + Tcl_Interp *interp) /* For error reporting. */ { SerialInfo *serialPtr = (SerialInfo *) instanceData; - int errorCode = 0, result = 0; + int errorCode, result = 0; SerialInfo *infoPtr, **nextPtrPtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + DWORD exitCode; - if ((flags & (TCL_CLOSE_READ | TCL_CLOSE_WRITE)) != 0) { - return EINVAL; - } - + errorCode = 0; if (serialPtr->validMask & TCL_READABLE) { PurgeComm(serialPtr->handle, PURGE_RXABORT | PURGE_RXCLEAR); @@ -620,12 +609,56 @@ SerialCloseProc( } serialPtr->validMask &= ~TCL_READABLE; - if (serialPtr->writeThread) { - TclPipeThreadStop(&serialPtr->writeTI, serialPtr->writeThread); + if (serialPtr->validMask & TCL_WRITABLE) { + /* + * Generally we cannot wait for a pending write operation because it + * may hang due to handshake + * WaitForSingleObject(serialPtr->evWritable, INFINITE); + */ + /* + * The thread may have already closed on it's own. Check it's exit + * code. + */ + + GetExitCodeThread(serialPtr->writeThread, &exitCode); + + if (exitCode == STILL_ACTIVE) { + /* + * Set the stop event so that if the writer thread is blocked in + * SerialWriterThread on WaitForMultipleEvents, it will exit + * cleanly. + */ + + SetEvent(serialPtr->evStopWriter); + + /* + * Wait at most 20 milliseconds for the writer thread to close. + */ + + if (WaitForSingleObject(serialPtr->writeThread, + 20) == WAIT_TIMEOUT) { + /* + * Forcibly terminate the background thread as a last resort. + * Note that we need to guard against terminating the thread + * while it is in the middle of Tcl_ThreadAlert because it + * won't be able to release the notifier lock. + */ + + Tcl_MutexLock(&serialMutex); + + /* BUG: this leaks memory */ + TerminateThread(serialPtr->writeThread, 0); + + Tcl_MutexUnlock(&serialMutex); + } + } + + CloseHandle(serialPtr->writeThread); CloseHandle(serialPtr->osWrite.hEvent); CloseHandle(serialPtr->evWritable); - CloseHandle(serialPtr->writeThread); + CloseHandle(serialPtr->evStartWriter); + CloseHandle(serialPtr->evStopWriter); serialPtr->writeThread = NULL; PurgeComm(serialPtr->handle, PURGE_TXABORT | PURGE_TXCLEAR); @@ -645,7 +678,7 @@ SerialCloseProc( && (GetStdHandle(STD_OUTPUT_HANDLE) != serialPtr->handle) && (GetStdHandle(STD_ERROR_HANDLE) != serialPtr->handle))) { if (CloseHandle(serialPtr->handle) == FALSE) { - Tcl_WinConvertError(GetLastError()); + TclWinConvertError(GetLastError()); errorCode = errno; } } @@ -673,7 +706,7 @@ SerialCloseProc( ckfree(serialPtr->writeBuf); serialPtr->writeBuf = NULL; } - ckfree(serialPtr); + ckfree((char*) serialPtr); if (errorCode == 0) { return result; @@ -855,7 +888,7 @@ SerialBlockingWrite( static int SerialInputProc( - void *instanceData, /* Serial state. */ + ClientData instanceData, /* Serial state. */ char *buf, /* Where to store data read. */ int bufSize, /* How much space is available in the * buffer? */ @@ -899,12 +932,12 @@ SerialInputProc( bufSize = cStat.cbInQue; } } else { - errno = *errorCode = EWOULDBLOCK; + errno = *errorCode = EAGAIN; return -1; } } else { /* - * BLOCKING mode: Tcl tries to read a full buffer of 4 kBytes here. + * BLOCKING mode: Tcl trys to read a full buffer of 4 kBytes here. */ if (cStat.cbInQue > 0) { @@ -918,7 +951,7 @@ SerialInputProc( } if (bufSize == 0) { - return 0; + return bytesRead = 0; } /* @@ -928,7 +961,7 @@ SerialInputProc( if (SerialBlockingRead(infoPtr, (LPVOID) buf, (DWORD) bufSize, &bytesRead, &infoPtr->osRead) == FALSE) { - Tcl_WinConvertError(GetLastError()); + TclWinConvertError(GetLastError()); *errorCode = errno; return -1; } @@ -962,8 +995,8 @@ SerialInputProc( static int SerialOutputProc( - void *instanceData, /* Serial state. */ - const char *buf, /* The data buffer. */ + ClientData instanceData, /* Serial state. */ + CONST char *buf, /* The data buffer. */ int toWrite, /* How many bytes to write? */ int *errorCode) /* Where to store error code. */ { @@ -973,9 +1006,9 @@ SerialOutputProc( *errorCode = 0; /* - * At EXIT Tcl tries to flush all open channels in blocking mode. We avoid + * 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 corresponding variables. + * checking the corrresponding variables. */ if (!initialized || TclInExit()) { @@ -1010,7 +1043,7 @@ SerialOutputProc( */ if (infoPtr->writeError) { - Tcl_WinConvertError(infoPtr->writeError); + TclWinConvertError(infoPtr->writeError); infoPtr->writeError = 0; goto error1; } @@ -1038,12 +1071,12 @@ SerialOutputProc( ckfree(infoPtr->writeBuf); } infoPtr->writeBufLen = toWrite; - infoPtr->writeBuf = (char *)ckalloc(toWrite); + infoPtr->writeBuf = ckalloc((unsigned int) toWrite); } - memcpy(infoPtr->writeBuf, buf, toWrite); + memcpy(infoPtr->writeBuf, buf, (size_t) toWrite); infoPtr->toWrite = toWrite; ResetEvent(infoPtr->evWritable); - TclPipeThreadSignal(&infoPtr->writeTI); + SetEvent(infoPtr->evStartWriter); bytesWritten = (DWORD) toWrite; } else { @@ -1069,7 +1102,7 @@ SerialOutputProc( return (int) bytesWritten; writeError: - Tcl_WinConvertError(GetLastError()); + TclWinConvertError(GetLastError()); error: /* @@ -1192,7 +1225,7 @@ SerialEventProc( static void SerialWatchProc( - void *instanceData, /* Serial state. */ + ClientData instanceData, /* Serial state. */ int mask) /* What events to watch for, OR-ed combination * of TCL_READABLE, TCL_WRITABLE and * TCL_EXCEPTION. */ @@ -1249,13 +1282,13 @@ SerialWatchProc( static int SerialGetHandleProc( - void *instanceData, /* The serial state. */ - TCL_UNUSED(int) /*direction*/, - void **handlePtr) /* Where to store the handle. */ + ClientData instanceData, /* The serial state. */ + int direction, /* TCL_READABLE or TCL_WRITABLE */ + ClientData *handlePtr) /* Where to store the handle. */ { SerialInfo *infoPtr = (SerialInfo *) instanceData; - *handlePtr = (void *)infoPtr->handle; + *handlePtr = (ClientData) infoPtr->handle; return TCL_OK; } @@ -1280,26 +1313,39 @@ static DWORD WINAPI SerialWriterThread( LPVOID arg) { - TclPipeThreadInfo *pipeTI = (TclPipeThreadInfo *)arg; - SerialInfo *infoPtr = NULL; /* access info only after success init/wait */ - DWORD bytesWritten, toWrite; + SerialInfo *infoPtr = (SerialInfo *)arg; + DWORD bytesWritten, toWrite, waitResult; char *buf; OVERLAPPED myWrite; /* Have an own OVERLAPPED in this thread. */ + HANDLE wEvents[2]; + + /* + * The stop event takes precedence by being first in the list. + */ + + wEvents[0] = infoPtr->evStopWriter; + wEvents[1] = infoPtr->evStartWriter; for (;;) { /* * Wait for the main thread to signal before attempting to write. */ - if (!TclPipeThreadWaitForSignal(&pipeTI)) { - /* exit */ + + waitResult = WaitForMultipleObjects(2, wEvents, FALSE, INFINITE); + + if (waitResult != (WAIT_OBJECT_0 + 1)) { + /* + * The start event was not signaled. It might be the stop event or + * an error, so exit. + */ + break; } - infoPtr = (SerialInfo *) pipeTI->clientData; buf = infoPtr->writeBuf; toWrite = infoPtr->toWrite; - myWrite.hEvent = CreateEventW(NULL, TRUE, FALSE, NULL); + myWrite.hEvent = CreateEvent(NULL, TRUE, FALSE, NULL); /* * Loop until all of the bytes are written or an error occurs. @@ -1358,27 +1404,6 @@ SerialWriterThread( Tcl_MutexUnlock(&serialMutex); } - /* - * We're about to close, so do any drain or discard required. - */ - - if (infoPtr) { - switch (infoPtr->flags & SERIAL_CLOSE_MASK) { - case SERIAL_CLOSE_DRAIN: - FlushFileBuffers(infoPtr->handle); - break; - case SERIAL_CLOSE_DISCARD: - PurgeComm(infoPtr->handle, PURGE_TXABORT | PURGE_TXCLEAR); - break; - } - } - - /* - * Worker exit, so inform the main thread or free TI-structure (if owned). - */ - - TclPipeThreadExit(&pipeTI); - return 0; } @@ -1390,7 +1415,7 @@ SerialWriterThread( * Opens or Reopens the serial port with the OVERLAPPED FLAG set * * Results: - * Returns the new handle, or INVALID_HANDLE_VALUE. + * Returns the new handle, or INVALID_HANDLE_VALUE. * If an existing channel is specified it is closed and reopened. * * Side effects: @@ -1402,7 +1427,7 @@ SerialWriterThread( HANDLE TclWinSerialOpen( HANDLE handle, - const WCHAR *name, + CONST TCHAR *name, DWORD access) { SerialInit(); @@ -1411,7 +1436,7 @@ TclWinSerialOpen( * If an open channel is specified, close it */ - if (handle != INVALID_HANDLE_VALUE && CloseHandle(handle) == FALSE) { + if ( handle != INVALID_HANDLE_VALUE && CloseHandle(handle) == FALSE) { return INVALID_HANDLE_VALUE; } @@ -1421,8 +1446,8 @@ TclWinSerialOpen( * finished */ - handle = CreateFileW(name, access, 0, 0, OPEN_EXISTING, - FILE_FLAG_OVERLAPPED, 0); + handle = (*tclWinProcs->createFileProc)(name, access, 0, 0, + OPEN_EXISTING, FILE_FLAG_OVERLAPPED, 0); return handle; } @@ -1452,13 +1477,14 @@ TclWinOpenSerialChannel( int permissions) { SerialInfo *infoPtr; + DWORD id; SerialInit(); - infoPtr = (SerialInfo *)ckalloc(sizeof(SerialInfo)); + infoPtr = (SerialInfo *) ckalloc((unsigned) sizeof(SerialInfo)); memset(infoPtr, 0, sizeof(SerialInfo)); - infoPtr->validMask = permissions & (TCL_READABLE|TCL_WRITABLE); + infoPtr->validMask = permissions; infoPtr->handle = handle; infoPtr->channel = (Tcl_Channel) NULL; infoPtr->readable = 0; @@ -1476,9 +1502,10 @@ TclWinOpenSerialChannel( * are shared between multiple channels (stdin/stdout). */ - TclWinGenerateChannelName(channelName, "file", infoPtr); + sprintf(channelName, "file%" TCL_I_MODIFIER "x", (size_t)infoPtr); + infoPtr->channel = Tcl_CreateChannel(&serialChannelType, channelName, - infoPtr, permissions); + (ClientData) infoPtr, permissions); SetupComm(handle, infoPtr->sysBufRead, infoPtr->sysBufWrite); @@ -1493,18 +1520,19 @@ TclWinOpenSerialChannel( InitializeCriticalSection(&infoPtr->csWrite); if (permissions & TCL_READABLE) { - infoPtr->osRead.hEvent = CreateEventW(NULL, TRUE, FALSE, NULL); + infoPtr->osRead.hEvent = CreateEvent(NULL, TRUE, FALSE, NULL); } if (permissions & TCL_WRITABLE) { /* * Initially the channel is writable and the writeThread is idle. */ - infoPtr->osWrite.hEvent = CreateEventW(NULL, TRUE, FALSE, NULL); - infoPtr->evWritable = CreateEventW(NULL, TRUE, TRUE, NULL); + infoPtr->osWrite.hEvent = CreateEvent(NULL, TRUE, FALSE, NULL); + infoPtr->evWritable = CreateEvent(NULL, TRUE, TRUE, NULL); + infoPtr->evStartWriter = CreateEvent(NULL, FALSE, FALSE, NULL); + infoPtr->evStopWriter = CreateEvent(NULL, FALSE, FALSE, NULL); infoPtr->writeThread = CreateThread(NULL, 256, SerialWriterThread, - TclPipeThreadCreateTI(&infoPtr->writeTI, infoPtr, - infoPtr->evWritable), 0, NULL); + infoPtr, 0, &id); } /* @@ -1513,7 +1541,7 @@ TclWinOpenSerialChannel( */ Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto"); - Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "\x1A {}"); + Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "\032 {}"); return infoPtr->channel; } @@ -1563,7 +1591,7 @@ SerialErrorStr( if (error & ~((DWORD) (SERIAL_READ_ERRORS | SERIAL_WRITE_ERRORS))) { char buf[TCL_INTEGER_SPACE + 1]; - snprintf(buf, sizeof(buf), "%ld", error); + wsprintfA(buf, "%d", error); Tcl_DStringAppendElement(dsPtr, buf); } } @@ -1618,19 +1646,19 @@ SerialModemStatusStr( static int SerialSetOptionProc( - void *instanceData, /* File state. */ + ClientData instanceData, /* File state. */ Tcl_Interp *interp, /* For error reporting - can be NULL. */ - const char *optionName, /* Which option to set? */ - const char *value) /* New value for option. */ + CONST char *optionName, /* Which option to set? */ + CONST char *value) /* New value for option. */ { SerialInfo *infoPtr; DCB dcb; BOOL result, flag; size_t len, vlen; Tcl_DString ds; - const WCHAR *native; - Tcl_Size argc; - const char **argv; + CONST TCHAR *native; + int argc; + CONST char **argv; infoPtr = (SerialInfo *) instanceData; @@ -1643,50 +1671,24 @@ SerialSetOptionProc( vlen = strlen(value); /* - * Option -closemode drain|discard|default - */ - - if ((len > 2) && (strncmp(optionName, "-closemode", len) == 0)) { - if (strncasecmp(value, "DEFAULT", vlen) == 0) { - infoPtr->flags &= ~SERIAL_CLOSE_MASK; - } else if (strncasecmp(value, "DRAIN", vlen) == 0) { - infoPtr->flags &= ~SERIAL_CLOSE_MASK; - infoPtr->flags |= SERIAL_CLOSE_DRAIN; - } else if (strncasecmp(value, "DISCARD", vlen) == 0) { - infoPtr->flags &= ~SERIAL_CLOSE_MASK; - infoPtr->flags |= SERIAL_CLOSE_DISCARD; - } else { - if (interp) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "bad mode \"%s\" for -closemode: must be" - " default, discard, or drain", value)); - Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FCONFIGURE", - "VALUE", (char *)NULL); - } - return TCL_ERROR; - } - return TCL_OK; - } - - /* * Option -mode baud,parity,databits,stopbits */ if ((len > 2) && (strncmp(optionName, "-mode", len) == 0)) { if (!GetCommState(infoPtr->handle, &dcb)) { - goto getStateFailed; + if (interp != NULL) { + Tcl_AppendResult(interp, "can't get comm state", NULL); + } + return TCL_ERROR; } - Tcl_DStringInit(&ds); - native = Tcl_UtfToWCharDString(value, TCL_INDEX_NONE, &ds); - result = BuildCommDCBW(native, &dcb); + native = Tcl_WinUtfToTChar(value, -1, &ds); + result = (*tclWinProcs->buildCommDCBProc)(native, &dcb); Tcl_DStringFree(&ds); if (result == FALSE) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "bad value \"%s\" for -mode: should be baud,parity,data,stop", - value)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "SERIALMODE", (char *)NULL); + Tcl_AppendResult(interp, "bad value \"", value, + "\" for -mode: should be baud,parity,data,stop", NULL); } return TCL_ERROR; } @@ -1701,7 +1703,10 @@ SerialSetOptionProc( dcb.fAbortOnError = FALSE; if (!SetCommState(infoPtr->handle, &dcb)) { - goto setStateFailed; + if (interp != NULL) { + Tcl_AppendResult(interp, "can't set comm state", NULL); + } + return TCL_ERROR; } return TCL_OK; } @@ -1712,7 +1717,10 @@ SerialSetOptionProc( if ((len > 1) && (strncmp(optionName, "-handshake", len) == 0)) { if (!GetCommState(infoPtr->handle, &dcb)) { - goto getStateFailed; + if (interp != NULL) { + Tcl_AppendResult(interp, "can't get comm state", NULL); + } + return TCL_ERROR; } /* @@ -1747,16 +1755,18 @@ SerialSetOptionProc( dcb.fDtrControl = DTR_CONTROL_HANDSHAKE; } else { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "bad value \"%s\" for -handshake: must be one of" - " xonxoff, rtscts, dtrdsr or none", value)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "HANDSHAKE", (char *)NULL); + Tcl_AppendResult(interp, "bad value \"", value, + "\" for -handshake: must be one of xonxoff, rtscts, " + "dtrdsr or none", NULL); } return TCL_ERROR; } if (!SetCommState(infoPtr->handle, &dcb)) { - goto setStateFailed; + if (interp != NULL) { + Tcl_AppendResult(interp, "can't set comm state", NULL); + } + return TCL_ERROR; } return TCL_OK; } @@ -1767,7 +1777,10 @@ SerialSetOptionProc( if ((len > 1) && (strncmp(optionName, "-xchar", len) == 0)) { if (!GetCommState(infoPtr->handle, &dcb)) { - goto getStateFailed; + if (interp != NULL) { + Tcl_AppendResult(interp, "can't get comm state", NULL); + } + return TCL_ERROR; } if (Tcl_SplitList(interp, value, &argc, &argv) == TCL_ERROR) { @@ -1776,12 +1789,11 @@ SerialSetOptionProc( if (argc != 2) { badXchar: if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "bad value for -xchar: should be a list of" - " two elements with each a single 8-bit character", TCL_INDEX_NONE)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "XCHAR", (char *)NULL); + Tcl_AppendResult(interp, "bad value for -xchar: should be " + "a list of two elements with each a single character", + NULL); } - ckfree(argv); + ckfree((char *) argv); return TCL_ERROR; } @@ -1798,24 +1810,27 @@ SerialSetOptionProc( dcb.XonChar = argv[0][0]; dcb.XoffChar = argv[1][0]; if (argv[0][0] & 0x80 || argv[1][0] & 0x80) { - Tcl_UniChar character = 0; + Tcl_UniChar character; int charLen; - charLen = TclUtfToUniChar(argv[0], &character); - if ((character > 0xFF) || argv[0][charLen]) { + charLen = Tcl_UtfToUniChar(argv[0], &character); + if (argv[0][charLen]) { goto badXchar; } dcb.XonChar = (char) character; - charLen = TclUtfToUniChar(argv[1], &character); - if ((character > 0xFF) || argv[1][charLen]) { + charLen = Tcl_UtfToUniChar(argv[1], &character); + if (argv[1][charLen]) { goto badXchar; } dcb.XoffChar = (char) character; } - ckfree(argv); + ckfree((char *) argv); if (!SetCommState(infoPtr->handle, &dcb)) { - goto setStateFailed; + if (interp != NULL) { + Tcl_AppendResult(interp, "can't set comm state", NULL); + } + return TCL_ERROR; } return TCL_OK; } @@ -1825,79 +1840,66 @@ SerialSetOptionProc( */ if ((len > 4) && (strncmp(optionName, "-ttycontrol", len) == 0)) { - Tcl_Size i; - int res = TCL_OK; + 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", (char *)NULL); + Tcl_AppendResult(interp, "bad value \"", value, + "\" for -ttycontrol: should be a list of " + "signal,value pairs", NULL); } - ckfree(argv); + ckfree((char *) argv); return TCL_ERROR; } for (i = 0; i < argc - 1; i += 2) { if (Tcl_GetBoolean(interp, argv[i+1], &flag) == TCL_ERROR) { - res = 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", TCL_INDEX_NONE)); - Tcl_SetErrorCode(interp, "TCL", "OPERATION", - "FCONFIGURE", "TTY_SIGNAL", (char *)NULL); + Tcl_AppendResult(interp, "can't set DTR signal", NULL); } - res = TCL_ERROR; + 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", TCL_INDEX_NONE)); - Tcl_SetErrorCode(interp, "TCL", "OPERATION", - "FCONFIGURE", "TTY_SIGNAL", (char *)NULL); + Tcl_AppendResult(interp, "can't set RTS signal", NULL); } - res = TCL_ERROR; + 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", TCL_INDEX_NONE)); - Tcl_SetErrorCode(interp, "TCL", "OPERATION", - "FCONFIGURE", "TTY_SIGNAL", (char *)NULL); + Tcl_AppendResult(interp,"can't set BREAK signal",NULL); } - res = TCL_ERROR; + 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", - (char *)NULL); + Tcl_AppendResult(interp, "bad signal name \"", argv[i], + "\" for -ttycontrol: must be DTR, RTS or BREAK", + NULL); } - res = TCL_ERROR; + result = TCL_ERROR; break; } } - ckfree(argv); - return res; + ckfree((char *) argv); + return result; } /* @@ -1910,7 +1912,7 @@ SerialSetOptionProc( * -sysbuffer 4096 or -sysbuffer {64536 4096} */ - int inSize = -1, outSize = -1; + size_t inSize = (size_t) -1, outSize = (size_t) -1; if (Tcl_SplitList(interp, value, &argc, &argv) == TCL_ERROR) { return TCL_ERROR; @@ -1922,24 +1924,20 @@ SerialSetOptionProc( inSize = atoi(argv[0]); outSize = atoi(argv[1]); } - ckfree(argv); + ckfree((char *) argv); if ((argc < 1) || (argc > 2) || (inSize <= 0) || (outSize <= 0)) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "bad value \"%s\" for -sysbuffer: should be " - "a list of one or two integers > 0", value)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "SYS_BUFFER", (char *)NULL); + Tcl_AppendResult(interp, "bad value \"", value, + "\" for -sysbuffer: should be a list of one or two " + "integers > 0", NULL); } return TCL_ERROR; } if (!SetupComm(infoPtr->handle, inSize, outSize)) { if (interp != NULL) { - Tcl_WinConvertError(GetLastError()); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't setup comm buffers: %s", - Tcl_PosixError(interp))); + Tcl_AppendResult(interp, "can't setup comm buffers", NULL); } return TCL_ERROR; } @@ -1952,12 +1950,18 @@ SerialSetOptionProc( */ if (!GetCommState(infoPtr->handle, &dcb)) { - goto getStateFailed; + if (interp != NULL) { + Tcl_AppendResult(interp, "can't get comm state", NULL); + } + return TCL_ERROR; } dcb.XonLim = (WORD) (infoPtr->sysBufRead*1/2); dcb.XoffLim = (WORD) (infoPtr->sysBufRead*1/4); if (!SetCommState(infoPtr->handle, &dcb)) { - goto setStateFailed; + if (interp != NULL) { + Tcl_AppendResult(interp, "can't set comm state", NULL); + } + return TCL_ERROR; } return TCL_OK; } @@ -1987,10 +1991,7 @@ SerialSetOptionProc( tout.ReadTotalTimeoutConstant = msec; if (!SetCommTimeouts(infoPtr->handle, &tout)) { if (interp != NULL) { - Tcl_WinConvertError(GetLastError()); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't set comm timeouts: %s", - Tcl_PosixError(interp))); + Tcl_AppendResult(interp, "can't set comm timeouts", NULL); } return TCL_ERROR; } @@ -1999,24 +2000,7 @@ SerialSetOptionProc( } return Tcl_BadChannelOption(interp, optionName, - "closemode mode handshake pollinterval sysbuffer timeout " - "ttycontrol xchar"); - - getStateFailed: - if (interp != NULL) { - Tcl_WinConvertError(GetLastError()); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't get comm state: %s", Tcl_PosixError(interp))); - } - return TCL_ERROR; - - setStateFailed: - if (interp != NULL) { - Tcl_WinConvertError(GetLastError()); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't set comm state: %s", Tcl_PosixError(interp))); - } - return TCL_ERROR; + "mode handshake pollinterval sysbuffer timeout ttycontrol xchar"); } /* @@ -2042,9 +2026,9 @@ SerialSetOptionProc( static int SerialGetOptionProc( - void *instanceData, /* File state. */ + ClientData instanceData, /* File state. */ Tcl_Interp *interp, /* For error reporting - can be NULL. */ - const char *optionName, /* Option to get. */ + CONST char *optionName, /* Option to get. */ Tcl_DString *dsPtr) /* Where to store value(s). */ { SerialInfo *infoPtr; @@ -2061,27 +2045,6 @@ SerialGetOptionProc( } /* - * Get option -closemode - */ - - if (len == 0) { - Tcl_DStringAppendElement(dsPtr, "-closemode"); - } - if (len==0 || (len>1 && strncmp(optionName, "-closemode", len)==0)) { - switch (infoPtr->flags & SERIAL_CLOSE_MASK) { - case SERIAL_CLOSE_DRAIN: - Tcl_DStringAppendElement(dsPtr, "drain"); - break; - case SERIAL_CLOSE_DISCARD: - Tcl_DStringAppendElement(dsPtr, "discard"); - break; - default: - Tcl_DStringAppendElement(dsPtr, "default"); - break; - } - } - - /* * Get option -mode */ @@ -2090,14 +2053,12 @@ SerialGetOptionProc( } if (len==0 || (len>2 && (strncmp(optionName, "-mode", len) == 0))) { char parity; - const char *stop; + char *stop; char buf[2 * TCL_INTEGER_SPACE + 16]; if (!GetCommState(infoPtr->handle, &dcb)) { if (interp != NULL) { - Tcl_WinConvertError(GetLastError()); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't get comm state: %s", Tcl_PosixError(interp))); + Tcl_AppendResult(interp, "can't get comm state", NULL); } return TCL_ERROR; } @@ -2110,7 +2071,7 @@ SerialGetOptionProc( stop = (dcb.StopBits == ONESTOPBIT) ? "1" : (dcb.StopBits == ONE5STOPBITS) ? "1.5" : "2"; - snprintf(buf, sizeof(buf), "%ld,%c,%d,%s", dcb.BaudRate, parity, + wsprintfA(buf, "%d,%c,%d,%s", dcb.BaudRate, parity, dcb.ByteSize, stop); Tcl_DStringAppendElement(dsPtr, buf); } @@ -2126,7 +2087,7 @@ SerialGetOptionProc( char buf[TCL_INTEGER_SPACE + 1]; valid = 1; - snprintf(buf, sizeof(buf), "%d", infoPtr->blockTime); + wsprintfA(buf, "%d", infoPtr->blockTime); Tcl_DStringAppendElement(dsPtr, buf); } @@ -2142,9 +2103,9 @@ SerialGetOptionProc( char buf[TCL_INTEGER_SPACE + 1]; valid = 1; - snprintf(buf, sizeof(buf), "%ld", infoPtr->sysBufRead); + wsprintfA(buf, "%d", infoPtr->sysBufRead); Tcl_DStringAppendElement(dsPtr, buf); - snprintf(buf, sizeof(buf), "%ld", infoPtr->sysBufWrite); + wsprintfA(buf, "%d", infoPtr->sysBufWrite); Tcl_DStringAppendElement(dsPtr, buf); } if (len == 0) { @@ -2165,15 +2126,13 @@ SerialGetOptionProc( if (!GetCommState(infoPtr->handle, &dcb)) { if (interp != NULL) { - Tcl_WinConvertError(GetLastError()); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't get comm state: %s", Tcl_PosixError(interp))); + Tcl_AppendResult(interp, "can't get comm state", NULL); } return TCL_ERROR; } - buf[Tcl_UniCharToUtf(UCHAR(dcb.XonChar), buf)] = '\0'; + sprintf(buf, "%c", dcb.XonChar); Tcl_DStringAppendElement(dsPtr, buf); - buf[Tcl_UniCharToUtf(UCHAR(dcb.XoffChar), buf)] = '\0'; + sprintf(buf, "%c", dcb.XoffChar); Tcl_DStringAppendElement(dsPtr, buf); } if (len == 0) { @@ -2225,9 +2184,9 @@ SerialGetOptionProc( count = (int) cStat.cbOutQue + infoPtr->writeQueue; LeaveCriticalSection(&infoPtr->csWrite); - snprintf(buf, sizeof(buf), "%ld", inBuffered + cStat.cbInQue); + wsprintfA(buf, "%d", inBuffered + cStat.cbInQue); Tcl_DStringAppendElement(dsPtr, buf); - snprintf(buf, sizeof(buf), "%d", outBuffered + count); + wsprintfA(buf, "%d", outBuffered + count); Tcl_DStringAppendElement(dsPtr, buf); } @@ -2243,9 +2202,7 @@ SerialGetOptionProc( if (!GetCommModemStatus(infoPtr->handle, &status)) { if (interp != NULL) { - Tcl_WinConvertError(GetLastError()); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't get tty status: %s", Tcl_PosixError(interp))); + Tcl_AppendResult(interp, "can't get tty status", NULL); } return TCL_ERROR; } @@ -2255,10 +2212,10 @@ SerialGetOptionProc( if (valid) { return TCL_OK; + } else { + return Tcl_BadChannelOption(interp, optionName, + "mode pollinterval lasterror queue sysbuffer ttystatus xchar"); } - return Tcl_BadChannelOption(interp, optionName, - "closemode mode pollinterval lasterror queue sysbuffer ttystatus " - "xchar"); } /* @@ -2279,7 +2236,7 @@ SerialGetOptionProc( static void SerialThreadActionProc( - void *instanceData, + ClientData instanceData, int action) { SerialInfo *infoPtr = (SerialInfo *) instanceData; @@ -2287,7 +2244,7 @@ SerialThreadActionProc( /* * 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 fileevent handlers before transfer thus takes care of + * Removal of the filevent handlers before transfer thus takes care of * this structure. */ diff --git a/win/tclWinSock.c b/win/tclWinSock.c index 0dd7871..8f565b9 100644 --- a/win/tclWinSock.c +++ b/win/tclWinSock.c @@ -3,15 +3,12 @@ * * This file contains Windows-specific socket related code. * - * Copyright © 1995-1997 Sun Microsystems, Inc. + * 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. * @@ -55,17 +52,20 @@ #endif /* - * 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. + * Support for control over sockets' KEEPALIVE and NODELAY behavior is + * currently disabled. */ -#define SET_BITS(var, bits) ((var) |= (bits)) -#define CLEAR_BITS(var, bits) ((var) &= ~(bits)) -#define GOT_BITS(var, bits) (((var) & (bits)) != 0) +#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. + */ -/* "sock" + a pointer in hex + \0 */ -#define SOCK_CHAN_LENGTH (16 + TCL_INTEGER_SPACE) +#undef getservbyname +#undef getsockopt +#undef setsockopt /* * The following variable is used to tell whether this module has been @@ -74,111 +74,58 @@ */ static int initialized = 0; -static const WCHAR className[] = L"TclSocket"; TCL_DECLARE_MUTEX(socketMutex) /* - * The following defines declare the messages used on socket windows. + * The following variable holds the network name of this host. */ -#define SOCKET_MESSAGE WM_USER+1 -#define SOCKET_SELECT WM_USER+2 -#define SOCKET_TERMINATE WM_USER+3 -#define SELECT TRUE -#define UNSELECT FALSE +static TclInitProcessGlobalValueProc InitializeHostName; +static ProcessGlobalValue hostName = { + 0, 0, NULL, NULL, InitializeHostName, NULL, NULL +}; /* - * This is needed to comply with the strict aliasing rules of GCC, but it also - * simplifies casting between the different sockaddr types. + * The following defines declare the messages used on socket windows. */ -typedef union { - struct sockaddr sa; - struct sockaddr_in sa4; - struct sockaddr_in6 sa6; - struct sockaddr_storage sas; -} address; - -#ifndef IN6_ARE_ADDR_EQUAL -#define IN6_ARE_ADDR_EQUAL IN6_ADDR_EQUAL -#endif +#define SOCKET_MESSAGE WM_USER+1 +#define SOCKET_SELECT WM_USER+2 +#define SOCKET_TERMINATE WM_USER+3 +#define SELECT TRUE +#define UNSELECT FALSE /* - * This structure describes per-instance state of a tcp-based channel. + * The following structure is used to store the data associated with each + * socket. + * All members modified by the notifier thread are defined as volatile. */ -typedef struct TcpState TcpState; - -typedef struct TcpFdList { - TcpState *statePtr; - SOCKET fd; - struct TcpFdList *next; -} TcpFdList; - -struct TcpState { +typedef struct SocketInfo { Tcl_Channel channel; /* Channel associated with this socket. */ - int flags; /* Bit field comprised of the flags described + SOCKET socket; /* Windows SOCKET handle. */ + volatile int flags; /* Bit field comprised of the flags described * below. */ - struct TcpFdList *sockets; /* Windows SOCKET handle. */ int watchEvents; /* OR'ed combination of FD_READ, FD_WRITE, * FD_CLOSE, FD_ACCEPT and FD_CONNECT that * indicate which events are interesting. */ volatile int readyEvents; /* OR'ed combination of FD_READ, FD_WRITE, * FD_CLOSE, FD_ACCEPT and FD_CONNECT that - * indicate which events have occurred. - * Set by notifier thread, access must be - * protected by semaphore */ + * indicate which events have occurred. */ int selectEvents; /* OR'ed combination of FD_READ, FD_WRITE, * FD_CLOSE, FD_ACCEPT and FD_CONNECT that * indicate which events are currently being * selected. */ volatile int acceptEventCount; /* Count of the current number of FD_ACCEPTs - * that have arrived and not yet processed. - * Set by notifier thread, access must be - * protected by semaphore */ + * that have arrived and not yet processed. */ Tcl_TcpAcceptProc *acceptProc; /* Proc to call on accept. */ - void *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 + ClientData acceptProcData; /* The data for the accept proc. */ + volatile int lastError; /* Error code from last message. */ + struct SocketInfo *nextPtr; /* The next socket on the per-thread socket * list. */ -}; - -/* - * These bits may be OR'ed 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 */ - -#define TCP_ASYNC_TEST_MODE (1<<8) /* Async testing activated. Do not - * automatically continue connection - * process */ +} SocketInfo; /* * The following structure is what is added to the Tcl event queue when a @@ -189,8 +136,8 @@ typedef struct { Tcl_Event header; /* Information that is standard for all * events. */ SOCKET socket; /* Socket descriptor that is ready. Used to - * find the TcpState structure for the file - * (can't point directly to the TcpState + * find the SocketInfo structure for the file + * (can't point directly to the SocketInfo * structure because it could go away while * the event is queued). */ } SocketEvent; @@ -201,6 +148,17 @@ typedef struct { #define TCP_BUFFER_SIZE 4096 +/* + * The following macros may be used to set the flags field of a SocketInfo + * structure. + */ + +#define SOCKET_ASYNC (1<<0) /* The socket is in blocking mode. */ +#define SOCKET_EOF (1<<1) /* A zero read happened on the + * socket. */ +#define SOCKET_ASYNC_CONNECT (1<<2) /* This socket uses async connect. */ +#define SOCKET_PENDING (1<<3) /* A message has been sent for this + * socket */ typedef struct { HWND hwnd; /* Handle to window for socket messages. */ @@ -211,44 +169,44 @@ typedef struct { * socketThread has been initialized and has * started. */ HANDLE socketListLock; /* Win32 Event to lock the socketList */ - TcpState *pendingTcpState; + SocketInfo *pendingSocketInfo; /* This socket is opened but not jet in the * list. This value is also checked by * the event structure. */ - TcpState *socketList; /* Every open socket in this thread has an + SocketInfo *socketList; /* Every open socket in this thread has an * entry on this list. */ } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; -static WNDCLASSW windowClass; +static WNDCLASS windowClass; /* - * Static routines for this file: + * Static functions defined in this file. */ -static int TcpConnect(Tcl_Interp *interp, - TcpState *state); -static void InitSocketWindowClass(void); -static TcpState * NewSocketInfo(SOCKET socket); -static void SocketExitHandler(void *clientData); +static SocketInfo * CreateSocket(Tcl_Interp *interp, int port, + const char *host, int server, const char *myaddr, + int myport, int async); +static int CreateSocketAddress(LPSOCKADDR_IN sockaddrPtr, + const char *host, int port); +static void InitSockets(void); +static SocketInfo * NewSocketInfo(SOCKET socket); +static void SocketExitHandler(ClientData clientData); static LRESULT CALLBACK SocketProc(HWND hwnd, UINT message, WPARAM wParam, LPARAM lParam); -static void TcpAccept(TcpFdList *fds, SOCKET newSocket, address addr); -static int WaitForConnect(TcpState *statePtr, int *errorCodePtr); -static int WaitForSocketEvent(TcpState *statePtr, int events, +static int SocketsEnabled(void); +static void TcpAccept(SocketInfo *infoPtr); +static int WaitForSocketEvent(SocketInfo *infoPtr, int events, int *errorCodePtr); -static void AddSocketInfoFd(TcpState *statePtr, SOCKET socket); -static int FindFDInList(TcpState *statePtr, SOCKET socket); static DWORD WINAPI SocketThread(LPVOID arg); -static void TcpThreadActionProc(void *instanceData, +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_DriverBlockModeProc TcpBlockProc; static Tcl_DriverCloseProc TcpCloseProc; -static Tcl_DriverClose2Proc TcpClose2Proc; static Tcl_DriverSetOptionProc TcpSetOptionProc; static Tcl_DriverGetOptionProc TcpGetOptionProc; static Tcl_DriverInputProc TcpInputProc; @@ -258,235 +216,192 @@ static Tcl_DriverGetHandleProc TcpGetHandleProc; /* * This structure describes the channel type structure for TCP socket - * based IO: + * based IO. */ -static const Tcl_ChannelType tcpChannelType = { - "tcp", /* Type name. */ - TCL_CHANNEL_VERSION_5, /* v5 channel */ -#ifndef TCL_NO_DEPRECATED - TcpCloseProc, /* Close proc. */ -#else - TCL_CLOSE2PROC, /* Close proc. */ -#endif - TcpInputProc, /* Input proc. */ - TcpOutputProc, /* Output proc. */ - NULL, /* Seek proc. */ - TcpSetOptionProc, /* Set option proc. */ - TcpGetOptionProc, /* Get option proc. */ - TcpWatchProc, /* Initialize notifier. */ - TcpGetHandleProc, /* Get OS handles out of channel. */ - TcpClose2Proc, /* Close2 proc. */ - TcpBlockModeProc, /* Set blocking or non-blocking mode.*/ - NULL, /* flush proc. */ - NULL, /* handler proc. */ - NULL, /* wide seek proc. */ - TcpThreadActionProc, /* thread action proc. */ - NULL /* truncate proc. */ +static Tcl_ChannelType tcpChannelType = { + "tcp", /* Type name. */ + TCL_CHANNEL_VERSION_5, /* v5 channel */ + TcpCloseProc, /* Close proc. */ + TcpInputProc, /* Input proc. */ + TcpOutputProc, /* Output proc. */ + NULL, /* Seek proc. */ + TcpSetOptionProc, /* Set option proc. */ + TcpGetOptionProc, /* Get option proc. */ + TcpWatchProc, /* Set up notifier to watch this channel. */ + TcpGetHandleProc, /* Get an OS handle from channel. */ + NULL, /* close2proc. */ + TcpBlockProc, /* Set socket into (non-)blocking mode. */ + NULL, /* flush proc. */ + NULL, /* handler proc. */ + NULL, /* wide seek proc */ + TcpThreadActionProc, /* thread action proc */ + NULL, /* truncate */ }; - -/* - * The following variable holds the network name of this host. - */ - -static TclInitProcessGlobalValueProc InitializeHostName; -static ProcessGlobalValue hostName = - {0, 0, NULL, NULL, InitializeHostName, NULL, NULL}; - -/* - * Simple wrapper round the SendMessage syscall. - */ - -#define SendSelectMessage(tsdPtr, message, payload) \ - SendMessageW((tsdPtr)->hwnd, SOCKET_SELECT, \ - (WPARAM) (message), (LPARAM) (payload)) - - -/* - * Address print debug functions - */ -#if 0 -void -printaddrinfo( - struct addrinfo *ai, - char *prefix) -{ - char host[NI_MAXHOST], port[NI_MAXSERV]; - - getnameinfo(ai->ai_addr, ai->ai_addrlen, - host, sizeof(host), port, sizeof(port), - NI_NUMERICHOST|NI_NUMERICSERV); -} - -void -printaddrinfolist( - struct addrinfo *addrlist, - char *prefix) -{ - struct addrinfo *ai; - - for (ai = addrlist; ai != NULL; ai = ai->ai_next) { - printaddrinfo(ai, prefix); - } -} -#endif /* *---------------------------------------------------------------------- * - * InitializeHostName -- + * InitSockets -- * - * This routine sets the process global value of the name of the local - * host on which the process is running. + * Initialize the socket module. If winsock startup is successful, + * registers the event window for the socket notifier code. + * + * Assumes socketMutex is held. * * Results: * None. * + * Side effects: + * Initializes winsock, registers a new window class and creates a + * window for use in asynchronous socket notification. + * *---------------------------------------------------------------------- */ -void -InitializeHostName( - char **valuePtr, - TCL_HASH_TYPE *lengthPtr, - Tcl_Encoding *encodingPtr) +static void +InitSockets(void) { - WCHAR wbuf[256]; - DWORD length = sizeof(wbuf)/sizeof(WCHAR); - Tcl_DString ds; + DWORD id; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + TclThreadDataKeyGet(&dataKey); + + if (!initialized) { + initialized = 1; + TclCreateLateExitHandler(SocketExitHandler, (ClientData) NULL); - Tcl_DStringInit(&ds); - if (GetComputerNameExW(ComputerNamePhysicalDnsFullyQualified, wbuf, &length) != 0) { /* - * Convert string from native to UTF then change to lowercase. + * Create the async notification window with a new class. We must + * create a new class to avoid a Windows 95 bug that causes us to get + * the wrong message number for socket events if the message window is + * a subclass of a static control. */ - Tcl_UtfToLower(Tcl_WCharToUtfDString(wbuf, TCL_INDEX_NONE, &ds)); + windowClass.style = 0; + windowClass.cbClsExtra = 0; + windowClass.cbWndExtra = 0; + windowClass.hInstance = TclWinGetTclInstance(); + windowClass.hbrBackground = NULL; + windowClass.lpszMenuName = NULL; + windowClass.lpszClassName = "TclSocket"; + windowClass.lpfnWndProc = SocketProc; + windowClass.hIcon = NULL; + windowClass.hCursor = NULL; + + if (!RegisterClassA(&windowClass)) { + TclWinConvertError(GetLastError()); + goto initFailure; + } + + } + + /* + * Check for per-thread initialization. + */ + + if (tsdPtr == NULL) { + tsdPtr = TCL_TSD_INIT(&dataKey); + tsdPtr->pendingSocketInfo = NULL; + tsdPtr->socketList = NULL; + tsdPtr->hwnd = NULL; + tsdPtr->threadId = Tcl_GetCurrentThread(); + tsdPtr->readyEvent = CreateEvent(NULL, FALSE, FALSE, NULL); + if (tsdPtr->readyEvent == NULL) { + goto initFailure; + } + tsdPtr->socketListLock = CreateEvent(NULL, FALSE, TRUE, NULL); + if (tsdPtr->socketListLock == NULL) { + goto initFailure; + } + tsdPtr->socketThread = CreateThread(NULL, 256, SocketThread, tsdPtr, + 0, &id); + if (tsdPtr->socketThread == NULL) { + goto initFailure; + } + + SetThreadPriority(tsdPtr->socketThread, THREAD_PRIORITY_HIGHEST); - } else { - TclInitSockets(); /* - * The buffer size of 256 is recommended by the MSDN page that - * documents gethostname() as being always adequate. + * Wait for the thread to signal when the window has been created and + * if it is ready to go. */ - Tcl_DString inDs; + WaitForSingleObject(tsdPtr->readyEvent, INFINITE); - Tcl_DStringInit(&inDs); - Tcl_DStringSetLength(&inDs, 256); - if (gethostname(Tcl_DStringValue(&inDs), - Tcl_DStringLength(&inDs)) == 0) { - Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(&inDs), - TCL_INDEX_NONE, &ds); + if (tsdPtr->hwnd == NULL) { + goto initFailure; /* Trouble creating the window */ } - Tcl_DStringFree(&inDs); + + Tcl_CreateEventSource(SocketSetupProc, SocketCheckProc, NULL); } + return; - *encodingPtr = Tcl_GetEncoding(NULL, "utf-8"); - *lengthPtr = Tcl_DStringLength(&ds); - *valuePtr = (char *)ckalloc(*lengthPtr + 1); - memcpy(*valuePtr, Tcl_DStringValue(&ds), *lengthPtr + 1); - Tcl_DStringFree(&ds); + initFailure: + TclpFinalizeSockets(); + initialized = -1; + return; } /* *---------------------------------------------------------------------- * - * Tcl_GetHostName -- + * SocketsEnabled -- * - * Returns the name of the local host. + * Check that the WinSock was successfully initialized. * * Results: - * A string containing the network name for this machine, or an empty - * string if we can't figure out the name. The caller must not modify or - * free this string. + * 1 if it is. * * Side effects: - * Caches the name to return for future calls. + * None. * *---------------------------------------------------------------------- */ -const char * -Tcl_GetHostName(void) + /* ARGSUSED */ +static int +SocketsEnabled(void) { - return Tcl_GetString(TclGetProcessGlobalValue(&hostName)); + int enabled; + Tcl_MutexLock(&socketMutex); + enabled = (initialized == 1); + Tcl_MutexUnlock(&socketMutex); + return enabled; } + /* *---------------------------------------------------------------------- * - * TclInitSockets -- + * SocketExitHandler -- * - * Initialization of sockets for the thread. Also creates message - * handling window class for the process if needed. + * Callback invoked during exit clean up to delete the socket + * communication window and to release the WinSock DLL. * * Results: - * Nothing. Panics on failure. + * None. * * Side effects: - * If not already prepared, initializes the TSD structure and socket - * message handling thread associated to the calling thread for the - * subsystem of the driver. + * None. * *---------------------------------------------------------------------- */ -void -TclInitSockets(void) + /* ARGSUSED */ +static void +SocketExitHandler( + ClientData clientData) /* Not used. */ { - /* Then Per thread initialization. */ - DWORD id; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); - - if (tsdPtr != NULL) { - return; - } - - InitSocketWindowClass(); - - /* - * 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); - + Tcl_MutexLock(&socketMutex); /* - * Wait for the thread to signal when the window has been created and if - * it is ready to go. + * Make sure the socket event handling window is cleaned-up for, at + * most, this thread. */ - WaitForSingleObject(tsdPtr->readyEvent, INFINITE); - - if (tsdPtr->hwnd != NULL) { - Tcl_CreateEventSource(SocketSetupProc, SocketCheckProc, NULL); - return; - } - - initFailure: - Tcl_Panic("InitSockets failed"); - return; + TclpFinalizeSockets(); + UnregisterClass("TclSocket", TclWinGetTclInstance()); + initialized = 0; + Tcl_MutexUnlock(&socketMutex); } /* @@ -511,507 +426,346 @@ TclInitSockets(void) void TclpFinalizeSockets(void) { - ThreadSpecificData *tsdPtr = (ThreadSpecificData *)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. - */ + ThreadSpecificData *tsdPtr; - WaitForSingleObject(tsdPtr->readyEvent, INFINITE); - tsdPtr->hwnd = NULL; + tsdPtr = (ThreadSpecificData *) TclThreadDataKeyGet(&dataKey); + if (tsdPtr != NULL) { + if (tsdPtr->socketThread != NULL) { + if (tsdPtr->hwnd != NULL) { + if (PostMessage(tsdPtr->hwnd, SOCKET_TERMINATE, 0, 0)) { + /* + * Wait for the thread to exit. This ensures that we are + * completely cleaned up before we leave this function. + */ + WaitForSingleObject(tsdPtr->readyEvent, INFINITE); + } + tsdPtr->hwnd = NULL; + } + CloseHandle(tsdPtr->socketThread); + tsdPtr->socketThread = NULL; } - CloseHandle(tsdPtr->socketThread); - tsdPtr->socketThread = NULL; - } - if (tsdPtr->readyEvent != NULL) { - CloseHandle(tsdPtr->readyEvent); - tsdPtr->readyEvent = NULL; - } - if (tsdPtr->socketListLock != NULL) { - CloseHandle(tsdPtr->socketListLock); - tsdPtr->socketListLock = NULL; + if (tsdPtr->readyEvent != NULL) { + CloseHandle(tsdPtr->readyEvent); + tsdPtr->readyEvent = NULL; + } + if (tsdPtr->socketListLock != NULL) { + CloseHandle(tsdPtr->socketListLock); + tsdPtr->socketListLock = NULL; + } + Tcl_DeleteEventSource(SocketSetupProc, SocketCheckProc, NULL); } - Tcl_DeleteEventSource(SocketSetupProc, SocketCheckProc, NULL); } /* *---------------------------------------------------------------------- * - * TcpBlockModeProc -- + * TclpHasSockets -- * - * This function is invoked by the generic IO level to set blocking and - * nonblocking mode on a TCP socket based channel. + * This function determines whether sockets are available on the current + * system and returns an error in interp if they are not. Note that + * interp may be NULL. * * Results: - * 0 if successful, errno when failed. + * Returns TCL_OK if the system supports sockets, or TCL_ERROR with an + * error in interp (if non-NULL). * * Side effects: - * Sets the device into blocking or nonblocking mode. + * If not already prepared, initializes the TSD structure and socket + * message handling thread associated to the calling thread for the + * subsystem of the driver. * *---------------------------------------------------------------------- */ -static int -TcpBlockModeProc( - void *instanceData, /* Socket state. */ - int mode) /* The mode to set. Can be one of - * TCL_MODE_BLOCKING or - * TCL_MODE_NONBLOCKING. */ +int +TclpHasSockets( + Tcl_Interp *interp) /* Where to write an error message if sockets + * are not present, or NULL if no such message + * is to be written. */ { - TcpState *statePtr = (TcpState *)instanceData; + Tcl_MutexLock(&socketMutex); + InitSockets(); + Tcl_MutexUnlock(&socketMutex); - if (mode == TCL_MODE_NONBLOCKING) { - SET_BITS(statePtr->flags, TCP_NONBLOCKING); - } else { - CLEAR_BITS(statePtr->flags, TCP_NONBLOCKING); + if (SocketsEnabled()) { + return TCL_OK; } - return 0; + if (interp != NULL) { + Tcl_AppendResult(interp, "sockets are not available on this system", + NULL); + } + return TCL_ERROR; } /* *---------------------------------------------------------------------- * - * WaitForConnect -- - * - * Check the state of an async connect process. If a connection attempt - * terminated, process it, which may finalize it or may start the next - * attempt. If a connect error occures, it is saved in - * statePtr->connectError to be reported by 'fconfigure -error'. + * SocketSetupProc -- * - * There are two modes of operation, defined by errorCodePtr: - * * non-NULL: Called by explicite read/write command. Block if socket - * is blocking. - * May return two error codes: - * * EWOULDBLOCK: if connect is still in progress - * * ENOTCONN: if connect failed. This would be the error message - * of a recv or sendto syscall so this is emulated here. - * * Null: Called by a background operation. Do not block and don't - * return any error code. + * This function is invoked before Tcl_DoOneEvent blocks waiting for an + * event. * * Results: - * 0 if the connection has completed, -1 if still in progress or there is - * an error. + * None. * * Side effects: - * Processes socket events off the system queue. May process - * asynchronous connect. + * Adjusts the block time if needed. * *---------------------------------------------------------------------- */ -static int -WaitForConnect( - TcpState *statePtr, /* State of the socket. */ - int *errorCodePtr) /* Where to store errors? A passed - * null-pointer activates background mode. */ +void +SocketSetupProc( + ClientData data, /* Not used. */ + int flags) /* Event flags as passed to Tcl_DoOneEvent. */ { - int result; - int oldMode; - ThreadSpecificData *tsdPtr; - - /* - * Check if an async connect failed already and error reporting is - * demanded, return the error ENOTCONN. - */ + SocketInfo *infoPtr; + Tcl_Time blockTime = { 0, 0 }; + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - if (errorCodePtr != NULL && GOT_BITS(statePtr->flags, TCP_ASYNC_FAILED)) { - *errorCodePtr = ENOTCONN; - return -1; + if (!(flags & TCL_FILE_EVENTS)) { + return; } /* - * Check if an async connect is running. If not return ok + * Check to see if there is a ready socket. If so, poll. */ - if (!GOT_BITS(statePtr->flags, TCP_ASYNC_CONNECT)) { - return 0; + WaitForSingleObject(tsdPtr->socketListLock, INFINITE); + for (infoPtr = tsdPtr->socketList; infoPtr != NULL; + infoPtr = infoPtr->nextPtr) { + if (infoPtr->readyEvents & infoPtr->watchEvents) { + Tcl_SetMaxBlockTime(&blockTime); + break; + } } + SetEvent(tsdPtr->socketListLock); +} + +/* + *---------------------------------------------------------------------- + * + * SocketCheckProc -- + * + * This function is called by Tcl_DoOneEvent to check the socket event + * source for events. + * + * Results: + * None. + * + * Side effects: + * May queue an event. + * + *---------------------------------------------------------------------- + */ - /* - * In socket test mode do not continue with the connect - * Exceptions are: - * - Call by recv/send and blocking socket - * (errorCodePtr != NULL && !GOT_BITS(flags, TCP_NONBLOCKING)) - * - Call by the event queue (errorCodePtr == NULL) - */ +static void +SocketCheckProc( + ClientData data, /* Not used. */ + int flags) /* Event flags as passed to Tcl_DoOneEvent. */ +{ + SocketInfo *infoPtr; + SocketEvent *evPtr; + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - if (GOT_BITS(statePtr->flags, TCP_ASYNC_TEST_MODE) - && errorCodePtr != NULL - && GOT_BITS(statePtr->flags, TCP_NONBLOCKING)) { - *errorCodePtr = EWOULDBLOCK; - return -1; + if (!(flags & TCL_FILE_EVENTS)) { + return; } /* - * 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 + * Queue events for any ready sockets that don't already have events + * queued (caused by persistent states that won't generate WinSock + * events). */ - while (1) { - /* - * Get the statePtr lock. - */ - - tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); - WaitForSingleObject(tsdPtr->socketListLock, INFINITE); - - /* - * Check for connect event. - */ - - if (GOT_BITS(statePtr->readyEvents, FD_CONNECT)) { - /* - * Consume the connect event. - */ - - CLEAR_BITS(statePtr->readyEvents, FD_CONNECT); - - /* - * For blocking sockets and foreground processing, disable async - * connect as we continue now synchronously. - */ - - if (errorCodePtr != NULL && - !GOT_BITS(statePtr->flags, TCP_NONBLOCKING)) { - CLEAR_BITS(statePtr->flags, TCP_ASYNC_CONNECT); - } - - /* - * Free list lock. - */ - - SetEvent(tsdPtr->socketListLock); - - /* - * Continue connect. If switched to synchronous connect, the - * connect is terminated. - */ - - result = TcpConnect(NULL, statePtr); - - /* - * Restore event service mode. - */ - - (void) Tcl_SetServiceMode(oldMode); - - /* - * Check for Successful connect or async connect restart - */ - - if (result == TCL_OK) { - /* - * Check for async connect restart (not possible for - * foreground blocking operation) - */ - - if (GOT_BITS(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 (GOT_BITS(statePtr->flags, TCP_NONBLOCKING)) { - *errorCodePtr = EWOULDBLOCK; - return -1; + WaitForSingleObject(tsdPtr->socketListLock, INFINITE); + for (infoPtr = tsdPtr->socketList; infoPtr != NULL; + infoPtr = infoPtr->nextPtr) { + if ((infoPtr->readyEvents & infoPtr->watchEvents) + && !(infoPtr->flags & SOCKET_PENDING)) { + infoPtr->flags |= SOCKET_PENDING; + evPtr = (SocketEvent *) ckalloc(sizeof(SocketEvent)); + evPtr->header.proc = SocketEventProc; + evPtr->socket = infoPtr->socket; + Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL); } - - /* - * Wait until something happens. - */ - - WaitForSingleObject(tsdPtr->readyEvent, INFINITE); } + SetEvent(tsdPtr->socketListLock); } /* *---------------------------------------------------------------------- * - * TcpInputProc -- + * SocketEventProc -- * - * This function is invoked by the generic IO level to read input from a - * TCP socket based channel. + * This function is called by Tcl_ServiceEvent when a socket event + * reaches the front of the event queue. This function is responsible for + * notifying the generic channel code. * * Results: - * The number of bytes read is returned or -1 on error. An output - * argument contains the POSIX error code on error, or zero if no error - * occurred. + * Returns 1 if the event was handled, meaning it should be removed from + * the queue. Returns 0 if the event was not handled, meaning it should + * stay on the queue. The only time the event isn't handled is if the + * TCL_FILE_EVENTS flag bit isn't set. * * Side effects: - * Reads input from the input device of the channel. + * Whatever the channel callback functions do. * *---------------------------------------------------------------------- */ static int -TcpInputProc( - void *instanceData, /* Socket state. */ - char *buf, /* Where to store data read. */ - int bufSize, /* How much space is available in the - * buffer? */ - int *errorCodePtr) /* Where to store error code. */ +SocketEventProc( + Tcl_Event *evPtr, /* Event to service. */ + int flags) /* Flags that indicate what events to handle, + * such as TCL_FILE_EVENTS. */ { - TcpState *statePtr = (TcpState *)instanceData; - int bytesRead; - DWORD error; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); + SocketInfo *infoPtr; + SocketEvent *eventPtr = (SocketEvent *) evPtr; + int mask = 0; + int events; + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - *errorCodePtr = 0; + if (!(flags & TCL_FILE_EVENTS)) { + return 0; + } /* - * First check to see if EOF was already detected, to prevent calling the - * socket stack after the first time EOF is detected. + * Find the specified socket on the socket list. */ - if (GOT_BITS(statePtr->flags, SOCKET_EOF)) { - return 0; + WaitForSingleObject(tsdPtr->socketListLock, INFINITE); + for (infoPtr = tsdPtr->socketList; infoPtr != NULL; + infoPtr = infoPtr->nextPtr) { + if (infoPtr->socket == eventPtr->socket) { + break; + } } + SetEvent(tsdPtr->socketListLock); /* - * 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 + * Discard events that have gone stale. */ - if (WaitForConnect(statePtr, errorCodePtr) != 0) { - return -1; + if (!infoPtr) { + return 1; } + infoPtr->flags &= ~SOCKET_PENDING; + /* - * 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. + * Handle connection requests directly. */ - while (1) { - SendSelectMessage(tsdPtr, UNSELECT, statePtr); + if (infoPtr->readyEvents & FD_ACCEPT) { + TcpAccept(infoPtr); + return 1; + } - /* - * Single fd operation: this proc is only called for a connected - * socket. - */ + /* + * Mask off unwanted events and compute the read/write mask so we can + * notify the channel. + */ - bytesRead = recv(statePtr->sockets->fd, buf, bufSize, 0); - CLEAR_BITS(statePtr->readyEvents, FD_READ); + events = infoPtr->readyEvents & infoPtr->watchEvents; + if (events & FD_CLOSE) { /* - * Check for end-of-file condition or successful read. + * If the socket was closed and the channel is still interested in + * read events, then we need to ensure that we keep polling for this + * event until someone does something with the channel. Note that we + * do this before calling Tcl_NotifyChannel so we don't have to watch + * out for the channel being deleted out from under us. This may cause + * a redundant trip through the event loop, but it's simpler than + * trying to do unwind protection. */ - if (bytesRead == 0) { - SET_BITS(statePtr->flags, SOCKET_EOF); - } - if (bytesRead != SOCKET_ERROR) { - break; - } - + Tcl_Time blockTime = { 0, 0 }; + Tcl_SetMaxBlockTime(&blockTime); + mask |= TCL_READABLE|TCL_WRITABLE; + } else if (events & FD_READ) { /* - * If an error occurs after the FD_CLOSE has arrived, then ignore the - * error and report an EOF. + * Throw the readable event if an async connect failed. */ - if (GOT_BITS(statePtr->readyEvents, FD_CLOSE)) { - SET_BITS(statePtr->flags, SOCKET_EOF); - bytesRead = 0; - break; - } + if (infoPtr->lastError) { - error = WSAGetLastError(); + mask |= TCL_READABLE; + + } else { + fd_set readFds; + struct timeval timeout; - /* - * If an RST comes, then ignore the error and report an EOF just like - * on Unix. - */ + /* + * We must check to see if data is really available, since someone + * could have consumed the data in the meantime. Turn off async + * notification so select will work correctly. If the socket is still + * readable, notify the channel driver, otherwise reset the async + * select handler and keep waiting. + */ - if (error == WSAECONNRESET) { - SET_BITS(statePtr->flags, SOCKET_EOF); - bytesRead = 0; - break; - } + SendMessage(tsdPtr->hwnd, SOCKET_SELECT, + (WPARAM) UNSELECT, (LPARAM) infoPtr); - /* - * Check for error condition or underflow in non-blocking case. - */ + FD_ZERO(&readFds); + FD_SET(infoPtr->socket, &readFds); + timeout.tv_usec = 0; + timeout.tv_sec = 0; - if (GOT_BITS(statePtr->flags, TCP_NONBLOCKING) - || (error != WSAEWOULDBLOCK)) { - Tcl_WinConvertError(error); - *errorCodePtr = Tcl_GetErrno(); - bytesRead = -1; - break; + if (select(0, &readFds, NULL, NULL, &timeout) != 0) { + mask |= TCL_READABLE; + } else { + infoPtr->readyEvents &= ~(FD_READ); + SendMessage(tsdPtr->hwnd, SOCKET_SELECT, + (WPARAM) SELECT, (LPARAM) infoPtr); + } } + } - /* - * In the blocking case, wait until the file becomes readable or - * closed and try again. - */ + /* + * writable event + */ - if (!WaitForSocketEvent(statePtr, FD_READ|FD_CLOSE, errorCodePtr)) { - bytesRead = -1; - break; - } + if (events & FD_WRITE) { + mask |= TCL_WRITABLE; } - SendSelectMessage(tsdPtr, SELECT, statePtr); - - return bytesRead; + if (mask) { + Tcl_NotifyChannel(infoPtr->channel, mask); + } + return 1; } /* *---------------------------------------------------------------------- * - * TcpOutputProc -- + * TcpBlockProc -- * - * This function is called by the generic IO level to write data to a - * socket based channel. + * Sets a socket into blocking or non-blocking mode. * * Results: - * The number of bytes written or -1 on failure. + * 0 if successful, errno if there was an error. * * Side effects: - * Produces output on the socket. + * None. * *---------------------------------------------------------------------- */ static int -TcpOutputProc( - void *instanceData, /* Socket state. */ - const char *buf, /* The data buffer. */ - int toWrite, /* How many bytes to write? */ - int *errorCodePtr) /* Where to store error code. */ +TcpBlockProc( + ClientData instanceData, /* The socket to block/un-block. */ + int mode) /* TCL_MODE_BLOCKING or + * TCL_MODE_NONBLOCKING. */ { - TcpState *statePtr = (TcpState *)instanceData; - int written; - DWORD error; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); - - *errorCodePtr = 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; - } - - while (1) { - SendSelectMessage(tsdPtr, UNSELECT, 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 (GOT_BITS(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) { - CLEAR_BITS(statePtr->readyEvents, FD_WRITE); - if (GOT_BITS(statePtr->flags, TCP_NONBLOCKING)) { - *errorCodePtr = EWOULDBLOCK; - written = -1; - break; - } - } else { - Tcl_WinConvertError(error); - *errorCodePtr = Tcl_GetErrno(); - written = -1; - break; - } - - /* - * In the blocking case, wait until the file becomes writable or - * closed and try again. - */ + SocketInfo *infoPtr = (SocketInfo *) instanceData; - if (!WaitForSocketEvent(statePtr, FD_WRITE|FD_CLOSE, errorCodePtr)) { - written = -1; - break; - } + if (mode == TCL_MODE_NONBLOCKING) { + infoPtr->flags |= SOCKET_ASYNC; + } else { + infoPtr->flags &= ~(SOCKET_ASYNC); } - - SendSelectMessage(tsdPtr, SELECT, statePtr); - - return written; + return 0; } /* @@ -1032,61 +786,50 @@ TcpOutputProc( *---------------------------------------------------------------------- */ + /* ARGSUSED */ static int TcpCloseProc( - void *instanceData, /* The socket to close. */ - TCL_UNUSED(Tcl_Interp *)) + ClientData instanceData, /* The socket to close. */ + Tcl_Interp *interp) /* Unused. */ { - TcpState *statePtr = (TcpState *)instanceData; + SocketInfo *infoPtr = (SocketInfo *) instanceData; /* TIP #218 */ int errorCode = 0; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); /* - * Clean up the OS socket handle. The default Windows setting for a - * socket is SO_DONTLINGER, which does a graceful shutdown in the - * background. + * 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. */ - while (statePtr->sockets != NULL) { - TcpFdList *thisfd = statePtr->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. + */ - statePtr->sockets = thisfd->next; - if (closesocket(thisfd->fd) == SOCKET_ERROR) { - Tcl_WinConvertError((DWORD) WSAGetLastError()); + if (closesocket(infoPtr->socket) == SOCKET_ERROR) { + TclWinConvertWSAError((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->pendingSocketInfo != NULL + && tsdPtr->pendingSocketInfo == infoPtr) { - if (tsdPtr->pendingTcpState != NULL - && tsdPtr->pendingTcpState == statePtr) { - /* - * Get infoPtr lock, because this concerns the notifier thread. - */ - + /* get infoPtr lock, because this concerns the notifier thread */ WaitForSingleObject(tsdPtr->socketListLock, INFINITE); - tsdPtr->pendingTcpState = NULL; - - /* - * Free list lock. - */ + tsdPtr->pendingSocketInfo = NULL; + /* Free list lock */ SetEvent(tsdPtr->socketListLock); } @@ -1097,865 +840,439 @@ TcpCloseProc( * fear of damaging the list. */ - ckfree(statePtr); + ckfree((char *) infoPtr); return errorCode; } /* *---------------------------------------------------------------------- * - * TcpClose2Proc -- + * NewSocketInfo -- * - * This function is called by the generic IO level to perform the channel - * type specific part of a half-close: namely, a shutdown() on a socket. + * This function allocates and initializes a new SocketInfo structure. * * Results: - * 0 if successful, the value of errno if failed. + * Returns a newly allocated SocketInfo. * * Side effects: - * Shuts down one side of the socket. + * None, except for allocation of memory. * *---------------------------------------------------------------------- */ -static int -TcpClose2Proc( - void *instanceData, /* The socket to close. */ - Tcl_Interp *interp, /* For error reporting. */ - int flags) /* Flags that indicate which side to close. */ +static SocketInfo * +NewSocketInfo( + SOCKET socket) { - TcpState *statePtr = (TcpState *)instanceData; - int readError = 0; - int writeError = 0; + SocketInfo *infoPtr; + /* ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); */ + + infoPtr = (SocketInfo *) ckalloc((unsigned) sizeof(SocketInfo)); + infoPtr->channel = 0; + infoPtr->socket = socket; + infoPtr->flags = 0; + infoPtr->watchEvents = 0; + infoPtr->readyEvents = 0; + infoPtr->selectEvents = 0; + infoPtr->acceptEventCount = 0; + infoPtr->acceptProc = NULL; + infoPtr->acceptProcData = NULL; + infoPtr->lastError = 0; /* - * Shutdown the OS socket handle. + * TIP #218. Removed the code inserting the new structure into the global + * list. This is now handled in the thread action callbacks, and only + * there. */ - if ((flags & (TCL_CLOSE_READ|TCL_CLOSE_WRITE)) == 0) { - return TcpCloseProc(instanceData, interp); - } + infoPtr->nextPtr = NULL; - /* - * Single fd operation: Tcl_OpenTcpServer() does not set TCL_READABLE or - * TCL_WRITABLE so this should never be called for a server socket. - */ - - if ((flags & TCL_CLOSE_READ) && (shutdown(statePtr->sockets->fd, SD_RECEIVE) == SOCKET_ERROR)) { - Tcl_WinConvertError((DWORD) WSAGetLastError()); - readError = Tcl_GetErrno(); - } - if ((flags & TCL_CLOSE_WRITE) && (shutdown(statePtr->sockets->fd, SD_SEND) == SOCKET_ERROR)) { - Tcl_WinConvertError((DWORD) WSAGetLastError()); - writeError = Tcl_GetErrno(); - } - return (readError != 0) ? readError : writeError; + return infoPtr; } /* *---------------------------------------------------------------------- * - * TcpSetOptionProc -- + * CreateSocket -- * - * Sets Tcp channel specific options. + * This function opens a new socket and initializes the SocketInfo + * structure. * * Results: - * None, unless an error happens. + * Returns a new SocketInfo, or NULL with an error in interp. * * Side effects: - * Changes attributes of the socket at the system level. + * None, except for allocation of memory. * *---------------------------------------------------------------------- */ -static int -TcpSetOptionProc( - void *instanceData, /* Socket state. */ - Tcl_Interp *interp, /* For error reporting - can be NULL. */ - const char *optionName, /* Name of the option to set. */ - const char *value) /* New value for option. */ +static SocketInfo * +CreateSocket( + Tcl_Interp *interp, /* For error reporting; can be NULL. */ + int port, /* Port number to open. */ + const char *host, /* Name of host on which to open port. */ + int server, /* 1 if socket should be a server socket, else + * 0 for a client socket. */ + const char *myaddr, /* Optional client-side address */ + int myport, /* Optional client-side port */ + int async) /* If nonzero, connect client socket + * asynchronously. */ { - TcpState *statePtr = (TcpState *)instanceData; - SOCKET sock; - size_t len = 0; - - if (optionName != NULL) { - len = strlen(optionName); - } - - sock = statePtr->sockets->fd; + u_long flag = 1; /* Indicates nonblocking mode. */ + SOCKADDR_IN sockaddr; /* Socket address */ + SOCKADDR_IN mysockaddr; /* Socket address for client */ + SOCKET sock = INVALID_SOCKET; + SocketInfo *infoPtr=NULL; /* The returned value. */ + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + TclThreadDataKeyGet(&dataKey); - if ((len > 1) && (optionName[1] == 'k') && - (strncmp(optionName, "-keepalive", len) == 0)) { - BOOL boolVar; - int rtn; + /* + * 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 (Tcl_GetBoolean(interp, value, &boolVar) != TCL_OK) { - return TCL_ERROR; - } - rtn = setsockopt(sock, SOL_SOCKET, SO_KEEPALIVE, - (const char *) &boolVar, sizeof(boolVar)); - if (rtn != 0) { - Tcl_WinConvertError(WSAGetLastError()); - if (interp) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "couldn't set socket option: %s", - Tcl_PosixError(interp))); - } - return TCL_ERROR; - } - return TCL_OK; + if (!SocketsEnabled()) { + return NULL; } - if ((len > 1) && (optionName[1] == 'n') && - (strncmp(optionName, "-nodelay", len) == 0)) { - BOOL boolVar; - int rtn; - if (Tcl_GetBoolean(interp, value, &boolVar) != TCL_OK) { - return TCL_ERROR; - } - rtn = setsockopt(sock, IPPROTO_TCP, TCP_NODELAY, - (const char *) &boolVar, sizeof(boolVar)); - if (rtn != 0) { - Tcl_WinConvertError(WSAGetLastError()); - if (interp) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "couldn't set socket option: %s", - Tcl_PosixError(interp))); - } - return TCL_ERROR; - } - return TCL_OK; + if (!CreateSocketAddress(&sockaddr, host, port)) { + goto error; + } + if ((myaddr != NULL || myport != 0) && + !CreateSocketAddress(&mysockaddr, myaddr, myport)) { + goto error; } - return Tcl_BadChannelOption(interp, optionName, "keepalive nodelay"); -} - -/* - *---------------------------------------------------------------------- - * - * 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( - void *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 = (TcpState *)instanceData; - char host[NI_MAXHOST], port[NI_MAXSERV]; - SOCKET sock; - size_t len = 0; - int reverseDNS = 0; -#define SUPPRESS_RDNS_VAR "::tcl::unsupported::noReverseDNS" + sock = socket(AF_INET, SOCK_STREAM, 0); + if (sock == INVALID_SOCKET) { + goto error; + } /* - * Go one step in async connect - * - * If any error is thrown save it as background error to report eventually - * below. + * Win-NT has a misfeature that sockets are inherited in child processes + * by default. Turn off the inherit bit. */ - if (!GOT_BITS(statePtr->flags, TCP_ASYNC_TEST_MODE)) { - WaitForConnect(statePtr, NULL); - } + SetHandleInformation((HANDLE) sock, HANDLE_FLAG_INHERIT, 0); - sock = statePtr->sockets->fd; - if (optionName != NULL) { - len = strlen(optionName); - } + /* + * Set kernel space buffering + */ - if ((len > 1) && (optionName[1] == 'e') && - (strncmp(optionName, "-error", len) == 0)) { + TclSockMinimumBuffers((void *)sock, TCP_BUFFER_SIZE); + + if (server) { /* - * Do not return any errors if async connect is running. + * 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 (!GOT_BITS(statePtr->flags, TCP_ASYNC_PENDING)) { - if (GOT_BITS(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 (bind(sock, (SOCKADDR *) &sockaddr, sizeof(SOCKADDR_IN)) + == SOCKET_ERROR) { + goto error; + } - if (statePtr->connectError != 0) { - Tcl_DStringAppend(dsPtr, - Tcl_ErrnoMsg(statePtr->connectError), TCL_INDEX_NONE); - statePtr->connectError = 0; - } - } else { - /* - * Report an eventual last error of the socket system. - */ + /* + * 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). + */ - int optlen; - int ret; - DWORD err; + if (listen(sock, SOMAXCONN) == SOCKET_ERROR) { + goto error; + } - /* - * Populate the err variable with a POSIX error - */ + /* + * Add this socket to the global list of sockets. + */ - optlen = sizeof(int); - ret = getsockopt(sock, SOL_SOCKET, SO_ERROR, - (char *)&err, &optlen); + infoPtr = NewSocketInfo(sock); - /* - * The error was not returned directly but should be taken - * from WSA. - */ + /* + * Set up the select mask for connection request events. + */ - if (ret == SOCKET_ERROR) { - err = WSAGetLastError(); - } + infoPtr->selectEvents = FD_ACCEPT; + infoPtr->watchEvents |= FD_ACCEPT; - /* - * Return error message. - */ + /* + * Register for interest in events in the select mask. Note that this + * automatically places the socket into non-blocking mode. + */ + + ioctlsocket(sock, (long) FIONBIO, &flag); + SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT, + (LPARAM) infoPtr); - if (err) { - Tcl_WinConvertError(err); - Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(Tcl_GetErrno()), TCL_INDEX_NONE); - } + } else { + /* + * Try to bind to a local port, if specified. + */ + + if (myaddr != NULL || myport != 0) { + if (bind(sock, (SOCKADDR *) &mysockaddr, sizeof(SOCKADDR_IN)) + == SOCKET_ERROR) { + goto error; } } - return TCL_OK; - } - if ((len > 1) && (optionName[1] == 'c') && - (strncmp(optionName, "-connecting", len) == 0)) { - Tcl_DStringAppend(dsPtr, - GOT_BITS(statePtr->flags, TCP_ASYNC_PENDING) - ? "1" : "0", TCL_INDEX_NONE); - return TCL_OK; - } + /* + * Allocate socket info structure + */ - if (interp != NULL - && Tcl_GetVar(interp, SUPPRESS_RDNS_VAR, 0) != NULL) { - reverseDNS = NI_NUMERICHOST; - } + infoPtr = NewSocketInfo(sock); - if ((len == 0) || ((len > 1) && (optionName[1] == 'p') && - (strncmp(optionName, "-peername", len) == 0))) { - address peername; - socklen_t size = sizeof(peername); + /* + * Set the socket into nonblocking mode if the connect should be done + * in the background. Activate connect notification. + */ + + if (async) { + + /* get infoPtr lock */ + WaitForSingleObject(tsdPtr->socketListLock, INFINITE); - if (GOT_BITS(statePtr->flags, TCP_ASYNC_PENDING)) { /* - * In async connect output an empty string + * Buffer new infoPtr in the tsd memory as long as it is not in + * the info list. This allows the event procedure to process the + * event. + * Bugfig for 336441ed59 to not ignore notifications until the + * infoPtr is in the list.. */ - if (len == 0) { - Tcl_DStringAppendElement(dsPtr, "-peername"); - Tcl_DStringAppendElement(dsPtr, ""); - } else { - return TCL_OK; - } - } else if (getpeername(sock, (LPSOCKADDR) &(peername.sa), - &size) == 0) { + tsdPtr->pendingSocketInfo = infoPtr; + /* - * Peername fetch succeeded - output list + * Set connect mask to connect events + * This is activated by a SOCKET_SELECT message to the notifier + * thread. */ - if (len == 0) { - Tcl_DStringAppendElement(dsPtr, "-peername"); - Tcl_DStringStartSublist(dsPtr); - } + infoPtr->selectEvents |= FD_CONNECT | FD_READ | FD_WRITE | FD_CLOSE; + infoPtr->flags |= SOCKET_ASYNC_CONNECT; + + /* + * Free list lock + */ + SetEvent(tsdPtr->socketListLock); - 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} + * Activate accept notification and put in async mode + * Bug 336441ed59: activate notification before connect + * so we do not miss a notification of a fialed connect. */ + ioctlsocket(sock, (long) FIONBIO, &flag); + SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT, + (LPARAM) infoPtr); - if (len) { - Tcl_WinConvertError((DWORD) WSAGetLastError()); - if (interp) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't get peername: %s", - Tcl_PosixError(interp))); - } - return TCL_ERROR; - } } - } - if ((len == 0) || ((len > 1) && (optionName[1] == 's') && - (strncmp(optionName, "-sockname", len) == 0))) { - TcpFdList *fds; - address sockname; - socklen_t size; - int found = 0; + /* + * Attempt to connect to the remote socket. + */ + + if (connect(sock, (SOCKADDR *) &sockaddr, + sizeof(SOCKADDR_IN)) == SOCKET_ERROR) { + TclWinConvertWSAError((DWORD) WSAGetLastError()); + if (Tcl_GetErrno() != EWOULDBLOCK) { + goto error; + } - if (len == 0) { - Tcl_DStringAppendElement(dsPtr, "-sockname"); - Tcl_DStringStartSublist(dsPtr); - } - if (GOT_BITS(statePtr->flags, TCP_ASYNC_PENDING)) { /* - * In async connect output an empty string + * The connection is progressing in the background. */ - found = 1; } else { - for (fds = statePtr->sockets; fds != NULL; fds = fds->next) { - sock = fds->fd; - size = sizeof(sockname); - if (getsockname(sock, &(sockname.sa), &size) >= 0) { - int flags = reverseDNS; - - found = 1; - getnameinfo(&sockname.sa, size, host, sizeof(host), - NULL, 0, NI_NUMERICHOST); - Tcl_DStringAppendElement(dsPtr, host); - /* - * We don't want to resolve INADDR_ANY and sin6addr_any; - * they can sometimes cause problems (and never have a - * name). - */ + /* + * Set up the select mask for read/write events. If the connect + * attempt has not completed, include connect events. + */ - 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) { - Tcl_WinConvertError((DWORD) WSAGetLastError()); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't get sockname: %s", Tcl_PosixError(interp))); - } - return TCL_ERROR; - } - } + infoPtr->selectEvents = FD_READ | FD_WRITE | FD_CLOSE; - if ((len == 0) || ((len > 1) && (optionName[1] == 'k') && - (strncmp(optionName, "-keepalive", len) == 0))) { - int optlen; - BOOL opt = FALSE; + /* + * Register for interest in events in the select mask. Note that this + * automatically places the socket into non-blocking mode. + */ - if (len == 0) { - sock = statePtr->sockets->fd; - Tcl_DStringAppendElement(dsPtr, "-keepalive"); - } - optlen = sizeof(BOOL); - getsockopt(sock, SOL_SOCKET, SO_KEEPALIVE, (char *)&opt, &optlen); - Tcl_DStringAppendElement(dsPtr, opt ? "1" : "0"); - if (len > 0) { - return TCL_OK; + ioctlsocket(sock, (long) FIONBIO, &flag); + SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT, + (LPARAM) infoPtr); } } - if ((len == 0) || ((len > 1) && (optionName[1] == 'n') && - (strncmp(optionName, "-nodelay", len) == 0))) { - int optlen; - BOOL opt = FALSE; + return infoPtr; - if (len == 0) { - sock = statePtr->sockets->fd; - Tcl_DStringAppendElement(dsPtr, "-nodelay"); - } - optlen = sizeof(BOOL); - getsockopt(sock, IPPROTO_TCP, TCP_NODELAY, (char *)&opt, &optlen); - Tcl_DStringAppendElement(dsPtr, opt ? "1" : "0"); - if (len > 0) { - return TCL_OK; - } + error: + TclWinConvertWSAError((DWORD) WSAGetLastError()); + if (interp != NULL) { + Tcl_AppendResult(interp, "couldn't open socket: ", + Tcl_PosixError(interp), NULL); } - - if (len > 0) { - return Tcl_BadChannelOption(interp, optionName, - "connecting keepalive nodelay peername sockname"); + if (infoPtr != NULL) { + /* + * Free the allocated socket info structure and close the socket + */ + TcpCloseProc(infoPtr, interp); + } else if (sock != INVALID_SOCKET) { + /* + * No socket structure jet - just close + */ + closesocket(sock); } - - return TCL_OK; + return NULL; } /* *---------------------------------------------------------------------- * - * TcpWatchProc -- + * CreateSocketAddress -- * - * Informs the channel driver of the events that the generic channel code - * wishes to receive on this socket. + * This function initializes a sockaddr structure for a host and port. * * Results: - * None. + * 1 if the host was valid, 0 if the host could not be converted to an IP + * address. * * Side effects: - * May cause the notifier to poll if any of the specified conditions are - * already true. + * Fills in the *sockaddrPtr structure. * *---------------------------------------------------------------------- */ -static void -TcpWatchProc( - void *instanceData, /* The socket state. */ - int mask) /* Events of interest; an OR-ed combination of - * TCL_READABLE, TCL_WRITABLE and - * TCL_EXCEPTION. */ +static int +CreateSocketAddress( + LPSOCKADDR_IN sockaddrPtr, /* Socket address */ + const char *host, /* Host. NULL implies INADDR_ANY */ + int port) /* Port number */ { - TcpState *statePtr = (TcpState *)instanceData; + struct hostent *hostent; /* Host database entry */ + struct in_addr addr; /* For 64/32 bit madness */ /* - * Update the watch events mask. Only if the socket is not a server - * socket. [Bug 557878] + * Check that WinSock is initialized; do not call it if not, to prevent + * system crashes. This can happen at exit time if the exit handler for + * WinSock ran before other exit handlers that want to use sockets. */ - if (!statePtr->acceptProc) { - statePtr->watchEvents = 0; - if (GOT_BITS(mask, TCL_READABLE)) { - SET_BITS(statePtr->watchEvents, FD_READ | FD_CLOSE); - } - if (GOT_BITS(mask, TCL_WRITABLE)) { - SET_BITS(statePtr->watchEvents, FD_WRITE | FD_CLOSE); - } - - /* - * If there are any conditions already set, then tell the notifier to - * poll rather than block. - */ - - if (statePtr->readyEvents & statePtr->watchEvents) { - Tcl_Time blockTime = { 0, 0 }; + if (!SocketsEnabled()) { + Tcl_SetErrno(EFAULT); + return 0; + } - Tcl_SetMaxBlockTime(&blockTime); + ZeroMemory(sockaddrPtr, sizeof(SOCKADDR_IN)); + sockaddrPtr->sin_family = AF_INET; + sockaddrPtr->sin_port = htons((unsigned short) (port & 0xFFFF)); + if (host == NULL) { + addr.s_addr = INADDR_ANY; + } else { + addr.s_addr = inet_addr(host); + if (addr.s_addr == INADDR_NONE) { + hostent = gethostbyname(host); + if (hostent != NULL) { + memcpy(&addr, hostent->h_addr, (size_t) hostent->h_length); + } else { +#ifdef EHOSTUNREACH + Tcl_SetErrno(EHOSTUNREACH); +#else +#ifdef ENXIO + Tcl_SetErrno(ENXIO); +#endif +#endif + return 0; /* Error. */ + } } } -} - -/* - *---------------------------------------------------------------------- - * - * TcpGetHandleProc -- - * - * Called from Tcl_GetChannelHandle to retrieve OS handles from inside a - * TCP socket based channel. - * - * Results: - * Returns TCL_OK with the fd in handlePtr, or TCL_ERROR if there is no - * handle for the specified direction. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ -static int -TcpGetHandleProc( - void *instanceData, /* The socket state. */ - TCL_UNUSED(int) /*direction*/, - void **handlePtr) /* Where to store the handle. */ -{ - TcpState *statePtr = (TcpState *)instanceData; + /* + * NOTE: On 64 bit machines the assignment below is rumored to not do the + * right thing. Please report errors related to this if you observe + * incorrect behavior on 64 bit machines such as DEC Alphas. Should we + * modify this code to do an explicit memcpy? + */ - *handlePtr = INT2PTR(statePtr->sockets->fd); - return TCL_OK; + sockaddrPtr->sin_addr.s_addr = addr.s_addr; + return 1; /* Success. */ } /* *---------------------------------------------------------------------- * - * TcpConnect -- - * - * This function opens a new socket in client mode. + * WaitForSocketEvent -- * - * This might be called in 3 circumstances: - * - By a regular socket command - * - By the event handler to continue an asynchronously connect - * - By a blocking socket function (gets/puts) to terminate the - * connect synchronously + * Waits until one of the specified events occurs on a socket. * * Results: - * TCL_OK, if the socket was successfully connected or an asynchronous - * connection is in progress. If an error occurs, TCL_ERROR is returned - * and an error message is left in interp. + * Returns 1 on success or 0 on failure, with an error code in + * errorCodePtr. * * Side effects: - * Opens a socket. - * - * Remarks: - * A single host name may resolve to more than one IP address, e.g. for - * an IPv4/IPv6 dual stack host. For handling 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. + * Processes socket events off the system queue. * *---------------------------------------------------------------------- */ static int -TcpConnect( - Tcl_Interp *interp, /* For error reporting; can be NULL. */ - TcpState *statePtr) +WaitForSocketEvent( + SocketInfo *infoPtr, /* Information about this socket. */ + int events, /* Events to look for. */ + int *errorCodePtr) /* Where to store errors? */ { - DWORD error; - int async_connect = GOT_BITS(statePtr->flags, TCP_ASYNC_CONNECT); - /* We are started with async connect and the - * connect notification was not yet - * received. */ - int async_callback = GOT_BITS(statePtr->flags, TCP_ASYNC_PENDING); - /* We were called by the event procedure and - * continue our loop. */ - ThreadSpecificData *tsdPtr = (ThreadSpecificData *)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) { - Tcl_WinConvertError((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) { - Tcl_WinConvertError((DWORD) WSAGetLastError()); - continue; - } - - /* - * For asynchronous 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. - */ - - SET_BITS(statePtr->selectEvents, FD_CONNECT); - - /* - * Free list lock. - */ - - SetEvent(tsdPtr->socketListLock); - - /* - * Activate accept notification. - */ - - SendSelectMessage(tsdPtr, SELECT, statePtr); - } - - /* - * Attempt to connect to the remote socket. - */ - - connect(statePtr->sockets->fd, statePtr->addr->ai_addr, - statePtr->addr->ai_addrlen); - - error = WSAGetLastError(); - Tcl_WinConvertError(error); - - if (async_connect && error == WSAEWOULDBLOCK) { - /* - * Asynchronous connect - * - * Remember that we jump back behind this next round - */ - - SET_BITS(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 - */ - - CLEAR_BITS(statePtr->flags, TCP_ASYNC_PENDING); - - /* - * Get statePtr lock. - */ - - WaitForSingleObject(tsdPtr->socketListLock, INFINITE); - - /* - * Get signaled connect error. - */ - - Tcl_WinConvertError((DWORD) statePtr->notifierConnectError); - - /* - * Clear eventual connect flag. - */ - - CLEAR_BITS(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 asynchronously - */ - - tsdPtr->pendingTcpState = NULL; - - if (Tcl_GetErrno() == 0) { - goto out; - } - } - } + int result = 1; + int oldMode; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + TclThreadDataKeyGet(&dataKey); - out: /* - * Socket connected or connection failed + * Be sure to disable event servicing so we are truly modal. */ + oldMode = Tcl_SetServiceMode(TCL_SERVICE_NONE); + /* - * Async connect terminated + * Reset WSAAsyncSelect so we have a fresh set of events pending. + * Don't do that if we are waiting for a connect as we may miss + * a connect (bug 336441ed59). */ - CLEAR_BITS(statePtr->flags, TCP_ASYNC_CONNECT); - - if (Tcl_GetErrno() == 0) { - /* - * Successfully 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. - */ - - SendSelectMessage(tsdPtr, SELECT, 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. - */ - - SET_BITS(statePtr->readyEvents, FD_WRITE | FD_READ); - - /* - * Flag error to event routine. - */ - - SET_BITS(statePtr->flags, TCP_ASYNC_FAILED); - - /* - * Save connect error to be reported by 'fconfigure -error'. - */ - - statePtr->connectError = Tcl_GetErrno(); - - /* - * Free list lock. - */ + if ( 0 == (events & FD_CONNECT) ) { + SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) UNSELECT, + (LPARAM) infoPtr); + + SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT, + (LPARAM) infoPtr); + } - SetEvent(tsdPtr->socketListLock); + while (1) { + if (infoPtr->lastError) { + *errorCodePtr = infoPtr->lastError; + result = 0; + break; + } else if (infoPtr->readyEvents & events) { + break; + } else if (infoPtr->flags & SOCKET_ASYNC) { + *errorCodePtr = EWOULDBLOCK; + result = 0; + break; } /* - * Error message on synchronous connect + * Wait until something happens. */ - if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "couldn't open socket: %s", Tcl_PosixError(interp))); - } - return TCL_ERROR; + WaitForSingleObject(tsdPtr->readyEvent, INFINITE); } - return TCL_OK; + + (void) Tcl_SetServiceMode(oldMode); + return result; } /* @@ -1982,62 +1299,40 @@ Tcl_OpenTcpClient( const char *host, /* Host on which to open port. */ const char *myaddr, /* Client-side address */ int myport, /* Client-side port */ - int async) /* If nonzero, attempt to do an asynchronous - * connect. Otherwise we do a blocking - * connect. */ + int async) /* If nonzero, should connect client socket + * asynchronously. */ { - TcpState *statePtr; - const char *errorMsg = NULL; - struct addrinfo *addrlist = NULL, *myaddrlist = NULL; - char channelName[SOCK_CHAN_LENGTH]; - - TclInitSockets(); - - /* - * Do the name lookups for the local and remote addresses. - */ + SocketInfo *infoPtr; + char channelName[16 + TCL_INTEGER_SPACE]; - 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) { - SET_BITS(statePtr->flags, TCP_ASYNC_CONNECT); + if (TclpHasSockets(interp) != TCL_OK) { + return NULL; } /* * Create a new client socket and wrap it in a channel. */ - if (TcpConnect(interp, statePtr) != TCL_OK) { - TcpCloseProc(statePtr, NULL); + + infoPtr = CreateSocket(interp, port, host, 0, myaddr, myport, async); + if (infoPtr == NULL) { return NULL; } - TclWinGenerateChannelName(channelName, "sock", 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; + sprintf(channelName, "sock%" TCL_I_MODIFIER "u", (size_t)infoPtr->socket); + + infoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName, + (ClientData) infoPtr, (TCL_READABLE | TCL_WRITABLE)); + if (Tcl_SetChannelOption(interp, infoPtr->channel, "-translation", + "auto crlf") == TCL_ERROR) { + Tcl_Close((Tcl_Interp *) NULL, infoPtr->channel); + return (Tcl_Channel) NULL; + } + if (Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "") + == TCL_ERROR) { + Tcl_Close((Tcl_Interp *) NULL, infoPtr->channel); + return (Tcl_Channel) NULL; } - return statePtr->channel; + return infoPtr->channel; } /* @@ -2053,18 +1348,22 @@ Tcl_OpenTcpClient( * Side effects: * None. * + * NOTE: Code contributed by Mark Diekhans (markd@grizzly.com) + * *---------------------------------------------------------------------- */ Tcl_Channel Tcl_MakeTcpClientChannel( - void *sock) /* The socket to wrap up into a channel. */ + ClientData sock) /* The socket to wrap up into a channel. */ { - TcpState *statePtr; - char channelName[SOCK_CHAN_LENGTH]; + SocketInfo *infoPtr; + char channelName[16 + TCL_INTEGER_SPACE]; ThreadSpecificData *tsdPtr; - TclInitSockets(); + if (TclpHasSockets(NULL) != TCL_OK) { + return NULL; + } tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); @@ -2074,32 +1373,33 @@ Tcl_MakeTcpClientChannel( TclSockMinimumBuffers(sock, TCP_BUFFER_SIZE); - statePtr = NewSocketInfo((SOCKET) sock); + infoPtr = NewSocketInfo((SOCKET) sock); /* * Start watching for read/write events on the socket. */ - statePtr->selectEvents = FD_READ | FD_CLOSE | FD_WRITE; - SendSelectMessage(tsdPtr, SELECT, statePtr); + infoPtr->selectEvents = FD_READ | FD_CLOSE | FD_WRITE; + SendMessage(tsdPtr->hwnd, SOCKET_SELECT, + (WPARAM) SELECT, (LPARAM) infoPtr); - TclWinGenerateChannelName(channelName, "sock", statePtr); - statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName, - statePtr, (TCL_READABLE | TCL_WRITABLE)); - Tcl_SetChannelOption(NULL, statePtr->channel, "-translation", "auto crlf"); - return statePtr->channel; + sprintf(channelName, "sock%" TCL_I_MODIFIER "u", (size_t)infoPtr->socket); + infoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName, + (ClientData) infoPtr, (TCL_READABLE | TCL_WRITABLE)); + Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto crlf"); + return infoPtr->channel; } /* *---------------------------------------------------------------------- * - * Tcl_OpenTcpServerEx -- + * 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. + * The channel or NULL if failed. An error message is returned in the + * interpreter on failure. * * Side effects: * Opens a server socket and creates a new channel. @@ -2108,217 +1408,118 @@ Tcl_MakeTcpClientChannel( */ Tcl_Channel -Tcl_OpenTcpServerEx( +Tcl_OpenTcpServer( Tcl_Interp *interp, /* For error reporting - may be NULL. */ - const char *service, /* Port number to open. */ - const char *myHost, /* Name of local host. */ - unsigned int flags, /* Flags. */ - int backlog, /* Length of OS listen backlog queue, or -1 - * for default. */ + int port, /* Port number to open. */ + const char *host, /* Name of local host. */ Tcl_TcpAcceptProc *acceptProc, /* Callback for accepting connections from new * clients. */ - void *acceptProcData) /* Data for the callback. */ + 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; - int optvalue, port; + SocketInfo *infoPtr; + char channelName[16 + TCL_INTEGER_SPACE]; - TclInitSockets(); + if (TclpHasSockets(interp) != TCL_OK) { + return NULL; + } /* - * Construct the addresses for each end of the socket. + * Create a new client socket and wrap it in a channel. */ - if (TclSockGetPort(interp, service, "tcp", &port) != TCL_OK) { - errorMsg = "invalid port number"; - goto error; - } - - 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) { - Tcl_WinConvertError((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); - } - - /* - * The SO_REUSEADDR option on Windows behaves like SO_REUSEPORT on - * unix systems. - */ - - if (GOT_BITS(flags, TCL_TCPSERVER_REUSEPORT)) { - optvalue = 1; - (void) setsockopt(sock, SOL_SOCKET, SO_REUSEADDR, - (char *) &optvalue, sizeof(optvalue)); - } - - /* - * Bind to the specified port. - * - * 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) { - Tcl_WinConvertError((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 (backlog < 0) { - backlog = SOMAXCONN; - } - if (listen(sock, backlog) == SOCKET_ERROR) { - Tcl_WinConvertError((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); + infoPtr = CreateSocket(interp, port, host, 1, NULL, 0, 0); + if (infoPtr == NULL) { + return NULL; } - if (statePtr != NULL) { - ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); - - statePtr->acceptProc = acceptProc; - statePtr->acceptProcData = acceptProcData; - TclWinGenerateChannelName(channelName, "sock", 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. - */ + infoPtr->acceptProc = acceptProc; + infoPtr->acceptProcData = acceptProcData; - ioctlsocket(sock, (long) FIONBIO, &flag); - SendSelectMessage(tsdPtr, SELECT, statePtr); - if (Tcl_SetChannelOption(interp, statePtr->channel, "-eofchar", "") - == TCL_ERROR) { - Tcl_Close(NULL, statePtr->channel); - return NULL; - } - return statePtr->channel; - } + sprintf(channelName, "sock%" TCL_I_MODIFIER "u", (size_t)infoPtr->socket); - if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "couldn't open socket: %s", - (errorMsg ? errorMsg : Tcl_PosixError(interp)))); + infoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName, + (ClientData) infoPtr, 0); + if (Tcl_SetChannelOption(interp, infoPtr->channel, "-eofchar", "") + == TCL_ERROR) { + Tcl_Close((Tcl_Interp *) NULL, infoPtr->channel); + return (Tcl_Channel) NULL; } - if (sock != INVALID_SOCKET) { - closesocket(sock); - } - return NULL; + return infoPtr->channel; } /* *---------------------------------------------------------------------- * * TcpAccept -- - * Accept a TCP socket connection. This is called by the event loop. + * + * Accept a TCP socket connection. This is called by SocketEventProc and + * it in turns calls the registered accept function. * * Results: * None. * * Side effects: - * Creates a new connection socket. Calls the registered callback for the - * connection acceptance mechanism. + * Invokes the accept proc which may invoke arbitrary Tcl code. * *---------------------------------------------------------------------- */ static void TcpAccept( - TcpFdList *fds, /* Server socket that accepted newSocket. */ - SOCKET newSocket, /* Newly accepted socket. */ - address addr) /* Address of new socket. */ + SocketInfo *infoPtr) /* Socket to accept. */ { - TcpState *newInfoPtr; - TcpState *statePtr = fds->statePtr; - int len = sizeof(addr); - char channelName[SOCK_CHAN_LENGTH]; - char host[NI_MAXHOST], port[NI_MAXSERV]; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); + SOCKET newSocket; + SocketInfo *newInfoPtr; + SOCKADDR_IN addr; + int len; + char channelName[16 + TCL_INTEGER_SPACE]; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + TclThreadDataKeyGet(&dataKey); + + /* + * Accept the incoming connection request. + */ + + len = sizeof(SOCKADDR_IN); + + newSocket = accept(infoPtr->socket, (SOCKADDR *)&addr, + &len); + + /* + * Protect access to sockets (acceptEventCount, readyEvents) in socketList + * by the lock. Fix for SF Tcl Bug 3056775. + */ + WaitForSingleObject(tsdPtr->socketListLock, INFINITE); + + /* + * Clear the ready mask so we can detect the next connection request. Note + * that connection requests are level triggered, so if there is a request + * already pending, a new event will be generated. + */ + + if (newSocket == INVALID_SOCKET) { + infoPtr->acceptEventCount = 0; + infoPtr->readyEvents &= ~(FD_ACCEPT); + + SetEvent(tsdPtr->socketListLock); + return; + } + + /* + * It is possible that more than one FD_ACCEPT has been sent, so an extra + * count must be kept. Decrement the count, and reset the readyEvent bit + * if the count is no longer > 0. + */ + + infoPtr->acceptEventCount--; + + if (infoPtr->acceptEventCount <= 0) { + infoPtr->readyEvents &= ~(FD_ACCEPT); + } + + SetEvent(tsdPtr->socketListLock); /* * Win-NT has a misfeature that sockets are inherited in child processes @@ -2328,7 +1529,7 @@ TcpAccept( SetHandleInformation((HANDLE) newSocket, HANDLE_FLAG_INHERIT, 0); /* - * Add this socket to the global list of sockets. + * Allocate socket info structure */ newInfoPtr = NewSocketInfo(newSocket); @@ -2338,19 +1539,20 @@ TcpAccept( */ newInfoPtr->selectEvents = (FD_READ | FD_WRITE | FD_CLOSE); - SendSelectMessage(tsdPtr, SELECT, newInfoPtr); + SendMessage(tsdPtr->hwnd, SOCKET_SELECT, + (WPARAM) SELECT, (LPARAM) newInfoPtr); - TclWinGenerateChannelName(channelName, "sock", newInfoPtr); + sprintf(channelName, "sock%" TCL_I_MODIFIER "u", (size_t)newInfoPtr->socket); newInfoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName, - newInfoPtr, (TCL_READABLE | TCL_WRITABLE)); + (ClientData) newInfoPtr, (TCL_READABLE | TCL_WRITABLE)); if (Tcl_SetChannelOption(NULL, newInfoPtr->channel, "-translation", "auto crlf") == TCL_ERROR) { - Tcl_Close(NULL, newInfoPtr->channel); + Tcl_Close((Tcl_Interp *) NULL, newInfoPtr->channel); return; } if (Tcl_SetChannelOption(NULL, newInfoPtr->channel, "-eofchar", "") == TCL_ERROR) { - Tcl_Close(NULL, newInfoPtr->channel); + Tcl_Close((Tcl_Interp *) NULL, newInfoPtr->channel); return; } @@ -2358,620 +1560,647 @@ TcpAccept( * Invoke the accept callback function. */ - if (statePtr->acceptProc != NULL) { - getnameinfo(&(addr.sa), len, host, sizeof(host), port, sizeof(port), - NI_NUMERICHOST|NI_NUMERICSERV); - statePtr->acceptProc(statePtr->acceptProcData, newInfoPtr->channel, - host, atoi(port)); + if (infoPtr->acceptProc != NULL) { + (infoPtr->acceptProc) (infoPtr->acceptProcData, newInfoPtr->channel, + inet_ntoa(addr.sin_addr), ntohs(addr.sin_port)); } } /* *---------------------------------------------------------------------- * - * InitSocketWindowClass -- + * TcpInputProc -- * - * Registers the event window class for the socket notifier code. - * Caller must not hold socket mutex lock. + * This function is called by the generic IO level to read data from a + * socket based channel. * * Results: - * None. + * The number of bytes read or -1 on error. * * Side effects: - * Register a new window class. + * Consumes input from the socket. * *---------------------------------------------------------------------- */ -static void -InitSocketWindowClass(void) +static int +TcpInputProc( + ClientData instanceData, /* The socket state. */ + char *buf, /* Where to store data. */ + int toRead, /* Maximum number of bytes to read. */ + int *errorCodePtr) /* Where to store error codes. */ { - if (initialized) { - return; + SocketInfo *infoPtr = (SocketInfo *) instanceData; + int bytesRead; + DWORD error; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + TclThreadDataKeyGet(&dataKey); + + *errorCodePtr = 0; + + /* + * Check that WinSock is initialized; do not call it if not, to prevent + * system crashes. This can happen at exit time if the exit handler for + * WinSock ran before other exit handlers that want to use sockets. + */ + + if (!SocketsEnabled()) { + *errorCodePtr = EFAULT; + return -1; } - Tcl_MutexLock(&socketMutex); - if (!initialized) { - initialized = 1; - TclCreateLateExitHandler(SocketExitHandler, NULL); + + /* + * First check to see if EOF was already detected, to prevent calling the + * socket stack after the first time EOF is detected. + */ + + if (infoPtr->flags & SOCKET_EOF) { + return 0; + } + + /* + * Check to see if the socket is connected before trying to read. + */ + + if ((infoPtr->flags & SOCKET_ASYNC_CONNECT) + && !WaitForSocketEvent(infoPtr, FD_CONNECT, errorCodePtr)) { + return -1; + } + + /* + * No EOF, and it is connected, so try to read more from the socket. Note + * that we clear the FD_READ bit because read events are level triggered + * so a new event will be generated if there is still data available to be + * read. We have to simulate blocking behavior here since we are always + * using non-blocking sockets. + */ + + while (1) { + SendMessage(tsdPtr->hwnd, SOCKET_SELECT, + (WPARAM) UNSELECT, (LPARAM) infoPtr); + bytesRead = recv(infoPtr->socket, buf, toRead, 0); + infoPtr->readyEvents &= ~(FD_READ); /* - * 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. + * Check for end-of-file condition or successful read. */ - windowClass.style = 0; - windowClass.cbClsExtra = 0; - windowClass.cbWndExtra = 0; - windowClass.hInstance = (HINSTANCE)TclWinGetTclInstance(); - windowClass.hbrBackground = NULL; - windowClass.lpszMenuName = NULL; - windowClass.lpszClassName = className; - windowClass.lpfnWndProc = SocketProc; - windowClass.hIcon = NULL; - windowClass.hCursor = NULL; + if (bytesRead == 0) { + infoPtr->flags |= SOCKET_EOF; + } + if (bytesRead != SOCKET_ERROR) { + break; + } - if (!RegisterClassW(&windowClass)) { - Tcl_WinConvertError(GetLastError()); - goto initFailure; + /* + * If an error occurs after the FD_CLOSE has arrived, then ignore the + * error and report an EOF. + */ + + if (infoPtr->readyEvents & FD_CLOSE) { + infoPtr->flags |= SOCKET_EOF; + bytesRead = 0; + break; + } + + error = WSAGetLastError(); + + /* + * If an RST comes, then ignore the error and report an EOF just like + * on unix. + */ + + if (error == WSAECONNRESET) { + infoPtr->flags |= SOCKET_EOF; + bytesRead = 0; + break; + } + + /* + * Check for error condition or underflow in non-blocking case. + */ + + if ((infoPtr->flags & SOCKET_ASYNC) || (error != WSAEWOULDBLOCK)) { + TclWinConvertWSAError(error); + *errorCodePtr = Tcl_GetErrno(); + bytesRead = -1; + break; + } + + /* + * In the blocking case, wait until the file becomes readable or + * closed and try again. + */ + + if (!WaitForSocketEvent(infoPtr, FD_READ|FD_CLOSE, errorCodePtr)) { + bytesRead = -1; + break; } } - Tcl_MutexUnlock(&socketMutex); - return; - initFailure: - Tcl_MutexUnlock(&socketMutex); /* Probably pointless before panicing */ - Tcl_Panic("InitSockets failed"); + SendMessage(tsdPtr->hwnd, SOCKET_SELECT, + (WPARAM) SELECT, (LPARAM) infoPtr); + + return bytesRead; } /* *---------------------------------------------------------------------- * - * SocketExitHandler -- + * TcpOutputProc -- * - * Callback invoked during exit clean up to delete the socket - * communication window. + * This function is called by the generic IO level to write data to a + * socket based channel. * * Results: - * None. + * The number of bytes written or -1 on failure. * * Side effects: - * None. + * Produces output on the socket. * *---------------------------------------------------------------------- */ -static void -SocketExitHandler( - TCL_UNUSED(void *)) +static int +TcpOutputProc( + ClientData instanceData, /* The socket state. */ + const char *buf, /* Where to get data. */ + int toWrite, /* Maximum number of bytes to write. */ + int *errorCodePtr) /* Where to store error codes. */ { - Tcl_MutexLock(&socketMutex); + SocketInfo *infoPtr = (SocketInfo *) instanceData; + int bytesWritten; + DWORD error; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + TclThreadDataKeyGet(&dataKey); + + *errorCodePtr = 0; /* - * Make sure the socket event handling window is cleaned-up for, at - * most, this thread. + * 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. */ - TclpFinalizeSockets(); - UnregisterClassW(className, (HINSTANCE)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( - TCL_UNUSED(void *), - int flags) /* Event flags as passed to Tcl_DoOneEvent. */ -{ - TcpState *statePtr; - Tcl_Time blockTime = { 0, 0 }; - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - - if (!GOT_BITS(flags, TCL_FILE_EVENTS)) { - return; + if (!SocketsEnabled()) { + *errorCodePtr = EFAULT; + return -1; } /* - * Check to see if there is a ready socket. If so, poll. + * Check to see if the socket is connected before trying to write. */ - WaitForSingleObject(tsdPtr->socketListLock, INFINITE); - for (statePtr = tsdPtr->socketList; statePtr != NULL; - statePtr = statePtr->nextPtr) { - if (GOT_BITS(statePtr->readyEvents, - statePtr->watchEvents | FD_CONNECT | FD_ACCEPT)) { - Tcl_SetMaxBlockTime(&blockTime); + + if ((infoPtr->flags & SOCKET_ASYNC_CONNECT) + && !WaitForSocketEvent(infoPtr, FD_CONNECT, errorCodePtr)) { + return -1; + } + + while (1) { + SendMessage(tsdPtr->hwnd, SOCKET_SELECT, + (WPARAM) UNSELECT, (LPARAM) infoPtr); + + bytesWritten = send(infoPtr->socket, buf, toWrite, 0); + if (bytesWritten != SOCKET_ERROR) { + /* + * Since Windows won't generate a new write event until we hit an + * overflow condition, we need to force the event loop to poll + * until the condition changes. + */ + + if (infoPtr->watchEvents & FD_WRITE) { + Tcl_Time blockTime = { 0, 0 }; + Tcl_SetMaxBlockTime(&blockTime); + } + break; + } + + /* + * Check for error condition or overflow. In the event of overflow, we + * need to clear the FD_WRITE flag so we can detect the next writable + * event. Note that Windows only sends a new writable event after a + * send fails with WSAEWOULDBLOCK. + */ + + error = WSAGetLastError(); + if (error == WSAEWOULDBLOCK) { + infoPtr->readyEvents &= ~(FD_WRITE); + if (infoPtr->flags & SOCKET_ASYNC) { + *errorCodePtr = EWOULDBLOCK; + bytesWritten = -1; + break; + } + } else { + TclWinConvertWSAError(error); + *errorCodePtr = Tcl_GetErrno(); + bytesWritten = -1; + break; + } + + /* + * In the blocking case, wait until the file becomes writable or + * closed and try again. + */ + + if (!WaitForSocketEvent(infoPtr, FD_WRITE|FD_CLOSE, errorCodePtr)) { + bytesWritten = -1; break; } } - SetEvent(tsdPtr->socketListLock); + + SendMessage(tsdPtr->hwnd, SOCKET_SELECT, + (WPARAM) SELECT, (LPARAM) infoPtr); + + return bytesWritten; } /* *---------------------------------------------------------------------- * - * SocketCheckProc -- + * TcpSetOptionProc -- * - * This function is called by Tcl_DoOneEvent to check the socket event - * source for events. + * Sets Tcp channel specific options. * * Results: - * None. + * None, unless an error happens. * * Side effects: - * May queue an event. + * Changes attributes of the socket at the system level. * *---------------------------------------------------------------------- */ -static void -SocketCheckProc( - TCL_UNUSED(void *), - int flags) /* Event flags as passed to Tcl_DoOneEvent. */ +static int +TcpSetOptionProc( + ClientData instanceData, /* Socket state. */ + Tcl_Interp *interp, /* For error reporting - can be NULL. */ + const char *optionName, /* Name of the option to set. */ + const char *value) /* New value for option. */ { - TcpState *statePtr; - SocketEvent *evPtr; - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - - if (!GOT_BITS(flags, TCL_FILE_EVENTS)) { - return; - } +#ifdef TCL_FEATURE_KEEPALIVE_NAGLE + SocketInfo *infoPtr; + SOCKET sock; +#endif /* - * Queue events for any ready sockets that don't already have events - * queued (caused by persistent states that won't generate WinSock - * events). + * Check that WinSock is initialized; do not call it if not, to prevent + * system crashes. This can happen at exit time if the exit handler for + * WinSock ran before other exit handlers that want to use sockets. */ - WaitForSingleObject(tsdPtr->socketListLock, INFINITE); - for (statePtr = tsdPtr->socketList; statePtr != NULL; - statePtr = statePtr->nextPtr) { - if (GOT_BITS(statePtr->readyEvents, - statePtr->watchEvents | FD_CONNECT | FD_ACCEPT) - && !GOT_BITS(statePtr->flags, SOCKET_PENDING)) { - SET_BITS(statePtr->flags, SOCKET_PENDING); - evPtr = (SocketEvent *)ckalloc(sizeof(SocketEvent)); - evPtr->header.proc = SocketEventProc; - evPtr->socket = statePtr->sockets->fd; - Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL); + if (!SocketsEnabled()) { + if (interp) { + Tcl_AppendResult(interp, "winsock is not initialized", NULL); } + return TCL_ERROR; } - SetEvent(tsdPtr->socketListLock); + +#ifdef TCL_FEATURE_KEEPALIVE_NAGLE + infoPtr = (SocketInfo *) instanceData; + sock = infoPtr->socket; + + if (!strcasecmp(optionName, "-keepalive")) { + BOOL val = FALSE; + int boolVar, rtn; + + if (Tcl_GetBoolean(interp, value, &boolVar) != TCL_OK) { + return TCL_ERROR; + } + if (boolVar) { + val = TRUE; + } + rtn = setsockopt(sock, SOL_SOCKET, SO_KEEPALIVE, + (const char *) &val, sizeof(BOOL)); + if (rtn != 0) { + TclWinConvertWSAError(WSAGetLastError()); + if (interp) { + Tcl_AppendResult(interp, "couldn't set socket option: ", + Tcl_PosixError(interp), NULL); + } + return TCL_ERROR; + } + return TCL_OK; + } else if (!strcasecmp(optionName, "-nagle")) { + BOOL val = FALSE; + int boolVar, rtn; + + if (Tcl_GetBoolean(interp, value, &boolVar) != TCL_OK) { + return TCL_ERROR; + } + if (!boolVar) { + val = TRUE; + } + rtn = setsockopt(sock, IPPROTO_TCP, TCP_NODELAY, + (const char *) &val, sizeof(BOOL)); + if (rtn != 0) { + TclWinConvertWSAError(WSAGetLastError()); + if (interp) { + Tcl_AppendResult(interp, "couldn't set socket option: ", + Tcl_PosixError(interp), NULL); + } + return TCL_ERROR; + } + return TCL_OK; + } + + return Tcl_BadChannelOption(interp, optionName, "keepalive nagle"); +#else + return Tcl_BadChannelOption(interp, optionName, ""); +#endif /*TCL_FEATURE_KEEPALIVE_NAGLE*/ } /* *---------------------------------------------------------------------- * - * SocketEventProc -- + * TcpGetOptionProc -- * - * This function is called by Tcl_ServiceEvent when a socket event - * reaches the front of the event queue. This function is responsible for - * notifying the generic channel code. + * Computes an option value for a TCP socket based channel, or a list of + * all options and their values. + * + * Note: This code is based on code contributed by John Haxby. * * Results: - * Returns 1 if the event was handled, meaning it should be removed from - * the queue. Returns 0 if the event was not handled, meaning it should - * stay on the queue. The only time the event isn't handled is if the - * TCL_FILE_EVENTS flag bit isn't set. + * A standard Tcl result. The value of the specified option or a list of + * all options and their values is returned in the supplied DString. * * Side effects: - * Whatever the channel callback functions do. + * None. * *---------------------------------------------------------------------- */ static int -SocketEventProc( - Tcl_Event *evPtr, /* Event to service. */ - int flags) /* Flags that indicate what events to handle, - * such as TCL_FILE_EVENTS. */ +TcpGetOptionProc( + ClientData instanceData, /* Socket state. */ + Tcl_Interp *interp, /* For error reporting - can be NULL */ + const char *optionName, /* Name of the option to retrieve the value + * for, or NULL to get all options and their + * values. */ + Tcl_DString *dsPtr) /* Where to store the computed value; + * initialized by caller. */ { - TcpState *statePtr; - SocketEvent *eventPtr = (SocketEvent *) evPtr; - int mask = 0, events; - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - TcpFdList *fds; - SOCKET newSocket; - address addr; - int len; - - if (!GOT_BITS(flags, TCL_FILE_EVENTS)) { - return 0; - } + SocketInfo *infoPtr; + SOCKADDR_IN sockname; + SOCKADDR_IN peername; + struct hostent *hostEntPtr; + SOCKET sock; + int size = sizeof(SOCKADDR_IN); + size_t len = 0; + char buf[TCL_INTEGER_SPACE]; /* - * Find the specified socket on the socket list. + * Check that WinSock is initialized; do not call it if not, to prevent + * system crashes. This can happen at exit time if the exit handler for + * WinSock ran before other exit handlers that want to use sockets. */ - WaitForSingleObject(tsdPtr->socketListLock, INFINITE); - for (statePtr = tsdPtr->socketList; statePtr != NULL; - statePtr = statePtr->nextPtr) { - if (statePtr->sockets->fd == eventPtr->socket) { - break; + if (!SocketsEnabled()) { + if (interp) { + Tcl_AppendResult(interp, "winsock is not initialized", NULL); } + return TCL_ERROR; } - /* - * Discard events that have gone stale. - */ - - if (!statePtr) { - SetEvent(tsdPtr->socketListLock); - return 1; + infoPtr = (SocketInfo *) instanceData; + sock = (int) infoPtr->socket; + if (optionName != NULL) { + len = strlen(optionName); } - /* - * Clear flag that (this) event is pending - */ - - CLEAR_BITS(statePtr->flags, SOCKET_PENDING); - - /* - * Continue async connect if pending and ready - */ + if ((len > 1) && (optionName[1] == 'e') && + (strncmp(optionName, "-error", len) == 0)) { + int optlen; + DWORD err; + int ret; + + optlen = sizeof(int); + ret = TclWinGetSockOpt((int)sock, SOL_SOCKET, SO_ERROR, + (char *)&err, &optlen); + if (ret == SOCKET_ERROR) { + err = WSAGetLastError(); + } + if (err) { + TclWinConvertWSAError(err); + Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(Tcl_GetErrno()), -1); + } + return TCL_OK; + } - if (GOT_BITS(statePtr->readyEvents, FD_CONNECT)) { - if (GOT_BITS(statePtr->flags, TCP_ASYNC_PENDING)) { - /* - * Do one step and save eventual connect error - */ + if ((len == 0) || ((len > 1) && (optionName[1] == 'p') && + (strncmp(optionName, "-peername", len) == 0))) { + if (getpeername(sock, (LPSOCKADDR) &peername, &size) == 0) { + if (len == 0) { + Tcl_DStringAppendElement(dsPtr, "-peername"); + Tcl_DStringStartSublist(dsPtr); + } + Tcl_DStringAppendElement(dsPtr, inet_ntoa(peername.sin_addr)); - SetEvent(tsdPtr->socketListLock); - WaitForConnect(statePtr,NULL); + if (peername.sin_addr.s_addr == 0) { + hostEntPtr = NULL; + } else { + hostEntPtr = gethostbyaddr((char *) &(peername.sin_addr), + sizeof(peername.sin_addr), AF_INET); + } + if (hostEntPtr != NULL) { + Tcl_DStringAppendElement(dsPtr, hostEntPtr->h_name); + } else { + Tcl_DStringAppendElement(dsPtr, inet_ntoa(peername.sin_addr)); + } + TclFormatInt(buf, ntohs(peername.sin_port)); + Tcl_DStringAppendElement(dsPtr, buf); + if (len == 0) { + Tcl_DStringEndSublist(dsPtr); + } else { + return TCL_OK; + } } else { /* - * No async connect reenter pending. Just clear event. + * getpeername failed - but if we were asked for all the options + * (len==0), don't flag an error at that point because it could be + * an fconfigure request on a server socket (such sockets have no + * peer). {Copied from unix/tclUnixChan.c} */ - CLEAR_BITS(statePtr->readyEvents, FD_CONNECT); - SetEvent(tsdPtr->socketListLock); + if (len) { + TclWinConvertWSAError((DWORD) WSAGetLastError()); + if (interp) { + Tcl_AppendResult(interp, "can't get peername: ", + Tcl_PosixError(interp), NULL); + } + return TCL_ERROR; + } } - return 1; } - /* - * Handle connection requests directly. - */ - - if (GOT_BITS(statePtr->readyEvents, FD_ACCEPT)) { - for (fds = statePtr->sockets; fds != NULL; fds = fds->next) { - /* - * Accept the incoming connection request. - */ - - len = sizeof(address); - newSocket = accept(fds->fd, &(addr.sa), &len); - - /* - * On Tcl server sockets with multiple OS fds we loop over the fds - * trying an accept() on each, so we expect INVALID_SOCKET. There - * are also other network stack conditions that can result in - * FD_ACCEPT but a subsequent failure on accept() by the time we - * get around to it. - * - * Access to sockets (acceptEventCount, readyEvents) in socketList - * is still protected by the lock (prevents reintroduction of - * SF Tcl Bug 3056775. - */ - - if (newSocket == INVALID_SOCKET) { - /* int err = WSAGetLastError(); */ - continue; + if ((len == 0) || ((len > 1) && (optionName[1] == 's') && + (strncmp(optionName, "-sockname", len) == 0))) { + if (getsockname(sock, (LPSOCKADDR) &sockname, &size) == 0) { + if (len == 0) { + Tcl_DStringAppendElement(dsPtr, "-sockname"); + Tcl_DStringStartSublist(dsPtr); } - - /* - * It is possible that more than one FD_ACCEPT has been sent, so - * an extra count must be kept. Decrement the count, and reset the - * readyEvent bit if the count is no longer > 0. - */ - - statePtr->acceptEventCount--; - - if (statePtr->acceptEventCount <= 0) { - CLEAR_BITS(statePtr->readyEvents, FD_ACCEPT); + Tcl_DStringAppendElement(dsPtr, inet_ntoa(sockname.sin_addr)); + if (sockname.sin_addr.s_addr == 0) { + hostEntPtr = NULL; + } else { + hostEntPtr = gethostbyaddr((char *) &(sockname.sin_addr), + sizeof(peername.sin_addr), AF_INET); } - - SetEvent(tsdPtr->socketListLock); - - /* - * Caution: TcpAccept() has the side-effect of evaluating the - * server accept script (via AcceptCallbackProc() in tclIOCmd.c), - * which can close the server socket and invalidate statePtr and - * fds. If TcpAccept() accepts a socket we must return immediately - * and let SocketCheckProc queue additional FD_ACCEPT events. - */ - - TcpAccept(fds, newSocket, addr); - return 1; + if (hostEntPtr != NULL) { + Tcl_DStringAppendElement(dsPtr, hostEntPtr->h_name); + } else { + Tcl_DStringAppendElement(dsPtr, inet_ntoa(sockname.sin_addr)); + } + TclFormatInt(buf, ntohs(sockname.sin_port)); + Tcl_DStringAppendElement(dsPtr, buf); + if (len == 0) { + Tcl_DStringEndSublist(dsPtr); + } else { + return TCL_OK; + } + } else { + if (interp) { + TclWinConvertWSAError((DWORD) WSAGetLastError()); + Tcl_AppendResult(interp, "can't get sockname: ", + Tcl_PosixError(interp), NULL); + } + return TCL_ERROR; } - - /* - * Loop terminated with no sockets accepted; clear the ready mask so - * we can detect the next connection request. Note that connection - * requests are level triggered, so if there is a request already - * pending, a new event will be generated. - */ - - statePtr->acceptEventCount = 0; - CLEAR_BITS(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 (GOT_BITS(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); - SET_BITS(mask, TCL_READABLE | TCL_WRITABLE); - } else if (GOT_BITS(events, FD_READ)) { - /* - * Throw the readable event if an async connect failed. - */ +#ifdef TCL_FEATURE_KEEPALIVE_NAGLE + if (len == 0 || !strncmp(optionName, "-keepalive", len)) { + int optlen; + BOOL opt = FALSE; - if (GOT_BITS(statePtr->flags, TCP_ASYNC_FAILED)) { - SET_BITS(mask, TCL_READABLE); + if (len == 0) { + Tcl_DStringAppendElement(dsPtr, "-keepalive"); + } + optlen = sizeof(BOOL); + getsockopt(sock, SOL_SOCKET, SO_KEEPALIVE, (char *)&opt, &optlen); + if (opt) { + Tcl_DStringAppendElement(dsPtr, "1"); } else { - fd_set readFds; - struct timeval timeout; - - /* - * We must check to see if data is really available, since someone - * could have consumed the data in the meantime. Turn off async - * notification so select will work correctly. If the socket is - * still readable, notify the channel driver, otherwise reset the - * async select handler and keep waiting. - */ - - SendSelectMessage(tsdPtr, UNSELECT, 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) { - SET_BITS(mask, TCL_READABLE); - } else { - CLEAR_BITS(statePtr->readyEvents, FD_READ); - SendSelectMessage(tsdPtr, SELECT, statePtr); - } + Tcl_DStringAppendElement(dsPtr, "0"); + } + if (len > 0) { + return TCL_OK; } } - /* - * writable event - */ + if (len == 0 || !strncmp(optionName, "-nagle", len)) { + int optlen; + BOOL opt = FALSE; - if (GOT_BITS(events, FD_WRITE)) { - SET_BITS(mask, TCL_WRITABLE); + if (len == 0) { + Tcl_DStringAppendElement(dsPtr, "-nagle"); + } + optlen = sizeof(BOOL); + getsockopt(sock, IPPROTO_TCP, TCP_NODELAY, (char *)&opt, + &optlen); + if (opt) { + Tcl_DStringAppendElement(dsPtr, "0"); + } else { + Tcl_DStringAppendElement(dsPtr, "1"); + } + if (len > 0) { + return TCL_OK; + } } +#endif /*TCL_FEATURE_KEEPALIVE_NAGLE*/ - /* - * Call registered event procedures - */ - - if (mask) { - Tcl_NotifyChannel(statePtr->channel, mask); + if (len > 0) { +#ifdef TCL_FEATURE_KEEPALIVE_NAGLE + return Tcl_BadChannelOption(interp, optionName, + "peername sockname keepalive nagle"); +#else + return Tcl_BadChannelOption(interp, optionName, "peername sockname"); +#endif /*TCL_FEATURE_KEEPALIVE_NAGLE*/ } - return 1; + + return TCL_OK; } /* *---------------------------------------------------------------------- * - * AddSocketInfoFd -- + * TcpWatchProc -- * - * This function adds a SOCKET file descriptor to the 'sockets' linked - * list of a TcpState structure. + * Informs the channel driver of the events that the generic channel code + * wishes to receive on this socket. * * Results: * None. * * Side effects: - * None, except for allocation of memory. + * May cause the notifier to poll if any of the specified conditions are + * already true. * *---------------------------------------------------------------------- */ static void -AddSocketInfoFd( - TcpState *statePtr, - SOCKET socket) +TcpWatchProc( + ClientData instanceData, /* The socket state. */ + int mask) /* Events of interest; an OR-ed combination of + * TCL_READABLE, TCL_WRITABLE and + * TCL_EXCEPTION. */ { - TcpFdList *fds = statePtr->sockets; + SocketInfo *infoPtr = (SocketInfo *) instanceData; - if (fds == NULL) { - /* - * Add the first FD. - */ + /* + * Update the watch events mask. Only if the socket is not a server + * socket. Fix for SF Tcl Bug #557878. + */ + + if (!infoPtr->acceptProc) { + infoPtr->watchEvents = 0; + if (mask & TCL_READABLE) { + infoPtr->watchEvents |= (FD_READ|FD_CLOSE|FD_ACCEPT); + } + if (mask & TCL_WRITABLE) { + infoPtr->watchEvents |= (FD_WRITE|FD_CLOSE|FD_CONNECT); + } - statePtr->sockets = (TcpFdList *)ckalloc(sizeof(TcpFdList)); - fds = statePtr->sockets; - } else { /* - * Find end of list and append FD. + * If there are any conditions already set, then tell the notifier to + * poll rather than block. */ - while (fds->next != NULL) { - fds = fds->next; + if (infoPtr->readyEvents & infoPtr->watchEvents) { + Tcl_Time blockTime = { 0, 0 }; + Tcl_SetMaxBlockTime(&blockTime); } - - fds->next = (TcpFdList *)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 = (TcpState *)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 -- + * TcpGetProc -- * - * Waits until one of the specified events occurs on a socket. - * For event FD_CONNECT use WaitForConnect. + * Called from Tcl_GetChannelHandle to retrieve an OS handle from inside + * a TCP socket based channel. * * Results: - * Returns 1 on success or 0 on failure, with an error code in - * errorCodePtr. + * Returns TCL_OK with the socket in handlePtr. * * Side effects: - * Processes socket events off the system queue. + * None. * *---------------------------------------------------------------------- */ static int -WaitForSocketEvent( - TcpState *statePtr, /* Information about this socket. */ - int events, /* Events to look for. May be one of - * FD_READ or FD_WRITE. - */ - int *errorCodePtr) /* Where to store errors? */ +TcpGetHandleProc( + ClientData instanceData, /* The socket state. */ + int direction, /* Not used. */ + ClientData *handlePtr) /* Where to store the handle. */ { - int result = 1; - int oldMode; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); - - /* - * Be sure to disable event servicing so we are truly modal. - */ - - oldMode = Tcl_SetServiceMode(TCL_SERVICE_NONE); - - /* - * Reset WSAAsyncSelect so we have a fresh set of events pending. - */ - - SendSelectMessage(tsdPtr, UNSELECT, statePtr); - SendSelectMessage(tsdPtr, SELECT, statePtr); - - while (1) { - int event_found; - - /* - * Get statePtr lock. - */ - - WaitForSingleObject(tsdPtr->socketListLock, INFINITE); + SocketInfo *statePtr = (SocketInfo *) instanceData; - /* - * Check if event occurred. - */ - - event_found = GOT_BITS(statePtr->readyEvents, events); - - /* - * Free list lock. - */ - - SetEvent(tsdPtr->socketListLock); - - /* - * Exit loop if event occurred. - */ - - if (event_found) { - break; - } - - /* - * Exit loop if event did not occur but this is a non-blocking channel - */ - - if (statePtr->flags & TCP_NONBLOCKING) { - *errorCodePtr = EWOULDBLOCK; - result = 0; - break; - } - - /* - * Wait until something happens. - */ - - WaitForSingleObject(tsdPtr->readyEvent, INFINITE); - } - - (void) Tcl_SetServiceMode(oldMode); - return result; + *handlePtr = (ClientData) statePtr->socket; + return TCL_OK; } /* @@ -2995,14 +2224,14 @@ SocketThread( LPVOID arg) { MSG msg; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *)arg; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *)(arg); /* * Create a dummy window receiving socket events. */ - tsdPtr->hwnd = CreateWindowW(className, className, WS_TILED, 0, 0, 0, 0, - NULL, NULL, windowClass.hInstance, arg); + tsdPtr->hwnd = CreateWindow("TclSocket", "TclSocket", + WS_TILED, 0, 0, 0, 0, NULL, NULL, windowClass.hInstance, arg); /* * Signalize thread creator that we are done creating the window. @@ -3021,11 +2250,11 @@ SocketThread( /* * 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(). + * PostMessage(SOCKET_TERMINATE) in TclpFinalizeSockets(). */ - while (GetMessageW(&msg, NULL, 0, 0) > 0) { - DispatchMessageW(&msg); + while (GetMessage(&msg, NULL, 0, 0) > 0) { + DispatchMessage(&msg); } /* @@ -3051,7 +2280,7 @@ SocketThread( * * Side effects: * The flags for the given socket are updated to reflect the event that - * occurred. + * occured. * *---------------------------------------------------------------------- */ @@ -3065,19 +2294,18 @@ SocketProc( { int event, error; SOCKET socket; - TcpState *statePtr; + SocketInfo *infoPtr; int info_found = 0; - TcpFdList *fds = NULL; ThreadSpecificData *tsdPtr = (ThreadSpecificData *) #ifdef _WIN64 - GetWindowLongPtrW(hwnd, GWLP_USERDATA); + GetWindowLongPtr(hwnd, GWLP_USERDATA); #else - GetWindowLongW(hwnd, GWL_USERDATA); + GetWindowLong(hwnd, GWL_USERDATA); #endif switch (message) { default: - return DefWindowProcW(hwnd, message, wParam, lParam); + return DefWindowProc(hwnd, message, wParam, lParam); break; case WM_CREATE: @@ -3087,10 +2315,10 @@ SocketProc( */ #ifdef _WIN64 - SetWindowLongPtrW(hwnd, GWLP_USERDATA, + SetWindowLongPtr(hwnd, GWLP_USERDATA, (LONG_PTR) ((LPCREATESTRUCT)lParam)->lpCreateParams); #else - SetWindowLongW(hwnd, GWL_USERDATA, + SetWindowLong(hwnd, GWL_USERDATA, (LONG) ((LPCREATESTRUCT)lParam)->lpCreateParams); #endif break; @@ -3104,63 +2332,73 @@ SocketProc( error = WSAGETSELECTERROR(lParam); socket = (SOCKET) wParam; - WaitForSingleObject(tsdPtr->socketListLock, INFINITE); - /* * Find the specified socket on the socket list and update its * eventState flag. */ - for (statePtr = tsdPtr->socketList; statePtr != NULL; - statePtr = statePtr->nextPtr) { - if (FindFDInList(statePtr, socket)) { + WaitForSingleObject(tsdPtr->socketListLock, INFINITE); + for (infoPtr = tsdPtr->socketList; infoPtr != NULL; + infoPtr = infoPtr->nextPtr) { + if (infoPtr->socket == socket) { info_found = 1; break; } } - /* - * Check if there is a pending info structure not jet in the list. + * 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; + if ( !info_found + && tsdPtr->pendingSocketInfo != NULL + && tsdPtr->pendingSocketInfo->socket ==socket ) { + infoPtr = tsdPtr->pendingSocketInfo; 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. + * happens, then clear the FD_ACCEPT count. Otherwise, + * increment the count if the current event is an FD_ACCEPT. */ - if (GOT_BITS(event, FD_CLOSE)) { - statePtr->acceptEventCount = 0; - CLEAR_BITS(statePtr->readyEvents, FD_WRITE | FD_ACCEPT); - } else if (GOT_BITS(event, FD_ACCEPT)) { - statePtr->acceptEventCount++; + if (event & FD_CLOSE) { + infoPtr->acceptEventCount = 0; + infoPtr->readyEvents &= ~(FD_WRITE|FD_ACCEPT); + } else if (event & FD_ACCEPT) { + infoPtr->acceptEventCount++; } - if (GOT_BITS(event, FD_CONNECT)) { + if (event & FD_CONNECT) { + /* + * The socket is now connected, clear the async connect + * flag. + */ + + infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT); + /* * Remember any error that occurred so we can report * connection failures. */ if (error != ERROR_SUCCESS) { - statePtr->notifierConnectError = error; + /* Async Connect error */ + TclWinConvertWSAError((DWORD) error); + infoPtr->lastError = Tcl_GetErrno(); + /* Fire also readable event on connect failure */ + infoPtr->readyEvents |= FD_READ; } - } - /* - * Inform main thread about signaled events - */ + /* fire writable event on connect */ + infoPtr->readyEvents |= FD_WRITE; - SET_BITS(statePtr->readyEvents, event); + } + + infoPtr->readyEvents |= event; /* * Wake up the Main Thread. @@ -3173,18 +2411,20 @@ SocketProc( break; case SOCKET_SELECT: - statePtr = (TcpState *) lParam; - for (fds = statePtr->sockets; fds != NULL; fds = fds->next) { - if (wParam == SELECT) { - WSAAsyncSelect(fds->fd, hwnd, - SOCKET_MESSAGE, statePtr->selectEvents); - } else { - /* - * Clear the selection mask - */ + infoPtr = (SocketInfo *) lParam; + if (wParam == SELECT) { + /* + * Start notification by windows messages on socket events + */ - WSAAsyncSelect(fds->fd, hwnd, 0, 0); - } + WSAAsyncSelect(infoPtr->socket, hwnd, + SOCKET_MESSAGE, infoPtr->selectEvents); + } else { + /* + * UNSELECT: Clear the selection mask + */ + + WSAAsyncSelect(infoPtr->socket, hwnd, 0, 0); } break; @@ -3199,31 +2439,83 @@ SocketProc( /* *---------------------------------------------------------------------- * - * FindFDInList -- + * Tcl_GetHostName -- * - * Return true, if the given file descriptor is contained in the - * file descriptor list. + * Returns the name of the local host. * * Results: - * true if found. + * A string containing the network name for this machine. The caller must + * not modify or free this string. * * Side effects: + * Caches the name to return for future calls. * *---------------------------------------------------------------------- */ -static int -FindFDInList( - TcpState *statePtr, - SOCKET socket) +const char * +Tcl_GetHostName(void) { - TcpFdList *fds; - for (fds = statePtr->sockets; fds != NULL; fds = fds->next) { - if (fds->fd == socket) { - return 1; + return Tcl_GetString(TclGetProcessGlobalValue(&hostName)); +} + +/* + *---------------------------------------------------------------------- + * + * InitializeHostName -- + * + * This routine sets the process global value of the name of the local + * host on which the process is running. + * + * Results: + * None. + * + *---------------------------------------------------------------------- + */ + +void +InitializeHostName( + char **valuePtr, + int *lengthPtr, + Tcl_Encoding *encodingPtr) +{ + WCHAR wbuf[MAX_COMPUTERNAME_LENGTH + 1]; + DWORD length = sizeof(wbuf) / sizeof(WCHAR); + Tcl_DString ds; + + if ((*tclWinProcs->getComputerNameProc)(wbuf, &length) != 0) { + /* + * Convert string from native to UTF then change to lowercase. + */ + + Tcl_UtfToLower(Tcl_WinTCharToUtf((TCHAR *) wbuf, -1, &ds)); + + } else { + Tcl_DStringInit(&ds); + if (TclpHasSockets(NULL) == TCL_OK) { + /* + * The buffer size of 256 is recommended by the MSDN page that + * documents gethostname() as being always adequate. + */ + + Tcl_DString inDs; + + Tcl_DStringInit(&inDs); + Tcl_DStringSetLength(&inDs, 256); + if (gethostname(Tcl_DStringValue(&inDs), + Tcl_DStringLength(&inDs)) == 0) { + Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(&inDs), -1, + &ds); + } + Tcl_DStringFree(&inDs); } } - return 0; + + *encodingPtr = Tcl_GetEncoding(NULL, "utf-8"); + *lengthPtr = Tcl_DStringLength(&ds); + *valuePtr = ckalloc((unsigned int) (*lengthPtr)+1); + memcpy(*valuePtr, Tcl_DStringValue(&ds), (size_t)(*lengthPtr)+1); + Tcl_DStringFree(&ds); } /* @@ -3231,11 +2523,10 @@ FindFDInList( * * TclWinGetSockOpt, et al. -- * - * Those functions are historically exported by the stubs table and - * just use the original system calls now. - * - * Warning: - * Those functions are depreciated and will be removed with TCL 9.0. + * These functions are wrappers that let us bind the WinSock API + * dynamically so we can run on systems that don't have the wsock32.dll. + * We need wrappers for these interfaces because they are called from the + * generic Tcl code. * * Results: * As defined for each function. @@ -3246,38 +2537,28 @@ FindFDInList( *---------------------------------------------------------------------- */ -#ifndef TCL_NO_DEPRECATED #undef TclWinGetSockOpt int -TclWinGetSockOpt( - SOCKET s, - int level, - int optname, - char *optval, - int *optlen) +TclWinGetSockOpt(SOCKET s, int level, int optname, char *optval, + int *optlen) { - return getsockopt(s, level, optname, optval, optlen); } + #undef TclWinSetSockOpt int -TclWinSetSockOpt( - SOCKET s, - int level, - int optname, - const char *optval, +TclWinSetSockOpt(SOCKET s, int level, int optname, const char *optval, int optlen) { return setsockopt(s, level, optname, optval, optlen); } -#undef TclpInetNtoa char * -TclpInetNtoa( - struct in_addr addr) +TclpInetNtoa(struct in_addr addr) { return inet_ntoa(addr); } + #undef TclWinGetServByName struct servent * TclWinGetServByName( @@ -3286,7 +2567,6 @@ TclWinGetServByName( { return getservbyname(name, proto); } -#endif /* TCL_NO_DEPRECATED */ /* *---------------------------------------------------------------------- @@ -3306,11 +2586,11 @@ TclWinGetServByName( static void TcpThreadActionProc( - void *instanceData, + ClientData instanceData, int action) { ThreadSpecificData *tsdPtr; - TcpState *statePtr = (TcpState *)instanceData; + SocketInfo *infoPtr = (SocketInfo *) instanceData; int notifyCmd; if (action == TCL_CHANNEL_THREAD_INSERT) { @@ -3319,23 +2599,25 @@ TcpThreadActionProc( * sockets will not work. */ - TclInitSockets(); + 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; + infoPtr->nextPtr = tsdPtr->socketList; + tsdPtr->socketList = infoPtr; + + if (infoPtr == tsdPtr->pendingSocketInfo) { + tsdPtr->pendingSocketInfo = NULL; } - + SetEvent(tsdPtr->socketListLock); notifyCmd = SELECT; } else { - TcpState **nextPtrPtr; + SocketInfo **nextPtrPtr; int removed = 0; tsdPtr = TCL_TSD_INIT(&dataKey); @@ -3348,8 +2630,8 @@ TcpThreadActionProc( WaitForSingleObject(tsdPtr->socketListLock, INFINITE); for (nextPtrPtr = &(tsdPtr->socketList); (*nextPtrPtr) != NULL; nextPtrPtr = &((*nextPtrPtr)->nextPtr)) { - if ((*nextPtrPtr) == statePtr) { - (*nextPtrPtr) = statePtr->nextPtr; + if ((*nextPtrPtr) == infoPtr) { + (*nextPtrPtr) = infoPtr->nextPtr; removed = 1; break; } @@ -3374,7 +2656,8 @@ TcpThreadActionProc( * thread. */ - SendSelectMessage(tsdPtr, notifyCmd, statePtr); + SendMessage(tsdPtr->hwnd, SOCKET_SELECT, + (WPARAM) notifyCmd, (LPARAM) infoPtr); } /* @@ -3382,7 +2665,5 @@ TcpThreadActionProc( * mode: c * c-basic-offset: 4 * fill-column: 78 - * tab-width: 8 - * indent-tabs-mode: nil * End: */ diff --git a/win/tclWinTest.c b/win/tclWinTest.c index ec12f67..e493fbf 100644 --- a/win/tclWinTest.c +++ b/win/tclWinTest.c @@ -3,27 +3,20 @@ * * Contains commands for platform specific tests on Windows. * - * Copyright © 1996 Sun Microsystems, Inc. + * 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" -#ifdef TCL_WITH_EXTERNAL_TOMMATH -# include "tommath.h" -#else -# include "tclTomMath.h" -#endif /* * For TestplatformChmod on Windows */ +#ifdef __WIN32__ #include <aclapi.h> -#include <sddl.h> +#endif /* * MinGW 3.4.2 does not define this. @@ -36,14 +29,20 @@ * Forward declarations of functions defined later in this file: */ -static Tcl_ObjCmdProc TesteventloopCmd; -static Tcl_ObjCmdProc TestvolumetypeCmd; -static Tcl_ObjCmdProc TestwinclockCmd; -static Tcl_ObjCmdProc TestwinsleepCmd; -static Tcl_ObjCmdProc TestSizeCmd; +int TclplatformtestInit(Tcl_Interp *interp); +static int TesteventloopCmd(ClientData dummy, Tcl_Interp *interp, + int argc, const char **argv); +static int TestvolumetypeCmd(ClientData dummy, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +static int TestwinclockCmd(ClientData dummy, Tcl_Interp* interp, + int objc, Tcl_Obj *const objv[]); +static int TestwinsleepCmd(ClientData dummy, Tcl_Interp* interp, + int objc, Tcl_Obj *const objv[]); static Tcl_ObjCmdProc TestExceptionCmd; static int TestplatformChmod(const char *nativePath, int pmode); -static Tcl_ObjCmdProc TestchmodCmd; +static int TestchmodCmd(ClientData dummy, + Tcl_Interp *interp, int argc, const char **argv); /* *---------------------------------------------------------------------- @@ -70,14 +69,13 @@ TclplatformtestInit( * Add commands for platform specific tests for Windows here. */ - Tcl_CreateObjCommand(interp, "testchmod", TestchmodCmd, NULL, NULL); - Tcl_CreateObjCommand(interp, "testeventloop", TesteventloopCmd, NULL, NULL); + Tcl_CreateCommand(interp, "testchmod", TestchmodCmd, NULL, NULL); + Tcl_CreateCommand(interp, "testeventloop", TesteventloopCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testvolumetype", TestvolumetypeCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testwinclock", TestwinclockCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testwinsleep", TestwinsleepCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testexcept", TestExceptionCmd, NULL, NULL); - Tcl_CreateObjCommand(interp, "testsize", TestSizeCmd, NULL, NULL); return TCL_OK; } @@ -101,22 +99,23 @@ TclplatformtestInit( static int TesteventloopCmd( - TCL_UNUSED(void *), + ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ - Tcl_Obj *const objv[]) /* Argument objects. */ + int argc, /* Number of arguments. */ + const char **argv) /* Argument strings. */ { static int *framePtr = NULL;/* Pointer to integer on stack frame of * innermost invocation of the "wait" * subcommand. */ - if (objc < 2) { - Tcl_WrongNumArgs(interp, 1, objv, "option ..."); + if (argc < 2) { + Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0], + " option ... \"", NULL); return TCL_ERROR; } - if (strcmp(Tcl_GetString(objv[1]), "done") == 0) { + if (strcmp(argv[1], "done") == 0) { *framePtr = 1; - } else if (strcmp(Tcl_GetString(objv[1]), "wait") == 0) { + } else if (strcmp(argv[1], "wait") == 0) { int *oldFramePtr, done; int oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL); @@ -136,7 +135,7 @@ TesteventloopCmd( while (!done) { MSG msg; - if (!GetMessageW(&msg, NULL, 0, 0)) { + if (!GetMessage(&msg, NULL, 0, 0)) { /* * The application is exiting, so repost the quit message and * start unwinding. @@ -146,13 +145,13 @@ TesteventloopCmd( break; } TranslateMessage(&msg); - DispatchMessageW(&msg); + DispatchMessage(&msg); } (void) Tcl_SetServiceMode(oldMode); framePtr = oldFramePtr; } else { - Tcl_AppendResult(interp, "bad option \"", Tcl_GetString(objv[1]), - "\": must be done or wait", (char *)NULL); + Tcl_AppendResult(interp, "bad option \"", argv[1], + "\": must be done or wait", NULL); return TCL_ERROR; } return TCL_OK; @@ -177,7 +176,7 @@ TesteventloopCmd( static int TestvolumetypeCmd( - TCL_UNUSED(void *), + ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -185,7 +184,7 @@ TestvolumetypeCmd( #define VOL_BUF_SIZE 32 int found; char volType[VOL_BUF_SIZE]; - const char *path; + char *path; if (objc > 2) { Tcl_WrongNumArgs(interp, 1, objv, "?name?"); @@ -206,11 +205,11 @@ TestvolumetypeCmd( if (found == 0) { Tcl_AppendResult(interp, "could not get volume type for \"", - (path?path:""), "\"", (char *)NULL); - Tcl_WinConvertError(GetLastError()); + (path?path:""), "\"", NULL); + TclWinConvertError(GetLastError()); return TCL_ERROR; } - Tcl_AppendResult(interp, volType, (char *)NULL); + Tcl_SetResult(interp, volType, TCL_VOLATILE); return TCL_OK; #undef VOL_BUF_SIZE } @@ -243,7 +242,7 @@ TestvolumetypeCmd( static int TestwinclockCmd( - TCL_UNUSED(void *), + ClientData dummy, /* Unused */ Tcl_Interp* interp, /* Tcl interpreter */ int objc, /* Argument count */ Tcl_Obj *const objv[]) /* Argument vector */ @@ -276,11 +275,11 @@ TestwinclockCmd( result = Tcl_NewObj(); Tcl_ListObjAppendElement(interp, result, - Tcl_NewWideIntObj(t2.QuadPart / 10000000)); + Tcl_NewIntObj((int) (t2.QuadPart / 10000000))); Tcl_ListObjAppendElement(interp, result, - Tcl_NewWideIntObj((t2.QuadPart / 10) % 1000000)); - Tcl_ListObjAppendElement(interp, result, Tcl_NewWideIntObj(tclTime.sec)); - Tcl_ListObjAppendElement(interp, result, Tcl_NewWideIntObj(tclTime.usec)); + 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)); @@ -292,7 +291,7 @@ TestwinclockCmd( static int TestwinsleepCmd( - TCL_UNUSED(void *), + ClientData clientData, /* Unused */ Tcl_Interp* interp, /* Tcl interpreter */ int objc, /* Parameter count */ Tcl_Obj *const * objv) /* Parameter vector */ @@ -310,28 +309,6 @@ TestwinsleepCmd( return TCL_OK; } -static int -TestSizeCmd( - TCL_UNUSED(void *), - 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]), "st_mtime") == 0) { - Tcl_StatBuf *statPtr; - Tcl_SetObjResult(interp, Tcl_NewWideIntObj(sizeof(statPtr->st_mtime))); - return TCL_OK; - } - -syntax: - Tcl_WrongNumArgs(interp, 1, objv, "st_mtime"); - return TCL_ERROR; -} - /* *---------------------------------------------------------------------- * @@ -357,12 +334,12 @@ syntax: static int TestExceptionCmd( - TCL_UNUSED(void *), + ClientData dummy, /* Unused */ Tcl_Interp* interp, /* Tcl interpreter */ int objc, /* Argument count */ Tcl_Obj *const objv[]) /* Argument vector */ { - static const char *const cmds[] = { + static const char *cmds[] = { "access_violation", "datatype_misalignment", "array_bounds", "float_denormal", "float_divbyzero", "float_inexact", "float_invalidop", "float_overflow", "float_stack", "float_underflow", @@ -410,225 +387,311 @@ TestExceptionCmd( /* SMASH! */ RaiseException(exceptions[cmd], EXCEPTION_NONCONTINUABLE, 0, NULL); + /* NOTREACHED */ return TCL_OK; } -/* - * This "chmod" works sufficiently for test script purposes. Do not expect - * it to be exact emulation of Unix chmod (not sure if that's even possible) - */ static int TestplatformChmod( const char *nativePath, int pmode) { + typedef DWORD (WINAPI *getSidLengthRequiredDef)(UCHAR); + typedef BOOL (WINAPI *initializeSidDef)(PSID, PSID_IDENTIFIER_AUTHORITY, + BYTE); + typedef PDWORD (WINAPI *getSidSubAuthorityDef)(PSID, DWORD); + typedef DWORD (WINAPI *setNamedSecurityInfoADef)(IN LPSTR, + IN SE_OBJECT_TYPE, IN SECURITY_INFORMATION, IN PSID, IN PSID, + IN PACL, IN PACL); + typedef BOOL (WINAPI *getAceDef)(PACL, DWORD, LPVOID *); + typedef BOOL (WINAPI *addAceDef)(PACL, DWORD, DWORD, LPVOID, DWORD); + typedef BOOL (WINAPI *equalSidDef)(PSID, PSID); + typedef BOOL (WINAPI *addAccessDeniedAceDef)(PACL, DWORD, DWORD, PSID); + typedef BOOL (WINAPI *initializeAclDef)(PACL, DWORD, DWORD); + typedef DWORD (WINAPI *getLengthSidDef)(PSID); + typedef BOOL (WINAPI *getAclInformationDef)(PACL, LPVOID, DWORD, + ACL_INFORMATION_CLASS); + typedef BOOL (WINAPI *getSecurityDescriptorDaclDef)(PSECURITY_DESCRIPTOR, + LPBOOL, PACL *, LPBOOL); + typedef BOOL (WINAPI *lookupAccountNameADef)(LPCSTR, LPCSTR, PSID, + PDWORD, LPSTR, LPDWORD, PSID_NAME_USE); + typedef BOOL (WINAPI *getFileSecurityADef)(LPCSTR, SECURITY_INFORMATION, + PSECURITY_DESCRIPTOR, DWORD, LPDWORD); + + static const SECURITY_INFORMATION infoBits = OWNER_SECURITY_INFORMATION + | GROUP_SECURITY_INFORMATION | DACL_SECURITY_INFORMATION; + static const DWORD readOnlyMask = FILE_DELETE_CHILD | FILE_ADD_FILE + | FILE_ADD_SUBDIRECTORY | FILE_WRITE_EA | FILE_APPEND_DATA + | FILE_WRITE_DATA | DELETE; + /* - * Note FILE_DELETE_CHILD missing from dirWriteMask because we do - * not want overriding of child's delete setting when testing + * References to security functions (only available on NT and later). */ - static const DWORD dirWriteMask = - FILE_WRITE_ATTRIBUTES | FILE_WRITE_EA | - FILE_ADD_FILE | FILE_ADD_SUBDIRECTORY | STANDARD_RIGHTS_WRITE | DELETE | - SYNCHRONIZE; - static const DWORD dirReadMask = - FILE_READ_ATTRIBUTES | FILE_READ_EA | FILE_LIST_DIRECTORY | - STANDARD_RIGHTS_READ | SYNCHRONIZE; - /* Note - default user privileges allow ignoring TRAVERSE setting */ - static const DWORD dirExecuteMask = - FILE_TRAVERSE | STANDARD_RIGHTS_READ | SYNCHRONIZE; - - static const DWORD fileWriteMask = - FILE_WRITE_ATTRIBUTES | FILE_WRITE_EA | FILE_WRITE_DATA | - FILE_APPEND_DATA | STANDARD_RIGHTS_WRITE | DELETE | SYNCHRONIZE; - static const DWORD fileReadMask = - FILE_READ_ATTRIBUTES | FILE_READ_EA | FILE_READ_DATA | - STANDARD_RIGHTS_READ | SYNCHRONIZE; - static const DWORD fileExecuteMask = - FILE_EXECUTE | STANDARD_RIGHTS_READ | SYNCHRONIZE; - - DWORD attr, newAclSize; - PACL newAcl = NULL; + + static getSidLengthRequiredDef getSidLengthRequiredProc; + static initializeSidDef initializeSidProc; + static getSidSubAuthorityDef getSidSubAuthorityProc; + static setNamedSecurityInfoADef setNamedSecurityInfoProc; + static getAceDef getAceProc; + static addAceDef addAceProc; + static equalSidDef equalSidProc; + static addAccessDeniedAceDef addAccessDeniedAceProc; + static initializeAclDef initializeAclProc; + static getLengthSidDef getLengthSidProc; + static getAclInformationDef getAclInformationProc; + static getSecurityDescriptorDaclDef getSecurityDescriptorDaclProc; + static lookupAccountNameADef lookupAccountNameProc; + static getFileSecurityADef getFileSecurityProc; + static int initialized = 0; + + const BOOL set_readOnly = !(pmode & 0222); + BOOL acl_readOnly_found = FALSE, curAclPresent, curAclDefaulted; + SID_IDENTIFIER_AUTHORITY userSidAuthority = { + SECURITY_WORLD_SID_AUTHORITY + }; + BYTE *secDesc = 0; + DWORD secDescLen, attr, newAclSize; + ACL_SIZE_INFORMATION ACLSize; + PACL curAcl, newAcl = 0; + WORD j; + SID *userSid = 0; + TCHAR *userDomain = 0; int res = 0; - HANDLE hToken = NULL; - int i; - int nSids = 0; - struct { - PSID pSid; - DWORD mask; - DWORD sidLen; - } aceEntry[3]; - DWORD dw; - int isDir; - TOKEN_USER *pTokenUser = NULL; - - res = -1; /* Assume failure */ - - attr = GetFileAttributesA(nativePath); - if (attr == 0xFFFFFFFF) { - goto done; /* Not found */ + /* + * One time initialization, dynamically load Windows NT features + */ + + if (!initialized) { + TCL_DECLARE_MUTEX(initializeMutex) + Tcl_MutexLock(&initializeMutex); + if (!initialized) { + HINSTANCE hInstance = LoadLibrary("Advapi32"); + + if (hInstance != NULL) { + setNamedSecurityInfoProc = (setNamedSecurityInfoADef) + GetProcAddress(hInstance, "SetNamedSecurityInfoA"); + getFileSecurityProc = (getFileSecurityADef) + GetProcAddress(hInstance, "GetFileSecurityA"); + getAceProc = (getAceDef) + GetProcAddress(hInstance, "GetAce"); + addAceProc = (addAceDef) + GetProcAddress(hInstance, "AddAce"); + equalSidProc = (equalSidDef) + GetProcAddress(hInstance, "EqualSid"); + addAccessDeniedAceProc = (addAccessDeniedAceDef) + GetProcAddress(hInstance, "AddAccessDeniedAce"); + initializeAclProc = (initializeAclDef) + GetProcAddress(hInstance, "InitializeAcl"); + getLengthSidProc = (getLengthSidDef) + GetProcAddress(hInstance, "GetLengthSid"); + getAclInformationProc = (getAclInformationDef) + GetProcAddress(hInstance, "GetAclInformation"); + getSecurityDescriptorDaclProc = (getSecurityDescriptorDaclDef) + GetProcAddress(hInstance, "GetSecurityDescriptorDacl"); + lookupAccountNameProc = (lookupAccountNameADef) + GetProcAddress(hInstance, "LookupAccountNameA"); + getSidLengthRequiredProc = (getSidLengthRequiredDef) + GetProcAddress(hInstance, "GetSidLengthRequired"); + initializeSidProc = (initializeSidDef) + GetProcAddress(hInstance, "InitializeSid"); + getSidSubAuthorityProc = (getSidSubAuthorityDef) + GetProcAddress(hInstance, "GetSidSubAuthority"); + + if (setNamedSecurityInfoProc && getAceProc && addAceProc + && equalSidProc && addAccessDeniedAceProc + && initializeAclProc && getLengthSidProc + && getAclInformationProc + && getSecurityDescriptorDaclProc + && lookupAccountNameProc && getFileSecurityProc + && getSidLengthRequiredProc && initializeSidProc + && getSidSubAuthorityProc) { + initialized = 1; + } + } + if (!initialized) { + initialized = -1; + } + } + Tcl_MutexUnlock(&initializeMutex); } - isDir = (attr & FILE_ATTRIBUTE_DIRECTORY) != 0; + /* + * Process the chmod request. + */ - if (!OpenProcessToken(GetCurrentProcess(), TOKEN_QUERY, &hToken)) { - goto done; - } + attr = GetFileAttributes(nativePath); - /* Get process SID */ - if (!GetTokenInformation(hToken, TokenUser, NULL, 0, &dw) - && GetLastError() != ERROR_INSUFFICIENT_BUFFER) { - goto done; - } - pTokenUser = (TOKEN_USER *)ckalloc(dw); - if (!GetTokenInformation(hToken, TokenUser, pTokenUser, dw, &dw)) { + /* + * nativePath not found + */ + + if (attr == 0xffffffff) { + res = -1; goto done; } - aceEntry[nSids].sidLen = GetLengthSid(pTokenUser->User.Sid); - aceEntry[nSids].pSid = ckalloc(aceEntry[nSids].sidLen); - if (!CopySid(aceEntry[nSids].sidLen, aceEntry[nSids].pSid, - pTokenUser->User.Sid)) { - ckfree(aceEntry[nSids].pSid); /* Since we have not ++'ed nSids */ + + /* + * If no ACL API is present or nativePath is not a directory, there is no + * special handling. + */ + + if (initialized < 0 || !(attr & FILE_ATTRIBUTE_DIRECTORY)) { goto done; } + /* - * Always include DACL modify rights so we don't get locked out + * Set the result to error, if the ACL change is successful it will be + * reset to 0. */ - aceEntry[nSids].mask = READ_CONTROL | WRITE_DAC | WRITE_OWNER | SYNCHRONIZE | - FILE_READ_ATTRIBUTES | FILE_WRITE_ATTRIBUTES; - if (pmode & 0700) { - /* Owner permissions. Assumes current process is owner */ - if (pmode & 0400) { - aceEntry[nSids].mask |= isDir ? dirReadMask : fileReadMask; - } - if (pmode & 0200) { - aceEntry[nSids].mask |= isDir ? dirWriteMask : fileWriteMask; - } - if (pmode & 0100) { - aceEntry[nSids].mask |= isDir ? dirExecuteMask : fileExecuteMask; - } - } - ++nSids; - if (pmode & 0070) { - /* Group permissions. */ + res = -1; - TOKEN_PRIMARY_GROUP *pTokenGroup; + /* + * Read the security descriptor for the directory. Note the first call + * obtains the size of the security descriptor. + */ - /* Get primary group SID */ - if (!GetTokenInformation( - hToken, TokenPrimaryGroup, NULL, 0, &dw) && - GetLastError() != ERROR_INSUFFICIENT_BUFFER) { - goto done; - } - pTokenGroup = (TOKEN_PRIMARY_GROUP *)ckalloc(dw); - if (!GetTokenInformation(hToken, TokenPrimaryGroup, pTokenGroup, dw, &dw)) { - ckfree(pTokenGroup); + if (!getFileSecurityProc(nativePath, infoBits, NULL, 0, &secDescLen)) { + DWORD secDescLen2 = 0; + + if (GetLastError() != ERROR_INSUFFICIENT_BUFFER) { goto done; } - aceEntry[nSids].sidLen = GetLengthSid(pTokenGroup->PrimaryGroup); - aceEntry[nSids].pSid = ckalloc(aceEntry[nSids].sidLen); - if (!CopySid(aceEntry[nSids].sidLen, aceEntry[nSids].pSid, pTokenGroup->PrimaryGroup)) { - ckfree(pTokenGroup); - ckfree(aceEntry[nSids].pSid); /* Since we have not ++'ed nSids */ + + secDesc = (BYTE *) ckalloc(secDescLen); + if (!getFileSecurityProc(nativePath, infoBits, + (PSECURITY_DESCRIPTOR) secDesc, secDescLen, &secDescLen2) + || (secDescLen < secDescLen2)) { goto done; } - ckfree(pTokenGroup); + } - /* Generate mask for group ACL */ + /* + * Get the World SID. + */ - aceEntry[nSids].mask = 0; - if (pmode & 0040) { - aceEntry[nSids].mask |= isDir ? dirReadMask : fileReadMask; - } - if (pmode & 0020) { - aceEntry[nSids].mask |= isDir ? dirWriteMask : fileWriteMask; - } - if (pmode & 0010) { - aceEntry[nSids].mask |= isDir ? dirExecuteMask : fileExecuteMask; - } - ++nSids; + userSid = (SID *) ckalloc(getSidLengthRequiredProc((UCHAR) 1)); + initializeSidProc(userSid, &userSidAuthority, (BYTE) 1); + *(getSidSubAuthorityProc(userSid, 0)) = SECURITY_WORLD_RID; + + /* + * If curAclPresent == false then curAcl and curAclDefaulted not valid. + */ + + if (!getSecurityDescriptorDaclProc((PSECURITY_DESCRIPTOR) secDesc, + &curAclPresent, &curAcl, &curAclDefaulted)) { + goto done; + } + if (!curAclPresent || !curAcl) { + ACLSize.AclBytesInUse = 0; + ACLSize.AceCount = 0; + } else if (!getAclInformationProc(curAcl, &ACLSize, sizeof(ACLSize), + AclSizeInformation)) { + goto done; } - if (pmode & 0007) { - /* World permissions */ - PSID pWorldSid; - if (!ConvertStringSidToSidA("S-1-1-0", &pWorldSid)) { - goto done; - } - aceEntry[nSids].sidLen = GetLengthSid(pWorldSid); - aceEntry[nSids].pSid = ckalloc(aceEntry[nSids].sidLen); - if (!CopySid(aceEntry[nSids].sidLen, aceEntry[nSids].pSid, pWorldSid)) { - LocalFree(pWorldSid); - ckfree(aceEntry[nSids].pSid); /* Since we have not ++'ed nSids */ - goto done; - } - LocalFree(pWorldSid); + /* + * Allocate memory for the new ACL. + */ - /* Generate mask for world ACL */ + newAclSize = ACLSize.AclBytesInUse + sizeof(ACCESS_DENIED_ACE) + + getLengthSidProc(userSid) - sizeof(DWORD); + newAcl = (ACL *) ckalloc(newAclSize); - aceEntry[nSids].mask = 0; - if (pmode & 0004) { - aceEntry[nSids].mask |= isDir ? dirReadMask : fileReadMask; - } - if (pmode & 0002) { - aceEntry[nSids].mask |= isDir ? dirWriteMask : fileWriteMask; - } - if (pmode & 0001) { - aceEntry[nSids].mask |= isDir ? dirExecuteMask : fileExecuteMask; - } - ++nSids; + /* + * Initialize the new ACL. + */ + + if (!initializeAclProc(newAcl, newAclSize, ACL_REVISION)) { + goto done; } - /* Allocate memory and initialize the new ACL. */ + /* + * Add denied to make readonly, this will be known as a "read-only tag". + */ - newAclSize = sizeof(ACL); - /* Add in size required for each ACE entry in the ACL */ - for (i = 0; i < nSids; ++i) { - newAclSize += - offsetof(ACCESS_ALLOWED_ACE, SidStart) + aceEntry[i].sidLen; - } - newAcl = (PACL)ckalloc(newAclSize); - if (!InitializeAcl(newAcl, newAclSize, ACL_REVISION)) { + if (set_readOnly && !addAccessDeniedAceProc(newAcl, ACL_REVISION, + readOnlyMask, userSid)) { goto done; } - for (i = 0; i < nSids; ++i) { - if (!AddAccessAllowedAce(newAcl, ACL_REVISION, aceEntry[i].mask, aceEntry[i].pSid)) { + acl_readOnly_found = FALSE; + for (j = 0; j < ACLSize.AceCount; j++) { + LPVOID pACE2; + ACE_HEADER *phACE2; + + if (!getAceProc(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 + && equalSidProc(userSid, (PSID) &pACEd->SidStart)) { + acl_readOnly_found = TRUE; + continue; + } + } + + /* + * Copy the current ACE from the old to the new ACL. + */ + + if (!addAceProc(newAcl, ACL_REVISION, MAXDWORD, (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) + * Apply the new ACL. */ - if (SetNamedSecurityInfoA((LPSTR)nativePath, SE_FILE_OBJECT, - DACL_SECURITY_INFORMATION | PROTECTED_DACL_SECURITY_INFORMATION, + if (set_readOnly == acl_readOnly_found || setNamedSecurityInfoProc( + (LPSTR) nativePath, SE_FILE_OBJECT, DACL_SECURITY_INFORMATION, NULL, NULL, newAcl, NULL) == ERROR_SUCCESS) { res = 0; } done: - if (pTokenUser) { - ckfree(pTokenUser); - } - if (hToken) { - CloseHandle(hToken); + if (secDesc) { + ckfree((char *) secDesc); } if (newAcl) { - ckfree(newAcl); + ckfree((char *) newAcl); + } + if (userSid) { + ckfree((char *) userSid); } - for (i = 0; i < nSids; ++i) { - ckfree(aceEntry[i].pSid); + if (userDomain) { + ckfree(userDomain); } if (res != 0) { return res; } - /* Run normal chmod command */ + /* + * Run normal chmod command. + */ + return chmod(nativePath, pmode); } @@ -653,33 +716,37 @@ TestplatformChmod( static int TestchmodCmd( - TCL_UNUSED(void *), + ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Parameter count */ - Tcl_Obj *const * objv) /* Parameter vector */ + int argc, /* Number of arguments. */ + const char **argv) /* Argument strings. */ { int i, mode; + char *rest; - if (objc < 2) { - Tcl_WrongNumArgs(interp, 1, objv, "mode file ?file ...?"); + if (argc < 2) { + usage: + Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], + " mode file ?file ...?", NULL); return TCL_ERROR; } - if (Tcl_GetIntFromObj(interp, objv[1], &mode) != TCL_OK) { - return TCL_ERROR; + mode = (int) strtol(argv[1], &rest, 8); + if ((rest == argv[1]) || (*rest != '\0')) { + goto usage; } - for (i = 2; i < objc; i++) { + for (i = 2; i < argc; i++) { Tcl_DString buffer; const char *translated; - translated = Tcl_TranslateFileName(interp, Tcl_GetString(objv[i]), &buffer); + translated = Tcl_TranslateFileName(interp, argv[i], &buffer); if (translated == NULL) { return TCL_ERROR; } if (TestplatformChmod(translated, mode) != 0) { Tcl_AppendResult(interp, translated, ": ", Tcl_PosixError(interp), - (char *)NULL); + NULL); return TCL_ERROR; } Tcl_DStringFree(&buffer); diff --git a/win/tclWinThrd.c b/win/tclWinThrd.c index e8d4d4d..2413a78 100644 --- a/win/tclWinThrd.c +++ b/win/tclWinThrd.c @@ -3,9 +3,8 @@ * * This file implements the Windows-specific thread operations. * - * Copyright © 1998 Sun Microsystems, Inc. - * Copyright © 1999 Scriptics Corporation - * Copyright © 2008 George Peter Staplin + * Copyright (c) 1998 by Sun Microsystems, Inc. + * Copyright (c) 1999 by Scriptics Corporation * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -13,6 +12,8 @@ #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 */ @@ -22,15 +23,18 @@ _CRTIMP unsigned int __cdecl _controlfp (unsigned int unNew, unsigned int unMask #endif /* - * This is the global lock used to serialize access to other serialization + * This is the master lock used to serialize access to other serialization * data structures. */ -static CRITICAL_SECTION globalLock; -static int initialized = 0; +static CRITICAL_SECTION masterLock; +static int init = 0; +#define MASTER_LOCK TclpMasterLock() +#define MASTER_UNLOCK TclpMasterUnlock() + /* - * This is the global lock used to serialize initialization and finalization + * This is the master lock used to serialize initialization and finalization * of Tcl as a whole. */ @@ -38,10 +42,10 @@ static CRITICAL_SECTION initLock; /* * allocLock is used by Tcl's version of malloc for synchronization. For - * obvious reasons, cannot use any dynamically allocated storage. + * obvious reasons, cannot use any dyamically allocated storage. */ -#if TCL_THREADS +#ifdef TCL_THREADS static struct Tcl_Mutex_ { CRITICAL_SECTION crit; @@ -76,7 +80,7 @@ static CRITICAL_SECTION joinLock; * The per-thread event and queue pointers. */ -#if TCL_THREADS +#ifdef TCL_THREADS typedef struct ThreadSpecificData { HANDLE condEvent; /* Per-thread condition event */ @@ -105,7 +109,7 @@ static Tcl_ThreadDataKey dataKey; * the queue. */ -typedef struct { +typedef struct WinCondition { CRITICAL_SECTION condLock; /* Lock to serialize queuing on the * condition. */ struct ThreadSpecificData *firstPtr; /* Queue pointers */ @@ -117,9 +121,10 @@ typedef struct { */ #ifdef USE_THREAD_ALLOC +static int once; static DWORD tlsKey; -typedef struct { +typedef struct allocMutex { Tcl_Mutex tlock; CRITICAL_SECTION wlock; } allocMutex; @@ -130,7 +135,7 @@ typedef struct { * to TclWinThreadStart. */ -typedef struct { +typedef struct WinThread { LPTHREAD_START_ROUTINE lpStartAddress; /* Original startup routine */ LPVOID lpParameter; /* Original startup data */ unsigned int fpControl; /* Floating point control word from the @@ -162,6 +167,7 @@ TclWinThreadStart( * from TclpThreadCreate */ { WinThread *winThreadPtr = (WinThread *) lpParameter; + unsigned int fpmask; LPTHREAD_START_ROUTINE lpOrigStartAddress; LPVOID lpOrigParameter; @@ -169,16 +175,18 @@ TclWinThreadStart( return TCL_ERROR; } - _controlfp(winThreadPtr->fpControl, _MCW_EM | _MCW_RC | 0x03000000 /* _MCW_DN */ -#if !defined(_WIN64) - | _MCW_PC + fpmask = _MCW_EM | _MCW_RC | _MCW_PC; + +#if defined(_MSC_VER) && _MSC_VER >= 1200 + fpmask |= _MCW_DN; #endif - ); + + _controlfp(winThreadPtr->fpControl, fpmask); lpOrigStartAddress = winThreadPtr->lpStartAddress; lpOrigParameter = winThreadPtr->lpParameter; - ckfree(winThreadPtr); + ckfree((char *)winThreadPtr); return lpOrigStartAddress(lpOrigParameter); } @@ -202,13 +210,13 @@ TclWinThreadStart( int TclpThreadCreate( Tcl_ThreadId *idPtr, /* Return, the ID of the thread. */ - Tcl_ThreadCreateProc *proc, /* Main() function of the thread. */ - void *clientData, /* The one argument to Main(). */ - TCL_HASH_TYPE stackSize, /* Size of stack for the new 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 */ + WinThread *winThreadPtr; /* Per-thread startup info */ HANDLE tHandle; winThreadPtr = (WinThread *)ckalloc(sizeof(WinThread)); @@ -219,14 +227,15 @@ TclpThreadCreate( EnterCriticalSection(&joinLock); *idPtr = 0; /* must initialize as Tcl_Thread is a pointer and - * on WIN64 sizeof void* != sizeof unsigned */ + * on WIN64 sizeof void* != sizeof unsigned + */ -#if defined(_MSC_VER) || defined(__MSVCRT__) - tHandle = (HANDLE) _beginthreadex(NULL, (unsigned)stackSize, +#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, + tHandle = CreateThread(NULL, (DWORD) stackSize, TclWinThreadStart, winThreadPtr, 0, (LPDWORD)idPtr); #endif @@ -240,7 +249,7 @@ TclpThreadCreate( /* * The only purpose of this is to decrement the reference count so the - * OS resources will be reacquired when the thread closes. + * OS resources will be reaquired when the thread closes. */ CloseHandle(tHandle); @@ -299,7 +308,7 @@ TclpThreadExit( TclSignalExitThread(Tcl_GetCurrentThread(), status); LeaveCriticalSection(&joinLock); -#if defined(_MSC_VER) || defined(__MSVCRT__) +#if defined(_MSC_VER) || defined(__MSVCRT__) || defined(__BORLANDC__) _endthreadex((unsigned) status); #else ExitThread((DWORD) status); @@ -325,7 +334,7 @@ TclpThreadExit( Tcl_ThreadId Tcl_GetCurrentThread(void) { - return (Tcl_ThreadId)INT2PTR(GetCurrentThreadId()); + return (Tcl_ThreadId) INT2PTR(GetCurrentThreadId()); } /* @@ -350,7 +359,7 @@ Tcl_GetCurrentThread(void) void TclpInitLock(void) { - if (!initialized) { + if (!init) { /* * There is a fundamental race here that is solved by creating the * first Tcl interpreter in a single threaded environment. Once the @@ -358,10 +367,10 @@ TclpInitLock(void) * that create interpreters in parallel. */ - initialized = 1; + init = 1; InitializeCriticalSection(&joinLock); InitializeCriticalSection(&initLock); - InitializeCriticalSection(&globalLock); + InitializeCriticalSection(&masterLock); } EnterCriticalSection(&initLock); } @@ -392,27 +401,27 @@ TclpInitUnlock(void) /* *---------------------------------------------------------------------- * - * TclpGlobalLock + * 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. + * held during creation of syncronization objects. * * Results: * None. * * Side effects: - * Acquire the global mutex. + * Acquire the master mutex. * *---------------------------------------------------------------------- */ void -TclpGlobalLock(void) +TclpMasterLock(void) { - if (!initialized) { + if (!init) { /* * There is a fundamental race here that is solved by creating the * first Tcl interpreter in a single threaded environment. Once the @@ -420,18 +429,18 @@ TclpGlobalLock(void) * that create interpreters in parallel. */ - initialized = 1; + init = 1; InitializeCriticalSection(&joinLock); InitializeCriticalSection(&initLock); - InitializeCriticalSection(&globalLock); + InitializeCriticalSection(&masterLock); } - EnterCriticalSection(&globalLock); + EnterCriticalSection(&masterLock); } /* *---------------------------------------------------------------------- * - * TclpGlobalUnlock + * TclpMasterUnlock * * This procedure is used to release a lock that serializes creation and * deletion of synchronization objects. @@ -440,15 +449,15 @@ TclpGlobalLock(void) * None. * * Side effects: - * Release the global mutex. + * Release the master mutex. * *---------------------------------------------------------------------- */ void -TclpGlobalUnlock(void) +TclpMasterUnlock(void) { - LeaveCriticalSection(&globalLock); + LeaveCriticalSection(&masterLock); } /* @@ -457,7 +466,7 @@ TclpGlobalUnlock(void) * Tcl_GetAllocMutex * * This procedure returns a pointer to a statically initialized mutex for - * use by the memory allocator. The allocator must use this lock, because + * use by the memory allocator. The alloctor must use this lock, because * all other locks are allocated... * * Results: @@ -473,7 +482,7 @@ TclpGlobalUnlock(void) Tcl_Mutex * Tcl_GetAllocMutex(void) { -#if TCL_THREADS +#ifdef TCL_THREADS if (!allocOnce) { InitializeCriticalSection(&allocLock.crit); allocOnce = 1; @@ -487,7 +496,7 @@ Tcl_GetAllocMutex(void) /* *---------------------------------------------------------------------- * - * TclFinalizeLock + * TclpFinalizeLock * * This procedure is used to destroy all private resources used in this * file. @@ -505,17 +514,17 @@ Tcl_GetAllocMutex(void) void TclFinalizeLock(void) { - TclpGlobalLock(); + MASTER_LOCK; DeleteCriticalSection(&joinLock); /* * Destroy the critical section that we are holding! */ - DeleteCriticalSection(&globalLock); - initialized = 0; + DeleteCriticalSection(&masterLock); + init = 0; -#if TCL_THREADS +#ifdef TCL_THREADS if (allocOnce) { DeleteCriticalSection(&allocLock.crit); allocOnce = 0; @@ -531,10 +540,10 @@ TclFinalizeLock(void) DeleteCriticalSection(&initLock); } -#if TCL_THREADS +#ifdef TCL_THREADS /* locally used prototype */ -static void FinalizeConditionEvent(void *data); +static void FinalizeConditionEvent(ClientData data); /* *---------------------------------------------------------------------- @@ -548,7 +557,7 @@ static void FinalizeConditionEvent(void *data); * None. * * Side effects: - * May block the current thread. The mutex is acquired when this returns. + * May block the current thread. The mutex is aquired when this returns. * *---------------------------------------------------------------------- */ @@ -560,19 +569,19 @@ Tcl_MutexLock( CRITICAL_SECTION *csPtr; if (*mutexPtr == NULL) { - TclpGlobalLock(); + MASTER_LOCK; /* - * Double inside global lock check to avoid a race. + * Double inside master lock check to avoid a race. */ if (*mutexPtr == NULL) { - csPtr = (CRITICAL_SECTION *)ckalloc(sizeof(CRITICAL_SECTION)); + csPtr = (CRITICAL_SECTION *) ckalloc(sizeof(CRITICAL_SECTION)); InitializeCriticalSection(csPtr); *mutexPtr = (Tcl_Mutex)csPtr; TclRememberMutex(mutexPtr); } - TclpGlobalUnlock(); + MASTER_UNLOCK; } csPtr = *((CRITICAL_SECTION **)mutexPtr); EnterCriticalSection(csPtr); @@ -628,7 +637,7 @@ TclpFinalizeMutex( if (csPtr != NULL) { DeleteCriticalSection(csPtr); - ckfree(csPtr); + ckfree((char *) csPtr); *mutexPtr = NULL; } } @@ -648,7 +657,7 @@ TclpFinalizeMutex( * None. * * Side effects: - * May block the current thread. The mutex is acquired when this returns. + * May block the current thread. The mutex is aquired when this returns. * Will allocate memory for a HANDLE and initialize this the first time * this Tcl_Condition is used. * @@ -659,7 +668,7 @@ void Tcl_ConditionWait( Tcl_Condition *condPtr, /* Really (WinCondition **) */ Tcl_Mutex *mutexPtr, /* Really (CRITICAL_SECTION **) */ - const Tcl_Time *timePtr) /* Timeout on waiting period */ + Tcl_Time *timePtr) /* Timeout on waiting period */ { WinCondition *winCondPtr; /* Per-condition queue head */ CRITICAL_SECTION *csPtr; /* Caller's Mutex, after casting */ @@ -674,57 +683,58 @@ Tcl_ConditionWait( */ if (tsdPtr->flags == WIN_THREAD_UNINIT) { - TclpGlobalLock(); + MASTER_LOCK; /* * Create the per-thread event and queue pointers. */ if (tsdPtr->flags == WIN_THREAD_UNINIT) { - tsdPtr->condEvent = CreateEventW(NULL, TRUE /* manual reset */, + tsdPtr->condEvent = CreateEvent(NULL, TRUE /* manual reset */, FALSE /* non signaled */, NULL); tsdPtr->nextPtr = NULL; tsdPtr->prevPtr = NULL; tsdPtr->flags = WIN_THREAD_RUNNING; doExit = 1; } - TclpGlobalUnlock(); + MASTER_UNLOCK; if (doExit) { /* * Create a per-thread exit handler to clean up the condEvent. We - * must be careful to do this outside the Global Lock because + * 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 Global Lock. + * and initializing that may drop back into the Master Lock. */ - Tcl_CreateThreadExitHandler(FinalizeConditionEvent, tsdPtr); + Tcl_CreateThreadExitHandler(FinalizeConditionEvent, + (ClientData) tsdPtr); } } if (*condPtr == NULL) { - TclpGlobalLock(); + MASTER_LOCK; /* * Initialize the per-condition queue pointers and Mutex. */ if (*condPtr == NULL) { - winCondPtr = (WinCondition *)ckalloc(sizeof(WinCondition)); + winCondPtr = (WinCondition *) ckalloc(sizeof(WinCondition)); InitializeCriticalSection(&winCondPtr->condLock); winCondPtr->firstPtr = NULL; winCondPtr->lastPtr = NULL; *condPtr = (Tcl_Condition) winCondPtr; TclRememberCondition(condPtr); } - TclpGlobalUnlock(); + MASTER_UNLOCK; } csPtr = *((CRITICAL_SECTION **)mutexPtr); winCondPtr = *((WinCondition **)condPtr); if (timePtr == NULL) { wtime = INFINITE; } else { - wtime = (DWORD)timePtr->sec * 1000 + (DWORD)timePtr->usec / 1000; + wtime = timePtr->sec * 1000 + timePtr->usec / 1000; } /* @@ -759,8 +769,7 @@ Tcl_ConditionWait( while (!timeout && (tsdPtr->flags & WIN_THREAD_BLOCKED)) { ResetEvent(tsdPtr->condEvent); LeaveCriticalSection(&winCondPtr->condLock); - if (WaitForSingleObjectEx(tsdPtr->condEvent, wtime, - TRUE) == WAIT_TIMEOUT) { + if (WaitForSingleObject(tsdPtr->condEvent, wtime) == WAIT_TIMEOUT) { timeout = 1; } EnterCriticalSection(&winCondPtr->condLock); @@ -776,9 +785,9 @@ Tcl_ConditionWait( timeout = 0; } else { /* - * When dequeueing, we can leave the tsdPtr->nextPtr and + * When dequeuing, we can leave the tsdPtr->nextPtr and * tsdPtr->prevPtr with dangling pointers because they are - * reinitialized w/out reading them when the thread is enqueued + * reinitialilzed w/out reading them when the thread is enqueued * later. */ @@ -879,7 +888,7 @@ Tcl_ConditionNotify( static void FinalizeConditionEvent( - void *data) + ClientData data) { ThreadSpecificData *tsdPtr = (ThreadSpecificData *) data; @@ -895,7 +904,7 @@ FinalizeConditionEvent( * This procedure is invoked to clean up a condition variable. This is * only safe to call at the end of time. * - * This assumes the Global Lock is held. + * This assumes the Master Lock is held. * * Results: * None. @@ -921,7 +930,7 @@ TclpFinalizeCondition( if (winCondPtr != NULL) { DeleteCriticalSection(&winCondPtr->condLock); - ckfree(winCondPtr); + ckfree((char *) winCondPtr); *condPtr = NULL; } } @@ -937,9 +946,9 @@ TclpFinalizeCondition( Tcl_Mutex * TclpNewAllocMutex(void) { - allocMutex *lockPtr; + struct allocMutex *lockPtr; - lockPtr = (allocMutex *)malloc(sizeof(allocMutex)); + lockPtr = malloc(sizeof(struct allocMutex)); if (lockPtr == NULL) { Tcl_Panic("could not allocate lock"); } @@ -961,24 +970,24 @@ TclpFreeAllocMutex( free(lockPtr); } -void -TclpInitAllocCache(void) +void * +TclpGetAllocCache(void) { - /* - * We need to make sure that TclpFreeAllocCache is called on each - * thread that calls this, but only on threads that call this. - */ + 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(); - if (tlsKey == TLS_OUT_OF_INDEXES) { - Tcl_Panic("could not allocate thread local storage"); + tlsKey = TlsAlloc(); + once = 1; + if (tlsKey == TLS_OUT_OF_INDEXES) { + Tcl_Panic("could not allocate thread local storage"); + } } -} -void * -TclpGetAllocCache(void) -{ - void *result; result = TlsGetValue(tlsKey); if ((result == NULL) && (GetLastError() != NO_ERROR)) { Tcl_Panic("TlsGetValue failed from TclpGetAllocCache"); @@ -1005,10 +1014,8 @@ TclpFreeAllocCache( 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. + * Called by us in TclpFinalizeThreadData when a thread exits and + * destroys the tsd key which stores allocator caches. */ TclFreeAllocCache(ptr); @@ -1016,7 +1023,7 @@ TclpFreeAllocCache( if (!success) { Tcl_Panic("TlsSetValue failed from TclpFreeAllocCache"); } - } else { + } else if (once) { /* * Called by us in TclFinalizeThreadAlloc() during the library * finalization initiated from Tcl_Finalize() @@ -1026,64 +1033,11 @@ TclpFreeAllocCache( if (!success) { Tcl_Panic("TlsFree failed from TclpFreeAllocCache"); } - } -} -#endif /* USE_THREAD_ALLOC */ - - -void * -TclpThreadCreateKey(void) -{ - DWORD *key; - - key = (DWORD *)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"); + once = 0; /* reset for next time. */ } - return key; } - -void -TclpThreadDeleteKey( - void *keyPtr) -{ - DWORD *key = (DWORD *)keyPtr; - - if (!TlsFree(*key)) { - Tcl_Panic("unable to delete key"); - } - - TclpSysFree(keyPtr); -} - -void -TclpThreadSetGlobalTSD( - void *tsdKeyPtr, - void *ptr) -{ - DWORD *key = (DWORD *)tsdKeyPtr; - - if (!TlsSetValue(*key, ptr)) { - Tcl_Panic("unable to set global TSD value"); - } -} - -void * -TclpThreadGetGlobalTSD( - void *tsdKeyPtr) -{ - DWORD *key = (DWORD *)tsdKeyPtr; - - return TlsGetValue(*key); -} - +#endif /* USE_THREAD_ALLOC */ #endif /* TCL_THREADS */ /* diff --git a/win/tclWinThrd.h b/win/tclWinThrd.h new file mode 100644 index 0000000..41bc7aa --- /dev/null +++ b/win/tclWinThrd.h @@ -0,0 +1,19 @@ +/* + * tclWinThrd.h -- + * + * This header file defines things for thread support. + * + * Copyright (c) 1998 Sun Microsystems, Inc. + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + +#ifndef _TCLWINTHRD +#define _TCLWINTHRD + +#ifdef TCL_THREADS + +#endif /* TCL_THREADS */ + +#endif /* _TCLWINTHRD */ diff --git a/win/tclWinTime.c b/win/tclWinTime.c index 438a8ec..0163723 100644 --- a/win/tclWinTime.c +++ b/win/tclWinTime.c @@ -4,7 +4,7 @@ * Contains Windows specific versions of Tcl functions that obtain time * values from the operating system. * - * Copyright © 1995-1998 Sun Microsystems, Inc. + * 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. @@ -27,7 +27,6 @@ * month, where index 1 is January. */ -#ifndef TCL_NO_DEPRECATED static const int normalDays[] = { -1, 30, 58, 89, 119, 150, 180, 211, 242, 272, 303, 333, 364 }; @@ -36,25 +35,22 @@ static const int leapDays[] = { -1, 30, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334, 365 }; -typedef struct { +typedef struct ThreadSpecificData { char tzName[64]; /* Time zone name */ struct tm tm; /* time information */ } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; -#endif /* TCL_NO_DEPRECATED */ /* * Data for managing high-resolution timers. */ -typedef struct { +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 @@ -65,6 +61,7 @@ typedef struct { 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: @@ -77,40 +74,35 @@ typedef struct { 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 */ - unsigned long long fileTimeSample[SAMPLES]; + Tcl_WideUInt fileTimeSample[SAMPLES]; /* Last 64 samples of system time. */ - long long perfCounterSample[SAMPLES]; + 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 }, + { NULL }, 0, 0, - 1, (HANDLE) NULL, (HANDLE) NULL, (HANDLE) NULL, -#if defined(HAVE_CAST_TO_UNION) && !defined(__cplusplus) - (LARGE_INTEGER) (long long) 0, +#ifdef HAVE_CAST_TO_UNION + (LARGE_INTEGER) (Tcl_WideInt) 0, (ULARGE_INTEGER) (DWORDLONG) 0, - (LARGE_INTEGER) (long long) 0, - (LARGE_INTEGER) (long long) 0, - (LARGE_INTEGER) (long long) 0, + (LARGE_INTEGER) (Tcl_WideInt) 0, + (LARGE_INTEGER) (Tcl_WideInt) 0, #else - {0, 0}, - {0, 0}, - {0, 0}, - {0, 0}, - {0, 0}, + 0, + 0, + 0, + 0, #endif { 0 }, { 0 }, @@ -118,36 +110,21 @@ static TimeInfo timeInfo = { }; /* - * 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. */ -#ifndef TCL_NO_DEPRECATED static struct tm * ComputeGMT(const time_t *tp); -#endif /* TCL_NO_DEPRECATED */ -static void StopCalibration(void *clientData); +static void StopCalibration(ClientData clientData); static DWORD WINAPI CalibrationThread(LPVOID arg); static void UpdateTimeEachSecond(void); -static void ResetCounterSamples(unsigned long long fileTime, - long long perfCounter, long long perfFreq); -static long long AccumulateSample(long long perfCounter, - unsigned long long fileTime); +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, - void *clientData); -static long long NativeGetMicroseconds(void); + ClientData clientData); static void NativeGetTime(Tcl_Time* timebuf, - void *clientData); + ClientData clientData); /* * TIP #233 (Virtualized Time): Data for the time hooks, if any. @@ -155,24 +132,7 @@ static void NativeGetTime(Tcl_Time* timebuf, Tcl_GetTimeProc *tclGetTimeProcPtr = NativeGetTime; Tcl_ScaleTimeProc *tclScaleTimeProcPtr = NativeScaleTime; -void *tclTimeClientData = NULL; - -/* - * Inlined version of Tcl_GetTime. - */ - -static inline void -GetTime( - Tcl_Time *timePtr) -{ - tclGetTimeProcPtr(timePtr, tclTimeClientData); -} - -static inline int -IsTimeNative(void) -{ - return tclGetTimeProcPtr == NativeGetTime; -} +ClientData tclTimeClientData = NULL; /* *---------------------------------------------------------------------- @@ -194,20 +154,10 @@ IsTimeNative(void) unsigned long TclpGetSeconds(void) { - long long usecSincePosixEpoch; + Tcl_Time t; - /* - * Try to use high resolution timer - */ - - if (IsTimeNative() && (usecSincePosixEpoch = NativeGetMicroseconds())) { - return usecSincePosixEpoch / 1000000; - } else { - Tcl_Time t; - - GetTime(&t); - return t.sec; - } + (*tclGetTimeProcPtr) (&t, tclTimeClientData); /* Tcl_GetTime inlined. */ + return t.sec; } /* @@ -218,7 +168,7 @@ TclpGetSeconds(void) * 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. + * start time is also system dependant. * * Results: * Number of clicks from some start time. @@ -232,121 +182,31 @@ TclpGetSeconds(void) unsigned long TclpGetClicks(void) { - long long usecSincePosixEpoch; - /* - * Try to use high resolution timer. + * Use the Tcl_GetTime abstraction to get the time in microseconds, as + * nearly as we can, and return it. */ - if (IsTimeNative() && (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 */ + unsigned long retval; /* Value to return */ - Tcl_Time now; /* Current Tcl time */ + (*tclGetTimeProcPtr) (&now, tclTimeClientData); /* Tcl_GetTime inlined */ - GetTime(&now); - return ((unsigned long)(now.sec)*1000000UL) + (unsigned long)(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). - * - *---------------------------------------------------------------------- - */ - -long long -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 (long long)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. - * - *---------------------------------------------------------------------- - */ + retval = (now.sec * 1000000) + now.usec; + return retval; -double -TclpWideClickInMicrosec(void) -{ - if (!wideClick.initialized) { - (void) TclpGetWideClicks(); /* initialize */ - } - return wideClick.microsecsScale; } /* *---------------------------------------------------------------------- * - * TclpGetMicroseconds -- + * TclpGetTimeZone -- * - * This procedure returns a WideInt value that represents the highest - * resolution clock in microseconds available on the system. + * Determines the current timezone. The method varies wildly between + * different Platform implementations, so its hidden in this function. * * Results: - * Number of microseconds (from the epoch). + * Minutes west of GMT. * * Side effects: * None. @@ -354,28 +214,16 @@ TclpWideClickInMicrosec(void) *---------------------------------------------------------------------- */ -long long -TclpGetMicroseconds(void) +int +TclpGetTimeZone( + unsigned long currentTime) { - long long usecSincePosixEpoch; + int timeZone; - /* - * Try to use high resolution timer. - */ + tzset(); + timeZone = timezone / 60; - if (IsTimeNative() && (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; - - GetTime(&now); - return (((long long) now.sec) * 1000000) + now.usec; - } + return timeZone; } /* @@ -404,18 +252,7 @@ void Tcl_GetTime( Tcl_Time *timePtr) /* Location to store time information. */ { - long long usecSincePosixEpoch; - - /* - * Try to use high resolution timer. - */ - - if (IsTimeNative() && (usecSincePosixEpoch = NativeGetMicroseconds())) { - timePtr->sec = (long) (usecSincePosixEpoch / 1000000); - timePtr->usec = (unsigned long) (usecSincePosixEpoch % 1000000); - } else { - GetTime(timePtr); - } + (*tclGetTimeProcPtr) (timePtr, tclTimeClientData); } /* @@ -437,8 +274,8 @@ Tcl_GetTime( static void NativeScaleTime( - TCL_UNUSED(Tcl_Time *), - TCL_UNUSED(void *)) + Tcl_Time *timePtr, + ClientData clientData) { /* * Native scale is 1:1. Nothing is done. @@ -448,104 +285,13 @@ NativeScaleTime( /* *---------------------------------------------------------------------- * - * IsPerfCounterAvailable -- - * - * Tests whether the performance counter is available, which is a gnarly - * problem on 32-bit systems. Also retrieves the nominal frequency of the - * performance counter. - * - * Results: - * 1 if the counter is available, 0 if not. - * - * Side effects: - * Updates fields of the timeInfo global. Make sure you hold the lock - * before calling this. - * - *---------------------------------------------------------------------- - */ - -static inline int -IsPerfCounterAvailable(void) -{ - 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 != (long long) 1193182 && - * timeInfo.nominalFreq.QuadPart != (long long) 3579545 && - */ - timeInfo.nominalFreq.QuadPart > (long long) 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; - 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 */ - == (int)systemInfo.dwNumberOfProcessors)) { - timeInfo.perfCounterAvailable = TRUE; - } else { - timeInfo.perfCounterAvailable = FALSE; - } - } -#endif /* above code is Win32 only */ - - return timeInfo.perfCounterAvailable; -} - -/* - *---------------------------------------------------------------------- - * - * NativeGetMicroseconds -- + * NativeGetTime -- * - * Gets the current system time in microseconds since the beginning - * of the epoch: 00:00 UCT, January 1, 1970. + * 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 wide integer with number of microseconds from the epoch, or - * 0 if high resolution timer is not available. + * Returns the current time in timePtr. * * Side effects: * On the first call, initializes a set of static variables to keep track @@ -558,20 +304,15 @@ IsPerfCounterAvailable(void) *---------------------------------------------------------------------- */ -static inline long long -NativeCalc100NsTicks( - ULONGLONG fileTimeLastCall, - LONGLONG perfCounterLastCall, - LONGLONG curCounterFreq, - LONGLONG curCounter) +static void +NativeGetTime( + Tcl_Time *timePtr, + ClientData clientData) { - return fileTimeLastCall + - ((curCounter - perfCounterLastCall) * 10000000 / curCounterFreq); -} + struct _timeb t; + int useFtime = 1; /* Flag == TRUE if we need to fall back on + * ftime rather than using the perf counter. */ -static long long -NativeGetMicroseconds(void) -{ /* * Initialize static storage on the first trip through. * @@ -582,20 +323,84 @@ NativeGetMicroseconds(void) 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 (IsPerfCounterAvailable()) { + if (timeInfo.perfCounterAvailable) { DWORD id; InitializeCriticalSection(&timeInfo.cs); - timeInfo.readyEvent = CreateEventW(NULL, FALSE, FALSE, NULL); - timeInfo.exitEvent = CreateEventW(NULL, FALSE, FALSE, NULL); + timeInfo.readyEvent = CreateEvent(NULL, FALSE, FALSE, NULL); + timeInfo.exitEvent = CreateEvent(NULL, FALSE, FALSE, NULL); timeInfo.calibrationThread = CreateThread(NULL, 256, CalibrationThread, (LPVOID) NULL, 0, &id); SetThreadPriority(timeInfo.calibrationThread, @@ -609,7 +414,7 @@ NativeGetMicroseconds(void) WaitForSingleObject(timeInfo.readyEvent, INFINITE); CloseHandle(timeInfo.readyEvent); - Tcl_CreateExitHandler(StopCalibration, NULL); + Tcl_CreateExitHandler(StopCalibration, (ClientData) NULL); } timeInfo.initialized = TRUE; } @@ -622,39 +427,22 @@ NativeGetMicroseconds(void) * time. */ - ULONGLONG fileTimeLastCall; - LONGLONG perfCounterLastCall, curCounterFreq; - /* Copy with current data of calibration - * cycle. */ - LARGE_INTEGER curCounter; /* Current performance counter. */ + Tcl_WideInt curFileTime;/* Current estimated time, expressed as 100-ns + * ticks since the Windows epoch. */ + static LARGE_INTEGER posixEpoch; + /* Posix epoch expressed as 100-ns ticks since + * the windows epoch. */ + Tcl_WideInt usecSincePosixEpoch; + /* Current microseconds since Posix epoch. */ - QueryPerformanceCounter(&curCounter); - - /* - * Hold time section locked as short as possible - */ + posixEpoch.LowPart = 0xD53E8000; + posixEpoch.HighPart = 0x019DB1DE; 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; - } + QueryPerformanceCounter(&curCounter); /* * If it appears to be more than 1.1 seconds since the last trip @@ -666,65 +454,29 @@ NativeGetMicroseconds(void) * 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; + if (curCounter.QuadPart - timeInfo.perfCounterLastCall.QuadPart < + 11 * timeInfo.curCounterFreq.QuadPart / 10) { + curFileTime = timeInfo.fileTimeLastCall.QuadPart + + ((curCounter.QuadPart - timeInfo.perfCounterLastCall.QuadPart) + * 10000000 / timeInfo.curCounterFreq.QuadPart); + timeInfo.fileTimeLastCall.QuadPart = curFileTime; + timeInfo.perfCounterLastCall.QuadPart = curCounter.QuadPart; + usecSincePosixEpoch = (curFileTime - posixEpoch.QuadPart) / 10; + timePtr->sec = (long) (usecSincePosixEpoch / 1000000); + timePtr->usec = (unsigned long) (usecSincePosixEpoch % 1000000); + useFtime = 0; } - } - /* - * 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, - TCL_UNUSED(void *)) -{ - long long usecSincePosixEpoch; - - /* - * Try to use high resolution timer. - */ + LeaveCriticalSection(&timeInfo.cs); + } - usecSincePosixEpoch = NativeGetMicroseconds(); - if (usecSincePosixEpoch) { - timePtr->sec = (long) (usecSincePosixEpoch / 1000000); - timePtr->usec = (unsigned long) (usecSincePosixEpoch % 1000000); - } else { + if (useFtime) { /* * High resolution timer is not available. Just use ftime. */ - struct _timeb t; - _ftime(&t); - timePtr->sec = (long) t.time; + timePtr->sec = (long)t.time; timePtr->usec = t.millitm * 1000; } } @@ -747,11 +499,9 @@ NativeGetTime( *---------------------------------------------------------------------- */ -void TclWinResetTimerResolution(void); - static void StopCalibration( - TCL_UNUSED(void *)) + ClientData unused) /* Client data is unused */ { SetEvent(timeInfo.exitEvent); @@ -768,6 +518,93 @@ StopCalibration( /* *---------------------------------------------------------------------- * + * TclpGetTZName -- + * + * Gets the current timezone string. + * + * Results: + * Returns a pointer to a static string, or NULL on failure. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +char * +TclpGetTZName( + int dst) +{ + int len; + char *zone, *p; + TIME_ZONE_INFORMATION tz; + Tcl_Encoding encoding; + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + char *name = tsdPtr->tzName; + + /* + * tzset() under Borland doesn't seem to set up tzname[] at all. + * tzset() under MSVC has the following weird observed behavior: + * First time we call "clock format [clock seconds] -format %Z -gmt 1" + * we get "GMT", but on all subsequent calls we get the current time + * ezone string, even though env(TZ) is GMT and the variable _timezone + * is 0. + */ + + name[0] = '\0'; + + zone = getenv("TZ"); + if (zone != NULL) { + /* + * TZ is of form "NST-4:30NDT", where "NST" would be the name of the + * standard time zone for this area, "-4:30" is the offset from GMT in + * hours, and "NDT is the name of the daylight savings time zone in + * this area. The offset and DST strings are optional. + */ + + len = strlen(zone); + if (len > 3) { + len = 3; + } + if (dst != 0) { + /* + * Skip the offset string and get the DST string. + */ + + p = zone + len; + p += strspn(p, "+-:0123456789"); + if (*p != '\0') { + zone = p; + len = strlen(zone); + if (len > 3) { + len = 3; + } + } + } + Tcl_ExternalToUtf(NULL, NULL, zone, len, 0, NULL, name, + sizeof(tsdPtr->tzName), NULL, NULL, NULL); + } + if (name[0] == '\0') { + if (GetTimeZoneInformation(&tz) == TIME_ZONE_ID_UNKNOWN) { + /* + * MSDN: On NT this is returned if DST is not used in the current + * TZ + */ + + dst = 0; + } + encoding = Tcl_GetEncoding(NULL, "unicode"); + Tcl_ExternalToUtf(NULL, encoding, + (char *) ((dst) ? tz.DaylightName : tz.StandardName), -1, + 0, NULL, name, sizeof(tsdPtr->tzName), NULL, NULL, NULL); + Tcl_FreeEncoding(encoding); + } + return name; +} + +/* + *---------------------------------------------------------------------- + * * TclpGetDate -- * * This function converts between seconds and struct tm. If useGMT is @@ -783,26 +620,15 @@ StopCalibration( *---------------------------------------------------------------------- */ -#ifndef TCL_NO_DEPRECATED struct tm * TclpGetDate( - const time_t *t, + CONST time_t *t, int useGMT) { struct tm *tmPtr; time_t time; -#if defined(_WIN64) || defined(_USE_64BIT_TIME_T) -# 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) -# undef timezone /* prevent conflict with timezone() function */ - long timezone = 0; -#endif - tzset(); /* @@ -811,15 +637,28 @@ TclpGetDate( * daylight savings time before the epoch. */ - if (t2 >= 0) { - return TclpLocaltime(&t2); - } + /* + * 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 + */ -#if defined(_MSC_VER) - _get_timezone(&timezone); +#ifdef __BORLANDC__ +#define LOCALTIME_VALIDITY_BOUNDARY SECSPERDAY +#else +#define LOCALTIME_VALIDITY_BOUNDARY 0 #endif - time = t2 - timezone; + if (*t >= LOCALTIME_VALIDITY_BOUNDARY) { + return TclpLocaltime(t); + } + + time = *t - timezone; /* * If we aren't near to overflowing the long, just add the bias and @@ -827,10 +666,10 @@ TclpGetDate( * result at the end. */ - if (t2 < (LONG_MAX - 2*SECSPERDAY) && t2 > (LONG_MIN + 2*SECSPERDAY)) { + if (*t < (LONG_MAX - 2*SECSPERDAY) && *t > (LONG_MIN + 2*SECSPERDAY)) { tmPtr = ComputeGMT(&time); } else { - tmPtr = ComputeGMT(&t2); + tmPtr = ComputeGMT(t); tzset(); @@ -846,14 +685,14 @@ TclpGetDate( time -= 60; } - time = tmPtr->tm_min + 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; + time = tmPtr->tm_hour + time/60; tmPtr->tm_hour = (int)(time % 24); if (tmPtr->tm_hour < 0) { tmPtr->tm_hour += 24; @@ -861,12 +700,12 @@ TclpGetDate( } time /= 24; - tmPtr->tm_mday += (int) time; - tmPtr->tm_yday += (int) time; - tmPtr->tm_wday = (tmPtr->tm_wday + (int) time) % 7; + tmPtr->tm_mday += (int)time; + tmPtr->tm_yday += (int)time; + tmPtr->tm_wday = (tmPtr->tm_wday + (int)time) % 7; } } else { - tmPtr = ComputeGMT(&t2); + tmPtr = ComputeGMT(t); } return tmPtr; } @@ -904,8 +743,8 @@ ComputeGMT( * Compute the 4 year span containing the specified time. */ - tmp = (long) (*tp / SECSPER4YEAR); - rem = (long) (*tp % SECSPER4YEAR); + tmp = (long)(*tp / SECSPER4YEAR); + rem = (long)(*tp % SECSPER4YEAR); /* * Correct for weird mod semantics so the remainder is always positive. @@ -972,7 +811,7 @@ ComputeGMT( * Compute day of week. Epoch started on a Thursday. */ - tmPtr->tm_wday = (long) (*tp / SECSPERDAY) + 4; + tmPtr->tm_wday = (long)(*tp / SECSPERDAY) + 4; if ((*tp % SECSPERDAY) < 0) { tmPtr->tm_wday--; } @@ -983,7 +822,6 @@ ComputeGMT( return tmPtr; } -#endif /* TCL_NO_DEPRECATED */ /* *---------------------------------------------------------------------- @@ -1013,7 +851,7 @@ ComputeGMT( static DWORD WINAPI CalibrationThread( - TCL_UNUSED(LPVOID)) + LPVOID arg) { FILETIME curFileTime; DWORD waitResult; @@ -1028,12 +866,6 @@ CalibrationThread( 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); @@ -1061,6 +893,7 @@ CalibrationThread( UpdateTimeEachSecond(); } + /* lint */ return (DWORD) 0; } @@ -1091,45 +924,29 @@ UpdateTimeEachSecond(void) /* 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. */ - long long estFreq; /* Estimated perf counter frequency. */ - long long vt0; /* Tcl time right now. */ - long long vt1; /* Tcl time one second from now. */ - long long tdiff; /* Difference between system clock and Tcl + 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. */ - long long driftFreq; /* Frequency needed to drift virtual time into + Tcl_WideInt driftFreq; /* Frequency needed to drift virtual time into * step over 1 second. */ /* - * Sample performance counter and system time (from Posix epoch). + * Sample performance counter and system time. */ + QueryPerformanceCounter(&curPerfCounter); 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)) { - /* - * Look again in next one second. - */ - - return; - } - QueryPerformanceCounter(&curPerfCounter); - lastFileTime.QuadPart = curFileTime.QuadPart; + EnterCriticalSection(&timeInfo.cs); /* - * We divide by timeInfo.curCounterFreq.QuadPart in several places. That + * 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 @@ -1138,6 +955,7 @@ UpdateTimeEachSecond(void) */ if (timeInfo.curCounterFreq.QuadPart == 0){ + LeaveCriticalSection(&timeInfo.cs); timeInfo.perfCounterAvailable = 0; return; } @@ -1157,7 +975,7 @@ UpdateTimeEachSecond(void) */ estFreq = AccumulateSample(curPerfCounter.QuadPart, - (unsigned long long) curFileTime.QuadPart); + (Tcl_WideUInt) curFileTime.QuadPart); /* * We want to adjust things so that time appears to be continuous. @@ -1176,9 +994,11 @@ UpdateTimeEachSecond(void) * is estFreq * 20000000 / (vt1 - vt0) */ - vt0 = NativeCalc100NsTicks(timeInfo.fileTimeLastCall.QuadPart, - timeInfo.perfCounterLastCall.QuadPart, - timeInfo.curCounterFreq.QuadPart, curPerfCounter.QuadPart); + vt0 = 10000000 * (curPerfCounter.QuadPart + - timeInfo.perfCounterLastCall.QuadPart) + / timeInfo.curCounterFreq.QuadPart + + timeInfo.fileTimeLastCall.QuadPart; + vt1 = 20000000 + curFileTime.QuadPart; /* * If we've gotten more than a second away from system time, then drifting @@ -1188,111 +1008,21 @@ UpdateTimeEachSecond(void) tdiff = vt0 - curFileTime.QuadPart; if (tdiff > 10000000 || tdiff < -10000000) { - /* - * Jump to current system time, use curent estimated frequency. - */ - - vt0 = curFileTime.QuadPart; + timeInfo.fileTimeLastCall.QuadPart = curFileTime.QuadPart; + timeInfo.curCounterFreq.QuadPart = estFreq; } 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; + driftFreq = estFreq * 20000000 / (vt1 - vt0); - /* - * 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; - long long 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; - } + if (driftFreq > 1003*estFreq/1000) { + driftFreq = 1003*estFreq/1000; + } else if (driftFreq < 997*estFreq/1000) { + driftFreq = 997*estFreq/1000; } - } - - /* - * 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 = driftFreq; } - timeInfo.fileTimeLastCall.QuadPart = vt0; - timeInfo.curCounterFreq.QuadPart = estFreq; timeInfo.perfCounterLastCall.QuadPart = curPerfCounter.QuadPart; LeaveCriticalSection(&timeInfo.cs); @@ -1319,13 +1049,12 @@ UpdateTimeEachSecond(void) static void ResetCounterSamples( - unsigned long long fileTime,/* Current file time */ - long long perfCounter, /* Current performance counter */ - long long perfFreq) /* Target performance frequency */ + Tcl_WideUInt fileTime, /* Current file time */ + Tcl_WideInt perfCounter, /* Current performance counter */ + Tcl_WideInt perfFreq) /* Target performance frequency */ { int i; - - for (i = SAMPLES - 1 ; i >= 0 ; --i) { + for (i=SAMPLES-1 ; i>=0 ; --i) { timeInfo.perfCounterSample[i] = perfCounter; timeInfo.fileTimeSample[i] = fileTime; perfCounter -= perfFreq; @@ -1360,22 +1089,20 @@ ResetCounterSamples( * case). */ -static long long +static Tcl_WideInt AccumulateSample( - long long perfCounter, - unsigned long long fileTime) + Tcl_WideInt perfCounter, + Tcl_WideUInt fileTime) { - unsigned long long workFTSample; - /* File time sample being removed from or + Tcl_WideUInt workFTSample; /* File time sample being removed from or * added to the circular buffer. */ - long long workPCSample; /* Performance counter sample being removed + Tcl_WideInt workPCSample; /* Performance counter sample being removed * from or added to the circular buffer. */ - unsigned long long lastFTSample; - /* Last file time sample recorded */ - long long lastPCSample; /* Last performance counter sample recorded */ - long long FTdiff; /* Difference between last FT and current */ - long long PCdiff; /* Difference between last PC and current */ - long long estFreq; /* Estimated performance counter frequency */ + 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. @@ -1409,7 +1136,7 @@ AccumulateSample( estFreq = 10000000 * (perfCounter - workPCSample) / (fileTime - workFTSample); timeInfo.perfCounterSample[timeInfo.sampleNo] = perfCounter; - timeInfo.fileTimeSample[timeInfo.sampleNo] = (long long) fileTime; + timeInfo.fileTimeSample[timeInfo.sampleNo] = (Tcl_WideInt) fileTime; /* * Advance the sample number. @@ -1439,10 +1166,9 @@ AccumulateSample( *---------------------------------------------------------------------- */ -#ifndef TCL_NO_DEPRECATED struct tm * TclpGmtime( - const time_t *timePtr) /* Pointer to the number of seconds since the + CONST time_t *timePtr) /* Pointer to the number of seconds since the * local system's epoch */ { /* @@ -1451,11 +1177,7 @@ TclpGmtime( * Posix gmtime_r function. */ -#if defined(_WIN64) || defined(_USE_64BIT_TIME_T) return gmtime(timePtr); -#else - return _gmtime32((const __time32_t *) timePtr); -#endif /* _WIN64 || _USE_64BIT_TIME_T */ } /* @@ -1477,8 +1199,9 @@ TclpGmtime( struct tm * TclpLocaltime( - const time_t *timePtr) /* Pointer to the number of seconds since the + CONST time_t *timePtr) /* Pointer to the number of seconds since the * local system's epoch */ + { /* * The MS implementation of localtime is thread safe because it returns @@ -1486,13 +1209,8 @@ TclpLocaltime( * provide a Posix localtime_r function. */ -#if defined(_WIN64) || defined(_USE_64BIT_TIME_T) return localtime(timePtr); -#else - return _localtime32((const __time32_t *) timePtr); -#endif /* _WIN64 || _USE_64BIT_TIME_T */ } -#endif /* TCL_NO_DEPRECATED */ /* *---------------------------------------------------------------------- @@ -1515,7 +1233,7 @@ void Tcl_SetTimeProc( Tcl_GetTimeProc *getProc, Tcl_ScaleTimeProc *scaleProc, - void *clientData) + ClientData clientData) { tclGetTimeProcPtr = getProc; tclScaleTimeProcPtr = scaleProc; @@ -1542,7 +1260,7 @@ void Tcl_QueryTimeProc( Tcl_GetTimeProc **getProc, Tcl_ScaleTimeProc **scaleProc, - void **clientData) + ClientData *clientData) { if (getProc) { *getProc = tclGetTimeProcPtr; diff --git a/win/tclooConfig.sh b/win/tclooConfig.sh deleted file mode 100644 index a400b5b..0000000 --- a/win/tclooConfig.sh +++ /dev/null @@ -1,19 +0,0 @@ -# tclooConfig.sh -- -# -# This shell script (for sh) is generated automatically by TclOO's configure -# script, or would be except it has no values that we substitute. It will -# create shell variables for most of the configuration options discovered by -# the configure script. This script is intended to be included by TEA-based -# configure scripts for TclOO extensions so that they don't have to figure -# this all out for themselves. -# -# The information in this file is specific to a single platform. - -# These are mostly empty because no special steps are ever needed from Tcl 8.6 -# onwards; all libraries and include files are just part of Tcl. -TCLOO_LIB_SPEC="" -TCLOO_STUB_LIB_SPEC="" -TCLOO_INCLUDE_SPEC="" -TCLOO_PRIVATE_INCLUDE_SPEC="" -TCLOO_CFLAGS="" -TCLOO_VERSION=1.3 diff --git a/win/tclsh.exe.manifest.in b/win/tclsh.exe.manifest.in index dc652e6..8b06fce 100644 --- a/win/tclsh.exe.manifest.in +++ b/win/tclsh.exe.manifest.in @@ -28,6 +28,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> @@ -35,10 +37,6 @@ xmlns="http://schemas.microsoft.com/SMI/2005/WindowsSettings"> <dpiAware>true</dpiAware> </asmv3:windowsSettings> - <asmv3:windowsSettings - xmlns="http://schemas.microsoft.com/SMI/2019/WindowsSettings"> - <activeCodePage>UTF-8</activeCodePage> - </asmv3:windowsSettings> </asmv3:application> <dependency> <dependentAssembly> diff --git a/win/tclsh.ico b/win/tclsh.ico Binary files differindex e254318..8bcaf48 100644 --- a/win/tclsh.ico +++ b/win/tclsh.ico diff --git a/win/tclsh.rc b/win/tclsh.rc index f439d08..161da50 100644 --- a/win/tclsh.rc +++ b/win/tclsh.rc @@ -8,6 +8,12 @@ // // 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 @@ -20,7 +26,7 @@ #define SUFFIX_DEBUG "" #endif -#define SUFFIX SUFFIX_STATIC SUFFIX_DEBUG +#define SUFFIX SUFFIX_THREADS SUFFIX_STATIC SUFFIX_DEBUG LANGUAGE 0x9, 0x1 /* LANG_ENGLISH, SUBLANG_DEFAULT */ @@ -44,8 +50,9 @@ BEGIN 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 1987-2022 Regents of the University of California and other parties\0" + 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 diff --git a/win/tcltest.rc b/win/tcltest.rc deleted file mode 100644 index 847a250..0000000 --- a/win/tcltest.rc +++ /dev/null @@ -1,75 +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 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_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", "Tcltest Application\0" - VALUE "OriginalFilename", "tcltest" STRINGIFY(TCL_MAJOR_VERSION) STRINGIFY(TCL_MINOR_VERSION) SUFFIX ".exe\0" - VALUE "FileVersion", TCL_PATCH_LEVEL - VALUE "LegalCopyright", "Copyright \251 1987-2022 Regents of the University of California and other parties\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" diff --git a/win/x86_64-w64-mingw32-nmakehlp.exe b/win/x86_64-w64-mingw32-nmakehlp.exe Binary files differdeleted file mode 100755 index f821add..0000000 --- a/win/x86_64-w64-mingw32-nmakehlp.exe +++ /dev/null |