diff options
Diffstat (limited to 'win')
39 files changed, 15905 insertions, 10828 deletions
diff --git a/win/Makefile.in b/win/Makefile.in index f11ef53..8883128 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -1,24 +1,21 @@ # -# This file is a Makefile for Tcl. If it has the name "Makefile.in" -# then it is a template for a Makefile; to generate the actual Makefile, -# run "./configure", which is a configuration script generated by the -# "autoconf" program (constructs like "@foo@" will get replaced in the -# actual Makefile. +# This file is a Makefile for Tcl. If it has the name "Makefile.in" then it +# is a template for a Makefile; to generate the actual Makefile, run +# "./configure", which is a configuration script generated by the "autoconf" +# program (constructs like "@foo@" will get replaced in the actual Makefile. VERSION = @TCL_VERSION@ -#---------------------------------------------------------------- -# Things you can change to personalize the Makefile for your own -# site (you can make these changes in either Makefile.in or -# Makefile, but changes to Makefile will get lost if you re-run -# the configuration script). -#---------------------------------------------------------------- +#-------------------------------------------------------------------------- +# Things you can change to personalize the Makefile for your own site (you can +# make these changes in either Makefile.in or Makefile, but changes to +# Makefile will get lost if you re-run the configuration script). +#-------------------------------------------------------------------------- -# Default top-level directories in which to install architecture- -# specific files (exec_prefix) and machine-independent files such -# as scripts (prefix). The values specified here may be overridden -# at configure-time with the --exec-prefix and --prefix options -# to the "configure" script. +# Default top-level directories in which to install architecture-specific +# files (exec_prefix) and machine-independent files such as scripts (prefix). +# The values specified here may be overridden at configure-time with the +# --exec-prefix and --prefix options to the "configure" script. prefix = @prefix@ exec_prefix = @exec_prefix@ @@ -27,16 +24,15 @@ libdir = @libdir@ includedir = @includedir@ mandir = @mandir@ -# The following definition can be set to non-null for special systems -# like AFS with replication. It allows the pathnames used for installation -# to be different than those used for actually reference files at -# run-time. INSTALL_ROOT is prepended to $prefix and $exec_prefix -# when installing files. +# The following definition can be set to non-null for special systems like AFS +# with replication. It allows the pathnames used for installation to be +# different than those used for actually reference files at run-time. +# INSTALL_ROOT is prepended to $prefix and $exec_prefix when installing files. INSTALL_ROOT = -# Directory from which applications will reference the library of Tcl -# scripts (note: you can set the TCL_LIBRARY environment variable at -# run-time to override this value): +# Directory from which applications will reference the library of Tcl scripts +# (note: you can set the TCL_LIBRARY environment variable at run-time to +# override this value): TCL_LIBRARY = $(prefix)/lib/tcl$(VERSION) # Path to use at runtime to refer to LIB_INSTALL_DIR: @@ -63,12 +59,10 @@ MAN_INSTALL_DIR = $(INSTALL_ROOT)$(mandir) # Directory in which to install manual entry for tclsh: MAN1_INSTALL_DIR = $(MAN_INSTALL_DIR)/man1 -# Directory in which to install manual entries for Tcl's C library -# procedures: +# Directory in which to install manual entries for Tcl's C library procedures: MAN3_INSTALL_DIR = $(MAN_INSTALL_DIR)/man3 -# Directory in which to install manual entries for the built-in -# Tcl commands: +# Directory in which to install manual entries for the built-in Tcl commands: MANN_INSTALL_DIR = $(MAN_INSTALL_DIR)/mann # Libraries built with optimization switches have this additional extension @@ -88,18 +82,19 @@ CFLAGS_OPTIMIZE = @CFLAGS_OPTIMIZE@ #CFLAGS = $(CFLAGS_DEBUG) $(CFLAGS_OPTIMIZE) CFLAGS = @CFLAGS@ @CFLAGS_DEFAULT@ -# To enable compilation debugging reverse the comment characters on -# one of the following lines. +# To enable compilation debugging reverse the comment characters on one of the +# following lines. COMPILE_DEBUG_FLAGS = #COMPILE_DEBUG_FLAGS = -DTCL_COMPILE_DEBUG #COMPILE_DEBUG_FLAGS = -DTCL_COMPILE_DEBUG -DTCL_COMPILE_STATS # Special compiler flags to use when building man2tcl on Windows. -MAN2TCLFLAGS = @MAN2TCLFLAGS@ +MAN2TCLFLAGS = @MAN2TCLFLAGS@ SRC_DIR = @srcdir@ ROOT_DIR = @srcdir@/.. GENERIC_DIR = @srcdir@/../generic +TOMMATH_DIR = @srcdir@/../libtommath WIN_DIR = @srcdir@ COMPAT_DIR = @srcdir@/../compat @@ -107,15 +102,29 @@ COMPAT_DIR = @srcdir@/../compat CYGPATH = @CYGPATH@ GENERIC_DIR_NATIVE = $(shell $(CYGPATH) '$(GENERIC_DIR)' | sed 's!\\!/!g') +TOMMATH_DIR_NATIVE = $(shell $(CYGPATH) '$(TOMMATH_DIR)' | sed 's!\\!/!g') WIN_DIR_NATIVE = $(shell $(CYGPATH) '$(WIN_DIR)' | sed 's!\\!/!g') ROOT_DIR_NATIVE = $(shell $(CYGPATH) '$(ROOT_DIR)' | sed 's!\\!/!g') - -LIBRARY_DIR = $(ROOT_DIR_NATIVE)/library - +#GENERIC_DIR_NATIVE = $(GENERIC_DIR) +#TOMMATH_DIR_NATIVE = $(TOMMATH_DIR) +#WIN_DIR_NATIVE = $(WIN_DIR) +#ROOT_DIR_NATIVE = $(ROOT_DIR) + +# Fully qualify library path so that `make test` +# does not depend on the current directory. +LIBRARY_DIR1 = $(shell cd '$(ROOT_DIR_NATIVE)/library' ; pwd) +LIBRARY_DIR = $(shell $(CYGPATH) '$(LIBRARY_DIR1)' | sed 's!\\!/!g') DLLSUFFIX = @DLLSUFFIX@ LIBSUFFIX = @LIBSUFFIX@ EXESUFFIX = @EXESUFFIX@ +VER = @TCL_MAJOR_VERSION@@TCL_MINOR_VERSION@ +DOTVER = @TCL_MAJOR_VERSION@.@TCL_MINOR_VERSION@ +DDEVER = @TCL_DDE_MAJOR_VERSION@@TCL_DDE_MINOR_VERSION@ +DDEDOTVER = @TCL_DDE_MAJOR_VERSION@.@TCL_DDE_MINOR_VERSION@ +REGVER = @TCL_REG_MAJOR_VERSION@@TCL_REG_MINOR_VERSION@ +REGDOTVER = @TCL_REG_MAJOR_VERSION@.@TCL_REG_MINOR_VERSION@ + TCL_STUB_LIB_FILE = @TCL_STUB_LIB_FILE@ TCL_DLL_FILE = @TCL_DLL_FILE@ TCL_LIB_FILE = @TCL_LIB_FILE@ @@ -129,11 +138,10 @@ SHARED_LIBRARIES = $(TCL_DLL_FILE) $(TCL_STUB_LIB_FILE) \ $(DDE_DLL_FILE) $(REG_DLL_FILE) $(PIPE_DLL_FILE) STATIC_LIBRARIES = $(TCL_LIB_FILE) $(REG_LIB_FILE) $(DDE_LIB_FILE) -# TCL_EXE is the name of a tclsh executable that is available *BEFORE* -# running make for the first time. Certain build targets (make genstubs) -# need it to be available on the PATH. This executable should *NOT* be -# required just to do a normal build although it can be required to run -# make dist. +# TCL_EXE is the name of a tclsh executable that is available *BEFORE* running +# make for the first time. Certain build targets (make genstubs) need it to be +# available on the PATH. This executable should *NOT* be required just to do a +# normal build although it can be required to run make dist. TCL_EXE = tclsh TCLSH = tclsh$(VER)${EXESUFFIX} @@ -143,11 +151,10 @@ MAN2TCL = man2tcl$(EXEEXT) @SET_MAKE@ -# Setting the VPATH variable to a list of paths will cause the -# makefile to look into these paths when resolving .c to .obj -# dependencies. +# Setting the VPATH variable to a list of paths will cause the Makefile to +# look into these paths when resolving .c to .obj dependencies. -VPATH = $(GENERIC_DIR):$(WIN_DIR):$(COMPAT_DIR) +VPATH = $(GENERIC_DIR):$(TOMMATH_DIR):$(WIN_DIR):$(COMPAT_DIR) AR = @AR@ RANLIB = @RANLIB@ @@ -168,12 +175,6 @@ SHLIB_LD = @SHLIB_LD@ SHLIB_LD_LIBS = @SHLIB_LD_LIBS@ $(LIBS) SHLIB_CFLAGS = @SHLIB_CFLAGS@ SHLIB_SUFFIX = @SHLIB_SUFFIX@ -VER = @TCL_MAJOR_VERSION@@TCL_MINOR_VERSION@ -DOTVER = @TCL_MAJOR_VERSION@.@TCL_MINOR_VERSION@ -DDEVER = @TCL_DDE_MAJOR_VERSION@@TCL_DDE_MINOR_VERSION@ -DDEDOTVER = @TCL_DDE_MAJOR_VERSION@.@TCL_DDE_MINOR_VERSION@ -REGVER = @TCL_REG_MAJOR_VERSION@@TCL_REG_MINOR_VERSION@ -REGDOTVER = @TCL_REG_MAJOR_VERSION@.@TCL_REG_MINOR_VERSION@ LIBS = @LIBS@ RMDIR = rm -rf @@ -183,14 +184,16 @@ RM = rm -f COPY = cp CC_SWITCHES = ${CFLAGS} ${CFLAGS_WARNING} ${TCL_SHLIB_CFLAGS} \ --I"${GENERIC_DIR_NATIVE}" -I"${WIN_DIR_NATIVE}" ${AC_FLAGS} \ +-I"${GENERIC_DIR_NATIVE}" -DTCL_TOMMATH -DMP_PREC=4 -I"${TOMMATH_DIR_NATIVE}" \ +-I"${WIN_DIR_NATIVE}" ${AC_FLAGS} \ ${COMPILE_DEBUG_FLAGS} CC_OBJNAME = @CC_OBJNAME@ CC_EXENAME = @CC_EXENAME@ STUB_CC_SWITCHES = ${CFLAGS} ${CFLAGS_WARNING} ${SHLIB_CFLAGS} \ --I"${GENERIC_DIR_NATIVE}" -I"${WIN_DIR_NATIVE}" ${AC_FLAGS} \ +-I"${GENERIC_DIR_NATIVE}" -DTCL_TOMMATH -DMP_PREC=4 -I"${TOMMATH_DIR_NATIVE}" \ +-I"${WIN_DIR_NATIVE}" ${AC_FLAGS} \ ${COMPILE_DEBUG_FLAGS} TCLTEST_OBJS = \ @@ -218,7 +221,9 @@ GENERIC_OBJS = \ tclCompCmds.$(OBJEXT) \ tclCompExpr.$(OBJEXT) \ tclCompile.$(OBJEXT) \ + tclConfig.$(OBJEXT) \ tclDate.$(OBJEXT) \ + tclDictObj.$(OBJEXT) \ tclEncoding.$(OBJEXT) \ tclEnv.$(OBJEXT) \ tclEvent.$(OBJEXT) \ @@ -233,6 +238,7 @@ GENERIC_OBJS = \ tclIO.$(OBJEXT) \ tclIOCmd.$(OBJEXT) \ tclIOGT.$(OBJEXT) \ + tclIORChan.$(OBJEXT) \ tclIOSock.$(OBJEXT) \ tclIOUtil.$(OBJEXT) \ tclLink.$(OBJEXT) \ @@ -245,9 +251,10 @@ GENERIC_OBJS = \ tclObj.$(OBJEXT) \ tclPanic.$(OBJEXT) \ tclParse.$(OBJEXT) \ - tclParseExpr.$(OBJEXT) \ + tclPathObj.$(OBJEXT) \ tclPipe.$(OBJEXT) \ tclPkg.$(OBJEXT) \ + tclPkgConfig.$(OBJEXT) \ tclPosixStr.$(OBJEXT) \ tclPreserve.$(OBJEXT) \ tclProc.$(OBJEXT) \ @@ -256,16 +263,87 @@ GENERIC_OBJS = \ tclResult.$(OBJEXT) \ tclScan.$(OBJEXT) \ tclStringObj.$(OBJEXT) \ + tclStrToD.$(OBJEXT) \ tclStubInit.$(OBJEXT) \ tclStubLib.$(OBJEXT) \ tclThread.$(OBJEXT) \ tclThreadAlloc.$(OBJEXT) \ tclThreadJoin.$(OBJEXT) \ + tclThreadStorage.$(OBJEXT) \ tclTimer.$(OBJEXT) \ + tclTomMathInterface.$(OBJEXT) \ + tclTrace.$(OBJEXT) \ tclUtf.$(OBJEXT) \ tclUtil.$(OBJEXT) \ tclVar.$(OBJEXT) +TOMMATH_OBJS = \ + bncore.${OBJEXT} \ + bn_reverse.${OBJEXT} \ + bn_fast_s_mp_mul_digs.${OBJEXT} \ + bn_fast_s_mp_sqr.${OBJEXT} \ + bn_mp_add.${OBJEXT} \ + bn_mp_add_d.${OBJEXT} \ + bn_mp_and.${OBJEXT} \ + bn_mp_clamp.${OBJEXT} \ + bn_mp_clear.${OBJEXT} \ + bn_mp_clear_multi.${OBJEXT} \ + bn_mp_cmp.${OBJEXT} \ + bn_mp_cmp_d.${OBJEXT} \ + bn_mp_cmp_mag.${OBJEXT} \ + bn_mp_cnt_lsb.${OBJEXT} \ + bn_mp_copy.${OBJEXT} \ + bn_mp_count_bits.${OBJEXT} \ + bn_mp_div.${OBJEXT} \ + bn_mp_div_d.${OBJEXT} \ + bn_mp_div_2.${OBJEXT} \ + bn_mp_div_2d.${OBJEXT} \ + bn_mp_div_3.${OBJEXT} \ + bn_mp_exch.${OBJEXT} \ + bn_mp_expt_d.${OBJEXT} \ + bn_mp_grow.${OBJEXT} \ + bn_mp_init.${OBJEXT} \ + bn_mp_init_copy.${OBJEXT} \ + bn_mp_init_multi.${OBJEXT} \ + bn_mp_init_set.${OBJEXT} \ + bn_mp_init_set_int.${OBJEXT} \ + bn_mp_init_size.${OBJEXT} \ + bn_mp_karatsuba_mul.${OBJEXT} \ + bn_mp_karatsuba_sqr.$(OBJEXT) \ + bn_mp_lshd.${OBJEXT} \ + bn_mp_mod.${OBJEXT} \ + bn_mp_mod_2d.${OBJEXT} \ + bn_mp_mul.${OBJEXT} \ + bn_mp_mul_2.${OBJEXT} \ + bn_mp_mul_2d.${OBJEXT} \ + bn_mp_mul_d.${OBJEXT} \ + bn_mp_neg.${OBJEXT} \ + bn_mp_or.${OBJEXT} \ + bn_mp_radix_size.${OBJEXT} \ + bn_mp_radix_smap.${OBJEXT} \ + bn_mp_read_radix.${OBJEXT} \ + bn_mp_rshd.${OBJEXT} \ + bn_mp_set.${OBJEXT} \ + bn_mp_set_int.${OBJEXT} \ + bn_mp_shrink.${OBJEXT} \ + bn_mp_sqr.${OBJEXT} \ + bn_mp_sqrt.${OBJEXT} \ + bn_mp_sub.${OBJEXT} \ + bn_mp_sub_d.${OBJEXT} \ + bn_mp_to_unsigned_bin.${OBJEXT} \ + bn_mp_to_unsigned_bin_n.${OBJEXT} \ + bn_mp_toom_mul.${OBJEXT} \ + bn_mp_toom_sqr.${OBJEXT} \ + bn_mp_toradix_n.${OBJEXT} \ + bn_mp_unsigned_bin_size.${OBJEXT} \ + bn_mp_xor.${OBJEXT} \ + bn_mp_zero.${OBJEXT} \ + bn_s_mp_add.${OBJEXT} \ + bn_s_mp_mul_digs.${OBJEXT} \ + bn_s_mp_sqr.${OBJEXT} \ + bn_s_mp_sub.${OBJEXT} + + WIN_OBJS = \ tclWin32Dll.$(OBJEXT) \ tclWinChan.$(OBJEXT) \ @@ -276,15 +354,11 @@ WIN_OBJS = \ tclWinFile.$(OBJEXT) \ tclWinInit.$(OBJEXT) \ tclWinLoad.$(OBJEXT) \ - tclWinMtherr.$(OBJEXT) \ tclWinNotify.$(OBJEXT) \ tclWinPipe.$(OBJEXT) \ tclWinSock.$(OBJEXT) \ tclWinThrd.$(OBJEXT) \ - tclWinTime.$(OBJEXT) - -COMPAT_OBJS = \ - strftime.$(OBJEXT) strtoll.$(OBJEXT) strtoull.$(OBJEXT) + tclWinTime.$(OBJEXT) PIPE_OBJS = stub16.$(OBJEXT) @@ -296,7 +370,7 @@ STUB_OBJS = tclStubLib.$(OBJEXT) TCLSH_OBJS = tclAppInit.$(OBJEXT) -TCL_OBJS = ${GENERIC_OBJS} ${WIN_OBJS} ${COMPAT_OBJS} +TCL_OBJS = ${GENERIC_OBJS} $(TOMMATH_OBJS) ${WIN_OBJS} TCL_DOCS = "$(ROOT_DIR_NATIVE)"/doc/*.[13n] @@ -321,10 +395,12 @@ $(MAN2TCL): $(ROOT_DIR)/tools/man2tcl.c $(TCLSH): $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE) $(TCLSH_OBJS) tclsh.$(RES) $(CC) $(CFLAGS) $(TCLSH_OBJS) $(TCL_LIB_FILE) $(LIBS) \ tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE) + @VC_MANIFEST_EMBED_EXE@ $(TCLTEST): $(TCL_LIB_FILE) $(TCLTEST_OBJS) $(CAT32) tclsh.$(RES) $(CC) $(CFLAGS) $(TCLTEST_OBJS) $(TCL_LIB_FILE) $(LIBS) \ tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE) + @VC_MANIFEST_EMBED_EXE@ cat32.$(OBJEXT): cat.c $(CC) -c $(CC_SWITCHES) @DEPARG@ $(CC_OBJNAME) @@ -332,8 +408,8 @@ cat32.$(OBJEXT): cat.c $(CAT32): cat32.$(OBJEXT) $(CC) $(CFLAGS) cat32.$(OBJEXT) $(CC_EXENAME) $(LIBS) $(LDFLAGS_CONSOLE) -# The following targets are configured by autoconf to generate either -# a shared library or static library +# The following targets are configured by autoconf to generate either a shared +# library or static library ${TCL_STUB_LIB_FILE}: ${STUB_OBJS} @$(RM) ${TCL_STUB_LIB_FILE} @@ -343,6 +419,7 @@ ${TCL_STUB_LIB_FILE}: ${STUB_OBJS} ${TCL_DLL_FILE}: ${TCL_OBJS} tcl.$(RES) @$(RM) ${TCL_DLL_FILE} @MAKE_DLL@ ${TCL_OBJS} tcl.$(RES) $(SHLIB_LD_LIBS) + @VC_MANIFEST_EMBED_DLL@ ${TCL_LIB_FILE}: ${TCL_OBJS} @$(RM) ${TCL_LIB_FILE} @@ -365,14 +442,13 @@ ${REG_LIB_FILE}: ${REG_OBJS} ${TCL_LIB_FILE} @$(RM) ${REG_LIB_FILE} @MAKE_LIB@ ${REG_OBJS} ${TCL_LIB_FILE} -# PIPE_DLL_FILE is actually an executable, don't build it -# like a DLL. +# PIPE_DLL_FILE is actually an executable, don't build it like a DLL. ${PIPE_DLL_FILE}: ${PIPE_OBJS} @$(RM) ${PIPE_DLL_FILE} @MAKE_EXE@ $(CFLAGS) ${PIPE_OBJS} $(LIBS) $(LDFLAGS_CONSOLE) -# Add the object extension to the implicit rules. By default .obj is not +# Add the object extension to the implicit rules. By default .obj is not # automatically added. .SUFFIXES: .${OBJEXT} @@ -411,8 +487,32 @@ tclWinReg.${OBJEXT} : tclWinReg.c tclWinDde.${OBJEXT} : tclWinDde.c $(CC) -c $(CC_SWITCHES) -DUSE_TCL_STUBS @DEPARG@ $(CC_OBJNAME) -# The following objects are part of the stub library and should not -# be built as DLL objects but none of the symbols should be exported +# TIP #59, embedding of configuration information into the binary library. +# +# Part of Tcl's configuration information are the paths where it was installed +# and where it will look for its libraries (which can be different). We derive +# this information from the variables which can be overridden by the user. As +# every path can be configured separately we do not remember one general +# prefix/exec_prefix but all the different paths individually. + +tclPkgConfig.${OBJEXT}: tclPkgConfig.c + $(CC) -c $(CC_SWITCHES) \ + -DCFG_INSTALL_LIBDIR=\"$(LIB_INSTALL_DIR)\" \ + -DCFG_INSTALL_BINDIR=\"$(BIN_INSTALL_DIR)\" \ + -DCFG_INSTALL_SCRDIR=\"$(SCRIPT_INSTALL_DIR)\" \ + -DCFG_INSTALL_INCDIR=\"$(INCLUDE_INSTALL_DIR)\" \ + -DCFG_INSTALL_DOCDIR=\"$(MAN_INSTALL_DIR)\" \ + \ + -DCFG_RUNTIME_LIBDIR=\"$(libdir)\" \ + -DCFG_RUNTIME_BINDIR=\"$(bindir)\" \ + -DCFG_RUNTIME_SCRDIR=\"$(TCL_LIBRARY)\" \ + -DCFG_RUNTIME_INCDIR=\"$(includedir)\" \ + -DCFG_RUNTIME_DOCDIR=\"$(mandir)\" \ + -DBUILD_tcl \ + @DEPARG@ $(CC_OBJNAME) + +# The following objects are part of the stub library and should not be built +# as DLL objects but none of the symbols should be exported tclStubLib.${OBJEXT}: tclStubLib.c $(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD @DEPARG@ $(CC_OBJNAME) @@ -420,12 +520,32 @@ tclStubLib.${OBJEXT}: tclStubLib.c # Implicit rule for all object files that will end up in the Tcl library -.c.${OBJEXT}: +%.${OBJEXT}: %.c $(CC) -c $(CC_SWITCHES) -DBUILD_tcl @DEPARG@ $(CC_OBJNAME) .rc.$(RES): $(RC) @RC_OUT@ $@ @RC_TYPE@ @RC_DEFINES@ @RC_INCLUDE@ "$(GENERIC_DIR_NATIVE)" @RC_INCLUDE@ "$(WIN_DIR_NATIVE)" @DEPARG@ +# The following target generates the file generic/tclDate.c from the yacc +# grammar found in generic/tclGetDate.y. This is only run by hand as yacc is +# not available in all environments. The name of the .c file is different than +# the name of the .y file so that make doesn't try to automatically regenerate +# the .c file. + +gendate: + bison --output-file=$(GENERIC_DIR)/tclDate.c \ + --name-prefix=TclDate \ + --no-lines \ + $(GENERIC_DIR)/tclGetDate.y + +# The following target generates the file generic/tclTomMath.h. It needs to be +# run (and the results checked) after updating to a new release of libtommath. + +gentommath_h: + $(TCL_EXE) "$(ROOT_DIR_NATIVE)\tools\fix_tommath_h.tcl" \ + "$(TOMMATH_DIR_NATIVE)\tommath.h" \ + > "$(GENERIC_DIR_NATIVE)\tclTomMath.h" + install: all install-binaries install-libraries install-doc install-binaries: binaries @@ -438,7 +558,7 @@ install-binaries: binaries else true; \ fi; \ done; - @for i in dde1.2 reg1.1; \ + @for i in dde1.3 reg1.2; \ do \ if [ ! -d $(LIB_INSTALL_DIR)/$$i ] ; then \ echo "Making directory $(LIB_INSTALL_DIR)/$$i"; \ @@ -462,26 +582,26 @@ install-binaries: binaries done @if [ -f $(DDE_DLL_FILE) ]; then \ echo installing $(DDE_DLL_FILE); \ - $(COPY) $(DDE_DLL_FILE) $(LIB_INSTALL_DIR)/dde1.2; \ + $(COPY) $(DDE_DLL_FILE) $(LIB_INSTALL_DIR)/dde1.3; \ $(COPY) $(ROOT_DIR)/library/dde/pkgIndex.tcl \ - $(LIB_INSTALL_DIR)/dde1.2; \ + $(LIB_INSTALL_DIR)/dde1.3; \ fi @if [ -f $(DDE_LIB_FILE) ]; then \ echo installing $(DDE_LIB_FILE); \ - $(COPY) $(DDE_LIB_FILE) $(LIB_INSTALL_DIR)/dde1.2; \ + $(COPY) $(DDE_LIB_FILE) $(LIB_INSTALL_DIR)/dde1.3; \ fi @if [ -f $(REG_DLL_FILE) ]; then \ echo installing $(REG_DLL_FILE); \ - $(COPY) $(REG_DLL_FILE) $(LIB_INSTALL_DIR)/reg1.1; \ + $(COPY) $(REG_DLL_FILE) $(LIB_INSTALL_DIR)/reg1.2; \ $(COPY) $(ROOT_DIR)/library/reg/pkgIndex.tcl \ - $(LIB_INSTALL_DIR)/reg1.1; \ + $(LIB_INSTALL_DIR)/reg1.2; \ fi @if [ -f $(REG_LIB_FILE) ]; then \ echo installing $(REG_LIB_FILE); \ - $(COPY) $(REG_LIB_FILE) $(LIB_INSTALL_DIR)/reg1.1; \ + $(COPY) $(REG_LIB_FILE) $(LIB_INSTALL_DIR)/reg1.2; \ fi -install-libraries: libraries +install-libraries: libraries install-tzdata install-msgs @for i in $(prefix)/lib $(INCLUDE_INSTALL_DIR) \ $(SCRIPT_INSTALL_DIR); \ do \ @@ -491,7 +611,7 @@ install-libraries: libraries else true; \ fi; \ done; - @for i in platform http1.0 http2.5 opt0.4 encoding msgcat1.3 tcltest2.2; \ + @for i in http1.0 opt0.4 encoding ../tcl8 ../tcl8/8.2 ../tcl8/8.3 ../tcl8/8.4 ../tcl8/8.4/platform ../tcl8/8.5; \ do \ if [ ! -d $(SCRIPT_INSTALL_DIR)/$$i ] ; then \ echo "Making directory $(SCRIPT_INSTALL_DIR)/$$i"; \ @@ -501,7 +621,11 @@ install-libraries: libraries done; @echo "Installing header files"; @for i in "$(GENERIC_DIR)/tcl.h" "$(GENERIC_DIR)/tclDecls.h" \ - "$(GENERIC_DIR)/tclPlatDecls.h" ; \ + "$(GENERIC_DIR)/tclPlatDecls.h" \ + "$(GENERIC_DIR)/tclTomMath.h" \ + "$(GENERIC_DIR)/tclTomMathDecls.h" \ + "$(TOMMATH_DIR)/tommath_class.h" \ + "$(TOMMATH_DIR)/tommath_superclass.h" ; \ do \ $(COPY) "$$i" "$(INCLUDE_INSTALL_DIR)"; \ done; @@ -510,41 +634,43 @@ install-libraries: libraries do \ $(COPY) "$$i" "$(SCRIPT_INSTALL_DIR)"; \ done; - @echo "Installing library platform directory"; - @for j in $(ROOT_DIR)/library/platform/*.tcl; \ - do \ - $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/platform"; \ - done; @echo "Installing library http1.0 directory"; @for j in $(ROOT_DIR)/library/http1.0/*.tcl; \ do \ $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/http1.0"; \ done; - @echo "Installing library http2.5 directory"; - @for j in $(ROOT_DIR)/library/http/*.tcl; \ - do \ - $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/http2.5"; \ - done; + @echo "Installing package http 2.7.6 as a Tcl Module"; + @$(COPY) $(ROOT_DIR)/library/http/http.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/http-2.7.6.tm; @echo "Installing library opt0.4 directory"; @for j in $(ROOT_DIR)/library/opt/*.tcl; \ do \ $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/opt0.4"; \ done; - @echo "Installing library msgcat1.3 directory"; - @for j in $(ROOT_DIR)/library/msgcat/*.tcl; \ - do \ - $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/msgcat1.3"; \ - done; - @echo "Installing library tcltest2.2 directory"; - @for j in $(ROOT_DIR)/library/tcltest/*.tcl; \ - do \ - $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/tcltest2.2"; \ - done; + @echo "Installing package msgcat 1.4.4 as a Tcl Module"; + @$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/msgcat-1.4.4.tm; + @echo "Installing package tcltest 2.3.3 as a Tcl Module"; + @$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/tcltest-2.3.3.tm; + @echo "Installing package platform 1.0.10 as a Tcl Module"; + @$(COPY) $(ROOT_DIR)/library/platform/platform.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/platform-1.0.10.tm; + @echo "Installing package platform::shell 1.1.4 as a Tcl Module"; + @$(COPY) $(ROOT_DIR)/library/platform/shell.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/platform/shell-1.1.4.tm; @echo "Installing encodings"; @for i in $(ROOT_DIR)/library/encoding/*.enc ; do \ $(COPY) "$$i" "$(SCRIPT_INSTALL_DIR)/encoding"; \ done; +install-tzdata: + @echo "Installing time zone data" + @TCL_LIBRARY="${LIBRARY_DIR}"; export TCL_LIBRARY; \ + ./$(TCLSH) "$(ROOT_DIR)/tools/installData.tcl" \ + "$(ROOT_DIR)/library/tzdata" "$(SCRIPT_INSTALL_DIR)/tzdata" + +install-msgs: + @echo "Installing message catalogs" + @TCL_LIBRARY="${LIBRARY_DIR}"; export TCL_LIBRARY; \ + ./$(TCLSH) "$(ROOT_DIR)/tools/installData.tcl" \ + "$(ROOT_DIR)/library/msgs" "$(SCRIPT_INSTALL_DIR)/msgs" + install-doc: doc # Optional target to install private headers @@ -554,11 +680,10 @@ install-private-headers: libraries if [ ! -d $$i ] ; then \ echo "Making directory $$i"; \ $(MKDIR) $$i; \ - chmod 755 $$i; \ else true; \ fi; \ done; - @echo "Installing private header files to $(PRIVATE_INCLUDE_INSTALL_DIR)/"; + @echo "Installing private header files"; @for i in "$(GENERIC_DIR)/tclInt.h" "$(GENERIC_DIR)/tclIntDecls.h" \ "$(GENERIC_DIR)/tclIntPlatDecls.h" "$(GENERIC_DIR)/tclPort.h" \ "$(WIN_DIR)/tclWinPort.h" ; \ @@ -566,22 +691,24 @@ install-private-headers: libraries $(COPY) "$$i" "$(PRIVATE_INCLUDE_INSTALL_DIR)"; \ done; -# Specifying TESTFLAGS on the command line is the standard way to pass -# args to tcltest, ie: +# Specifying TESTFLAGS on the command line is the standard way to pass args to +# tcltest, i.e.: # % make test TESTFLAGS="-verbose bps -file fileName.test" test: binaries $(TCLTEST) TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \ ./$(TCLTEST) "$(ROOT_DIR_NATIVE)/tests/all.tcl" $(TESTFLAGS) \ - | ./$(CAT32) + -load "set ::ddelib [file normalize ${DDE_DLL_FILE}]; \ + set ::reglib [file normalize ${REG_DLL_FILE}]" | ./$(CAT32) # Useful target to launch a built tcltest with the proper path,... runtest: binaries $(TCLTEST) @TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \ - ./$(TCLTEST) $(TESTFLAGS) $(SCRIPT) + ./$(TCLTEST) $(TESTFLAGS) -load "set ::ddelib [file normalize ${DDE_DLL_FILE}]; \ + set ::reglib [file normalize ${REG_DLL_FILE}]" $(SCRIPT) -# This target can be used to run tclsh from the build directory -# via `make shell SCRIPT=foo.tcl` +# This target can be used to run tclsh from the build directory via +# `make shell SCRIPT=foo.tcl` shell: binaries @TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \ ./$(TCLSH) $(SCRIPT) @@ -589,7 +716,7 @@ shell: binaries # This target can be used to run tclsh inside either gdb or insight gdb: binaries @echo "set env TCL_LIBRARY=$(LIBRARY_DIR)" > gdb.run - gdb ./tclsh --command=gdb.run + gdb ./$(TCLSH) --command=gdb.run rm gdb.run depend: @@ -607,7 +734,7 @@ clean: cleanhelp distclean: clean $(RM) Makefile config.status config.cache config.log tclConfig.sh \ - tcl.hpj + tcl.hpj config.status.lineno # # Regenerate the stubs files. @@ -623,4 +750,5 @@ genstubs: $(TCL_EXE) "$(ROOT_DIR_NATIVE)\tools\genStubs.tcl" \ "$(GENERIC_DIR_NATIVE)" \ "$(GENERIC_DIR_NATIVE)\tcl.decls" \ - "$(GENERIC_DIR_NATIVE)\tclInt.decls" + "$(GENERIC_DIR_NATIVE)\tclInt.decls" \ + "$(GENERIC_DIR_NATIVE)\tclTomMath.decls" @@ -1,4 +1,4 @@ -Tcl 8.4 for Windows +Tcl 8.5 for Windows 1. Introduction --------------- @@ -16,7 +16,7 @@ The information in this file is maintained on the web at: In order to compile Tcl for Windows, you need the following: - Tcl 8.4 Source Distribution (plus any patches) + Tcl 8.5 Source Distribution (plus any patches) and @@ -51,9 +51,9 @@ Use the Makefile "install" target to install Tcl. It will install it according to the prefix options you provided in the correct directory structure. -Note that in order to run tclsh84.exe, you must ensure that tcl84.dll -and tclpip84.dll are on your path, in the system directory, or in the -directory containing tclsh84.exe. +Note that in order to run tclsh85.exe, you must ensure that tcl85.dll is on +your path, in the system directory, or in the directory containing +tclsh85.exe. Note: Tcl no longer provides support for Win32s. diff --git a/win/README.binary b/win/README.binary deleted file mode 100644 index 8388235..0000000 --- a/win/README.binary +++ /dev/null @@ -1,141 +0,0 @@ -Tcl/Tk 8.4 for Windows, Binary Distribution - -1. Introduction ---------------- - -This directory contains the binary distribution of Tcl/Tk 8.4.19 for -Windows. It was compiled with Microsoft Visual C++ 6.0 using Win32 -API, so that it will run under Windows NT, 95, 98 and 2000. - -Tcl provides a powerful platform for creating integration applications -that tie together diverse applications, protocols, devices, and -frameworks. When paired with the Tk toolkit, Tcl provides the fastest -and most powerful way to create GUI applications that run on PCs, Unix, -and the Macintosh. Tcl can also be used for a variety of web-related -tasks and for creating powerful command languages for applications. - -Tcl is maintained, enhanced, and distributed freely by the Tcl community. - -2. Documentation ----------------- - -The home of Tcl and Tk sources and bug database on the Web is at: - http://tcl.sourceforge.net/ - -The home page for the Tcl Developer Xchange is at: - http://www.tcl.tk/ - -The home page for the Tcl/Tk 8.4 release is - http://www.tcl.tk/software/tcltk/8.4.html - -Detailed release notes can be found at the file distributions page -by clicking on the relevant version. - http://sourceforge.net/project/showfiles.php?group_id=10894 - -Information about Tcl itself can be found at - http://www.tcl.tk/scripting/ - -There are many Tcl books on the market. Most are listed at - http://www.tcl.tk/resource/doc/books/ - -There are notes about compiling Tcl at - http://www.tcl.tk/doc/howto/compile.html - -3. Installation ---------------- - -The binary release is distributed as a self-extracting archive called -tcl<version>.exe. The setup program which will prompt you for an -installation directory. It will create the installation heirarchy -under the specified directory, and install a wish application icon -under the program manager group of your choice. - -We are no longer supporting use of Tcl with 16-bit versions of -Windows. Microsoft has completely dropped support of the Win32s -subsystem. - -4. Linking against the binary release --------------------------------------- - -In order to link your applications against the .dll files shipped with -this release, you will need to use the appropriate .lib file for your -compiler. In the lib directory of the installation directory, there -are library files for the Microsoft Visual C++ compiler: - - tcl84.lib - tk84.lib - -5. Building dynamically loadable extensions --------------------------------------------- - -Please refer to the example dynamically loadable extension provided on -our ftp site: - - ftp://ftp.scriptics.com/pub/tcl/misc/example.zip - -This archive contains a template that you can use for building -extensions that will be loadable on Unix, Windows, and Macintosh -systems. - -6. Reporting Bugs ------------------ -If you have comments or bug reports for the Windows version of Tcl, -please use our online database at: - - http://tcl.sourceforge.net/ - -or post them to the newsgroup comp.lang.tcl. - -7. Tcl newsgroup ------------------ - -There is a network news group "comp.lang.tcl" intended for the exchange -of information about Tcl, Tk, and related applications. Feel free to use -the newsgroup both for general information questions and for bug reports. -We read the newsgroup and will attempt to fix bugs and problems reported -to it. - -When using comp.lang.tcl, please be sure that your e-mail return address -is correctly set in your postings. This allows people to respond directly -to you, rather than the entire newsgroup, for answers that are not of -general interest. A bad e-mail return address may prevent you from -getting answers to your questions. You may have to reconfigure your news -reading software to ensure that it is supplying valid e-mail addresses. - -8. Tcl contributed archive --------------------------- - -Many people have created exciting packages and applications based on Tcl -and/or Tk and made them freely available to the Tcl community. An archive -of these contributions is kept on the machine ftp.neosoft.com. You -can access the archive using anonymous FTP; the Tcl contributed archive is -in the directory "/pub/tcl". The archive also contains several FAQ -("frequently asked questions") documents that provide solutions to problems -that are commonly encountered by TCL newcomers. - -9. Tcl Resource Center ----------------------- - -Visit http://www.tcl.tk/resource/ to see an annotated index of -many Tcl resources available on the World Wide Web. This includes papers, -books, and FAQs, as well as extensions, applications, binary releases, and -patches. You can contribute patches by using the Tracker at - - http://tcl.sourceforge.net/ - -You can also recommend more URLs for the resource center using the forms -labeled "Add a Resource". - -10. Mailing lists ----------------- - -Several mailing lists are hosted at SourceForge to discuss development or -use issues (like Macintosh and Windows topics). For more information and -to subscribe, visit: - - http://sourceforge.net/projects/tcl/ - -and go to the Mailing Lists page. There are also Special Interest Groups -(SIGs) setup for these topics and more at: - - http://www.tcl.tk/ diff --git a/win/buildall.vc.bat b/win/buildall.vc.bat index 383e774..55b29ae 100755..100644 --- a/win/buildall.vc.bat +++ b/win/buildall.vc.bat @@ -1,56 +1,123 @@ @echo off - :: This is an example batchfile for building everything. Please :: edit this (or make your own) for your needs and wants using :: the instructions for calling makefile.vc found in makefile.vc +set SYMBOLS= + +:OPTIONS +if "%1" == "/?" goto help +if /i "%1" == "/help" goto help +if %1.==symbols. goto SYMBOLS +if %1.==debug. goto SYMBOLS +goto OPTIONS_DONE + +:SYMBOLS + set SYMBOLS=symbols + shift + goto OPTIONS + +:OPTIONS_DONE + +:: reset errorlevel +cd > nul + +:: We need to run the development environment batch script that comes +:: with developer studio (v4,5,6,7,etc...) All have it. These paths +:: might not be correct. You may need to edit these. +:: +if not defined MSDevDir ( + call "C:\Program Files\Microsoft Developer Studio\vc98\bin\vcvars32.bat" + ::call "C:\Program Files\Microsoft Developer Studio\vc\bin\vcvars32.bat" + ::call c:\dev\devstudio60\vc98\bin\vcvars32.bat + if errorlevel 1 goto no_vcvars +) + + +echo. echo Sit back and have a cup of coffee while this grinds through ;) echo You asked for *everything*, remember? echo. - title Building Tcl, please wait... -if "%MSVCDir%" == "" call c:\dev\devstudio60\vc98\bin\vcvars32.bat -::if "%MSVCDir%" == "" call "C:\Program Files\Microsoft Developer Studio\vc98\bin\vcvars32.bat" -set INSTALLDIR=C:\Program Files\Tcl + +:: makefile.vc uses this for its default anyways, but show its use here +:: just to be explicit and convey understanding to the user. Setting +:: the INSTALLDIR envar prior to running this batchfile affects all builds. +:: +if "%INSTALLDIR%" == "" set INSTALLDIR=C:\Program Files\Tcl + :: Build the normal stuff along with the help file. :: -nmake -nologo -f makefile.vc release winhelp OPTS=none +set OPTS=none +if not %SYMBOLS%.==. set OPTS=symbols +nmake -nologo -f makefile.vc release winhelp OPTS=%OPTS% %1 if errorlevel 1 goto error :: Build the static core, dlls and shell. :: -nmake -nologo -f makefile.vc release OPTS=static +set OPTS=static +if not %SYMBOLS%.==. set OPTS=symbols,static +nmake -nologo -f makefile.vc release OPTS=%OPTS% %1 if errorlevel 1 goto error :: Build the special static libraries that use the dynamic runtime. :: -nmake -nologo -f makefile.vc core dlls OPTS=static,msvcrt +set OPTS=static,msvcrt +if not %SYMBOLS%.==. set OPTS=symbols,static,msvcrt +nmake -nologo -f makefile.vc core dlls OPTS=%OPTS% %1 if errorlevel 1 goto error :: Build the core and shell for thread support. :: -nmake -nologo -f makefile.vc shell OPTS=threads +set OPTS=threads +if not %SYMBOLS%.==. set OPTS=symbols,threads +nmake -nologo -f makefile.vc shell OPTS=%OPTS% %1 if errorlevel 1 goto error -:: Build a static, thread support core library (no shell). +:: Build a static, thread support core library with a shell. :: -nmake -nologo -f makefile.vc core OPTS=static,threads +set OPTS=static,threads +if not %SYMBOLS%.==. set OPTS=symbols,static,threads +nmake -nologo -f makefile.vc shell OPTS=%OPTS% %1 if errorlevel 1 goto error -:: Build the special static libraries the use the dynamic runtime, +:: Build the special static libraries that use the dynamic runtime, :: but now with thread support. :: -nmake -nologo -f makefile.vc core dlls OPTS=static,msvcrt,threads +set OPTS=static,msvcrt,threads +if not %SYMBOLS%.==. set OPTS=symbols,static,msvcrt,threads +nmake -nologo -f makefile.vc core dlls OPTS=%OPTS% %1 if errorlevel 1 goto error +set OPTS= +set SYMBOLS= goto end :error echo *** BOOM! *** +goto end + +:no_vcvars +echo vcvars32.bat not found. You'll need to edit this batch script. +goto out + +:help +title buildall.vc.bat help message +echo usage: +echo %0 : builds Tcl for all build types (do this first) +echo %0 install : installs all the release builds (do this second) +echo %0 symbols : builds Tcl for all debugging build types +echo %0 symbols install : install all the debug builds. +echo. +goto out :end -title Building Tcl, please wait...DONE! +title Building Tcl, please wait... DONE! echo DONE! +goto out + +:out pause +title Command Prompt @@ -10,15 +10,19 @@ */ #include <stdio.h> -#include <io.h> +#ifdef __CYGWIN__ +# include <unistd.h> +#else +# include <io.h> +#endif #include <string.h> int -main() -{ +main(void) +{ char buf[1024]; int n; - char *err; + const char *err; while (1) { n = read(0, buf, sizeof(buf)); @@ -32,4 +36,3 @@ main() return 0; } - diff --git a/win/coffbase.txt b/win/coffbase.txt index 35dac3d..8d3f84b 100644 --- a/win/coffbase.txt +++ b/win/coffbase.txt @@ -22,4 +22,12 @@ itk 0x10580000 0x00080000 bltlite 0x10600000 0x00080000 blt 0x10680000 0x00080000 iocpsock 0x10700000 0x00080000 -tls 0x10780000 0x00080000 +tls 0x10780000 0x00100000 +winico 0x10880000 0x00010000 +tile 0x10900000 0x00080000 +memchan 0x109D0000 0x00010000 +tdom 0x109E0000 0x00080000 +tkvideo 0x10B00000 0x00010000 +snack 0x1E000000 0x00400000 +sound 0x1E400000 0x00400000 +snackogg 0x1E800000 0x00200000 diff --git a/win/configure b/win/configure index 1fe4dde..7ff7248 100755 --- a/win/configure +++ b/win/configure @@ -1,38 +1,325 @@ #! /bin/sh - # Guess values for system-dependent variables and create Makefiles. -# Generated automatically using autoconf version 2.13 -# Copyright (C) 1992, 93, 94, 95, 96 Free Software Foundation, Inc. +# Generated by GNU Autoconf 2.59. # +# Copyright (C) 2003 Free Software Foundation, Inc. # This configure script is free software; the Free Software Foundation # gives unlimited permission to copy, distribute and modify it. +## --------------------- ## +## M4sh Initialization. ## +## --------------------- ## + +# Be Bourne compatible +if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then + emulate sh + NULLCMD=: + # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which + # is contrary to our usage. Disable this feature. + alias -g '${1+"$@"}'='"$@"' +elif test -n "${BASH_VERSION+set}" && (set -o posix) >/dev/null 2>&1; then + set -o posix +fi +DUALCASE=1; export DUALCASE # for MKS sh + +# Support unset when possible. +if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then + as_unset=unset +else + as_unset=false +fi + + +# Work around bugs in pre-3.0 UWIN ksh. +$as_unset ENV MAIL MAILPATH +PS1='$ ' +PS2='> ' +PS4='+ ' + +# NLS nuisances. +for as_var in \ + LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \ + LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \ + LC_TELEPHONE LC_TIME +do + if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then + eval $as_var=C; export $as_var + else + $as_unset $as_var + fi +done + +# Required to use basename. +if expr a : '\(a\)' >/dev/null 2>&1; then + as_expr=expr +else + as_expr=false +fi -# Defaults: -ac_help= +if (basename /) >/dev/null 2>&1 && test "X`basename / 2>&1`" = "X/"; then + as_basename=basename +else + as_basename=false +fi + + +# Name of the executable. +as_me=`$as_basename "$0" || +$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ + X"$0" : 'X\(//\)$' \| \ + X"$0" : 'X\(/\)$' \| \ + . : '\(.\)' 2>/dev/null || +echo X/"$0" | + sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/; q; } + /^X\/\(\/\/\)$/{ s//\1/; q; } + /^X\/\(\/\).*/{ s//\1/; q; } + s/.*/./; q'` + + +# PATH needs CR, and LINENO needs CR and PATH. +# Avoid depending upon Character Ranges. +as_cr_letters='abcdefghijklmnopqrstuvwxyz' +as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' +as_cr_Letters=$as_cr_letters$as_cr_LETTERS +as_cr_digits='0123456789' +as_cr_alnum=$as_cr_Letters$as_cr_digits + +# The user is always right. +if test "${PATH_SEPARATOR+set}" != set; then + echo "#! /bin/sh" >conf$$.sh + echo "exit 0" >>conf$$.sh + chmod +x conf$$.sh + if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then + PATH_SEPARATOR=';' + else + PATH_SEPARATOR=: + fi + rm -f conf$$.sh +fi + + + as_lineno_1=$LINENO + as_lineno_2=$LINENO + as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null` + test "x$as_lineno_1" != "x$as_lineno_2" && + test "x$as_lineno_3" = "x$as_lineno_2" || { + # Find who we are. Look in the path if we contain no path at all + # relative or not. + case $0 in + *[\\/]* ) as_myself=$0 ;; + *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break +done + + ;; + esac + # We did not find ourselves, most probably we were run as `sh COMMAND' + # in which case we are not to be found in the path. + if test "x$as_myself" = x; then + as_myself=$0 + fi + if test ! -f "$as_myself"; then + { echo "$as_me: error: cannot find myself; rerun with an absolute path" >&2 + { (exit 1); exit 1; }; } + fi + case $CONFIG_SHELL in + '') + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for as_base in sh bash ksh sh5; do + case $as_dir in + /*) + if ("$as_dir/$as_base" -c ' + as_lineno_1=$LINENO + as_lineno_2=$LINENO + as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null` + test "x$as_lineno_1" != "x$as_lineno_2" && + test "x$as_lineno_3" = "x$as_lineno_2" ') 2>/dev/null; then + $as_unset BASH_ENV || test "${BASH_ENV+set}" != set || { BASH_ENV=; export BASH_ENV; } + $as_unset ENV || test "${ENV+set}" != set || { ENV=; export ENV; } + CONFIG_SHELL=$as_dir/$as_base + export CONFIG_SHELL + exec "$CONFIG_SHELL" "$0" ${1+"$@"} + fi;; + esac + done +done +;; + esac + + # Create $as_me.lineno as a copy of $as_myself, but with $LINENO + # uniformly replaced by the line number. The first 'sed' inserts a + # line-number line before each line; the second 'sed' does the real + # work. The second script uses 'N' to pair each line-number line + # with the numbered line, and appends trailing '-' during + # substitution so that $LINENO is not a special case at line end. + # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the + # second 'sed' script. Blame Lee E. McMahon for sed's syntax. :-) + sed '=' <$as_myself | + sed ' + N + s,$,-, + : loop + s,^\(['$as_cr_digits']*\)\(.*\)[$]LINENO\([^'$as_cr_alnum'_]\),\1\2\1\3, + t loop + s,-$,, + s,^['$as_cr_digits']*\n,, + ' >$as_me.lineno && + chmod +x $as_me.lineno || + { echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2 + { (exit 1); exit 1; }; } + + # Don't try to exec as it changes $[0], causing all sort of problems + # (the dirname of $[0] is not the place where we might find the + # original and so on. Autoconf is especially sensible to this). + . ./$as_me.lineno + # Exit status is that of the last command. + exit +} + + +case `echo "testing\c"; echo 1,2,3`,`echo -n testing; echo 1,2,3` in + *c*,-n*) ECHO_N= ECHO_C=' +' ECHO_T=' ' ;; + *c*,* ) ECHO_N=-n ECHO_C= ECHO_T= ;; + *) ECHO_N= ECHO_C='\c' ECHO_T= ;; +esac + +if expr a : '\(a\)' >/dev/null 2>&1; then + as_expr=expr +else + as_expr=false +fi + +rm -f conf$$ conf$$.exe conf$$.file +echo >conf$$.file +if ln -s conf$$.file conf$$ 2>/dev/null; then + # We could just check for DJGPP; but this test a) works b) is more generic + # and c) will remain valid once DJGPP supports symlinks (DJGPP 2.04). + if test -f conf$$.exe; then + # Don't use ln at all; we don't have any links + as_ln_s='cp -p' + else + as_ln_s='ln -s' + fi +elif ln conf$$.file conf$$ 2>/dev/null; then + as_ln_s=ln +else + as_ln_s='cp -p' +fi +rm -f conf$$ conf$$.exe conf$$.file + +if mkdir -p . 2>/dev/null; then + as_mkdir_p=: +else + test -d ./-p && rmdir ./-p + as_mkdir_p=false +fi + +as_executable_p="test -f" + +# Sed expression to map a string onto a valid CPP name. +as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" + +# Sed expression to map a string onto a valid variable name. +as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" + + +# IFS +# We need space, tab and new line, in precisely that order. +as_nl=' +' +IFS=" $as_nl" + +# CDPATH. +$as_unset CDPATH + + +# Name of the host. +# hostname on some systems (SVR3.2, Linux) returns a bogus exit status, +# so uname gets run too. +ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q` + +exec 6>&1 + +# +# Initializations. +# ac_default_prefix=/usr/local -# Any additions from configure.in: -ac_help="$ac_help - --enable-threads build with threads" -ac_help="$ac_help - --enable-shared build and link with shared libraries [--enable-shared]" -ac_help="$ac_help - --enable-64bit enable 64bit support (where applicable)" -ac_help="$ac_help - --enable-wince enable Win/CE support (where applicable)" -ac_help="$ac_help - --with-celib=DIR use Windows/CE support library from DIR" -ac_help="$ac_help - --enable-symbols build with debugging symbols [--disable-symbols]" +ac_config_libobj_dir=. +cross_compiling=no +subdirs= +MFLAGS= +MAKEFLAGS= +SHELL=${CONFIG_SHELL-/bin/sh} + +# Maximum number of lines to put in a shell here document. +# This variable seems obsolete. It should probably be removed, and +# only ac_max_sed_lines should be used. +: ${ac_max_here_lines=38} + +# Identity of this package. +PACKAGE_NAME= +PACKAGE_TARNAME= +PACKAGE_VERSION= +PACKAGE_STRING= +PACKAGE_BUGREPORT= + +ac_unique_file="../generic/tcl.h" +# Factoring default headers for most tests. +ac_includes_default="\ +#include <stdio.h> +#if HAVE_SYS_TYPES_H +# include <sys/types.h> +#endif +#if HAVE_SYS_STAT_H +# include <sys/stat.h> +#endif +#if STDC_HEADERS +# include <stdlib.h> +# include <stddef.h> +#else +# if HAVE_STDLIB_H +# include <stdlib.h> +# endif +#endif +#if HAVE_STRING_H +# if !STDC_HEADERS && HAVE_MEMORY_H +# include <memory.h> +# endif +# include <string.h> +#endif +#if HAVE_STRINGS_H +# include <strings.h> +#endif +#if HAVE_INTTYPES_H +# include <inttypes.h> +#else +# if HAVE_STDINT_H +# include <stdint.h> +# endif +#endif +#if HAVE_UNISTD_H +# include <unistd.h> +#endif" + +ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT CPP EGREP AR ac_ct_AR RANLIB ac_ct_RANLIB RC ac_ct_RC SET_MAKE TCL_THREADS CYGPATH CELIB_DIR DL_LIBS CFLAGS_DEBUG CFLAGS_OPTIMIZE CFLAGS_WARNING CFLAGS_DEFAULT LDFLAGS_DEFAULT VC_MANIFEST_EMBED_DLL VC_MANIFEST_EMBED_EXE TCL_VERSION TCL_MAJOR_VERSION TCL_MINOR_VERSION TCL_PATCH_LEVEL TCL_LIB_FILE TCL_LIB_FLAG TCL_LIB_SPEC TCL_STUB_LIB_FILE TCL_STUB_LIB_FLAG TCL_STUB_LIB_SPEC TCL_STUB_LIB_PATH TCL_INCLUDE_SPEC TCL_BUILD_STUB_LIB_SPEC TCL_BUILD_STUB_LIB_PATH TCL_DLL_FILE TCL_SRC_DIR TCL_BIN_DIR TCL_DBGX CFG_TCL_SHARED_LIB_SUFFIX CFG_TCL_UNSHARED_LIB_SUFFIX CFG_TCL_EXPORT_FILE_SUFFIX EXTRA_CFLAGS DEPARG CC_OBJNAME CC_EXENAME LDFLAGS_DEBUG LDFLAGS_OPTIMIZE LDFLAGS_CONSOLE LDFLAGS_WINDOW STLIB_LD SHLIB_LD SHLIB_LD_LIBS SHLIB_CFLAGS SHLIB_SUFFIX TCL_SHARED_BUILD LIBS_GUI DLLSUFFIX LIBPREFIX LIBSUFFIX EXESUFFIX LIBRARIES MAKE_LIB POST_MAKE_LIB MAKE_DLL MAKE_EXE TCL_BUILD_LIB_SPEC TCL_LD_SEARCH_FLAGS TCL_NEEDS_EXP_FILE TCL_BUILD_EXP_FILE TCL_EXP_FILE TCL_LIB_VERSIONS_OK TCL_PACKAGE_PATH TCL_DDE_VERSION TCL_DDE_MAJOR_VERSION TCL_DDE_MINOR_VERSION TCL_DDE_PATCH_LEVEL TCL_REG_VERSION TCL_REG_MAJOR_VERSION TCL_REG_MINOR_VERSION TCL_REG_PATCH_LEVEL RC_OUT RC_TYPE RC_INCLUDE RC_DEFINE RC_DEFINES RES LIBOBJS LTLIBOBJS' +ac_subst_files='' # Initialize some variables set by options. +ac_init_help= +ac_init_version=false # The variables have the same names as the options, with # dashes changed to underlines. -build=NONE -cache_file=./config.cache +cache_file=/dev/null exec_prefix=NONE -host=NONE no_create= -nonopt=NONE no_recursion= prefix=NONE program_prefix=NONE @@ -41,10 +328,15 @@ program_transform_name=s,x,x, silent= site= srcdir= -target=NONE verbose= x_includes=NONE x_libraries=NONE + +# Installation directory options. +# These are left unexpanded so users can "make install exec_prefix=/foo" +# and all the variables that are supposed to be based on exec_prefix +# by default will actually change. +# Use braces instead of parens because sh, perl, etc. also accept them. bindir='${exec_prefix}/bin' sbindir='${exec_prefix}/sbin' libexecdir='${exec_prefix}/libexec' @@ -58,17 +350,9 @@ oldincludedir='/usr/include' infodir='${prefix}/info' mandir='${prefix}/man' -# Initialize some other variables. -subdirs= -MFLAGS= MAKEFLAGS= -SHELL=${CONFIG_SHELL-/bin/sh} -# Maximum number of lines to put in a shell here document. -ac_max_here_lines=12 - ac_prev= for ac_option do - # If the previous option needs an argument, assign it. if test -n "$ac_prev"; then eval "$ac_prev=\$ac_option" @@ -76,59 +360,59 @@ do continue fi - case "$ac_option" in - -*=*) ac_optarg=`echo "$ac_option" | sed 's/[-_a-zA-Z0-9]*=//'` ;; - *) ac_optarg= ;; - esac + ac_optarg=`expr "x$ac_option" : 'x[^=]*=\(.*\)'` # Accept the important Cygnus configure options, so we can diagnose typos. - case "$ac_option" in + case $ac_option in -bindir | --bindir | --bindi | --bind | --bin | --bi) ac_prev=bindir ;; -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*) - bindir="$ac_optarg" ;; + bindir=$ac_optarg ;; -build | --build | --buil | --bui | --bu) - ac_prev=build ;; + ac_prev=build_alias ;; -build=* | --build=* | --buil=* | --bui=* | --bu=*) - build="$ac_optarg" ;; + build_alias=$ac_optarg ;; -cache-file | --cache-file | --cache-fil | --cache-fi \ | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c) ac_prev=cache_file ;; -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \ | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*) - cache_file="$ac_optarg" ;; + cache_file=$ac_optarg ;; + + --config-cache | -C) + cache_file=config.cache ;; -datadir | --datadir | --datadi | --datad | --data | --dat | --da) ac_prev=datadir ;; -datadir=* | --datadir=* | --datadi=* | --datad=* | --data=* | --dat=* \ | --da=*) - datadir="$ac_optarg" ;; + datadir=$ac_optarg ;; -disable-* | --disable-*) - ac_feature=`echo $ac_option|sed -e 's/-*disable-//'` + ac_feature=`expr "x$ac_option" : 'x-*disable-\(.*\)'` # Reject names that are not valid shell variable names. - if test -n "`echo $ac_feature| sed 's/[-a-zA-Z0-9_]//g'`"; then - { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; } - fi - ac_feature=`echo $ac_feature| sed 's/-/_/g'` - eval "enable_${ac_feature}=no" ;; + expr "x$ac_feature" : ".*[^-_$as_cr_alnum]" >/dev/null && + { echo "$as_me: error: invalid feature name: $ac_feature" >&2 + { (exit 1); exit 1; }; } + ac_feature=`echo $ac_feature | sed 's/-/_/g'` + eval "enable_$ac_feature=no" ;; -enable-* | --enable-*) - ac_feature=`echo $ac_option|sed -e 's/-*enable-//' -e 's/=.*//'` + ac_feature=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'` # Reject names that are not valid shell variable names. - if test -n "`echo $ac_feature| sed 's/[-_a-zA-Z0-9]//g'`"; then - { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; } - fi - ac_feature=`echo $ac_feature| sed 's/-/_/g'` - case "$ac_option" in - *=*) ;; + expr "x$ac_feature" : ".*[^-_$as_cr_alnum]" >/dev/null && + { echo "$as_me: error: invalid feature name: $ac_feature" >&2 + { (exit 1); exit 1; }; } + ac_feature=`echo $ac_feature | sed 's/-/_/g'` + case $ac_option in + *=*) ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`;; *) ac_optarg=yes ;; esac - eval "enable_${ac_feature}='$ac_optarg'" ;; + eval "enable_$ac_feature='$ac_optarg'" ;; -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \ | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \ @@ -137,95 +421,47 @@ do -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \ | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \ | --exec=* | --exe=* | --ex=*) - exec_prefix="$ac_optarg" ;; + exec_prefix=$ac_optarg ;; -gas | --gas | --ga | --g) # Obsolete; use --with-gas. with_gas=yes ;; - -help | --help | --hel | --he) - # Omit some internal or obsolete options to make the list less imposing. - # This message is too long to be a string in the A/UX 3.1 sh. - cat << EOF -Usage: configure [options] [host] -Options: [defaults in brackets after descriptions] -Configuration: - --cache-file=FILE cache test results in FILE - --help print this message - --no-create do not create output files - --quiet, --silent do not print \`checking...' messages - --version print the version of autoconf that created configure -Directory and file names: - --prefix=PREFIX install architecture-independent files in PREFIX - [$ac_default_prefix] - --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX - [same as prefix] - --bindir=DIR user executables in DIR [EPREFIX/bin] - --sbindir=DIR system admin executables in DIR [EPREFIX/sbin] - --libexecdir=DIR program executables in DIR [EPREFIX/libexec] - --datadir=DIR read-only architecture-independent data in DIR - [PREFIX/share] - --sysconfdir=DIR read-only single-machine data in DIR [PREFIX/etc] - --sharedstatedir=DIR modifiable architecture-independent data in DIR - [PREFIX/com] - --localstatedir=DIR modifiable single-machine data in DIR [PREFIX/var] - --libdir=DIR object code libraries in DIR [EPREFIX/lib] - --includedir=DIR C header files in DIR [PREFIX/include] - --oldincludedir=DIR C header files for non-gcc in DIR [/usr/include] - --infodir=DIR info documentation in DIR [PREFIX/info] - --mandir=DIR man documentation in DIR [PREFIX/man] - --srcdir=DIR find the sources in DIR [configure dir or ..] - --program-prefix=PREFIX prepend PREFIX to installed program names - --program-suffix=SUFFIX append SUFFIX to installed program names - --program-transform-name=PROGRAM - run sed PROGRAM on installed program names -EOF - cat << EOF -Host type: - --build=BUILD configure for building on BUILD [BUILD=HOST] - --host=HOST configure for HOST [guessed] - --target=TARGET configure for TARGET [TARGET=HOST] -Features and packages: - --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no) - --enable-FEATURE[=ARG] include FEATURE [ARG=yes] - --with-PACKAGE[=ARG] use PACKAGE [ARG=yes] - --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no) - --x-includes=DIR X include files are in DIR - --x-libraries=DIR X library files are in DIR -EOF - if test -n "$ac_help"; then - echo "--enable and --with options recognized:$ac_help" - fi - exit 0 ;; + -help | --help | --hel | --he | -h) + ac_init_help=long ;; + -help=r* | --help=r* | --hel=r* | --he=r* | -hr*) + ac_init_help=recursive ;; + -help=s* | --help=s* | --hel=s* | --he=s* | -hs*) + ac_init_help=short ;; -host | --host | --hos | --ho) - ac_prev=host ;; + ac_prev=host_alias ;; -host=* | --host=* | --hos=* | --ho=*) - host="$ac_optarg" ;; + host_alias=$ac_optarg ;; -includedir | --includedir | --includedi | --included | --include \ | --includ | --inclu | --incl | --inc) ac_prev=includedir ;; -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \ | --includ=* | --inclu=* | --incl=* | --inc=*) - includedir="$ac_optarg" ;; + includedir=$ac_optarg ;; -infodir | --infodir | --infodi | --infod | --info | --inf) ac_prev=infodir ;; -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*) - infodir="$ac_optarg" ;; + infodir=$ac_optarg ;; -libdir | --libdir | --libdi | --libd) ac_prev=libdir ;; -libdir=* | --libdir=* | --libdi=* | --libd=*) - libdir="$ac_optarg" ;; + libdir=$ac_optarg ;; -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \ | --libexe | --libex | --libe) ac_prev=libexecdir ;; -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \ | --libexe=* | --libex=* | --libe=*) - libexecdir="$ac_optarg" ;; + libexecdir=$ac_optarg ;; -localstatedir | --localstatedir | --localstatedi | --localstated \ | --localstate | --localstat | --localsta | --localst \ @@ -234,19 +470,19 @@ EOF -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \ | --localstate=* | --localstat=* | --localsta=* | --localst=* \ | --locals=* | --local=* | --loca=* | --loc=* | --lo=*) - localstatedir="$ac_optarg" ;; + localstatedir=$ac_optarg ;; -mandir | --mandir | --mandi | --mand | --man | --ma | --m) ac_prev=mandir ;; -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*) - mandir="$ac_optarg" ;; + mandir=$ac_optarg ;; -nfp | --nfp | --nf) # Obsolete; use --without-fp. with_fp=no ;; -no-create | --no-create | --no-creat | --no-crea | --no-cre \ - | --no-cr | --no-c) + | --no-cr | --no-c | -n) no_create=yes ;; -no-recursion | --no-recursion | --no-recursio | --no-recursi \ @@ -260,26 +496,26 @@ EOF -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \ | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \ | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*) - oldincludedir="$ac_optarg" ;; + oldincludedir=$ac_optarg ;; -prefix | --prefix | --prefi | --pref | --pre | --pr | --p) ac_prev=prefix ;; -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*) - prefix="$ac_optarg" ;; + prefix=$ac_optarg ;; -program-prefix | --program-prefix | --program-prefi | --program-pref \ | --program-pre | --program-pr | --program-p) ac_prev=program_prefix ;; -program-prefix=* | --program-prefix=* | --program-prefi=* \ | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*) - program_prefix="$ac_optarg" ;; + program_prefix=$ac_optarg ;; -program-suffix | --program-suffix | --program-suffi | --program-suff \ | --program-suf | --program-su | --program-s) ac_prev=program_suffix ;; -program-suffix=* | --program-suffix=* | --program-suffi=* \ | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*) - program_suffix="$ac_optarg" ;; + program_suffix=$ac_optarg ;; -program-transform-name | --program-transform-name \ | --program-transform-nam | --program-transform-na \ @@ -296,7 +532,7 @@ EOF | --program-transfo=* | --program-transf=* \ | --program-trans=* | --program-tran=* \ | --progr-tra=* | --program-tr=* | --program-t=*) - program_transform_name="$ac_optarg" ;; + program_transform_name=$ac_optarg ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil) @@ -306,7 +542,7 @@ EOF ac_prev=sbindir ;; -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \ | --sbi=* | --sb=*) - sbindir="$ac_optarg" ;; + sbindir=$ac_optarg ;; -sharedstatedir | --sharedstatedir | --sharedstatedi \ | --sharedstated | --sharedstate | --sharedstat | --sharedsta \ @@ -317,58 +553,57 @@ EOF | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \ | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \ | --sha=* | --sh=*) - sharedstatedir="$ac_optarg" ;; + sharedstatedir=$ac_optarg ;; -site | --site | --sit) ac_prev=site ;; -site=* | --site=* | --sit=*) - site="$ac_optarg" ;; + site=$ac_optarg ;; -srcdir | --srcdir | --srcdi | --srcd | --src | --sr) ac_prev=srcdir ;; -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*) - srcdir="$ac_optarg" ;; + srcdir=$ac_optarg ;; -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \ | --syscon | --sysco | --sysc | --sys | --sy) ac_prev=sysconfdir ;; -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \ | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*) - sysconfdir="$ac_optarg" ;; + sysconfdir=$ac_optarg ;; -target | --target | --targe | --targ | --tar | --ta | --t) - ac_prev=target ;; + ac_prev=target_alias ;; -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*) - target="$ac_optarg" ;; + target_alias=$ac_optarg ;; -v | -verbose | --verbose | --verbos | --verbo | --verb) verbose=yes ;; - -version | --version | --versio | --versi | --vers) - echo "configure generated by autoconf version 2.13" - exit 0 ;; + -version | --version | --versio | --versi | --vers | -V) + ac_init_version=: ;; -with-* | --with-*) - ac_package=`echo $ac_option|sed -e 's/-*with-//' -e 's/=.*//'` + ac_package=`expr "x$ac_option" : 'x-*with-\([^=]*\)'` # Reject names that are not valid shell variable names. - if test -n "`echo $ac_package| sed 's/[-_a-zA-Z0-9]//g'`"; then - { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; } - fi + expr "x$ac_package" : ".*[^-_$as_cr_alnum]" >/dev/null && + { echo "$as_me: error: invalid package name: $ac_package" >&2 + { (exit 1); exit 1; }; } ac_package=`echo $ac_package| sed 's/-/_/g'` - case "$ac_option" in - *=*) ;; + case $ac_option in + *=*) ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`;; *) ac_optarg=yes ;; esac - eval "with_${ac_package}='$ac_optarg'" ;; + eval "with_$ac_package='$ac_optarg'" ;; -without-* | --without-*) - ac_package=`echo $ac_option|sed -e 's/-*without-//'` + ac_package=`expr "x$ac_option" : 'x-*without-\(.*\)'` # Reject names that are not valid shell variable names. - if test -n "`echo $ac_package| sed 's/[-a-zA-Z0-9_]//g'`"; then - { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; } - fi - ac_package=`echo $ac_package| sed 's/-/_/g'` - eval "with_${ac_package}=no" ;; + expr "x$ac_package" : ".*[^-_$as_cr_alnum]" >/dev/null && + { echo "$as_me: error: invalid package name: $ac_package" >&2 + { (exit 1); exit 1; }; } + ac_package=`echo $ac_package | sed 's/-/_/g'` + eval "with_$ac_package=no" ;; --x) # Obsolete; use --with-x. @@ -379,99 +614,110 @@ EOF ac_prev=x_includes ;; -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \ | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*) - x_includes="$ac_optarg" ;; + x_includes=$ac_optarg ;; -x-libraries | --x-libraries | --x-librarie | --x-librari \ | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l) ac_prev=x_libraries ;; -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \ | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*) - x_libraries="$ac_optarg" ;; + x_libraries=$ac_optarg ;; - -*) { echo "configure: error: $ac_option: invalid option; use --help to show usage" 1>&2; exit 1; } + -*) { echo "$as_me: error: unrecognized option: $ac_option +Try \`$0 --help' for more information." >&2 + { (exit 1); exit 1; }; } ;; + *=*) + ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='` + # Reject names that are not valid shell variable names. + expr "x$ac_envvar" : ".*[^_$as_cr_alnum]" >/dev/null && + { echo "$as_me: error: invalid variable name: $ac_envvar" >&2 + { (exit 1); exit 1; }; } + ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` + eval "$ac_envvar='$ac_optarg'" + export $ac_envvar ;; + *) - if test -n "`echo $ac_option| sed 's/[-a-z0-9.]//g'`"; then - echo "configure: warning: $ac_option: invalid host type" 1>&2 - fi - if test "x$nonopt" != xNONE; then - { echo "configure: error: can only configure for one host and one target at a time" 1>&2; exit 1; } - fi - nonopt="$ac_option" + # FIXME: should be removed in autoconf 3.0. + echo "$as_me: WARNING: you should use --build, --host, --target" >&2 + expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null && + echo "$as_me: WARNING: invalid host type: $ac_option" >&2 + : ${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option} ;; esac done if test -n "$ac_prev"; then - { echo "configure: error: missing argument to --`echo $ac_prev | sed 's/_/-/g'`" 1>&2; exit 1; } -fi - -trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15 - -# File descriptor usage: -# 0 standard input -# 1 file creation -# 2 errors and warnings -# 3 some systems may open it to /dev/tty -# 4 used on the Kubota Titan -# 6 checking for... messages and results -# 5 compiler messages saved in config.log -if test "$silent" = yes; then - exec 6>/dev/null -else - exec 6>&1 + ac_option=--`echo $ac_prev | sed 's/_/-/g'` + { echo "$as_me: error: missing argument to $ac_option" >&2 + { (exit 1); exit 1; }; } fi -exec 5>./config.log -echo "\ -This file contains any messages produced by compilers while -running configure, to aid debugging if configure makes a mistake. -" 1>&5 +# Be sure to have absolute paths. +for ac_var in exec_prefix prefix +do + eval ac_val=$`echo $ac_var` + case $ac_val in + [\\/$]* | ?:[\\/]* | NONE | '' ) ;; + *) { echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2 + { (exit 1); exit 1; }; };; + esac +done -# Strip out --no-create and --no-recursion so they do not pile up. -# Also quote any args containing shell metacharacters. -ac_configure_args= -for ac_arg +# Be sure to have absolute paths. +for ac_var in bindir sbindir libexecdir datadir sysconfdir sharedstatedir \ + localstatedir libdir includedir oldincludedir infodir mandir do - case "$ac_arg" in - -no-create | --no-create | --no-creat | --no-crea | --no-cre \ - | --no-cr | --no-c) ;; - -no-recursion | --no-recursion | --no-recursio | --no-recursi \ - | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) ;; - *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?]*) - ac_configure_args="$ac_configure_args '$ac_arg'" ;; - *) ac_configure_args="$ac_configure_args $ac_arg" ;; + eval ac_val=$`echo $ac_var` + case $ac_val in + [\\/$]* | ?:[\\/]* ) ;; + *) { echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2 + { (exit 1); exit 1; }; };; esac done -# NLS nuisances. -# Only set these to C if already set. These must not be set unconditionally -# because not all systems understand e.g. LANG=C (notably SCO). -# Fixing LC_MESSAGES prevents Solaris sh from translating var values in `set'! -# Non-C LC_CTYPE values break the ctype check. -if test "${LANG+set}" = set; then LANG=C; export LANG; fi -if test "${LC_ALL+set}" = set; then LC_ALL=C; export LC_ALL; fi -if test "${LC_MESSAGES+set}" = set; then LC_MESSAGES=C; export LC_MESSAGES; fi -if test "${LC_CTYPE+set}" = set; then LC_CTYPE=C; export LC_CTYPE; fi +# There might be people who depend on the old broken behavior: `$host' +# used to hold the argument of --host etc. +# FIXME: To remove some day. +build=$build_alias +host=$host_alias +target=$target_alias + +# FIXME: To remove some day. +if test "x$host_alias" != x; then + if test "x$build_alias" = x; then + cross_compiling=maybe + echo "$as_me: WARNING: If you wanted to set the --build type, don't use --host. + If a cross compiler is detected then cross compile mode will be used." >&2 + elif test "x$build_alias" != "x$host_alias"; then + cross_compiling=yes + fi +fi -# confdefs.h avoids OS command line length limits that DEFS can exceed. -rm -rf conftest* confdefs.h -# AIX cpp loses on an empty file, so make sure it contains at least a newline. -echo > confdefs.h +ac_tool_prefix= +test -n "$host_alias" && ac_tool_prefix=$host_alias- + +test "$silent" = yes && exec 6>/dev/null -# A filename unique to this package, relative to the directory that -# configure is in, which we can look for to find out if srcdir is correct. -ac_unique_file=../generic/tcl.h # Find the source files, if location was not specified. if test -z "$srcdir"; then ac_srcdir_defaulted=yes # Try the directory containing this script, then its parent. - ac_prog=$0 - ac_confdir=`echo $ac_prog|sed 's%/[^/][^/]*$%%'` - test "x$ac_confdir" = "x$ac_prog" && ac_confdir=. + ac_confdir=`(dirname "$0") 2>/dev/null || +$as_expr X"$0" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$0" : 'X\(//\)[^/]' \| \ + X"$0" : 'X\(//\)$' \| \ + X"$0" : 'X\(/\)' \| \ + . : '\(.\)' 2>/dev/null || +echo X"$0" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; } + /^X\(\/\/\)[^/].*/{ s//\1/; q; } + /^X\(\/\/\)$/{ s//\1/; q; } + /^X\(\/\).*/{ s//\1/; q; } + s/.*/./; q'` srcdir=$ac_confdir if test ! -r $srcdir/$ac_unique_file; then srcdir=.. @@ -481,13 +727,471 @@ else fi if test ! -r $srcdir/$ac_unique_file; then if test "$ac_srcdir_defaulted" = yes; then - { echo "configure: error: can not find sources in $ac_confdir or .." 1>&2; exit 1; } + { echo "$as_me: error: cannot find sources ($ac_unique_file) in $ac_confdir or .." >&2 + { (exit 1); exit 1; }; } else - { echo "configure: error: can not find sources in $srcdir" 1>&2; exit 1; } + { echo "$as_me: error: cannot find sources ($ac_unique_file) in $srcdir" >&2 + { (exit 1); exit 1; }; } fi fi -srcdir=`echo "${srcdir}" | sed 's%\([^/]\)/*$%\1%'` +(cd $srcdir && test -r ./$ac_unique_file) 2>/dev/null || + { echo "$as_me: error: sources are in $srcdir, but \`cd $srcdir' does not work" >&2 + { (exit 1); exit 1; }; } +srcdir=`echo "$srcdir" | sed 's%\([^\\/]\)[\\/]*$%\1%'` +ac_env_build_alias_set=${build_alias+set} +ac_env_build_alias_value=$build_alias +ac_cv_env_build_alias_set=${build_alias+set} +ac_cv_env_build_alias_value=$build_alias +ac_env_host_alias_set=${host_alias+set} +ac_env_host_alias_value=$host_alias +ac_cv_env_host_alias_set=${host_alias+set} +ac_cv_env_host_alias_value=$host_alias +ac_env_target_alias_set=${target_alias+set} +ac_env_target_alias_value=$target_alias +ac_cv_env_target_alias_set=${target_alias+set} +ac_cv_env_target_alias_value=$target_alias +ac_env_CC_set=${CC+set} +ac_env_CC_value=$CC +ac_cv_env_CC_set=${CC+set} +ac_cv_env_CC_value=$CC +ac_env_CFLAGS_set=${CFLAGS+set} +ac_env_CFLAGS_value=$CFLAGS +ac_cv_env_CFLAGS_set=${CFLAGS+set} +ac_cv_env_CFLAGS_value=$CFLAGS +ac_env_LDFLAGS_set=${LDFLAGS+set} +ac_env_LDFLAGS_value=$LDFLAGS +ac_cv_env_LDFLAGS_set=${LDFLAGS+set} +ac_cv_env_LDFLAGS_value=$LDFLAGS +ac_env_CPPFLAGS_set=${CPPFLAGS+set} +ac_env_CPPFLAGS_value=$CPPFLAGS +ac_cv_env_CPPFLAGS_set=${CPPFLAGS+set} +ac_cv_env_CPPFLAGS_value=$CPPFLAGS +ac_env_CPP_set=${CPP+set} +ac_env_CPP_value=$CPP +ac_cv_env_CPP_set=${CPP+set} +ac_cv_env_CPP_value=$CPP +# +# Report the --help message. +# +if test "$ac_init_help" = "long"; then + # Omit some internal or obsolete options to make the list less imposing. + # This message is too long to be a string in the A/UX 3.1 sh. + cat <<_ACEOF +\`configure' configures this package to adapt to many kinds of systems. + +Usage: $0 [OPTION]... [VAR=VALUE]... + +To assign environment variables (e.g., CC, CFLAGS...), specify them as +VAR=VALUE. See below for descriptions of some of the useful variables. + +Defaults for the options are specified in brackets. + +Configuration: + -h, --help display this help and exit + --help=short display options specific to this package + --help=recursive display the short help of all the included packages + -V, --version display version information and exit + -q, --quiet, --silent do not print \`checking...' messages + --cache-file=FILE cache test results in FILE [disabled] + -C, --config-cache alias for \`--cache-file=config.cache' + -n, --no-create do not create output files + --srcdir=DIR find the sources in DIR [configure dir or \`..'] + +_ACEOF + + cat <<_ACEOF +Installation directories: + --prefix=PREFIX install architecture-independent files in PREFIX + [$ac_default_prefix] + --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX + [PREFIX] + +By default, \`make install' will install all the files in +\`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc. You can specify +an installation prefix other than \`$ac_default_prefix' using \`--prefix', +for instance \`--prefix=\$HOME'. + +For better control, use the options below. + +Fine tuning of the installation directories: + --bindir=DIR user executables [EPREFIX/bin] + --sbindir=DIR system admin executables [EPREFIX/sbin] + --libexecdir=DIR program executables [EPREFIX/libexec] + --datadir=DIR read-only architecture-independent data [PREFIX/share] + --sysconfdir=DIR read-only single-machine data [PREFIX/etc] + --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com] + --localstatedir=DIR modifiable single-machine data [PREFIX/var] + --libdir=DIR object code libraries [EPREFIX/lib] + --includedir=DIR C header files [PREFIX/include] + --oldincludedir=DIR C header files for non-gcc [/usr/include] + --infodir=DIR info documentation [PREFIX/info] + --mandir=DIR man documentation [PREFIX/man] +_ACEOF + + cat <<\_ACEOF +_ACEOF +fi + +if test -n "$ac_init_help"; then + + cat <<\_ACEOF + +Optional Features: + --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no) + --enable-FEATURE[=ARG] include FEATURE [ARG=yes] + --enable-threads build with threads + --enable-shared build and link with shared libraries --enable-shared + --enable-64bit enable 64bit support (where applicable) + --enable-wince enable Win/CE support (where applicable) + --enable-symbols build with debugging symbols --disable-symbols + --enable-embedded-manifest + embed manifest if possible (default: yes) + +Optional Packages: + --with-PACKAGE[=ARG] use PACKAGE [ARG=yes] + --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no) + --with-encoding encoding for configuration values + --with-celib=DIR use Windows/CE support library from DIR + +Some influential environment variables: + CC C compiler command + CFLAGS C compiler flags + LDFLAGS linker flags, e.g. -L<lib dir> if you have libraries in a + nonstandard directory <lib dir> + CPPFLAGS C/C++ preprocessor flags, e.g. -I<include dir> if you have + headers in a nonstandard directory <include dir> + CPP C preprocessor + +Use these variables to override the choices made by `configure' or to help +it to find libraries and programs with nonstandard names/locations. + +_ACEOF +fi + +if test "$ac_init_help" = "recursive"; then + # If there are subdirs, report their specific --help. + ac_popdir=`pwd` + for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue + test -d $ac_dir || continue + ac_builddir=. + +if test "$ac_dir" != .; then + ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'` + # A "../" for each directory in $ac_dir_suffix. + ac_top_builddir=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,../,g'` +else + ac_dir_suffix= ac_top_builddir= +fi + +case $srcdir in + .) # No --srcdir option. We are building in place. + ac_srcdir=. + if test -z "$ac_top_builddir"; then + ac_top_srcdir=. + else + ac_top_srcdir=`echo $ac_top_builddir | sed 's,/$,,'` + fi ;; + [\\/]* | ?:[\\/]* ) # Absolute path. + ac_srcdir=$srcdir$ac_dir_suffix; + ac_top_srcdir=$srcdir ;; + *) # Relative path. + ac_srcdir=$ac_top_builddir$srcdir$ac_dir_suffix + ac_top_srcdir=$ac_top_builddir$srcdir ;; +esac + +# Do not use `cd foo && pwd` to compute absolute paths, because +# the directories may not exist. +case `pwd` in +.) ac_abs_builddir="$ac_dir";; +*) + case "$ac_dir" in + .) ac_abs_builddir=`pwd`;; + [\\/]* | ?:[\\/]* ) ac_abs_builddir="$ac_dir";; + *) ac_abs_builddir=`pwd`/"$ac_dir";; + esac;; +esac +case $ac_abs_builddir in +.) ac_abs_top_builddir=${ac_top_builddir}.;; +*) + case ${ac_top_builddir}. in + .) ac_abs_top_builddir=$ac_abs_builddir;; + [\\/]* | ?:[\\/]* ) ac_abs_top_builddir=${ac_top_builddir}.;; + *) ac_abs_top_builddir=$ac_abs_builddir/${ac_top_builddir}.;; + esac;; +esac +case $ac_abs_builddir in +.) ac_abs_srcdir=$ac_srcdir;; +*) + case $ac_srcdir in + .) ac_abs_srcdir=$ac_abs_builddir;; + [\\/]* | ?:[\\/]* ) ac_abs_srcdir=$ac_srcdir;; + *) ac_abs_srcdir=$ac_abs_builddir/$ac_srcdir;; + esac;; +esac +case $ac_abs_builddir in +.) ac_abs_top_srcdir=$ac_top_srcdir;; +*) + case $ac_top_srcdir in + .) ac_abs_top_srcdir=$ac_abs_builddir;; + [\\/]* | ?:[\\/]* ) ac_abs_top_srcdir=$ac_top_srcdir;; + *) ac_abs_top_srcdir=$ac_abs_builddir/$ac_top_srcdir;; + esac;; +esac + + cd $ac_dir + # Check for guested configure; otherwise get Cygnus style configure. + if test -f $ac_srcdir/configure.gnu; then + echo + $SHELL $ac_srcdir/configure.gnu --help=recursive + elif test -f $ac_srcdir/configure; then + echo + $SHELL $ac_srcdir/configure --help=recursive + elif test -f $ac_srcdir/configure.ac || + test -f $ac_srcdir/configure.in; then + echo + $ac_configure --help + else + echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2 + fi + cd $ac_popdir + done +fi + +test -n "$ac_init_help" && exit 0 +if $ac_init_version; then + cat <<\_ACEOF + +Copyright (C) 2003 Free Software Foundation, Inc. +This configure script is free software; the Free Software Foundation +gives unlimited permission to copy, distribute and modify it. +_ACEOF + exit 0 +fi +exec 5>config.log +cat >&5 <<_ACEOF +This file contains any messages produced by compilers while +running configure, to aid debugging if configure makes a mistake. + +It was created by $as_me, which was +generated by GNU Autoconf 2.59. Invocation command line was + + $ $0 $@ + +_ACEOF +{ +cat <<_ASUNAME +## --------- ## +## Platform. ## +## --------- ## + +hostname = `(hostname || uname -n) 2>/dev/null | sed 1q` +uname -m = `(uname -m) 2>/dev/null || echo unknown` +uname -r = `(uname -r) 2>/dev/null || echo unknown` +uname -s = `(uname -s) 2>/dev/null || echo unknown` +uname -v = `(uname -v) 2>/dev/null || echo unknown` + +/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown` +/bin/uname -X = `(/bin/uname -X) 2>/dev/null || echo unknown` + +/bin/arch = `(/bin/arch) 2>/dev/null || echo unknown` +/usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null || echo unknown` +/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown` +hostinfo = `(hostinfo) 2>/dev/null || echo unknown` +/bin/machine = `(/bin/machine) 2>/dev/null || echo unknown` +/usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null || echo unknown` +/bin/universe = `(/bin/universe) 2>/dev/null || echo unknown` + +_ASUNAME + +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + echo "PATH: $as_dir" +done + +} >&5 + +cat >&5 <<_ACEOF + + +## ----------- ## +## Core tests. ## +## ----------- ## + +_ACEOF + + +# Keep a trace of the command line. +# Strip out --no-create and --no-recursion so they do not pile up. +# Strip out --silent because we don't want to record it for future runs. +# Also quote any args containing shell meta-characters. +# Make two passes to allow for proper duplicate-argument suppression. +ac_configure_args= +ac_configure_args0= +ac_configure_args1= +ac_sep= +ac_must_keep_next=false +for ac_pass in 1 2 +do + for ac_arg + do + case $ac_arg in + -no-create | --no-c* | -n | -no-recursion | --no-r*) continue ;; + -q | -quiet | --quiet | --quie | --qui | --qu | --q \ + | -silent | --silent | --silen | --sile | --sil) + continue ;; + *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?\"\']*) + ac_arg=`echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;; + esac + case $ac_pass in + 1) ac_configure_args0="$ac_configure_args0 '$ac_arg'" ;; + 2) + ac_configure_args1="$ac_configure_args1 '$ac_arg'" + if test $ac_must_keep_next = true; then + ac_must_keep_next=false # Got value, back to normal. + else + case $ac_arg in + *=* | --config-cache | -C | -disable-* | --disable-* \ + | -enable-* | --enable-* | -gas | --g* | -nfp | --nf* \ + | -q | -quiet | --q* | -silent | --sil* | -v | -verb* \ + | -with-* | --with-* | -without-* | --without-* | --x) + case "$ac_configure_args0 " in + "$ac_configure_args1"*" '$ac_arg' "* ) continue ;; + esac + ;; + -* ) ac_must_keep_next=true ;; + esac + fi + ac_configure_args="$ac_configure_args$ac_sep'$ac_arg'" + # Get rid of the leading space. + ac_sep=" " + ;; + esac + done +done +$as_unset ac_configure_args0 || test "${ac_configure_args0+set}" != set || { ac_configure_args0=; export ac_configure_args0; } +$as_unset ac_configure_args1 || test "${ac_configure_args1+set}" != set || { ac_configure_args1=; export ac_configure_args1; } + +# When interrupted or exit'd, cleanup temporary files, and complete +# config.log. We remove comments because anyway the quotes in there +# would cause problems or look ugly. +# WARNING: Be sure not to use single quotes in there, as some shells, +# such as our DU 5.0 friend, will then `close' the trap. +trap 'exit_status=$? + # Save into config.log some information that might help in debugging. + { + echo + + cat <<\_ASBOX +## ---------------- ## +## Cache variables. ## +## ---------------- ## +_ASBOX + echo + # The following way of writing the cache mishandles newlines in values, +{ + (set) 2>&1 | + case `(ac_space='"'"' '"'"'; set | grep ac_space) 2>&1` in + *ac_space=\ *) + sed -n \ + "s/'"'"'/'"'"'\\\\'"'"''"'"'/g; + s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='"'"'\\2'"'"'/p" + ;; + *) + sed -n \ + "s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1=\\2/p" + ;; + esac; +} + echo + + cat <<\_ASBOX +## ----------------- ## +## Output variables. ## +## ----------------- ## +_ASBOX + echo + for ac_var in $ac_subst_vars + do + eval ac_val=$`echo $ac_var` + echo "$ac_var='"'"'$ac_val'"'"'" + done | sort + echo + + if test -n "$ac_subst_files"; then + cat <<\_ASBOX +## ------------- ## +## Output files. ## +## ------------- ## +_ASBOX + echo + for ac_var in $ac_subst_files + do + eval ac_val=$`echo $ac_var` + echo "$ac_var='"'"'$ac_val'"'"'" + done | sort + echo + fi + + if test -s confdefs.h; then + cat <<\_ASBOX +## ----------- ## +## confdefs.h. ## +## ----------- ## +_ASBOX + echo + sed "/^$/d" confdefs.h | sort + echo + fi + test "$ac_signal" != 0 && + echo "$as_me: caught signal $ac_signal" + echo "$as_me: exit $exit_status" + } >&5 + rm -f core *.core && + rm -rf conftest* confdefs* conf$$* $ac_clean_files && + exit $exit_status + ' 0 +for ac_signal in 1 2 13 15; do + trap 'ac_signal='$ac_signal'; { (exit 1); exit 1; }' $ac_signal +done +ac_signal=0 + +# confdefs.h avoids OS command line length limits that DEFS can exceed. +rm -rf conftest* confdefs.h +# AIX cpp loses on an empty file, so make sure it contains at least a newline. +echo >confdefs.h + +# Predefined preprocessor variables. + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_NAME "$PACKAGE_NAME" +_ACEOF + + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_TARNAME "$PACKAGE_TARNAME" +_ACEOF + + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_VERSION "$PACKAGE_VERSION" +_ACEOF + + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_STRING "$PACKAGE_STRING" +_ACEOF + + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT" +_ACEOF + + +# Let the site file select an alternate cache file if it wants to. # Prefer explicitly selected file to automatically selected ones. if test -z "$CONFIG_SITE"; then if test "x$prefix" != xNONE; then @@ -498,57 +1202,128 @@ if test -z "$CONFIG_SITE"; then fi for ac_site_file in $CONFIG_SITE; do if test -r "$ac_site_file"; then - echo "loading site script $ac_site_file" + { echo "$as_me:$LINENO: loading site script $ac_site_file" >&5 +echo "$as_me: loading site script $ac_site_file" >&6;} + sed 's/^/| /' "$ac_site_file" >&5 . "$ac_site_file" fi done if test -r "$cache_file"; then - echo "loading cache $cache_file" - . $cache_file + # Some versions of bash will fail to source /dev/null (special + # files actually), so we avoid doing that. + if test -f "$cache_file"; then + { echo "$as_me:$LINENO: loading cache $cache_file" >&5 +echo "$as_me: loading cache $cache_file" >&6;} + case $cache_file in + [\\/]* | ?:[\\/]* ) . $cache_file;; + *) . ./$cache_file;; + esac + fi else - echo "creating cache $cache_file" - > $cache_file + { echo "$as_me:$LINENO: creating cache $cache_file" >&5 +echo "$as_me: creating cache $cache_file" >&6;} + >$cache_file fi -ac_ext=c -# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options. -ac_cpp='$CPP $CPPFLAGS' -ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5' -ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5' -cross_compiling=$ac_cv_prog_cc_cross - -ac_exeext= -ac_objext=o -if (echo "testing\c"; echo 1,2,3) | grep c >/dev/null; then - # Stardent Vistra SVR4 grep lacks -e, says ghazi@caip.rutgers.edu. - if (echo -n testing; echo 1,2,3) | sed s/-n/xn/ | grep xn >/dev/null; then - ac_n= ac_c=' -' ac_t=' ' - else - ac_n=-n ac_c= ac_t= +# Check that the precious variables saved in the cache have kept the same +# value. +ac_cache_corrupted=false +for ac_var in `(set) 2>&1 | + sed -n 's/^ac_env_\([a-zA-Z_0-9]*\)_set=.*/\1/p'`; do + eval ac_old_set=\$ac_cv_env_${ac_var}_set + eval ac_new_set=\$ac_env_${ac_var}_set + eval ac_old_val="\$ac_cv_env_${ac_var}_value" + eval ac_new_val="\$ac_env_${ac_var}_value" + case $ac_old_set,$ac_new_set in + set,) + { echo "$as_me:$LINENO: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5 +echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;} + ac_cache_corrupted=: ;; + ,set) + { echo "$as_me:$LINENO: error: \`$ac_var' was not set in the previous run" >&5 +echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;} + ac_cache_corrupted=: ;; + ,);; + *) + if test "x$ac_old_val" != "x$ac_new_val"; then + { echo "$as_me:$LINENO: error: \`$ac_var' has changed since the previous run:" >&5 +echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;} + { echo "$as_me:$LINENO: former value: $ac_old_val" >&5 +echo "$as_me: former value: $ac_old_val" >&2;} + { echo "$as_me:$LINENO: current value: $ac_new_val" >&5 +echo "$as_me: current value: $ac_new_val" >&2;} + ac_cache_corrupted=: + fi;; + esac + # Pass precious variables to config.status. + if test "$ac_new_set" = set; then + case $ac_new_val in + *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?\"\']*) + ac_arg=$ac_var=`echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;; + *) ac_arg=$ac_var=$ac_new_val ;; + esac + case " $ac_configure_args " in + *" '$ac_arg' "*) ;; # Avoid dups. Use of quotes ensures accuracy. + *) ac_configure_args="$ac_configure_args '$ac_arg'" ;; + esac fi -else - ac_n= ac_c='\c' ac_t= +done +if $ac_cache_corrupted; then + { echo "$as_me:$LINENO: error: changes in the environment can compromise the build" >&5 +echo "$as_me: error: changes in the environment can compromise the build" >&2;} + { { echo "$as_me:$LINENO: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&5 +echo "$as_me: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&2;} + { (exit 1); exit 1; }; } fi +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + + + + + + + + -TCL_VERSION=8.4 + + + + + + + + + +# The following define is needed when building with Cygwin since newer +# versions of autoconf incorrectly set SHELL to /bin/bash instead of +# /bin/sh. The bash shell seems to suffer from some strange failures. +SHELL=/bin/sh + +TCL_VERSION=8.5 TCL_MAJOR_VERSION=8 -TCL_MINOR_VERSION=4 -TCL_PATCH_LEVEL=".19" +TCL_MINOR_VERSION=5 +TCL_PATCH_LEVEL=".10" VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION -TCL_DDE_VERSION=1.2 +TCL_DDE_VERSION=1.3 TCL_DDE_MAJOR_VERSION=1 -TCL_DDE_MINOR_VERSION=2 +TCL_DDE_MINOR_VERSION=3 +TCL_DDE_PATCH_LEVEL="2" DDEVER=$TCL_DDE_MAJOR_VERSION$TCL_DDE_MINOR_VERSION -TCL_REG_VERSION=1.1 +TCL_REG_VERSION=1.2 TCL_REG_MAJOR_VERSION=1 -TCL_REG_MINOR_VERSION=1 +TCL_REG_MINOR_VERSION=2 +TCL_REG_PATCH_LEVEL="1" REGVER=$TCL_REG_MAJOR_VERSION$TCL_REG_MINOR_VERSION #------------------------------------------------------------------------ @@ -574,214 +1349,659 @@ if test "${CFLAGS+set}" != "set" ; then CFLAGS="" fi -# Extract the first word of "gcc", so it can be a program name with args. +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu +if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}gcc", so it can be a program name with args. +set dummy ${ac_tool_prefix}gcc; ac_word=$2 +echo "$as_me:$LINENO: checking for $ac_word" >&5 +echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 +if test "${ac_cv_prog_CC+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_CC="${ac_tool_prefix}gcc" + echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done +done + +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + echo "$as_me:$LINENO: result: $CC" >&5 +echo "${ECHO_T}$CC" >&6 +else + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 +fi + +fi +if test -z "$ac_cv_prog_CC"; then + ac_ct_CC=$CC + # Extract the first word of "gcc", so it can be a program name with args. set dummy gcc; ac_word=$2 -echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:581: checking for $ac_word" >&5 -if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 +echo "$as_me:$LINENO: checking for $ac_word" >&5 +echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 +if test "${ac_cv_prog_ac_ct_CC+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + if test -n "$ac_ct_CC"; then + ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_CC="gcc" + echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done +done + +fi +fi +ac_ct_CC=$ac_cv_prog_ac_ct_CC +if test -n "$ac_ct_CC"; then + echo "$as_me:$LINENO: result: $ac_ct_CC" >&5 +echo "${ECHO_T}$ac_ct_CC" >&6 +else + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 +fi + + CC=$ac_ct_CC +else + CC="$ac_cv_prog_CC" +fi + +if test -z "$CC"; then + if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}cc", so it can be a program name with args. +set dummy ${ac_tool_prefix}cc; ac_word=$2 +echo "$as_me:$LINENO: checking for $ac_word" >&5 +echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 +if test "${ac_cv_prog_CC+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else - IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":" - ac_dummy="$PATH" - for ac_dir in $ac_dummy; do - test -z "$ac_dir" && ac_dir=. - if test -f $ac_dir/$ac_word; then - ac_cv_prog_CC="gcc" - break - fi - done - IFS="$ac_save_ifs" +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_CC="${ac_tool_prefix}cc" + echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done +done + fi fi -CC="$ac_cv_prog_CC" +CC=$ac_cv_prog_CC if test -n "$CC"; then - echo "$ac_t""$CC" 1>&6 + echo "$as_me:$LINENO: result: $CC" >&5 +echo "${ECHO_T}$CC" >&6 else - echo "$ac_t""no" 1>&6 + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 fi +fi +if test -z "$ac_cv_prog_CC"; then + ac_ct_CC=$CC + # Extract the first word of "cc", so it can be a program name with args. +set dummy cc; ac_word=$2 +echo "$as_me:$LINENO: checking for $ac_word" >&5 +echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 +if test "${ac_cv_prog_ac_ct_CC+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + if test -n "$ac_ct_CC"; then + ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_CC="cc" + echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done +done + +fi +fi +ac_ct_CC=$ac_cv_prog_ac_ct_CC +if test -n "$ac_ct_CC"; then + echo "$as_me:$LINENO: result: $ac_ct_CC" >&5 +echo "${ECHO_T}$ac_ct_CC" >&6 +else + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 +fi + + CC=$ac_ct_CC +else + CC="$ac_cv_prog_CC" +fi + +fi if test -z "$CC"; then # Extract the first word of "cc", so it can be a program name with args. set dummy cc; ac_word=$2 -echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:611: checking for $ac_word" >&5 -if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 +echo "$as_me:$LINENO: checking for $ac_word" >&5 +echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 +if test "${ac_cv_prog_CC+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else - IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":" ac_prog_rejected=no - ac_dummy="$PATH" - for ac_dir in $ac_dummy; do - test -z "$ac_dir" && ac_dir=. - if test -f $ac_dir/$ac_word; then - if test "$ac_dir/$ac_word" = "/usr/ucb/cc"; then - ac_prog_rejected=yes - continue - fi - ac_cv_prog_CC="cc" - break - fi - done - IFS="$ac_save_ifs" +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + if test "$as_dir/$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then + ac_prog_rejected=yes + continue + fi + ac_cv_prog_CC="cc" + echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done +done + if test $ac_prog_rejected = yes; then # We found a bogon in the path, so make sure we never use it. set dummy $ac_cv_prog_CC shift - if test $# -gt 0; then + if test $# != 0; then # We chose a different compiler from the bogus one. # However, it has the same basename, so the bogon will be chosen # first if we set CC to just the basename; use the full file name. shift - set dummy "$ac_dir/$ac_word" "$@" - shift - ac_cv_prog_CC="$@" + ac_cv_prog_CC="$as_dir/$ac_word${1+' '}$@" fi fi fi fi -CC="$ac_cv_prog_CC" +CC=$ac_cv_prog_CC if test -n "$CC"; then - echo "$ac_t""$CC" 1>&6 + echo "$as_me:$LINENO: result: $CC" >&5 +echo "${ECHO_T}$CC" >&6 else - echo "$ac_t""no" 1>&6 + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 fi - if test -z "$CC"; then - case "`uname -s`" in - *win32* | *WIN32*) - # Extract the first word of "cl", so it can be a program name with args. -set dummy cl; ac_word=$2 -echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:662: checking for $ac_word" >&5 -if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 +fi +if test -z "$CC"; then + if test -n "$ac_tool_prefix"; then + for ac_prog in cl + do + # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args. +set dummy $ac_tool_prefix$ac_prog; ac_word=$2 +echo "$as_me:$LINENO: checking for $ac_word" >&5 +echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 +if test "${ac_cv_prog_CC+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else - IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":" - ac_dummy="$PATH" - for ac_dir in $ac_dummy; do - test -z "$ac_dir" && ac_dir=. - if test -f $ac_dir/$ac_word; then - ac_cv_prog_CC="cl" - break - fi - done - IFS="$ac_save_ifs" +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_CC="$ac_tool_prefix$ac_prog" + echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done +done + fi fi -CC="$ac_cv_prog_CC" +CC=$ac_cv_prog_CC if test -n "$CC"; then - echo "$ac_t""$CC" 1>&6 + echo "$as_me:$LINENO: result: $CC" >&5 +echo "${ECHO_T}$CC" >&6 else - echo "$ac_t""no" 1>&6 + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 fi - ;; - esac + + test -n "$CC" && break + done +fi +if test -z "$CC"; then + ac_ct_CC=$CC + for ac_prog in cl +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +echo "$as_me:$LINENO: checking for $ac_word" >&5 +echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 +if test "${ac_cv_prog_ac_ct_CC+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + if test -n "$ac_ct_CC"; then + ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_CC="$ac_prog" + echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 fi - test -z "$CC" && { echo "configure: error: no acceptable cc found in \$PATH" 1>&2; exit 1; } +done +done + +fi +fi +ac_ct_CC=$ac_cv_prog_ac_ct_CC +if test -n "$ac_ct_CC"; then + echo "$as_me:$LINENO: result: $ac_ct_CC" >&5 +echo "${ECHO_T}$ac_ct_CC" >&6 +else + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 fi -echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works""... $ac_c" 1>&6 -echo "configure:694: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works" >&5 + test -n "$ac_ct_CC" && break +done -ac_ext=c -# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options. -ac_cpp='$CPP $CPPFLAGS' -ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5' -ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5' -cross_compiling=$ac_cv_prog_cc_cross - -cat > conftest.$ac_ext << EOF - -#line 705 "configure" -#include "confdefs.h" - -main(){return(0);} -EOF -if { (eval echo configure:710: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - ac_cv_prog_cc_works=yes - # If we can't run a trivial program, we are probably using a cross compiler. - if (./conftest; exit) 2>/dev/null; then - ac_cv_prog_cc_cross=no + CC=$ac_ct_CC +fi + +fi + + +test -z "$CC" && { { echo "$as_me:$LINENO: error: no acceptable C compiler found in \$PATH +See \`config.log' for more details." >&5 +echo "$as_me: error: no acceptable C compiler found in \$PATH +See \`config.log' for more details." >&2;} + { (exit 1); exit 1; }; } + +# Provide some information about the compiler. +echo "$as_me:$LINENO:" \ + "checking for C compiler version" >&5 +ac_compiler=`set X $ac_compile; echo $2` +{ (eval echo "$as_me:$LINENO: \"$ac_compiler --version </dev/null >&5\"") >&5 + (eval $ac_compiler --version </dev/null >&5) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } +{ (eval echo "$as_me:$LINENO: \"$ac_compiler -v </dev/null >&5\"") >&5 + (eval $ac_compiler -v </dev/null >&5) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } +{ (eval echo "$as_me:$LINENO: \"$ac_compiler -V </dev/null >&5\"") >&5 + (eval $ac_compiler -V </dev/null >&5) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } + +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +ac_clean_files_save=$ac_clean_files +ac_clean_files="$ac_clean_files a.out a.exe b.out" +# Try to create an executable without -o first, disregard a.out. +# It will help us diagnose broken compilers, and finding out an intuition +# of exeext. +echo "$as_me:$LINENO: checking for C compiler default output file name" >&5 +echo $ECHO_N "checking for C compiler default output file name... $ECHO_C" >&6 +ac_link_default=`echo "$ac_link" | sed 's/ -o *conftest[^ ]*//'` +if { (eval echo "$as_me:$LINENO: \"$ac_link_default\"") >&5 + (eval $ac_link_default) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; then + # Find the output, starting from the most likely. This scheme is +# not robust to junk in `.', hence go to wildcards (a.*) only as a last +# resort. + +# Be careful to initialize this variable, since it used to be cached. +# Otherwise an old cache value of `no' led to `EXEEXT = no' in a Makefile. +ac_cv_exeext= +# b.out is created by i960 compilers. +for ac_file in a_out.exe a.exe conftest.exe a.out conftest a.* conftest.* b.out +do + test -f "$ac_file" || continue + case $ac_file in + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.o | *.obj ) + ;; + conftest.$ac_ext ) + # This is the source file. + ;; + [ab].out ) + # We found the default executable, but exeext='' is most + # certainly right. + break;; + *.* ) + ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` + # FIXME: I believe we export ac_cv_exeext for Libtool, + # but it would be cool to find out if it's true. Does anybody + # maintain Libtool? --akim. + export ac_cv_exeext + break;; + * ) + break;; + esac +done +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +{ { echo "$as_me:$LINENO: error: C compiler cannot create executables +See \`config.log' for more details." >&5 +echo "$as_me: error: C compiler cannot create executables +See \`config.log' for more details." >&2;} + { (exit 77); exit 77; }; } +fi + +ac_exeext=$ac_cv_exeext +echo "$as_me:$LINENO: result: $ac_file" >&5 +echo "${ECHO_T}$ac_file" >&6 + +# Check the compiler produces executables we can run. If not, either +# the compiler is broken, or we cross compile. +echo "$as_me:$LINENO: checking whether the C compiler works" >&5 +echo $ECHO_N "checking whether the C compiler works... $ECHO_C" >&6 +# FIXME: These cross compiler hacks should be removed for Autoconf 3.0 +# If not cross compiling, check that we can run a simple program. +if test "$cross_compiling" != yes; then + if { ac_try='./$ac_file' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + cross_compiling=no else - ac_cv_prog_cc_cross=yes + if test "$cross_compiling" = maybe; then + cross_compiling=yes + else + { { echo "$as_me:$LINENO: error: cannot run C compiled programs. +If you meant to cross compile, use \`--host'. +See \`config.log' for more details." >&5 +echo "$as_me: error: cannot run C compiled programs. +If you meant to cross compile, use \`--host'. +See \`config.log' for more details." >&2;} + { (exit 1); exit 1; }; } + fi fi -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - ac_cv_prog_cc_works=no fi -rm -fr conftest* -ac_ext=c -# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options. -ac_cpp='$CPP $CPPFLAGS' -ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5' -ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5' -cross_compiling=$ac_cv_prog_cc_cross - -echo "$ac_t""$ac_cv_prog_cc_works" 1>&6 -if test $ac_cv_prog_cc_works = no; then - { echo "configure: error: installation or configuration problem: C compiler cannot create executables." 1>&2; exit 1; } -fi -echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler""... $ac_c" 1>&6 -echo "configure:736: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler" >&5 -echo "$ac_t""$ac_cv_prog_cc_cross" 1>&6 -cross_compiling=$ac_cv_prog_cc_cross - -echo $ac_n "checking whether we are using GNU C""... $ac_c" 1>&6 -echo "configure:741: checking whether we are using GNU C" >&5 -if eval "test \"`echo '$''{'ac_cv_prog_gcc'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - cat > conftest.c <<EOF -#ifdef __GNUC__ - yes; -#endif -EOF -if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:750: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then - ac_cv_prog_gcc=yes +echo "$as_me:$LINENO: result: yes" >&5 +echo "${ECHO_T}yes" >&6 + +rm -f a.out a.exe conftest$ac_cv_exeext b.out +ac_clean_files=$ac_clean_files_save +# Check the compiler produces executables we can run. If not, either +# the compiler is broken, or we cross compile. +echo "$as_me:$LINENO: checking whether we are cross compiling" >&5 +echo $ECHO_N "checking whether we are cross compiling... $ECHO_C" >&6 +echo "$as_me:$LINENO: result: $cross_compiling" >&5 +echo "${ECHO_T}$cross_compiling" >&6 + +echo "$as_me:$LINENO: checking for suffix of executables" >&5 +echo $ECHO_N "checking for suffix of executables... $ECHO_C" >&6 +if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; then + # If both `conftest.exe' and `conftest' are `present' (well, observable) +# catch `conftest.exe'. For instance with Cygwin, `ls conftest' will +# work properly (i.e., refer to `conftest.exe'), while it won't with +# `rm'. +for ac_file in conftest.exe conftest conftest.*; do + test -f "$ac_file" || continue + case $ac_file in + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.o | *.obj ) ;; + *.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` + export ac_cv_exeext + break;; + * ) break;; + esac +done else - ac_cv_prog_gcc=no -fi + { { echo "$as_me:$LINENO: error: cannot compute suffix of executables: cannot compile and link +See \`config.log' for more details." >&5 +echo "$as_me: error: cannot compute suffix of executables: cannot compile and link +See \`config.log' for more details." >&2;} + { (exit 1); exit 1; }; } fi -echo "$ac_t""$ac_cv_prog_gcc" 1>&6 +rm -f conftest$ac_cv_exeext +echo "$as_me:$LINENO: result: $ac_cv_exeext" >&5 +echo "${ECHO_T}$ac_cv_exeext" >&6 -if test $ac_cv_prog_gcc = yes; then - GCC=yes +rm -f conftest.$ac_ext +EXEEXT=$ac_cv_exeext +ac_exeext=$EXEEXT +echo "$as_me:$LINENO: checking for suffix of object files" >&5 +echo $ECHO_N "checking for suffix of object files... $ECHO_C" >&6 +if test "${ac_cv_objext+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +rm -f conftest.o conftest.obj +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; then + for ac_file in `(ls conftest.o conftest.obj; ls conftest.*) 2>/dev/null`; do + case $ac_file in + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg ) ;; + *) ac_cv_objext=`expr "$ac_file" : '.*\.\(.*\)'` + break;; + esac +done else - GCC= + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +{ { echo "$as_me:$LINENO: error: cannot compute suffix of object files: cannot compile +See \`config.log' for more details." >&5 +echo "$as_me: error: cannot compute suffix of object files: cannot compile +See \`config.log' for more details." >&2;} + { (exit 1); exit 1; }; } fi -ac_test_CFLAGS="${CFLAGS+set}" -ac_save_CFLAGS="$CFLAGS" -CFLAGS= -echo $ac_n "checking whether ${CC-cc} accepts -g""... $ac_c" 1>&6 -echo "configure:769: checking whether ${CC-cc} accepts -g" >&5 -if eval "test \"`echo '$''{'ac_cv_prog_cc_g'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 +rm -f conftest.$ac_cv_objext conftest.$ac_ext +fi +echo "$as_me:$LINENO: result: $ac_cv_objext" >&5 +echo "${ECHO_T}$ac_cv_objext" >&6 +OBJEXT=$ac_cv_objext +ac_objext=$OBJEXT +echo "$as_me:$LINENO: checking whether we are using the GNU C compiler" >&5 +echo $ECHO_N "checking whether we are using the GNU C compiler... $ECHO_C" >&6 +if test "${ac_cv_c_compiler_gnu+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else - echo 'void f(){}' > conftest.c -if test -z "`${CC-cc} -g -c conftest.c 2>&1`"; then - ac_cv_prog_cc_g=yes + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ + +int +main () +{ +#ifndef __GNUC__ + choke me +#endif + + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_compiler_gnu=yes else - ac_cv_prog_cc_g=no + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_compiler_gnu=no fi -rm -f conftest* +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +ac_cv_c_compiler_gnu=$ac_compiler_gnu fi +echo "$as_me:$LINENO: result: $ac_cv_c_compiler_gnu" >&5 +echo "${ECHO_T}$ac_cv_c_compiler_gnu" >&6 +GCC=`test $ac_compiler_gnu = yes && echo yes` +ac_test_CFLAGS=${CFLAGS+set} +ac_save_CFLAGS=$CFLAGS +CFLAGS="-g" +echo "$as_me:$LINENO: checking whether $CC accepts -g" >&5 +echo $ECHO_N "checking whether $CC accepts -g... $ECHO_C" >&6 +if test "${ac_cv_prog_cc_g+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_prog_cc_g=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 -echo "$ac_t""$ac_cv_prog_cc_g" 1>&6 +ac_cv_prog_cc_g=no +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +fi +echo "$as_me:$LINENO: result: $ac_cv_prog_cc_g" >&5 +echo "${ECHO_T}$ac_cv_prog_cc_g" >&6 if test "$ac_test_CFLAGS" = set; then - CFLAGS="$ac_save_CFLAGS" + CFLAGS=$ac_save_CFLAGS elif test $ac_cv_prog_cc_g = yes; then if test "$GCC" = yes; then CFLAGS="-g -O2" @@ -795,143 +2015,1027 @@ else CFLAGS= fi fi +echo "$as_me:$LINENO: checking for $CC option to accept ANSI C" >&5 +echo $ECHO_N "checking for $CC option to accept ANSI C... $ECHO_C" >&6 +if test "${ac_cv_prog_cc_stdc+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + ac_cv_prog_cc_stdc=no +ac_save_CC=$CC +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#include <stdarg.h> +#include <stdio.h> +#include <sys/types.h> +#include <sys/stat.h> +/* Most of the following tests are stolen from RCS 5.7's src/conf.sh. */ +struct buf { int x; }; +FILE * (*rcsopen) (struct buf *, struct stat *, int); +static char *e (p, i) + char **p; + int i; +{ + return p[i]; +} +static char *f (char * (*g) (char **, int), char **p, ...) +{ + char *s; + va_list v; + va_start (v,p); + s = g (p, va_arg (v,int)); + va_end (v); + return s; +} +/* OSF 4.0 Compaq cc is some sort of almost-ANSI by default. It has + function prototypes and stuff, but not '\xHH' hex character constants. + These don't provoke an error unfortunately, instead are silently treated + as 'x'. The following induces an error, until -std1 is added to get + proper ANSI mode. Curiously '\x00'!='x' always comes out true, for an + array size at least. It's necessary to write '\x00'==0 to get something + that's true only with -std1. */ +int osf4_cc_array ['\x00' == 0 ? 1 : -1]; + +int test (int i, double x); +struct s1 {int (*f) (int a);}; +struct s2 {int (*f) (double a);}; +int pairnames (int, char **, FILE *(*)(struct buf *, struct stat *, int), int, int); +int argc; +char **argv; +int +main () +{ +return f (e, argv, 0) != argv[0] || f (e, argv, 1) != argv[1]; + ; + return 0; +} +_ACEOF +# Don't try gcc -ansi; that turns off useful extensions and +# breaks some systems' header files. +# AIX -qlanglvl=ansi +# Ultrix and OSF/1 -std1 +# HP-UX 10.20 and later -Ae +# HP-UX older versions -Aa -D_HPUX_SOURCE +# SVR4 -Xc -D__EXTENSIONS__ +for ac_arg in "" -qlanglvl=ansi -std1 -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__" +do + CC="$ac_save_CC $ac_arg" + rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_prog_cc_stdc=$ac_arg +break +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 -# To properly support cross-compilation, one would -# need to use these tool checks instead of -# the ones below and reconfigure with -# autoconf 2.50. You can also just set -# the CC, AR, RANLIB, and RC environment -# variables if you want to cross compile. +fi +rm -f conftest.err conftest.$ac_objext +done +rm -f conftest.$ac_ext conftest.$ac_objext +CC=$ac_save_CC -if test "${GCC}" = "yes" ; then - # Extract the first word of "ar", so it can be a program name with args. -set dummy ar; ac_word=$2 -echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:812: checking for $ac_word" >&5 -if eval "test \"`echo '$''{'ac_cv_prog_AR'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 +fi + +case "x$ac_cv_prog_cc_stdc" in + x|xno) + echo "$as_me:$LINENO: result: none needed" >&5 +echo "${ECHO_T}none needed" >&6 ;; + *) + echo "$as_me:$LINENO: result: $ac_cv_prog_cc_stdc" >&5 +echo "${ECHO_T}$ac_cv_prog_cc_stdc" >&6 + CC="$CC $ac_cv_prog_cc_stdc" ;; +esac + +# Some people use a C++ compiler to compile C. Since we use `exit', +# in C++ we need to declare it. In case someone uses the same compiler +# for both compiling C and C++ we need to have the C++ compiler decide +# the declaration of exit, since it's the most demanding environment. +cat >conftest.$ac_ext <<_ACEOF +#ifndef __cplusplus + choke me +#endif +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + for ac_declaration in \ + '' \ + 'extern "C" void std::exit (int) throw (); using std::exit;' \ + 'extern "C" void std::exit (int); using std::exit;' \ + 'extern "C" void exit (int) throw ();' \ + 'extern "C" void exit (int);' \ + 'void exit (int);' +do + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +$ac_declaration +#include <stdlib.h> +int +main () +{ +exit (42); + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + : +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +continue +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +$ac_declaration +int +main () +{ +exit (42); + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + break +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +done +rm -f conftest* +if test -n "$ac_declaration"; then + echo '#ifdef __cplusplus' >>confdefs.h + echo $ac_declaration >>confdefs.h + echo '#endif' >>confdefs.h +fi + +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + +echo "$as_me:$LINENO: checking for inline" >&5 +echo $ECHO_N "checking for inline... $ECHO_C" >&6 +if test "${ac_cv_c_inline+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + ac_cv_c_inline=no +for ac_kw in inline __inline__ __inline; do + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#ifndef __cplusplus +typedef int foo_t; +static $ac_kw foo_t static_foo () {return 0; } +$ac_kw foo_t foo () {return 0; } +#endif + +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_c_inline=$ac_kw; break +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +done + +fi +echo "$as_me:$LINENO: result: $ac_cv_c_inline" >&5 +echo "${ECHO_T}$ac_cv_c_inline" >&6 + + +case $ac_cv_c_inline in + inline | yes) ;; + *) + case $ac_cv_c_inline in + no) ac_val=;; + *) ac_val=$ac_cv_c_inline;; + esac + cat >>confdefs.h <<_ACEOF +#ifndef __cplusplus +#define inline $ac_val +#endif +_ACEOF + ;; +esac + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu +echo "$as_me:$LINENO: checking how to run the C preprocessor" >&5 +echo $ECHO_N "checking how to run the C preprocessor... $ECHO_C" >&6 +# On Suns, sometimes $CPP names a directory. +if test -n "$CPP" && test -d "$CPP"; then + CPP= +fi +if test -z "$CPP"; then + if test "${ac_cv_prog_CPP+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + # Double quotes because CPP needs to be expanded + for CPP in "$CC -E" "$CC -E -traditional-cpp" "/lib/cpp" + do + ac_preproc_ok=false +for ac_c_preproc_warn_flag in '' yes +do + # Use a header file that comes with gcc, so configuring glibc + # with a fresh cross-compiler works. + # Prefer <limits.h> to <assert.h> if __STDC__ is defined, since + # <limits.h> exists even on freestanding compilers. + # On the NeXT, cc -E runs the code through the compiler's parser, + # not just through cpp. "Syntax error" is here to catch this case. + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#ifdef __STDC__ +# include <limits.h> +#else +# include <assert.h> +#endif + Syntax error +_ACEOF +if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 + (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } >/dev/null; then + if test -s conftest.err; then + ac_cpp_err=$ac_c_preproc_warn_flag + ac_cpp_err=$ac_cpp_err$ac_c_werror_flag + else + ac_cpp_err= + fi +else + ac_cpp_err=yes +fi +if test -z "$ac_cpp_err"; then + : +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + # Broken: fails on valid input. +continue +fi +rm -f conftest.err conftest.$ac_ext + + # OK, works on sane cases. Now check whether non-existent headers + # can be detected and how. + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#include <ac_nonexistent.h> +_ACEOF +if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 + (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } >/dev/null; then + if test -s conftest.err; then + ac_cpp_err=$ac_c_preproc_warn_flag + ac_cpp_err=$ac_cpp_err$ac_c_werror_flag + else + ac_cpp_err= + fi +else + ac_cpp_err=yes +fi +if test -z "$ac_cpp_err"; then + # Broken: success on invalid input. +continue +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + # Passes both tests. +ac_preproc_ok=: +break +fi +rm -f conftest.err conftest.$ac_ext + +done +# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. +rm -f conftest.err conftest.$ac_ext +if $ac_preproc_ok; then + break +fi + + done + ac_cv_prog_CPP=$CPP + +fi + CPP=$ac_cv_prog_CPP +else + ac_cv_prog_CPP=$CPP +fi +echo "$as_me:$LINENO: result: $CPP" >&5 +echo "${ECHO_T}$CPP" >&6 +ac_preproc_ok=false +for ac_c_preproc_warn_flag in '' yes +do + # Use a header file that comes with gcc, so configuring glibc + # with a fresh cross-compiler works. + # Prefer <limits.h> to <assert.h> if __STDC__ is defined, since + # <limits.h> exists even on freestanding compilers. + # On the NeXT, cc -E runs the code through the compiler's parser, + # not just through cpp. "Syntax error" is here to catch this case. + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#ifdef __STDC__ +# include <limits.h> +#else +# include <assert.h> +#endif + Syntax error +_ACEOF +if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 + (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } >/dev/null; then + if test -s conftest.err; then + ac_cpp_err=$ac_c_preproc_warn_flag + ac_cpp_err=$ac_cpp_err$ac_c_werror_flag + else + ac_cpp_err= + fi +else + ac_cpp_err=yes +fi +if test -z "$ac_cpp_err"; then + : +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + # Broken: fails on valid input. +continue +fi +rm -f conftest.err conftest.$ac_ext + + # OK, works on sane cases. Now check whether non-existent headers + # can be detected and how. + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#include <ac_nonexistent.h> +_ACEOF +if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 + (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } >/dev/null; then + if test -s conftest.err; then + ac_cpp_err=$ac_c_preproc_warn_flag + ac_cpp_err=$ac_cpp_err$ac_c_werror_flag + else + ac_cpp_err= + fi +else + ac_cpp_err=yes +fi +if test -z "$ac_cpp_err"; then + # Broken: success on invalid input. +continue +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + # Passes both tests. +ac_preproc_ok=: +break +fi +rm -f conftest.err conftest.$ac_ext + +done +# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. +rm -f conftest.err conftest.$ac_ext +if $ac_preproc_ok; then + : +else + { { echo "$as_me:$LINENO: error: C preprocessor \"$CPP\" fails sanity check +See \`config.log' for more details." >&5 +echo "$as_me: error: C preprocessor \"$CPP\" fails sanity check +See \`config.log' for more details." >&2;} + { (exit 1); exit 1; }; } +fi + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + +echo "$as_me:$LINENO: checking for egrep" >&5 +echo $ECHO_N "checking for egrep... $ECHO_C" >&6 +if test "${ac_cv_prog_egrep+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + if echo a | (grep -E '(a|b)') >/dev/null 2>&1 + then ac_cv_prog_egrep='grep -E' + else ac_cv_prog_egrep='egrep' + fi +fi +echo "$as_me:$LINENO: result: $ac_cv_prog_egrep" >&5 +echo "${ECHO_T}$ac_cv_prog_egrep" >&6 + EGREP=$ac_cv_prog_egrep + + +echo "$as_me:$LINENO: checking for ANSI C header files" >&5 +echo $ECHO_N "checking for ANSI C header files... $ECHO_C" >&6 +if test "${ac_cv_header_stdc+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#include <stdlib.h> +#include <stdarg.h> +#include <string.h> +#include <float.h> + +int +main () +{ + + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_header_stdc=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_cv_header_stdc=no +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext + +if test $ac_cv_header_stdc = yes; then + # SunOS 4.x string.h does not declare mem*, contrary to ANSI. + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#include <string.h> + +_ACEOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + $EGREP "memchr" >/dev/null 2>&1; then + : +else + ac_cv_header_stdc=no +fi +rm -f conftest* + +fi + +if test $ac_cv_header_stdc = yes; then + # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI. + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#include <stdlib.h> + +_ACEOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + $EGREP "free" >/dev/null 2>&1; then + : +else + ac_cv_header_stdc=no +fi +rm -f conftest* + +fi + +if test $ac_cv_header_stdc = yes; then + # /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi. + if test "$cross_compiling" = yes; then + : +else + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#include <ctype.h> +#if ((' ' & 0x0FF) == 0x020) +# define ISLOWER(c) ('a' <= (c) && (c) <= 'z') +# define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c)) +#else +# define ISLOWER(c) \ + (('a' <= (c) && (c) <= 'i') \ + || ('j' <= (c) && (c) <= 'r') \ + || ('s' <= (c) && (c) <= 'z')) +# define TOUPPER(c) (ISLOWER(c) ? ((c) | 0x40) : (c)) +#endif + +#define XOR(e, f) (((e) && !(f)) || (!(e) && (f))) +int +main () +{ + int i; + for (i = 0; i < 256; i++) + if (XOR (islower (i), ISLOWER (i)) + || toupper (i) != TOUPPER (i)) + exit(2); + exit (0); +} +_ACEOF +rm -f conftest$ac_exeext +if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && { ac_try='./conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + : +else + echo "$as_me: program exited with status $ac_status" >&5 +echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +( exit $ac_status ) +ac_cv_header_stdc=no +fi +rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext +fi +fi +fi +echo "$as_me:$LINENO: result: $ac_cv_header_stdc" >&5 +echo "${ECHO_T}$ac_cv_header_stdc" >&6 +if test $ac_cv_header_stdc = yes; then + +cat >>confdefs.h <<\_ACEOF +#define STDC_HEADERS 1 +_ACEOF + +fi + + +if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}ar", so it can be a program name with args. +set dummy ${ac_tool_prefix}ar; ac_word=$2 +echo "$as_me:$LINENO: checking for $ac_word" >&5 +echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 +if test "${ac_cv_prog_AR+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$AR"; then ac_cv_prog_AR="$AR" # Let the user override the test. else - IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":" - ac_dummy="$PATH" - for ac_dir in $ac_dummy; do - test -z "$ac_dir" && ac_dir=. - if test -f $ac_dir/$ac_word; then - ac_cv_prog_AR="ar" - break - fi - done - IFS="$ac_save_ifs" +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_AR="${ac_tool_prefix}ar" + echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done +done + fi fi -AR="$ac_cv_prog_AR" +AR=$ac_cv_prog_AR if test -n "$AR"; then - echo "$ac_t""$AR" 1>&6 + echo "$as_me:$LINENO: result: $AR" >&5 +echo "${ECHO_T}$AR" >&6 else - echo "$ac_t""no" 1>&6 + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 fi - # Extract the first word of "ranlib", so it can be a program name with args. -set dummy ranlib; ac_word=$2 -echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:841: checking for $ac_word" >&5 -if eval "test \"`echo '$''{'ac_cv_prog_RANLIB'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 +fi +if test -z "$ac_cv_prog_AR"; then + ac_ct_AR=$AR + # Extract the first word of "ar", so it can be a program name with args. +set dummy ar; ac_word=$2 +echo "$as_me:$LINENO: checking for $ac_word" >&5 +echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 +if test "${ac_cv_prog_ac_ct_AR+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + if test -n "$ac_ct_AR"; then + ac_cv_prog_ac_ct_AR="$ac_ct_AR" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_AR="ar" + echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done +done + +fi +fi +ac_ct_AR=$ac_cv_prog_ac_ct_AR +if test -n "$ac_ct_AR"; then + echo "$as_me:$LINENO: result: $ac_ct_AR" >&5 +echo "${ECHO_T}$ac_ct_AR" >&6 +else + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 +fi + + AR=$ac_ct_AR +else + AR="$ac_cv_prog_AR" +fi + +if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}ranlib", so it can be a program name with args. +set dummy ${ac_tool_prefix}ranlib; ac_word=$2 +echo "$as_me:$LINENO: checking for $ac_word" >&5 +echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 +if test "${ac_cv_prog_RANLIB+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$RANLIB"; then ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test. else - IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":" - ac_dummy="$PATH" - for ac_dir in $ac_dummy; do - test -z "$ac_dir" && ac_dir=. - if test -f $ac_dir/$ac_word; then - ac_cv_prog_RANLIB="ranlib" - break - fi - done - IFS="$ac_save_ifs" +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_RANLIB="${ac_tool_prefix}ranlib" + echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done +done + fi fi -RANLIB="$ac_cv_prog_RANLIB" +RANLIB=$ac_cv_prog_RANLIB if test -n "$RANLIB"; then - echo "$ac_t""$RANLIB" 1>&6 + echo "$as_me:$LINENO: result: $RANLIB" >&5 +echo "${ECHO_T}$RANLIB" >&6 else - echo "$ac_t""no" 1>&6 + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 fi - # Extract the first word of "windres", so it can be a program name with args. -set dummy windres; ac_word=$2 -echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:870: checking for $ac_word" >&5 -if eval "test \"`echo '$''{'ac_cv_prog_RC'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 +fi +if test -z "$ac_cv_prog_RANLIB"; then + ac_ct_RANLIB=$RANLIB + # Extract the first word of "ranlib", so it can be a program name with args. +set dummy ranlib; ac_word=$2 +echo "$as_me:$LINENO: checking for $ac_word" >&5 +echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 +if test "${ac_cv_prog_ac_ct_RANLIB+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + if test -n "$ac_ct_RANLIB"; then + ac_cv_prog_ac_ct_RANLIB="$ac_ct_RANLIB" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_RANLIB="ranlib" + echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done +done + +fi +fi +ac_ct_RANLIB=$ac_cv_prog_ac_ct_RANLIB +if test -n "$ac_ct_RANLIB"; then + echo "$as_me:$LINENO: result: $ac_ct_RANLIB" >&5 +echo "${ECHO_T}$ac_ct_RANLIB" >&6 +else + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 +fi + + RANLIB=$ac_ct_RANLIB +else + RANLIB="$ac_cv_prog_RANLIB" +fi + +if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}windres", so it can be a program name with args. +set dummy ${ac_tool_prefix}windres; ac_word=$2 +echo "$as_me:$LINENO: checking for $ac_word" >&5 +echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 +if test "${ac_cv_prog_RC+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$RC"; then ac_cv_prog_RC="$RC" # Let the user override the test. else - IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":" - ac_dummy="$PATH" - for ac_dir in $ac_dummy; do - test -z "$ac_dir" && ac_dir=. - if test -f $ac_dir/$ac_word; then - ac_cv_prog_RC="windres" - break - fi - done - IFS="$ac_save_ifs" +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_RC="${ac_tool_prefix}windres" + echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done +done + fi fi -RC="$ac_cv_prog_RC" +RC=$ac_cv_prog_RC if test -n "$RC"; then - echo "$ac_t""$RC" 1>&6 + echo "$as_me:$LINENO: result: $RC" >&5 +echo "${ECHO_T}$RC" >&6 else - echo "$ac_t""no" 1>&6 + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 +fi + fi +if test -z "$ac_cv_prog_RC"; then + ac_ct_RC=$RC + # Extract the first word of "windres", so it can be a program name with args. +set dummy windres; ac_word=$2 +echo "$as_me:$LINENO: checking for $ac_word" >&5 +echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 +if test "${ac_cv_prog_ac_ct_RC+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + if test -n "$ac_ct_RC"; then + ac_cv_prog_ac_ct_RC="$ac_ct_RC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_RC="windres" + echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done +done +fi +fi +ac_ct_RC=$ac_cv_prog_ac_ct_RC +if test -n "$ac_ct_RC"; then + echo "$as_me:$LINENO: result: $ac_ct_RC" >&5 +echo "${ECHO_T}$ac_ct_RC" >&6 +else + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 +fi - if test "${AR}" = "" ; then - { echo "configure: error: Required archive tool 'ar' not found on PATH." 1>&2; exit 1; } - fi - if test "${RANLIB}" = "" ; then - { echo "configure: error: Required archive index tool 'ranlib' not found on PATH." 1>&2; exit 1; } - fi - if test "${RC}" = "" ; then - { echo "configure: error: Required resource tool 'windres' not found on PATH." 1>&2; exit 1; } - fi + RC=$ac_ct_RC +else + RC="$ac_cv_prog_RC" fi + #-------------------------------------------------------------------- # Checks to see if the make program sets the $MAKE variable. #-------------------------------------------------------------------- -echo $ac_n "checking whether ${MAKE-make} sets \${MAKE}""... $ac_c" 1>&6 -echo "configure:913: checking whether ${MAKE-make} sets \${MAKE}" >&5 -set dummy ${MAKE-make}; ac_make=`echo "$2" | sed 'y%./+-%__p_%'` -if eval "test \"`echo '$''{'ac_cv_prog_make_${ac_make}_set'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 +echo "$as_me:$LINENO: checking 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 > conftestmake <<\EOF + cat >conftest.make <<\_ACEOF all: - @echo 'ac_maketemp="${MAKE}"' -EOF + @echo 'ac_maketemp="$(MAKE)"' +_ACEOF # GNU make sometimes prints "make[1]: Entering...", which would confuse us. -eval `${MAKE-make} -f conftestmake 2>/dev/null | grep temp=` +eval `${MAKE-make} -f conftest.make 2>/dev/null | grep temp=` if test -n "$ac_maketemp"; then eval ac_cv_prog_make_${ac_make}_set=yes else eval ac_cv_prog_make_${ac_make}_set=no fi -rm -f conftestmake +rm -f conftest.make fi if eval "test \"`echo '$ac_cv_prog_make_'${ac_make}_set`\" = yes"; then - echo "$ac_t""yes" 1>&6 + echo "$as_me:$LINENO: result: yes" >&5 +echo "${ECHO_T}yes" >&6 SET_MAKE= else - echo "$ac_t""no" 1>&6 + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 SET_MAKE="MAKE=${MAKE-make}" fi @@ -940,58 +3044,90 @@ fi # Perform additinal compiler tests. #-------------------------------------------------------------------- -echo $ac_n "checking for Cygwin environment""... $ac_c" 1>&6 -echo "configure:945: checking for Cygwin environment" >&5 -if eval "test \"`echo '$''{'ac_cv_cygwin'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 + +echo "$as_me:$LINENO: checking for Cygwin version of gcc" >&5 +echo $ECHO_N "checking for Cygwin version of gcc... $ECHO_C" >&6 +if test "${ac_cv_cygwin+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else - cat > conftest.$ac_ext <<EOF -#line 950 "configure" -#include "confdefs.h" + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ + +#ifdef __CYGWIN__ +#error cygwin +#endif -int main() { +int +main () +{ -#ifndef __CYGWIN__ -#define __CYGWIN__ __CYGWIN32__ -#endif -return __CYGWIN__; -; return 0; } -EOF -if { (eval echo configure:961: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then - rm -rf conftest* - ac_cv_cygwin=yes -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then ac_cv_cygwin=no -fi -rm -f conftest* -rm -f conftest* -fi +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 -echo "$ac_t""$ac_cv_cygwin" 1>&6 -CYGWIN= -test "$ac_cv_cygwin" = yes && CYGWIN=yes +ac_cv_cygwin=yes +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +fi +echo "$as_me:$LINENO: result: $ac_cv_cygwin" >&5 +echo "${ECHO_T}$ac_cv_cygwin" >&6 if test "$ac_cv_cygwin" = "yes" ; then - { echo "configure: error: Compiling under Cygwin is not currently supported. + { { echo "$as_me:$LINENO: error: Compiling under Cygwin is not currently supported. A maintainer for the Cygwin port of Tcl/Tk is needed. See the README -file for information about building with Mingw." 1>&2; exit 1; } +file for information about building with Mingw." >&5 +echo "$as_me: error: Compiling under Cygwin is not currently supported. +A maintainer for the Cygwin port of Tcl/Tk is needed. See the README +file for information about building with Mingw." >&2;} + { (exit 1); exit 1; }; } fi -echo $ac_n "checking for SEH support in compiler""... $ac_c" 1>&6 -echo "configure:986: checking for SEH support in compiler" >&5 -if eval "test \"`echo '$''{'tcl_cv_seh'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 +echo "$as_me:$LINENO: checking for SEH support in compiler" >&5 +echo $ECHO_N "checking for SEH support in compiler... $ECHO_C" >&6 +if test "${tcl_cv_seh+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else if test "$cross_compiling" = yes; then tcl_cv_seh=no else - cat > conftest.$ac_ext <<EOF -#line 994 "configure" -#include "confdefs.h" + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ #define WIN32_LEAN_AND_MEAN #include <windows.h> @@ -1008,27 +3144,38 @@ int main(int argc, char** argv) { return 1; } -EOF -if { (eval echo configure:1013: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null -then +_ACEOF +rm -f conftest$ac_exeext +if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && { ac_try='./conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then tcl_cv_seh=yes else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -fr conftest* - tcl_cv_seh=no + echo "$as_me: program exited with status $ac_status" >&5 +echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +( exit $ac_status ) +tcl_cv_seh=no fi -rm -fr conftest* +rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi - fi - -echo "$ac_t""$tcl_cv_seh" 1>&6 +echo "$as_me:$LINENO: result: $tcl_cv_seh" >&5 +echo "${ECHO_T}$tcl_cv_seh" >&6 if test "$tcl_cv_seh" = "no" ; then - cat >> confdefs.h <<\EOF + +cat >>confdefs.h <<\_ACEOF #define HAVE_NO_SEH 1 -EOF +_ACEOF fi @@ -1038,43 +3185,71 @@ fi # with Cygwin's version as of 2002-04-10, define it to be int, # sufficient for getting the current code to work. # -echo $ac_n "checking for EXCEPTION_DISPOSITION support in include files""... $ac_c" 1>&6 -echo "configure:1043: checking for EXCEPTION_DISPOSITION support in include files" >&5 -if eval "test \"`echo '$''{'tcl_cv_eh_disposition'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 +echo "$as_me:$LINENO: checking for EXCEPTION_DISPOSITION support in include files" >&5 +echo $ECHO_N "checking for EXCEPTION_DISPOSITION support in include files... $ECHO_C" >&6 +if test "${tcl_cv_eh_disposition+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else - cat > conftest.$ac_ext <<EOF -#line 1048 "configure" -#include "confdefs.h" + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ #define WIN32_LEAN_AND_MEAN #include <windows.h> #undef WIN32_LEAN_AND_MEAN -int main() { +int +main () +{ EXCEPTION_DISPOSITION x; -; return 0; } -EOF -if { (eval echo configure:1061: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then - rm -rf conftest* + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then tcl_cv_eh_disposition=yes else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - tcl_cv_eh_disposition=no -fi -rm -f conftest* + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 +tcl_cv_eh_disposition=no fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext -echo "$ac_t""$tcl_cv_eh_disposition" 1>&6 +fi +echo "$as_me:$LINENO: result: $tcl_cv_eh_disposition" >&5 +echo "${ECHO_T}$tcl_cv_eh_disposition" >&6 if test "$tcl_cv_eh_disposition" = "no" ; then - cat >> confdefs.h <<\EOF + +cat >>confdefs.h <<\_ACEOF #define EXCEPTION_DISPOSITION int -EOF +_ACEOF fi @@ -1082,44 +3257,72 @@ fi # Check to see if the winsock2.h include file provided contains # typedefs like LPFN_ACCEPT and friends. # -echo $ac_n "checking for LPFN_ACCEPT support in winsock2.h""... $ac_c" 1>&6 -echo "configure:1087: checking for LPFN_ACCEPT support in winsock2.h" >&5 -if eval "test \"`echo '$''{'tcl_cv_lpfn_decls'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 +echo "$as_me:$LINENO: checking for LPFN_ACCEPT support in winsock2.h" >&5 +echo $ECHO_N "checking for LPFN_ACCEPT support in winsock2.h... $ECHO_C" >&6 +if test "${tcl_cv_lpfn_decls+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else - cat > conftest.$ac_ext <<EOF -#line 1092 "configure" -#include "confdefs.h" + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ #define WIN32_LEAN_AND_MEAN #include <windows.h> #undef WIN32_LEAN_AND_MEAN #include <winsock2.h> -int main() { +int +main () +{ LPFN_ACCEPT accept; -; return 0; } -EOF -if { (eval echo configure:1106: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then - rm -rf conftest* + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then tcl_cv_lpfn_decls=yes else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - tcl_cv_lpfn_decls=no -fi -rm -f conftest* + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 +tcl_cv_lpfn_decls=no fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext -echo "$ac_t""$tcl_cv_lpfn_decls" 1>&6 +fi +echo "$as_me:$LINENO: result: $tcl_cv_lpfn_decls" >&5 +echo "${ECHO_T}$tcl_cv_lpfn_decls" >&6 if test "$tcl_cv_lpfn_decls" = "no" ; then - cat >> confdefs.h <<\EOF + +cat >>confdefs.h <<\_ACEOF #define HAVE_NO_LPFN_DECLS 1 -EOF +_ACEOF fi @@ -1127,46 +3330,74 @@ fi # even if VOID has already been #defined. The win32api # used by mingw and cygwin is known to do this. -echo $ac_n "checking for winnt.h that ignores VOID define""... $ac_c" 1>&6 -echo "configure:1132: checking for winnt.h that ignores VOID define" >&5 -if eval "test \"`echo '$''{'tcl_cv_winnt_ignore_void'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 +echo "$as_me:$LINENO: checking for winnt.h that ignores VOID define" >&5 +echo $ECHO_N "checking for winnt.h that ignores VOID define... $ECHO_C" >&6 +if test "${tcl_cv_winnt_ignore_void+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else - cat > conftest.$ac_ext <<EOF -#line 1137 "configure" -#include "confdefs.h" + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ #define VOID void #define WIN32_LEAN_AND_MEAN #include <windows.h> #undef WIN32_LEAN_AND_MEAN -int main() { +int +main () +{ CHAR c; SHORT s; LONG l; -; return 0; } -EOF -if { (eval echo configure:1153: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then - rm -rf conftest* + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then tcl_cv_winnt_ignore_void=yes else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - tcl_cv_winnt_ignore_void=no -fi -rm -f conftest* + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 +tcl_cv_winnt_ignore_void=no fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext -echo "$ac_t""$tcl_cv_winnt_ignore_void" 1>&6 +fi +echo "$as_me:$LINENO: result: $tcl_cv_winnt_ignore_void" >&5 +echo "${ECHO_T}$tcl_cv_winnt_ignore_void" >&6 if test "$tcl_cv_winnt_ignore_void" = "yes" ; then - cat >> confdefs.h <<\EOF + +cat >>confdefs.h <<\_ACEOF #define HAVE_WINNT_IGNORE_VOID 1 -EOF +_ACEOF fi @@ -1180,45 +3411,73 @@ fi # register and not on the stack. Instead, we just # call it from inline asm code. -echo $ac_n "checking for alloca declaration in malloc.h""... $ac_c" 1>&6 -echo "configure:1185: checking for alloca declaration in malloc.h" >&5 -if eval "test \"`echo '$''{'tcl_cv_malloc_decl_alloca'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 +echo "$as_me:$LINENO: checking for alloca declaration in malloc.h" >&5 +echo $ECHO_N "checking for alloca declaration in malloc.h... $ECHO_C" >&6 +if test "${tcl_cv_malloc_decl_alloca+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else - cat > conftest.$ac_ext <<EOF -#line 1190 "configure" -#include "confdefs.h" + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ #include <malloc.h> -int main() { +int +main () +{ size_t arg = 0; void* ptr; ptr = alloca; ptr = alloca(arg); -; return 0; } -EOF -if { (eval echo configure:1204: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then - rm -rf conftest* + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then tcl_cv_malloc_decl_alloca=yes else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - tcl_cv_malloc_decl_alloca=no -fi -rm -f conftest* + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 +tcl_cv_malloc_decl_alloca=no fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext -echo "$ac_t""$tcl_cv_malloc_decl_alloca" 1>&6 +fi +echo "$as_me:$LINENO: result: $tcl_cv_malloc_decl_alloca" >&5 +echo "${ECHO_T}$tcl_cv_malloc_decl_alloca" >&6 if test "$tcl_cv_malloc_decl_alloca" = "no" && test "${GCC}" = "yes" ; then - cat >> confdefs.h <<\EOF + +cat >>confdefs.h <<\_ACEOF #define HAVE_ALLOCA_GCC_INLINE 1 -EOF +_ACEOF fi @@ -1226,174 +3485,290 @@ fi # This is used to stop gcc from printing a compiler # warning when initializing a union member. -echo $ac_n "checking for cast to union support""... $ac_c" 1>&6 -echo "configure:1231: checking for cast to union support" >&5 -if eval "test \"`echo '$''{'tcl_cv_cast_to_union'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 +echo "$as_me:$LINENO: checking for cast to union support" >&5 +echo $ECHO_N "checking for cast to union support... $ECHO_C" >&6 +if test "${tcl_cv_cast_to_union+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else - cat > conftest.$ac_ext <<EOF -#line 1236 "configure" -#include "confdefs.h" + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ -int main() { +int +main () +{ union foo { int i; double d; }; union foo f = (union foo) (int) 0; -; return 0; } -EOF -if { (eval echo configure:1246: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then - rm -rf conftest* + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then tcl_cv_cast_to_union=yes else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - tcl_cv_cast_to_union=no -fi -rm -f conftest* + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 +tcl_cv_cast_to_union=no fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext -echo "$ac_t""$tcl_cv_cast_to_union" 1>&6 +fi +echo "$as_me:$LINENO: result: $tcl_cv_cast_to_union" >&5 +echo "${ECHO_T}$tcl_cv_cast_to_union" >&6 if test "$tcl_cv_cast_to_union" = "yes"; then - cat >> confdefs.h <<\EOF + +cat >>confdefs.h <<\_ACEOF #define HAVE_CAST_TO_UNION 1 -EOF +_ACEOF fi # Check to see if struct _stat32i64 exists in mingw's sys/stat.h -echo $ac_n "checking if struct _stat32i64 missing""... $ac_c" 1>&6 -echo "configure:1270: checking if struct _stat32i64 missing" >&5 -if eval "test \"`echo '$''{'tcl_struct_stat32i64'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 +echo "$as_me:$LINENO: checking if struct _stat32i64 missing" >&5 +echo $ECHO_N "checking if struct _stat32i64 missing... $ECHO_C" >&6 +if test "${tcl_struct_stat32i64+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else - cat > conftest.$ac_ext <<EOF -#line 1275 "configure" -#include "confdefs.h" + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ #include <sys/types.h> #include <sys/stat.h> -int main() { +int +main () +{ struct _stat32i64 foo; -; return 0; } -EOF -if { (eval echo configure:1287: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then - rm -rf conftest* + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then tcl_struct_stat32i64=no else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - tcl_struct_stat32i64=yes -fi -rm -f conftest* + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 +tcl_struct_stat32i64=yes fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext -echo "$ac_t""$tcl_struct_stat32i64" 1>&6 +fi +echo "$as_me:$LINENO: result: $tcl_struct_stat32i64" >&5 +echo "${ECHO_T}$tcl_struct_stat32i64" >&6 if test "$tcl_struct_stat32i64" = "yes" ; then - cat >> confdefs.h <<\EOF + +cat >>confdefs.h <<\_ACEOF #define HAVE_NO_STRUCT_STAT32I64 1 -EOF +_ACEOF fi -#-------------------------------------------------------------------- -# Determines the correct binary file extension (.o, .obj, .exe etc.) -#-------------------------------------------------------------------- +# See if declarations like FINDEX_INFO_LEVELS are +# missing from winbase.h. This is known to be +# a problem with VC++ 5.2. -echo $ac_n "checking for object suffix""... $ac_c" 1>&6 -echo "configure:1314: checking for object suffix" >&5 -if eval "test \"`echo '$''{'ac_cv_objext'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - rm -f conftest* -echo 'int i = 1;' > conftest.$ac_ext -if { (eval echo configure:1320: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then - for ac_file in conftest.*; do - case $ac_file in - *.c) ;; - *) ac_cv_objext=`echo $ac_file | sed -e s/conftest.//` ;; - esac - done +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 - { echo "configure: error: installation or configuration problem; compiler does not work" 1>&2; exit 1; } -fi -rm -f conftest* -fi + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ -echo "$ac_t""$ac_cv_objext" 1>&6 -OBJEXT=$ac_cv_objext -ac_objext=$ac_cv_objext - -echo $ac_n "checking for mingw32 environment""... $ac_c" 1>&6 -echo "configure:1338: checking for mingw32 environment" >&5 -if eval "test \"`echo '$''{'ac_cv_mingw32'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - cat > conftest.$ac_ext <<EOF -#line 1343 "configure" -#include "confdefs.h" - -int main() { -return __MINGW32__; -; return 0; } -EOF -if { (eval echo configure:1350: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then - rm -rf conftest* - ac_cv_mingw32=yes -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - ac_cv_mingw32=no +#define WIN32_LEAN_AND_MEAN +#include <windows.h> +#undef WIN32_LEAN_AND_MEAN + +int +main () +{ + + FINDEX_INFO_LEVELS i; + FINDEX_SEARCH_OPS j; + + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + tcl_cv_findex_enums=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +tcl_cv_findex_enums=no fi -rm -f conftest* -rm -f conftest* +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext + fi +echo "$as_me:$LINENO: result: $tcl_cv_findex_enums" >&5 +echo "${ECHO_T}$tcl_cv_findex_enums" >&6 +if test "$tcl_cv_findex_enums" = "no"; then -echo "$ac_t""$ac_cv_mingw32" 1>&6 -MINGW32= -test "$ac_cv_mingw32" = yes && MINGW32=yes +cat >>confdefs.h <<\_ACEOF +#define HAVE_NO_FINDEX_ENUMS 1 +_ACEOF + +fi +# See if MWMO_ALERTABLE is missing from winuser.h +# This is known to be a problem with Mingw. -echo $ac_n "checking for executable suffix""... $ac_c" 1>&6 -echo "configure:1369: checking for executable suffix" >&5 -if eval "test \"`echo '$''{'ac_cv_exeext'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 +echo "$as_me:$LINENO: checking for MWMO_ALERTABLE in winuser.h" >&5 +echo $ECHO_N "checking for MWMO_ALERTABLE in winuser.h... $ECHO_C" >&6 +if test "${tcl_cv_mwmo_alertable+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else - if test "$CYGWIN" = yes || test "$MINGW32" = yes; then - ac_cv_exeext=.exe + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ + +#define WIN32_LEAN_AND_MEAN +#include <windows.h> +#undef WIN32_LEAN_AND_MEAN + +int +main () +{ + + int i = MWMO_ALERTABLE; + + ; + 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_mwmo_alertable=yes else - rm -f conftest* - echo 'int main () { return 0; }' > conftest.$ac_ext - ac_cv_exeext= - if { (eval echo configure:1379: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; }; then - for file in conftest.*; do - case $file in - *.c | *.o | *.obj) ;; - *) ac_cv_exeext=`echo $file | sed -e s/conftest//` ;; - esac - done - else - { echo "configure: error: installation or configuration problem: compiler cannot create executables." 1>&2; exit 1; } - fi - rm -f conftest* - test x"${ac_cv_exeext}" = x && ac_cv_exeext=no + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +tcl_cv_mwmo_alertable=no fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext + fi +echo "$as_me:$LINENO: result: $tcl_cv_mwmo_alertable" >&5 +echo "${ECHO_T}$tcl_cv_mwmo_alertable" >&6 +if test "$tcl_cv_mwmo_alertable" = "no"; then + +cat >>confdefs.h <<\_ACEOF +#define HAVE_NO_MWMO_ALERTABLE 1 +_ACEOF + +fi + +#-------------------------------------------------------------------- +# Determines the correct binary file extension (.o, .obj, .exe etc.) +#-------------------------------------------------------------------- + -EXEEXT="" -test x"${ac_cv_exeext}" != xno && EXEEXT=${ac_cv_exeext} -echo "$ac_t""${ac_cv_exeext}" 1>&6 -ac_exeext=$EXEEXT #-------------------------------------------------------------------- @@ -1401,35 +3776,62 @@ ac_exeext=$EXEEXT #-------------------------------------------------------------------- - echo $ac_n "checking for building with threads""... $ac_c" 1>&6 -echo "configure:1406: checking for building with threads" >&5 + echo "$as_me:$LINENO: checking for building with threads" >&5 +echo $ECHO_N "checking for building with threads... $ECHO_C" >&6 # Check whether --enable-threads or --disable-threads was given. if test "${enable_threads+set}" = set; then enableval="$enable_threads" tcl_ok=$enableval else tcl_ok=no -fi - +fi; if test "$tcl_ok" = "yes"; then - echo "$ac_t""yes" 1>&6 + echo "$as_me:$LINENO: result: yes" >&5 +echo "${ECHO_T}yes" >&6 TCL_THREADS=1 - cat >> confdefs.h <<\EOF + cat >>confdefs.h <<\_ACEOF #define TCL_THREADS 1 -EOF +_ACEOF # USE_THREAD_ALLOC tells us to try the special thread-based # allocator that significantly reduces lock contention - cat >> confdefs.h <<\EOF + cat >>confdefs.h <<\_ACEOF #define USE_THREAD_ALLOC 1 -EOF +_ACEOF else TCL_THREADS=0 - echo "$ac_t""no (default)" 1>&6 + echo "$as_me:$LINENO: result: no (default)" >&5 +echo "${ECHO_T}no (default)" >&6 + fi + + + +#------------------------------------------------------------------------ +# Embedded configuration information, encoding to use for the values, TIP #59 +#------------------------------------------------------------------------ + + + +# Check whether --with-encoding or --without-encoding was given. +if test "${with_encoding+set}" = set; then + withval="$with_encoding" + with_tcencoding=${withval} +fi; + + if test x"${with_tcencoding}" != x ; then + cat >>confdefs.h <<_ACEOF +#define TCL_CFGVAL_ENCODING "${with_tcencoding}" +_ACEOF + + else + # Default encoding on windows is not "iso8859-1" + cat >>confdefs.h <<\_ACEOF +#define TCL_CFGVAL_ENCODING "cp1252" +_ACEOF + fi - #-------------------------------------------------------------------- @@ -1438,16 +3840,15 @@ EOF #-------------------------------------------------------------------- - echo $ac_n "checking how to build libraries""... $ac_c" 1>&6 -echo "configure:1443: checking how to build libraries" >&5 + echo "$as_me:$LINENO: checking how to build libraries" >&5 +echo $ECHO_N "checking how to build libraries... $ECHO_C" >&6 # Check whether --enable-shared or --disable-shared was given. if test "${enable_shared+set}" = set; then enableval="$enable_shared" tcl_ok=$enableval else tcl_ok=yes -fi - +fi; if test "${enable_shared+set}" = set; then enableval="$enable_shared" @@ -1457,14 +3858,16 @@ fi fi if test "$tcl_ok" = "yes" ; then - echo "$ac_t""shared" 1>&6 + echo "$as_me:$LINENO: result: shared" >&5 +echo "${ECHO_T}shared" >&6 SHARED_BUILD=1 else - echo "$ac_t""static" 1>&6 + echo "$as_me:$LINENO: result: static" >&5 +echo "${ECHO_T}static" >&6 SHARED_BUILD=0 - cat >> confdefs.h <<\EOF + cat >>confdefs.h <<\_ACEOF #define STATIC_BUILD 1 -EOF +_ACEOF fi @@ -1475,79 +3878,158 @@ EOF # after SC_ENABLE_SHARED checks the configure switches. #-------------------------------------------------------------------- +# On IRIX 5.3, sys/types and inttypes.h are conflicting. + + + + + + + + + +for ac_header in sys/types.h sys/stat.h stdlib.h string.h memory.h strings.h \ + inttypes.h stdint.h unistd.h +do +as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` +echo "$as_me:$LINENO: checking for $ac_header" >&5 +echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 +if eval "test \"\${$as_ac_Header+set}\" = set"; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +$ac_includes_default + +#include <$ac_header> +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + eval "$as_ac_Header=yes" +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +eval "$as_ac_Header=no" +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +fi +echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 +echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 +if test `eval echo '${'$as_ac_Header'}'` = yes; then + cat >>confdefs.h <<_ACEOF +#define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 +_ACEOF + +fi + +done + + # Step 0: Enable 64 bit support? - echo $ac_n "checking if 64bit support is requested""... $ac_c" 1>&6 -echo "configure:1484: checking if 64bit support is requested" >&5 + echo "$as_me:$LINENO: checking if 64bit support is requested" >&5 +echo $ECHO_N "checking if 64bit support is requested... $ECHO_C" >&6 # Check whether --enable-64bit or --disable-64bit was given. if test "${enable_64bit+set}" = set; then enableval="$enable_64bit" do64bit=$enableval else do64bit=no -fi - - echo "$ac_t""$do64bit" 1>&6 +fi; + echo "$as_me:$LINENO: result: $do64bit" >&5 +echo "${ECHO_T}$do64bit" >&6 # Cross-compiling options for Windows/CE builds - echo $ac_n "checking if Windows/CE build is requested""... $ac_c" 1>&6 -echo "configure:1498: checking if Windows/CE build is requested" >&5 + echo "$as_me:$LINENO: checking if Windows/CE build is requested" >&5 +echo $ECHO_N "checking if Windows/CE build is requested... $ECHO_C" >&6 # Check whether --enable-wince or --disable-wince was given. if test "${enable_wince+set}" = set; then enableval="$enable_wince" doWince=$enableval else doWince=no -fi +fi; + echo "$as_me:$LINENO: result: $doWince" >&5 +echo "${ECHO_T}$doWince" >&6 - echo "$ac_t""$doWince" 1>&6 + echo "$as_me:$LINENO: checking for Windows/CE celib directory" >&5 +echo $ECHO_N "checking for Windows/CE celib directory... $ECHO_C" >&6 - echo $ac_n "checking for Windows/CE celib directory""... $ac_c" 1>&6 -echo "configure:1510: checking for Windows/CE celib directory" >&5 - # Check whether --with-celib or --without-celib was given. +# Check whether --with-celib or --without-celib was given. if test "${with_celib+set}" = set; then withval="$with_celib" CELIB_DIR=$withval else CELIB_DIR=NO_CELIB -fi - - echo "$ac_t""$CELIB_DIR" 1>&6 +fi; + echo "$as_me:$LINENO: result: $CELIB_DIR" >&5 +echo "${ECHO_T}$CELIB_DIR" >&6 # Set some defaults (may get changed below) EXTRA_CFLAGS="" # Extract the first word of "cygpath", so it can be a program name with args. set dummy cygpath; ac_word=$2 -echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:1527: checking for $ac_word" >&5 -if eval "test \"`echo '$''{'ac_cv_prog_CYGPATH'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 +echo "$as_me:$LINENO: checking for $ac_word" >&5 +echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 +if test "${ac_cv_prog_CYGPATH+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$CYGPATH"; then ac_cv_prog_CYGPATH="$CYGPATH" # Let the user override the test. else - IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":" - ac_dummy="$PATH" - for ac_dir in $ac_dummy; do - test -z "$ac_dir" && ac_dir=. - if test -f $ac_dir/$ac_word; then - ac_cv_prog_CYGPATH="cygpath -w" - break - fi - done - IFS="$ac_save_ifs" +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_CYGPATH="cygpath -w" + echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done +done + test -z "$ac_cv_prog_CYGPATH" && ac_cv_prog_CYGPATH="echo" fi fi -CYGPATH="$ac_cv_prog_CYGPATH" +CYGPATH=$ac_cv_prog_CYGPATH if test -n "$CYGPATH"; then - echo "$ac_t""$CYGPATH" 1>&6 + echo "$as_me:$LINENO: result: $CYGPATH" >&5 +echo "${ECHO_T}$CYGPATH" >&6 else - echo "$ac_t""no" 1>&6 + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 fi @@ -1570,13 +4052,20 @@ fi echo "101 \"name\"" >> $conftest echo "END" >> $conftest - echo $ac_n "checking for Windows native path bug in windres""... $ac_c" 1>&6 -echo "configure:1575: checking for Windows native path bug in windres" >&5 + echo "$as_me:$LINENO: checking for Windows native path bug in windres" >&5 +echo $ECHO_N "checking for Windows native path bug in windres... $ECHO_C" >&6 cyg_conftest=`$CYGPATH $conftest` - if { ac_try='$RC -o conftest.res.o $cyg_conftest'; { (eval echo configure:1577: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } ; then - echo "$ac_t""no" 1>&6 + if { ac_try='$RC -o conftest.res.o $cyg_conftest' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } ; then + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 else - echo "$ac_t""yes" 1>&6 + echo "$as_me:$LINENO: result: yes" >&5 +echo "${ECHO_T}yes" >&6 CYGPATH=echo fi conftest= @@ -1591,13 +4080,14 @@ echo "configure:1575: checking for Windows native path bug in windres" >&5 # set various compiler flags depending on whether we are using gcc or cl - echo $ac_n "checking compiler flags""... $ac_c" 1>&6 -echo "configure:1596: checking compiler flags" >&5 + echo "$as_me:$LINENO: checking compiler flags" >&5 +echo $ECHO_N "checking compiler flags... $ECHO_C" >&6 if test "${GCC}" = "yes" ; then SHLIB_LD="" SHLIB_LD_LIBS="" - LIBS="" - LIBS_GUI="-lgdi32 -lcomdlg32 -limm32 -lcomctl32 -lshell32" + LIBS="-lws2_32" + # mingw needs to link ole32 and oleaut32 for [send], but MSVC doesn't + LIBS_GUI="-lgdi32 -lcomdlg32 -limm32 -lcomctl32 -lshell32 -luuid -lole32 -loleaut32" STLIB_LD='${AR} cr' RC_OUT=-o RC_TYPE= @@ -1629,7 +4119,8 @@ echo "configure:1596: checking compiler flags" >&5 if test "${SHARED_BUILD}" = "0" ; then # static - echo "$ac_t""using static flags" 1>&6 + echo "$as_me:$LINENO: result: using static flags" >&5 +echo "${ECHO_T}using static flags" >&6 runtime= MAKE_DLL="echo " LIBSUFFIX="s\${DBGX}.a" @@ -1638,12 +4129,16 @@ echo "configure:1596: checking compiler flags" >&5 EXESUFFIX="s\${DBGX}.exe" else # dynamic - echo "$ac_t""using shared flags" 1>&6 + echo "$as_me:$LINENO: result: using shared flags" >&5 +echo "${ECHO_T}using shared flags" >&6 # ad-hoc check to see if CC supports -shared. if "${CC}" -shared 2>&1 | egrep ': -shared not supported' >/dev/null; then - { echo "configure: error: ${CC} does not support the -shared option. - You will need to upgrade to a newer version of the toolchain." 1>&2; exit 1; } + { { echo "$as_me:$LINENO: error: ${CC} does not support the -shared option. + You will need to upgrade to a newer version of the toolchain." >&5 +echo "$as_me: error: ${CC} does not support the -shared option. + You will need to upgrade to a newer version of the toolchain." >&2;} + { (exit 1); exit 1; }; } fi runtime= @@ -1670,7 +4165,7 @@ echo "configure:1596: checking compiler flags" >&5 CFLAGS_DEBUG=-g CFLAGS_OPTIMIZE="-O2 -fomit-frame-pointer" - CFLAGS_WARNING="-Wall -fno-strict-aliasing" + CFLAGS_WARNING="-Wall" LDFLAGS_DEBUG= LDFLAGS_OPTIMIZE= @@ -1698,47 +4193,78 @@ echo "configure:1596: checking compiler flags" >&5 case "$do64bit" in amd64|x64|yes) MACHINE="AMD64" ; # assume AMD64 as default 64-bit build - echo "$ac_t"" Using 64-bit $MACHINE mode" 1>&6 + echo "$as_me:$LINENO: result: Using 64-bit $MACHINE mode" >&5 +echo "${ECHO_T} Using 64-bit $MACHINE mode" >&6 ;; ia64) MACHINE="IA64" - echo "$ac_t"" Using 64-bit $MACHINE mode" 1>&6 + echo "$as_me:$LINENO: result: Using 64-bit $MACHINE mode" >&5 +echo "${ECHO_T} Using 64-bit $MACHINE mode" >&6 ;; *) - cat > conftest.$ac_ext <<EOF -#line 1710 "configure" -#include "confdefs.h" + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ #ifdef _WIN64 #error 64-bit #endif - -int main() { -; return 0; } -EOF -if { (eval echo configure:1721: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then - rm -rf conftest* +int +main () +{ + + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then tcl_win_64bit=no else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - tcl_win_64bit=yes - + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +tcl_win_64bit=yes + fi -rm -f conftest* +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext if test "$tcl_win_64bit" = "yes" ; then do64bit=amd64 MACHINE="AMD64" - echo "$ac_t"" Using 64-bit $MACHINE mode" 1>&6 + echo "$as_me:$LINENO: result: Using 64-bit $MACHINE mode" >&5 +echo "${ECHO_T} Using 64-bit $MACHINE mode" >&6 fi ;; esac else if test "${SHARED_BUILD}" = "0" ; then # static - echo "$ac_t""using static flags" 1>&6 + echo "$as_me:$LINENO: result: using static flags" >&5 +echo "${ECHO_T}using static flags" >&6 runtime=-MT MAKE_DLL="echo " LIBSUFFIX="s\${DBGX}.lib" @@ -1748,7 +4274,8 @@ rm -f conftest* SHLIB_LD_LIBS="" else # dynamic - echo "$ac_t""using shared flags" 1>&6 + echo "$as_me:$LINENO: result: using shared flags" >&5 +echo "${ECHO_T}using shared flags" >&6 runtime=-MD # Add SHLIB_LD_LIBS to the Make rule, not here. MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -out:\$@" @@ -1782,21 +4309,88 @@ rm -f conftest* ;; esac if test ! -d "${PATH64}" ; then - echo "configure: warning: Could not find 64-bit $MACHINE SDK to enable 64bit mode" 1>&2 - echo "configure: warning: Ensure latest Platform SDK is installed" 1>&2 + { echo "$as_me:$LINENO: WARNING: Could not find 64-bit $MACHINE SDK to enable 64bit mode" >&5 +echo "$as_me: WARNING: Could not find 64-bit $MACHINE SDK to enable 64bit mode" >&2;} + { echo "$as_me:$LINENO: WARNING: Ensure latest Platform SDK is installed" >&5 +echo "$as_me: WARNING: Ensure latest Platform SDK is installed" >&2;} do64bit="no" else - echo "$ac_t"" Using 64-bit $MACHINE mode" 1>&6 + echo "$as_me:$LINENO: result: Using 64-bit $MACHINE mode" >&5 +echo "${ECHO_T} Using 64-bit $MACHINE mode" >&6 fi fi - LIBS="user32.lib advapi32.lib" + LIBS="user32.lib advapi32.lib ws2_32.lib" if test "$do64bit" != "no" ; then # The space-based-path will work for the Makefile, but will # not work if AC_TRY_COMPILE is called. TEA has the # TEA_PATH_NOSPACE to avoid this issue. - CC="\"${PATH64}/cl.exe\" -I\"${MSSDK}/Include\" \ - -I\"${MSSDK}/Include/crt\" -I\"${MSSDK}/Include/crt/sys\"" + # Check if _WIN64 is already recognized, and if so we don't + # need to modify CC. + echo "$as_me:$LINENO: checking whether _WIN64 is declared" >&5 +echo $ECHO_N "checking whether _WIN64 is declared... $ECHO_C" >&6 +if test "${ac_cv_have_decl__WIN64+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +$ac_includes_default +int +main () +{ +#ifndef _WIN64 + char *p = (char *) _WIN64; +#endif + + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_have_decl__WIN64=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_cv_have_decl__WIN64=no +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +fi +echo "$as_me:$LINENO: result: $ac_cv_have_decl__WIN64" >&5 +echo "${ECHO_T}$ac_cv_have_decl__WIN64" >&6 +if test $ac_cv_have_decl__WIN64 = yes; then + : +else + CC="\"${PATH64}/cl.exe\" -I\"${MSSDK}/Include\" \ + -I\"${MSSDK}/Include/crt\" \ + -I\"${MSSDK}/Include/crt/sys\"" +fi + RC="\"${MSSDK}/bin/rc.exe\"" CFLAGS_DEBUG="-nologo -Zi -Od ${runtime}d" # Do not use -O2 for Win64 - this has proved buggy in code gen. @@ -1858,11 +4452,15 @@ rm -f conftest* SDKROOT=`echo "$SDKROOT" | sed -e 's!\\\!/!g'` CELIB_DIR=`echo "$CELIB_DIR" | sed -e 's!\\\!/!g'` if test ! -d "${CELIB_DIR}/inc"; then - { echo "configure: error: Invalid celib directory "${CELIB_DIR}"" 1>&2; exit 1; } + { { echo "$as_me:$LINENO: error: Invalid celib directory \"${CELIB_DIR}\"" >&5 +echo "$as_me: error: Invalid celib directory \"${CELIB_DIR}\"" >&2;} + { (exit 1); exit 1; }; } fi if test ! -d "${SDKROOT}/${OSVERSION}/${PLATFORM}/Lib/${TARGETCPU}"\ -o ! -d "${WCEROOT}/EVC/${OSVERSION}/bin"; then - { echo "configure: error: could not find PocketPC SDK or target compiler to enable WinCE mode $CEVERSION,$TARGETCPU,$ARCH,$PLATFORM" 1>&2; exit 1; } + { { echo "$as_me:$LINENO: error: could not find PocketPC SDK or target compiler to enable WinCE mode $CEVERSION,$TARGETCPU,$ARCH,$PLATFORM" >&5 +echo "$as_me: error: could not find PocketPC SDK or target compiler to enable WinCE mode $CEVERSION,$TARGETCPU,$ARCH,$PLATFORM" >&2;} + { (exit 1); exit 1; }; } else CEINCLUDE="${SDKROOT}/${OSVERSION}/${PLATFORM}/include" if test -d "${CEINCLUDE}/${TARGETCPU}" ; then @@ -1884,28 +4482,28 @@ rm -f conftest* arch=`echo ${ARCH} | awk '{print tolower($0)}'` defs="${ARCH} _${ARCH}_ ${arch} PALM_SIZE _MT _DLL _WINDOWS" for i in $defs ; do - cat >> confdefs.h <<EOF + cat >>confdefs.h <<_ACEOF #define $i 1 -EOF +_ACEOF done # if test "${ARCH}" = "X86EM"; then # AC_DEFINE_UNQUOTED(_WIN32_WCE_EMULATION) # fi - cat >> confdefs.h <<EOF + cat >>confdefs.h <<_ACEOF #define _WIN32_WCE $CEVERSION -EOF +_ACEOF - cat >> confdefs.h <<EOF + cat >>confdefs.h <<_ACEOF #define UNDER_CE $CEVERSION -EOF +_ACEOF CFLAGS_DEBUG="-nologo -Zi -Od" CFLAGS_OPTIMIZE="-nologo -O2" lversion=`echo ${CEVERSION} | sed -e 's/\(.\)\(..\)/\1\.\2/'` lflags="-nodefaultlib -MACHINE:${ARCH} -LIBPATH:\"${CELIBPATH}\" -subsystem:windowsce,${lversion} -nologo" LINKBIN="\"${CEBINROOT}/link.exe\"" - + if test "${CEVERSION}" -lt 400 ; then LIBS="coredll.lib corelibc.lib winsock.lib" else @@ -1916,7 +4514,7 @@ EOF LIBS="$LIBS \"\${CELIB_DIR}/wince-${ARCH}-pocket-wce300-release/celib.lib\"" LIBS_GUI="commctrl.lib commdlg.lib" else - LIBS_GUI="gdi32.lib comdlg32.lib imm32.lib comctl32.lib shell32.lib" + LIBS_GUI="gdi32.lib comdlg32.lib imm32.lib comctl32.lib shell32.lib uuid.lib" fi SHLIB_LD="${LINKBIN} -dll -incremental:no ${lflags}" @@ -1955,13 +4553,291 @@ EOF fi fi + if test "$do64bit" != "no" ; then + cat >>confdefs.h <<\_ACEOF +#define TCL_CFG_DO64BIT 1 +_ACEOF + + fi + # DL_LIBS is empty, but then we match the Unix version - - - - + + + + +echo "$as_me:$LINENO: checking for intptr_t" >&5 +echo $ECHO_N "checking for intptr_t... $ECHO_C" >&6 +if test "${ac_cv_type_intptr_t+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +$ac_includes_default +int +main () +{ +if ((intptr_t *) 0) + return 0; +if (sizeof (intptr_t)) + return 0; + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_type_intptr_t=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_cv_type_intptr_t=no +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +fi +echo "$as_me:$LINENO: result: $ac_cv_type_intptr_t" >&5 +echo "${ECHO_T}$ac_cv_type_intptr_t" >&6 +if test $ac_cv_type_intptr_t = yes; then + + +cat >>confdefs.h <<\_ACEOF +#define HAVE_INTPTR_T 1 +_ACEOF + +else + + echo "$as_me:$LINENO: checking for pointer-size signed integer type" >&5 +echo $ECHO_N "checking for pointer-size signed integer type... $ECHO_C" >&6 +if test "${tcl_cv_intptr_t+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + + for tcl_cv_intptr_t in "int" "long" "long long" none; do + if test "$tcl_cv_intptr_t" != none; then + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +$ac_includes_default +int +main () +{ +static int test_array [1 - 2 * !(sizeof (void *) <= sizeof ($tcl_cv_intptr_t))]; +test_array [0] = 0 + + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + tcl_ok=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +tcl_ok=no +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext + test "$tcl_ok" = yes && break; fi + done +fi +echo "$as_me:$LINENO: result: $tcl_cv_intptr_t" >&5 +echo "${ECHO_T}$tcl_cv_intptr_t" >&6 + if test "$tcl_cv_intptr_t" != none; then + +cat >>confdefs.h <<_ACEOF +#define intptr_t $tcl_cv_intptr_t +_ACEOF + + fi + +fi + +echo "$as_me:$LINENO: checking for uintptr_t" >&5 +echo $ECHO_N "checking for uintptr_t... $ECHO_C" >&6 +if test "${ac_cv_type_uintptr_t+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +$ac_includes_default +int +main () +{ +if ((uintptr_t *) 0) + return 0; +if (sizeof (uintptr_t)) + return 0; + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_type_uintptr_t=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_cv_type_uintptr_t=no +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +fi +echo "$as_me:$LINENO: result: $ac_cv_type_uintptr_t" >&5 +echo "${ECHO_T}$ac_cv_type_uintptr_t" >&6 +if test $ac_cv_type_uintptr_t = yes; then + + +cat >>confdefs.h <<\_ACEOF +#define HAVE_UINTPTR_T 1 +_ACEOF + +else + + echo "$as_me:$LINENO: checking for pointer-size unsigned integer type" >&5 +echo $ECHO_N "checking for pointer-size unsigned integer type... $ECHO_C" >&6 +if test "${tcl_cv_uintptr_t+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + + for tcl_cv_uintptr_t in "unsigned int" "unsigned long" "unsigned long long" \ + none; do + if test "$tcl_cv_uintptr_t" != none; then + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +$ac_includes_default +int +main () +{ +static int test_array [1 - 2 * !(sizeof (void *) <= sizeof ($tcl_cv_uintptr_t))]; +test_array [0] = 0 + + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + tcl_ok=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +tcl_ok=no +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext + test "$tcl_ok" = yes && break; fi + done +fi +echo "$as_me:$LINENO: result: $tcl_cv_uintptr_t" >&5 +echo "${ECHO_T}$tcl_cv_uintptr_t" >&6 + if test "$tcl_cv_uintptr_t" != none; then + +cat >>confdefs.h <<_ACEOF +#define uintptr_t $tcl_cv_uintptr_t +_ACEOF + + fi + +fi + #-------------------------------------------------------------------- # Set the default compiler switches based on the --enable-symbols # option. This macro depends on C flags, and should be called @@ -1969,56 +4845,68 @@ EOF #-------------------------------------------------------------------- - echo $ac_n "checking for build with symbols""... $ac_c" 1>&6 -echo "configure:1974: checking for build with symbols" >&5 + echo "$as_me:$LINENO: checking for build with symbols" >&5 +echo $ECHO_N "checking for build with symbols... $ECHO_C" >&6 # Check whether --enable-symbols or --disable-symbols was given. if test "${enable_symbols+set}" = set; then enableval="$enable_symbols" tcl_ok=$enableval else tcl_ok=no -fi - +fi; # FIXME: Currently, LDFLAGS_DEFAULT is not used, it should work like CFLAGS_DEFAULT. if test "$tcl_ok" = "no"; then CFLAGS_DEFAULT='$(CFLAGS_OPTIMIZE)' LDFLAGS_DEFAULT='$(LDFLAGS_OPTIMIZE)' DBGX="" - echo "$ac_t""no" 1>&6 + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 + + cat >>confdefs.h <<\_ACEOF +#define TCL_CFG_OPTIMIZED 1 +_ACEOF + else CFLAGS_DEFAULT='$(CFLAGS_DEBUG)' LDFLAGS_DEFAULT='$(LDFLAGS_DEBUG)' DBGX=g if test "$tcl_ok" = "yes"; then - echo "$ac_t""yes (standard debugging)" 1>&6 + echo "$as_me:$LINENO: result: yes (standard debugging)" >&5 +echo "${ECHO_T}yes (standard debugging)" >&6 fi fi - - + + + cat >>confdefs.h <<\_ACEOF +#define TCL_CFG_DEBUG 1 +_ACEOF + if test "$tcl_ok" = "mem" -o "$tcl_ok" = "all"; then - cat >> confdefs.h <<\EOF + cat >>confdefs.h <<\_ACEOF #define TCL_MEM_DEBUG 1 -EOF +_ACEOF fi if test "$tcl_ok" = "compile" -o "$tcl_ok" = "all"; then - cat >> confdefs.h <<\EOF + cat >>confdefs.h <<\_ACEOF #define TCL_COMPILE_DEBUG 1 -EOF +_ACEOF - cat >> confdefs.h <<\EOF + cat >>confdefs.h <<\_ACEOF #define TCL_COMPILE_STATS 1 -EOF +_ACEOF fi if test "$tcl_ok" != "yes" -a "$tcl_ok" != "no"; then if test "$tcl_ok" = "all"; then - echo "$ac_t""enabled symbols mem compile debugging" 1>&6 + echo "$as_me:$LINENO: result: enabled symbols mem compile debugging" >&5 +echo "${ECHO_T}enabled symbols mem compile debugging" >&6 else - echo "$ac_t""enabled $tcl_ok debugging" 1>&6 + echo "$as_me:$LINENO: result: enabled $tcl_ok debugging" >&5 +echo "${ECHO_T}enabled $tcl_ok debugging" >&6 fi fi @@ -2026,122 +4914,61 @@ EOF TCL_DBGX=${DBGX} #-------------------------------------------------------------------- -# man2tcl needs this so that it can use errno.h +# Embed the manifest if we can determine how #-------------------------------------------------------------------- -echo $ac_n "checking how to run the C preprocessor""... $ac_c" 1>&6 -echo "configure:2034: checking how to run the C preprocessor" >&5 -# On Suns, sometimes $CPP names a directory. -if test -n "$CPP" && test -d "$CPP"; then - CPP= -fi -if test -z "$CPP"; then -if eval "test \"`echo '$''{'ac_cv_prog_CPP'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - # This must be in double quotes, not single quotes, because CPP may get - # substituted into the Makefile and "${CC-cc}" will confuse make. - CPP="${CC-cc} -E" - # On the NeXT, cc -E runs the code through the compiler's parser, - # not just through cpp. - cat > conftest.$ac_ext <<EOF -#line 2049 "configure" -#include "confdefs.h" -#include <assert.h> -Syntax Error -EOF -ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:2055: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } -ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` -if test -z "$ac_err"; then - : -else - echo "$ac_err" >&5 - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - CPP="${CC-cc} -E -traditional-cpp" - cat > conftest.$ac_ext <<EOF -#line 2066 "configure" -#include "confdefs.h" -#include <assert.h> -Syntax Error -EOF -ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:2072: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } -ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` -if test -z "$ac_err"; then - : -else - echo "$ac_err" >&5 - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - CPP="${CC-cc} -nologo -E" - cat > conftest.$ac_ext <<EOF -#line 2083 "configure" -#include "confdefs.h" -#include <assert.h> -Syntax Error -EOF -ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:2089: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } -ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` -if test -z "$ac_err"; then - : + + echo "$as_me:$LINENO: checking whether to embed manifest" >&5 +echo $ECHO_N "checking whether to embed manifest... $ECHO_C" >&6 + # Check whether --enable-embedded-manifest or --disable-embedded-manifest was given. +if test "${enable_embedded_manifest+set}" = set; then + enableval="$enable_embedded_manifest" + embed_ok=$enableval else - echo "$ac_err" >&5 - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - CPP=/lib/cpp -fi -rm -f conftest* -fi -rm -f conftest* -fi -rm -f conftest* - ac_cv_prog_CPP="$CPP" -fi - CPP="$ac_cv_prog_CPP" -else - ac_cv_prog_CPP="$CPP" -fi -echo "$ac_t""$CPP" 1>&6 - -ac_safe=`echo "errno.h" | sed 'y%./+-%__p_%'` -echo $ac_n "checking for errno.h""... $ac_c" 1>&6 -echo "configure:2115: checking for errno.h" >&5 -if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - cat > conftest.$ac_ext <<EOF -#line 2120 "configure" -#include "confdefs.h" -#include <errno.h> -EOF -ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:2125: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } -ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` -if test -z "$ac_err"; then - rm -rf conftest* - eval "ac_cv_header_$ac_safe=yes" -else - echo "$ac_err" >&5 - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_header_$ac_safe=no" + embed_ok=yes +fi; + + VC_MANIFEST_EMBED_DLL= + VC_MANIFEST_EMBED_EXE= + result=no + if test "$embed_ok" = "yes" -a "${SHARED_BUILD}" = "1" \ + -a "$GCC" != "yes" ; then + # Add the magic to embed the manifest into the dll/exe + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ + +#if defined(_MSC_VER) && _MSC_VER >= 1400 +print("manifest needed") +#endif + +_ACEOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + $EGREP "manifest needed" >/dev/null 2>&1; then + + # Could do a CHECK_PROG for mt, but should always be with MSVC8+ + # Could add 'if test -f' check, but manifest should be created + # in this compiler case + # Add in a manifest argument that may be specified + # XXX Needs improvement so that the test for existence accounts + # XXX for a provided (known) manifest + VC_MANIFEST_EMBED_DLL="if test -f \$@.manifest ; then mt.exe -nologo -manifest \$@.manifest -outputresource:\$@\;2 ; fi" + VC_MANIFEST_EMBED_EXE="if test -f \$@.manifest ; then mt.exe -nologo -manifest \$@.manifest -outputresource:\$@\;1 ; fi" + result=yes + if test "x" != x ; then + result="yes ()" + fi + fi rm -f conftest* -fi -if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then - echo "$ac_t""yes" 1>&6 - : -else - echo "$ac_t""no" 1>&6 -MAN2TCLFLAGS="-DNO_ERRNO_H" -fi + + fi + echo "$as_me:$LINENO: result: $result" >&5 +echo "${ECHO_T}$result" >&6 + @@ -2292,7 +5119,6 @@ fi - # win only @@ -2309,338 +5135,1001 @@ fi -trap '' 1 2 15 -cat > confcache <<\EOF + + + ac_config_files="$ac_config_files Makefile tclConfig.sh tcl.hpj" +cat >confcache <<\_ACEOF # This file is a shell script that caches the results of configure # tests run on this system so they can be shared between configure -# scripts and configure runs. It is not useful on other systems. -# If it contains results you don't want to keep, you may remove or edit it. +# scripts and configure runs, see configure's option --config-cache. +# It is not useful on other systems. If it contains results you don't +# want to keep, you may remove or edit it. # -# By default, configure uses ./config.cache as the cache file, -# creating it if it does not exist already. You can give configure -# the --cache-file=FILE option to use a different cache file; that is -# what configure does when it calls configure scripts in -# subdirectories, so they share the cache. -# Giving --cache-file=/dev/null disables caching, for debugging configure. -# config.status only pays attention to the cache file if you give it the -# --recheck option to rerun configure. +# config.status only pays attention to the cache file if you give it +# the --recheck option to rerun configure. # -EOF +# `ac_cv_env_foo' variables (set or unset) will be overridden when +# loading this file, other *unset* `ac_cv_foo' will be assigned the +# following values. + +_ACEOF + # The following way of writing the cache mishandles newlines in values, # but we know of no workaround that is simple, portable, and efficient. # So, don't put newlines in cache variables' values. # Ultrix sh set writes to stderr and can't be redirected directly, # and sets the high bit in the cache file unless we assign to the vars. -(set) 2>&1 | - case `(ac_space=' '; set | grep ac_space) 2>&1` in - *ac_space=\ *) - # `set' does not quote correctly, so add quotes (double-quote substitution - # turns \\\\ into \\, and sed turns \\ into \). - sed -n \ - -e "s/'/'\\\\''/g" \ - -e "s/^\\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\\)=\\(.*\\)/\\1=\${\\1='\\2'}/p" - ;; - *) - # `set' quotes correctly as required by POSIX, so do not add quotes. - sed -n -e 's/^\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\)=\(.*\)/\1=${\1=\2}/p' - ;; - esac >> confcache -if cmp -s $cache_file confcache; then - : -else +{ + (set) 2>&1 | + case `(ac_space=' '; set | grep ac_space) 2>&1` in + *ac_space=\ *) + # `set' does not quote correctly, so add quotes (double-quote + # substitution turns \\\\ into \\, and sed turns \\ into \). + sed -n \ + "s/'/'\\\\''/g; + s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p" + ;; + *) + # `set' quotes correctly as required by POSIX, so do not add quotes. + sed -n \ + "s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1=\\2/p" + ;; + esac; +} | + sed ' + t clear + : clear + s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/ + t end + /^ac_cv_env/!s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/ + : end' >>confcache +if diff $cache_file confcache >/dev/null 2>&1; then :; else if test -w $cache_file; then - echo "updating cache $cache_file" - cat confcache > $cache_file + test "x$cache_file" != "x/dev/null" && echo "updating cache $cache_file" + cat confcache >$cache_file else echo "not updating unwritable cache $cache_file" fi fi rm -f confcache -trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15 - test "x$prefix" = xNONE && prefix=$ac_default_prefix # Let make expand exec_prefix. test "x$exec_prefix" = xNONE && exec_prefix='${prefix}' -# Any assignment to VPATH causes Sun make to only execute -# the first set of double-colon rules, so remove it if not needed. -# If there is a colon in the path, we need to keep it. +# VPATH may cause trouble with some makes, so we remove $(srcdir), +# ${srcdir} and @srcdir@ from VPATH if srcdir is ".", strip leading and +# trailing colons and then remove the whole line if VPATH becomes empty +# (actually we leave an empty line to preserve line numbers). if test "x$srcdir" = x.; then - ac_vpsub='/^[ ]*VPATH[ ]*=[^:]*$/d' + ac_vpsub='/^[ ]*VPATH[ ]*=/{ +s/:*\$(srcdir):*/:/; +s/:*\${srcdir}:*/:/; +s/:*@srcdir@:*/:/; +s/^\([^=]*=[ ]*\):*/\1/; +s/:*$//; +s/^[^=]*=[ ]*$//; +}' fi -trap 'rm -f $CONFIG_STATUS conftest*; exit 1' 1 2 15 - # Transform confdefs.h into DEFS. # Protect against shell expansion while executing Makefile rules. # Protect against Makefile macro expansion. -cat > conftest.defs <<\EOF -s%#define \([A-Za-z_][A-Za-z0-9_]*\) *\(.*\)%-D\1=\2%g -s%[ `~#$^&*(){}\\|;'"<>?]%\\&%g -s%\[%\\&%g -s%\]%\\&%g -s%\$%$$%g -EOF -DEFS=`sed -f conftest.defs confdefs.h | tr '\012' ' '` -rm -f conftest.defs - - -# Without the "./", some shells look in PATH for config.status. -: ${CONFIG_STATUS=./config.status} +# +# If the first sed substitution is executed (which looks for macros that +# take arguments), then we branch to the quote section. Otherwise, +# look for a macro that doesn't take arguments. +cat >confdef2opt.sed <<\_ACEOF +t clear +: clear +s,^[ ]*#[ ]*define[ ][ ]*\([^ (][^ (]*([^)]*)\)[ ]*\(.*\),-D\1=\2,g +t quote +s,^[ ]*#[ ]*define[ ][ ]*\([^ ][^ ]*\)[ ]*\(.*\),-D\1=\2,g +t quote +d +: quote +s,[ `~#$^&*(){}\\|;'"<>?],\\&,g +s,\[,\\&,g +s,\],\\&,g +s,\$,$$,g +p +_ACEOF +# We use echo to avoid assuming a particular line-breaking character. +# The extra dot is to prevent the shell from consuming trailing +# line-breaks from the sub-command output. A line-break within +# single-quotes doesn't work because, if this script is created in a +# platform that uses two characters for line-breaks (e.g., DOS), tr +# would break. +ac_LF_and_DOT=`echo; echo .` +DEFS=`sed -n -f confdef2opt.sed confdefs.h | tr "$ac_LF_and_DOT" ' .'` +rm -f confdef2opt.sed + + +ac_libobjs= +ac_ltlibobjs= +for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue + # 1. Remove the extension, and $U if already installed. + ac_i=`echo "$ac_i" | + sed 's/\$U\././;s/\.o$//;s/\.obj$//'` + # 2. Add them. + ac_libobjs="$ac_libobjs $ac_i\$U.$ac_objext" + ac_ltlibobjs="$ac_ltlibobjs $ac_i"'$U.lo' +done +LIBOBJS=$ac_libobjs -echo creating $CONFIG_STATUS -rm -f $CONFIG_STATUS -cat > $CONFIG_STATUS <<EOF -#! /bin/sh -# Generated automatically by configure. +LTLIBOBJS=$ac_ltlibobjs + + + +: ${CONFIG_STATUS=./config.status} +ac_clean_files_save=$ac_clean_files +ac_clean_files="$ac_clean_files $CONFIG_STATUS" +{ echo "$as_me:$LINENO: creating $CONFIG_STATUS" >&5 +echo "$as_me: creating $CONFIG_STATUS" >&6;} +cat >$CONFIG_STATUS <<_ACEOF +#! $SHELL +# Generated by $as_me. # Run this file to recreate the current configuration. -# This directory was configured as follows, -# on host `(hostname || uname -n) 2>/dev/null | sed 1q`: -# -# $0 $ac_configure_args -# # Compiler output produced by configure, useful for debugging -# configure, is in ./config.log if it exists. +# configure, is in config.log if it exists. + +debug=false +ac_cs_recheck=false +ac_cs_silent=false +SHELL=\${CONFIG_SHELL-$SHELL} +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF +## --------------------- ## +## M4sh Initialization. ## +## --------------------- ## + +# Be Bourne compatible +if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then + emulate sh + NULLCMD=: + # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which + # is contrary to our usage. Disable this feature. + alias -g '${1+"$@"}'='"$@"' +elif test -n "${BASH_VERSION+set}" && (set -o posix) >/dev/null 2>&1; then + set -o posix +fi +DUALCASE=1; export DUALCASE # for MKS sh -ac_cs_usage="Usage: $CONFIG_STATUS [--recheck] [--version] [--help]" -for ac_option +# Support unset when possible. +if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then + as_unset=unset +else + as_unset=false +fi + + +# Work around bugs in pre-3.0 UWIN ksh. +$as_unset ENV MAIL MAILPATH +PS1='$ ' +PS2='> ' +PS4='+ ' + +# NLS nuisances. +for as_var in \ + LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \ + LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \ + LC_TELEPHONE LC_TIME do - case "\$ac_option" in - -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) - echo "running \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion" - exec \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion ;; - -version | --version | --versio | --versi | --vers | --ver | --ve | --v) - echo "$CONFIG_STATUS generated by autoconf version 2.13" - exit 0 ;; - -help | --help | --hel | --he | --h) - echo "\$ac_cs_usage"; exit 0 ;; - *) echo "\$ac_cs_usage"; exit 1 ;; - esac + if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then + eval $as_var=C; export $as_var + else + $as_unset $as_var + fi done -ac_given_srcdir=$srcdir +# Required to use basename. +if expr a : '\(a\)' >/dev/null 2>&1; then + as_expr=expr +else + as_expr=false +fi -trap 'rm -fr `echo "Makefile tclConfig.sh tcl.hpj" | sed "s/:[^ ]*//g"` conftest*; exit 1' 1 2 15 -EOF -cat >> $CONFIG_STATUS <<EOF +if (basename /) >/dev/null 2>&1 && test "X`basename / 2>&1`" = "X/"; then + as_basename=basename +else + as_basename=false +fi -# Protect against being on the right side of a sed subst in config.status. -sed 's/%@/@@/; s/@%/@@/; s/%g\$/@g/; /@g\$/s/[\\\\&%]/\\\\&/g; - s/@@/%@/; s/@@/@%/; s/@g\$/%g/' > conftest.subs <<\\CEOF -$ac_vpsub -$extrasub -s%@SHELL@%$SHELL%g -s%@CFLAGS@%$CFLAGS%g -s%@CPPFLAGS@%$CPPFLAGS%g -s%@CXXFLAGS@%$CXXFLAGS%g -s%@FFLAGS@%$FFLAGS%g -s%@DEFS@%$DEFS%g -s%@LDFLAGS@%$LDFLAGS%g -s%@LIBS@%$LIBS%g -s%@exec_prefix@%$exec_prefix%g -s%@prefix@%$prefix%g -s%@program_transform_name@%$program_transform_name%g -s%@bindir@%$bindir%g -s%@sbindir@%$sbindir%g -s%@libexecdir@%$libexecdir%g -s%@datadir@%$datadir%g -s%@sysconfdir@%$sysconfdir%g -s%@sharedstatedir@%$sharedstatedir%g -s%@localstatedir@%$localstatedir%g -s%@libdir@%$libdir%g -s%@includedir@%$includedir%g -s%@oldincludedir@%$oldincludedir%g -s%@infodir@%$infodir%g -s%@mandir@%$mandir%g -s%@CC@%$CC%g -s%@AR@%$AR%g -s%@RANLIB@%$RANLIB%g -s%@RC@%$RC%g -s%@SET_MAKE@%$SET_MAKE%g -s%@OBJEXT@%$OBJEXT%g -s%@EXEEXT@%$EXEEXT%g -s%@TCL_THREADS@%$TCL_THREADS%g -s%@CYGPATH@%$CYGPATH%g -s%@CELIB_DIR@%$CELIB_DIR%g -s%@DL_LIBS@%$DL_LIBS%g -s%@CFLAGS_DEBUG@%$CFLAGS_DEBUG%g -s%@CFLAGS_OPTIMIZE@%$CFLAGS_OPTIMIZE%g -s%@CFLAGS_WARNING@%$CFLAGS_WARNING%g -s%@CFLAGS_DEFAULT@%$CFLAGS_DEFAULT%g -s%@LDFLAGS_DEFAULT@%$LDFLAGS_DEFAULT%g -s%@CPP@%$CPP%g -s%@MAN2TCLFLAGS@%$MAN2TCLFLAGS%g -s%@TCL_VERSION@%$TCL_VERSION%g -s%@TCL_MAJOR_VERSION@%$TCL_MAJOR_VERSION%g -s%@TCL_MINOR_VERSION@%$TCL_MINOR_VERSION%g -s%@TCL_PATCH_LEVEL@%$TCL_PATCH_LEVEL%g -s%@TCL_LIB_FILE@%$TCL_LIB_FILE%g -s%@TCL_LIB_FLAG@%$TCL_LIB_FLAG%g -s%@TCL_LIB_SPEC@%$TCL_LIB_SPEC%g -s%@TCL_STUB_LIB_FILE@%$TCL_STUB_LIB_FILE%g -s%@TCL_STUB_LIB_FLAG@%$TCL_STUB_LIB_FLAG%g -s%@TCL_STUB_LIB_SPEC@%$TCL_STUB_LIB_SPEC%g -s%@TCL_STUB_LIB_PATH@%$TCL_STUB_LIB_PATH%g -s%@TCL_INCLUDE_SPEC@%$TCL_INCLUDE_SPEC%g -s%@TCL_BUILD_STUB_LIB_SPEC@%$TCL_BUILD_STUB_LIB_SPEC%g -s%@TCL_BUILD_STUB_LIB_PATH@%$TCL_BUILD_STUB_LIB_PATH%g -s%@TCL_DLL_FILE@%$TCL_DLL_FILE%g -s%@TCL_SRC_DIR@%$TCL_SRC_DIR%g -s%@TCL_BIN_DIR@%$TCL_BIN_DIR%g -s%@TCL_DBGX@%$TCL_DBGX%g -s%@CFG_TCL_SHARED_LIB_SUFFIX@%$CFG_TCL_SHARED_LIB_SUFFIX%g -s%@CFG_TCL_UNSHARED_LIB_SUFFIX@%$CFG_TCL_UNSHARED_LIB_SUFFIX%g -s%@CFG_TCL_EXPORT_FILE_SUFFIX@%$CFG_TCL_EXPORT_FILE_SUFFIX%g -s%@EXTRA_CFLAGS@%$EXTRA_CFLAGS%g -s%@DEPARG@%$DEPARG%g -s%@CC_OBJNAME@%$CC_OBJNAME%g -s%@CC_EXENAME@%$CC_EXENAME%g -s%@LDFLAGS_DEBUG@%$LDFLAGS_DEBUG%g -s%@LDFLAGS_OPTIMIZE@%$LDFLAGS_OPTIMIZE%g -s%@LDFLAGS_CONSOLE@%$LDFLAGS_CONSOLE%g -s%@LDFLAGS_WINDOW@%$LDFLAGS_WINDOW%g -s%@STLIB_LD@%$STLIB_LD%g -s%@SHLIB_LD@%$SHLIB_LD%g -s%@SHLIB_LD_LIBS@%$SHLIB_LD_LIBS%g -s%@SHLIB_CFLAGS@%$SHLIB_CFLAGS%g -s%@SHLIB_SUFFIX@%$SHLIB_SUFFIX%g -s%@TCL_SHARED_BUILD@%$TCL_SHARED_BUILD%g -s%@LIBS_GUI@%$LIBS_GUI%g -s%@DLLSUFFIX@%$DLLSUFFIX%g -s%@LIBPREFIX@%$LIBPREFIX%g -s%@LIBSUFFIX@%$LIBSUFFIX%g -s%@EXESUFFIX@%$EXESUFFIX%g -s%@LIBRARIES@%$LIBRARIES%g -s%@MAKE_LIB@%$MAKE_LIB%g -s%@POST_MAKE_LIB@%$POST_MAKE_LIB%g -s%@MAKE_DLL@%$MAKE_DLL%g -s%@MAKE_EXE@%$MAKE_EXE%g -s%@TCL_BUILD_LIB_SPEC@%$TCL_BUILD_LIB_SPEC%g -s%@TCL_LD_SEARCH_FLAGS@%$TCL_LD_SEARCH_FLAGS%g -s%@TCL_NEEDS_EXP_FILE@%$TCL_NEEDS_EXP_FILE%g -s%@TCL_BUILD_EXP_FILE@%$TCL_BUILD_EXP_FILE%g -s%@TCL_EXP_FILE@%$TCL_EXP_FILE%g -s%@LIBOBJS@%$LIBOBJS%g -s%@TCL_LIB_VERSIONS_OK@%$TCL_LIB_VERSIONS_OK%g -s%@TCL_PACKAGE_PATH@%$TCL_PACKAGE_PATH%g -s%@TCL_DDE_VERSION@%$TCL_DDE_VERSION%g -s%@TCL_DDE_MAJOR_VERSION@%$TCL_DDE_MAJOR_VERSION%g -s%@TCL_DDE_MINOR_VERSION@%$TCL_DDE_MINOR_VERSION%g -s%@TCL_REG_VERSION@%$TCL_REG_VERSION%g -s%@TCL_REG_MAJOR_VERSION@%$TCL_REG_MAJOR_VERSION%g -s%@TCL_REG_MINOR_VERSION@%$TCL_REG_MINOR_VERSION%g -s%@RC_OUT@%$RC_OUT%g -s%@RC_TYPE@%$RC_TYPE%g -s%@RC_INCLUDE@%$RC_INCLUDE%g -s%@RC_DEFINE@%$RC_DEFINE%g -s%@RC_DEFINES@%$RC_DEFINES%g -s%@RES@%$RES%g -CEOF -EOF - -cat >> $CONFIG_STATUS <<\EOF - -# Split the substitutions into bite-sized pieces for seds with -# small command number limits, like on Digital OSF/1 and HP-UX. -ac_max_sed_cmds=90 # Maximum number of lines to put in a sed script. -ac_file=1 # Number of current file. -ac_beg=1 # First line for current file. -ac_end=$ac_max_sed_cmds # Line after last line for current file. -ac_more_lines=: -ac_sed_cmds="" -while $ac_more_lines; do - if test $ac_beg -gt 1; then - sed "1,${ac_beg}d; ${ac_end}q" conftest.subs > conftest.s$ac_file +# Name of the executable. +as_me=`$as_basename "$0" || +$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ + X"$0" : 'X\(//\)$' \| \ + X"$0" : 'X\(/\)$' \| \ + . : '\(.\)' 2>/dev/null || +echo X/"$0" | + sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/; q; } + /^X\/\(\/\/\)$/{ s//\1/; q; } + /^X\/\(\/\).*/{ s//\1/; q; } + s/.*/./; q'` + + +# PATH needs CR, and LINENO needs CR and PATH. +# Avoid depending upon Character Ranges. +as_cr_letters='abcdefghijklmnopqrstuvwxyz' +as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' +as_cr_Letters=$as_cr_letters$as_cr_LETTERS +as_cr_digits='0123456789' +as_cr_alnum=$as_cr_Letters$as_cr_digits + +# The user is always right. +if test "${PATH_SEPARATOR+set}" != set; then + echo "#! /bin/sh" >conf$$.sh + echo "exit 0" >>conf$$.sh + chmod +x conf$$.sh + if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then + PATH_SEPARATOR=';' else - sed "${ac_end}q" conftest.subs > conftest.s$ac_file + PATH_SEPARATOR=: fi - if test ! -s conftest.s$ac_file; then - ac_more_lines=false - rm -f conftest.s$ac_file + rm -f conf$$.sh +fi + + + as_lineno_1=$LINENO + as_lineno_2=$LINENO + as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null` + test "x$as_lineno_1" != "x$as_lineno_2" && + test "x$as_lineno_3" = "x$as_lineno_2" || { + # Find who we are. Look in the path if we contain no path at all + # relative or not. + case $0 in + *[\\/]* ) as_myself=$0 ;; + *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break +done + + ;; + esac + # We did not find ourselves, most probably we were run as `sh COMMAND' + # in which case we are not to be found in the path. + if test "x$as_myself" = x; then + as_myself=$0 + fi + if test ! -f "$as_myself"; then + { { echo "$as_me:$LINENO: error: cannot find myself; rerun with an absolute path" >&5 +echo "$as_me: error: cannot find myself; rerun with an absolute path" >&2;} + { (exit 1); exit 1; }; } + fi + case $CONFIG_SHELL in + '') + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for as_base in sh bash ksh sh5; do + case $as_dir in + /*) + if ("$as_dir/$as_base" -c ' + as_lineno_1=$LINENO + as_lineno_2=$LINENO + as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null` + test "x$as_lineno_1" != "x$as_lineno_2" && + test "x$as_lineno_3" = "x$as_lineno_2" ') 2>/dev/null; then + $as_unset BASH_ENV || test "${BASH_ENV+set}" != set || { BASH_ENV=; export BASH_ENV; } + $as_unset ENV || test "${ENV+set}" != set || { ENV=; export ENV; } + CONFIG_SHELL=$as_dir/$as_base + export CONFIG_SHELL + exec "$CONFIG_SHELL" "$0" ${1+"$@"} + fi;; + esac + done +done +;; + esac + + # Create $as_me.lineno as a copy of $as_myself, but with $LINENO + # uniformly replaced by the line number. The first 'sed' inserts a + # line-number line before each line; the second 'sed' does the real + # work. The second script uses 'N' to pair each line-number line + # with the numbered line, and appends trailing '-' during + # substitution so that $LINENO is not a special case at line end. + # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the + # second 'sed' script. Blame Lee E. McMahon for sed's syntax. :-) + sed '=' <$as_myself | + sed ' + N + s,$,-, + : loop + s,^\(['$as_cr_digits']*\)\(.*\)[$]LINENO\([^'$as_cr_alnum'_]\),\1\2\1\3, + t loop + s,-$,, + s,^['$as_cr_digits']*\n,, + ' >$as_me.lineno && + chmod +x $as_me.lineno || + { { echo "$as_me:$LINENO: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&5 +echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2;} + { (exit 1); exit 1; }; } + + # Don't try to exec as it changes $[0], causing all sort of problems + # (the dirname of $[0] is not the place where we might find the + # original and so on. Autoconf is especially sensible to this). + . ./$as_me.lineno + # Exit status is that of the last command. + exit +} + + +case `echo "testing\c"; echo 1,2,3`,`echo -n testing; echo 1,2,3` in + *c*,-n*) ECHO_N= ECHO_C=' +' ECHO_T=' ' ;; + *c*,* ) ECHO_N=-n ECHO_C= ECHO_T= ;; + *) ECHO_N= ECHO_C='\c' ECHO_T= ;; +esac + +if expr a : '\(a\)' >/dev/null 2>&1; then + as_expr=expr +else + as_expr=false +fi + +rm -f conf$$ conf$$.exe conf$$.file +echo >conf$$.file +if ln -s conf$$.file conf$$ 2>/dev/null; then + # We could just check for DJGPP; but this test a) works b) is more generic + # and c) will remain valid once DJGPP supports symlinks (DJGPP 2.04). + if test -f conf$$.exe; then + # Don't use ln at all; we don't have any links + as_ln_s='cp -p' else - if test -z "$ac_sed_cmds"; then - ac_sed_cmds="sed -f conftest.s$ac_file" - else - ac_sed_cmds="$ac_sed_cmds | sed -f conftest.s$ac_file" - fi - ac_file=`expr $ac_file + 1` - ac_beg=$ac_end - ac_end=`expr $ac_end + $ac_max_sed_cmds` + as_ln_s='ln -s' fi +elif ln conf$$.file conf$$ 2>/dev/null; then + as_ln_s=ln +else + as_ln_s='cp -p' +fi +rm -f conf$$ conf$$.exe conf$$.file + +if mkdir -p . 2>/dev/null; then + as_mkdir_p=: +else + test -d ./-p && rmdir ./-p + as_mkdir_p=false +fi + +as_executable_p="test -f" + +# Sed expression to map a string onto a valid CPP name. +as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" + +# Sed expression to map a string onto a valid variable name. +as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" + + +# IFS +# We need space, tab and new line, in precisely that order. +as_nl=' +' +IFS=" $as_nl" + +# CDPATH. +$as_unset CDPATH + +exec 6>&1 + +# Open the log real soon, to keep \$[0] and so on meaningful, and to +# report actual input values of CONFIG_FILES etc. instead of their +# values after options handling. Logging --version etc. is OK. +exec 5>>config.log +{ + echo + sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX +## Running $as_me. ## +_ASBOX +} >&5 +cat >&5 <<_CSEOF + +This file was extended by $as_me, which was +generated by GNU Autoconf 2.59. Invocation command line was + + CONFIG_FILES = $CONFIG_FILES + CONFIG_HEADERS = $CONFIG_HEADERS + CONFIG_LINKS = $CONFIG_LINKS + CONFIG_COMMANDS = $CONFIG_COMMANDS + $ $0 $@ + +_CSEOF +echo "on `(hostname || uname -n) 2>/dev/null | sed 1q`" >&5 +echo >&5 +_ACEOF + +# Files that config.status was made for. +if test -n "$ac_config_files"; then + echo "config_files=\"$ac_config_files\"" >>$CONFIG_STATUS +fi + +if test -n "$ac_config_headers"; then + echo "config_headers=\"$ac_config_headers\"" >>$CONFIG_STATUS +fi + +if test -n "$ac_config_links"; then + echo "config_links=\"$ac_config_links\"" >>$CONFIG_STATUS +fi + +if test -n "$ac_config_commands"; then + echo "config_commands=\"$ac_config_commands\"" >>$CONFIG_STATUS +fi + +cat >>$CONFIG_STATUS <<\_ACEOF + +ac_cs_usage="\ +\`$as_me' instantiates files from templates according to the +current configuration. + +Usage: $0 [OPTIONS] [FILE]... + + -h, --help print this help, then exit + -V, --version print version number, then exit + -q, --quiet do not print progress messages + -d, --debug don't remove temporary files + --recheck update $as_me by reconfiguring in the same conditions + --file=FILE[:TEMPLATE] + instantiate the configuration file FILE + +Configuration files: +$config_files + +Report bugs to <bug-autoconf@gnu.org>." +_ACEOF + +cat >>$CONFIG_STATUS <<_ACEOF +ac_cs_version="\\ +config.status +configured by $0, generated by GNU Autoconf 2.59, + with options \\"`echo "$ac_configure_args" | sed 's/[\\""\`\$]/\\\\&/g'`\\" + +Copyright (C) 2003 Free Software Foundation, Inc. +This config.status script is free software; the Free Software Foundation +gives unlimited permission to copy, distribute and modify it." +srcdir=$srcdir +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF +# If no file are specified by the user, then we need to provide default +# value. By we need to know if files were specified by the user. +ac_need_defaults=: +while test $# != 0 +do + case $1 in + --*=*) + ac_option=`expr "x$1" : 'x\([^=]*\)='` + ac_optarg=`expr "x$1" : 'x[^=]*=\(.*\)'` + ac_shift=: + ;; + -*) + ac_option=$1 + ac_optarg=$2 + ac_shift=shift + ;; + *) # This is not an option, so the user has probably given explicit + # arguments. + ac_option=$1 + ac_need_defaults=false;; + esac + + case $ac_option in + # Handling of the options. +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF + -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) + ac_cs_recheck=: ;; + --version | --vers* | -V ) + echo "$ac_cs_version"; exit 0 ;; + --he | --h) + # Conflict between --help and --header + { { echo "$as_me:$LINENO: error: ambiguous option: $1 +Try \`$0 --help' for more information." >&5 +echo "$as_me: error: ambiguous option: $1 +Try \`$0 --help' for more information." >&2;} + { (exit 1); exit 1; }; };; + --help | --hel | -h ) + echo "$ac_cs_usage"; exit 0 ;; + --debug | --d* | -d ) + debug=: ;; + --file | --fil | --fi | --f ) + $ac_shift + CONFIG_FILES="$CONFIG_FILES $ac_optarg" + ac_need_defaults=false;; + --header | --heade | --head | --hea ) + $ac_shift + CONFIG_HEADERS="$CONFIG_HEADERS $ac_optarg" + ac_need_defaults=false;; + -q | -quiet | --quiet | --quie | --qui | --qu | --q \ + | -silent | --silent | --silen | --sile | --sil | --si | --s) + ac_cs_silent=: ;; + + # This is an error. + -*) { { echo "$as_me:$LINENO: error: unrecognized option: $1 +Try \`$0 --help' for more information." >&5 +echo "$as_me: error: unrecognized option: $1 +Try \`$0 --help' for more information." >&2;} + { (exit 1); exit 1; }; } ;; + + *) ac_config_targets="$ac_config_targets $1" ;; + + esac + shift done -if test -z "$ac_sed_cmds"; then - ac_sed_cmds=cat + +ac_configure_extra_args= + +if $ac_cs_silent; then + exec 6>/dev/null + ac_configure_extra_args="$ac_configure_extra_args --silent" fi -EOF -cat >> $CONFIG_STATUS <<EOF +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF +if \$ac_cs_recheck; then + echo "running $SHELL $0 " $ac_configure_args \$ac_configure_extra_args " --no-create --no-recursion" >&6 + exec $SHELL $0 $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion +fi -CONFIG_FILES=\${CONFIG_FILES-"Makefile tclConfig.sh tcl.hpj"} -EOF -cat >> $CONFIG_STATUS <<\EOF -for ac_file in .. $CONFIG_FILES; do if test "x$ac_file" != x..; then - # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in". - case "$ac_file" in - *:*) ac_file_in=`echo "$ac_file"|sed 's%[^:]*:%%'` - ac_file=`echo "$ac_file"|sed 's%:.*%%'` ;; - *) ac_file_in="${ac_file}.in" ;; +_ACEOF + + + + + +cat >>$CONFIG_STATUS <<\_ACEOF +for ac_config_target in $ac_config_targets +do + case "$ac_config_target" in + # Handling of arguments. + "Makefile" ) CONFIG_FILES="$CONFIG_FILES Makefile" ;; + "tclConfig.sh" ) CONFIG_FILES="$CONFIG_FILES tclConfig.sh" ;; + "tcl.hpj" ) CONFIG_FILES="$CONFIG_FILES tcl.hpj" ;; + *) { { echo "$as_me:$LINENO: error: invalid argument: $ac_config_target" >&5 +echo "$as_me: error: invalid argument: $ac_config_target" >&2;} + { (exit 1); exit 1; }; };; esac +done - # Adjust a relative srcdir, top_srcdir, and INSTALL for subdirectories. +# If the user did not use the arguments to specify the items to instantiate, +# then the envvar interface is used. Set only those that are not. +# We use the long form for the default assignment because of an extremely +# bizarre bug on SunOS 4.1.3. +if $ac_need_defaults; then + test "${CONFIG_FILES+set}" = set || CONFIG_FILES=$config_files +fi - # Remove last slash and all that follows it. Not all systems have dirname. - ac_dir=`echo $ac_file|sed 's%/[^/][^/]*$%%'` - if test "$ac_dir" != "$ac_file" && test "$ac_dir" != .; then - # The file is in a subdirectory. - test ! -d "$ac_dir" && mkdir "$ac_dir" - ac_dir_suffix="/`echo $ac_dir|sed 's%^\./%%'`" - # A "../" for each directory in $ac_dir_suffix. - ac_dots=`echo $ac_dir_suffix|sed 's%/[^/]*%../%g'` - else - ac_dir_suffix= ac_dots= +# Have a temporary directory for convenience. Make it in the build tree +# simply because there is no reason to put it here, and in addition, +# creating and moving files from /tmp can sometimes cause problems. +# Create a temporary directory, and hook for its removal unless debugging. +$debug || +{ + trap 'exit_status=$?; rm -rf $tmp && exit $exit_status' 0 + trap '{ (exit 1); exit 1; }' 1 2 13 15 +} + +# Create a (secure) tmp directory for tmp files. + +{ + tmp=`(umask 077 && mktemp -d -q "./confstatXXXXXX") 2>/dev/null` && + test -n "$tmp" && test -d "$tmp" +} || +{ + tmp=./confstat$$-$RANDOM + (umask 077 && mkdir $tmp) +} || +{ + echo "$me: cannot create a temporary directory in ." >&2 + { (exit 1); exit 1; } +} + +_ACEOF + +cat >>$CONFIG_STATUS <<_ACEOF + +# +# CONFIG_FILES section. +# + +# No need to generate the scripts if there are no CONFIG_FILES. +# This happens for instance when ./config.status config.h +if test -n "\$CONFIG_FILES"; then + # Protect against being on the right side of a sed subst in config.status. + sed 's/,@/@@/; s/@,/@@/; s/,;t t\$/@;t t/; /@;t t\$/s/[\\\\&,]/\\\\&/g; + s/@@/,@/; s/@@/@,/; s/@;t t\$/,;t t/' >\$tmp/subs.sed <<\\CEOF +s,@SHELL@,$SHELL,;t t +s,@PATH_SEPARATOR@,$PATH_SEPARATOR,;t t +s,@PACKAGE_NAME@,$PACKAGE_NAME,;t t +s,@PACKAGE_TARNAME@,$PACKAGE_TARNAME,;t t +s,@PACKAGE_VERSION@,$PACKAGE_VERSION,;t t +s,@PACKAGE_STRING@,$PACKAGE_STRING,;t t +s,@PACKAGE_BUGREPORT@,$PACKAGE_BUGREPORT,;t t +s,@exec_prefix@,$exec_prefix,;t t +s,@prefix@,$prefix,;t t +s,@program_transform_name@,$program_transform_name,;t t +s,@bindir@,$bindir,;t t +s,@sbindir@,$sbindir,;t t +s,@libexecdir@,$libexecdir,;t t +s,@datadir@,$datadir,;t t +s,@sysconfdir@,$sysconfdir,;t t +s,@sharedstatedir@,$sharedstatedir,;t t +s,@localstatedir@,$localstatedir,;t t +s,@libdir@,$libdir,;t t +s,@includedir@,$includedir,;t t +s,@oldincludedir@,$oldincludedir,;t t +s,@infodir@,$infodir,;t t +s,@mandir@,$mandir,;t t +s,@build_alias@,$build_alias,;t t +s,@host_alias@,$host_alias,;t t +s,@target_alias@,$target_alias,;t t +s,@DEFS@,$DEFS,;t t +s,@ECHO_C@,$ECHO_C,;t t +s,@ECHO_N@,$ECHO_N,;t t +s,@ECHO_T@,$ECHO_T,;t t +s,@LIBS@,$LIBS,;t t +s,@CC@,$CC,;t t +s,@CFLAGS@,$CFLAGS,;t t +s,@LDFLAGS@,$LDFLAGS,;t t +s,@CPPFLAGS@,$CPPFLAGS,;t t +s,@ac_ct_CC@,$ac_ct_CC,;t t +s,@EXEEXT@,$EXEEXT,;t t +s,@OBJEXT@,$OBJEXT,;t t +s,@CPP@,$CPP,;t t +s,@EGREP@,$EGREP,;t t +s,@AR@,$AR,;t t +s,@ac_ct_AR@,$ac_ct_AR,;t t +s,@RANLIB@,$RANLIB,;t t +s,@ac_ct_RANLIB@,$ac_ct_RANLIB,;t t +s,@RC@,$RC,;t t +s,@ac_ct_RC@,$ac_ct_RC,;t t +s,@SET_MAKE@,$SET_MAKE,;t t +s,@TCL_THREADS@,$TCL_THREADS,;t t +s,@CYGPATH@,$CYGPATH,;t t +s,@CELIB_DIR@,$CELIB_DIR,;t t +s,@DL_LIBS@,$DL_LIBS,;t t +s,@CFLAGS_DEBUG@,$CFLAGS_DEBUG,;t t +s,@CFLAGS_OPTIMIZE@,$CFLAGS_OPTIMIZE,;t t +s,@CFLAGS_WARNING@,$CFLAGS_WARNING,;t t +s,@CFLAGS_DEFAULT@,$CFLAGS_DEFAULT,;t t +s,@LDFLAGS_DEFAULT@,$LDFLAGS_DEFAULT,;t t +s,@VC_MANIFEST_EMBED_DLL@,$VC_MANIFEST_EMBED_DLL,;t t +s,@VC_MANIFEST_EMBED_EXE@,$VC_MANIFEST_EMBED_EXE,;t t +s,@TCL_VERSION@,$TCL_VERSION,;t t +s,@TCL_MAJOR_VERSION@,$TCL_MAJOR_VERSION,;t t +s,@TCL_MINOR_VERSION@,$TCL_MINOR_VERSION,;t t +s,@TCL_PATCH_LEVEL@,$TCL_PATCH_LEVEL,;t t +s,@TCL_LIB_FILE@,$TCL_LIB_FILE,;t t +s,@TCL_LIB_FLAG@,$TCL_LIB_FLAG,;t t +s,@TCL_LIB_SPEC@,$TCL_LIB_SPEC,;t t +s,@TCL_STUB_LIB_FILE@,$TCL_STUB_LIB_FILE,;t t +s,@TCL_STUB_LIB_FLAG@,$TCL_STUB_LIB_FLAG,;t t +s,@TCL_STUB_LIB_SPEC@,$TCL_STUB_LIB_SPEC,;t t +s,@TCL_STUB_LIB_PATH@,$TCL_STUB_LIB_PATH,;t t +s,@TCL_INCLUDE_SPEC@,$TCL_INCLUDE_SPEC,;t t +s,@TCL_BUILD_STUB_LIB_SPEC@,$TCL_BUILD_STUB_LIB_SPEC,;t t +s,@TCL_BUILD_STUB_LIB_PATH@,$TCL_BUILD_STUB_LIB_PATH,;t t +s,@TCL_DLL_FILE@,$TCL_DLL_FILE,;t t +s,@TCL_SRC_DIR@,$TCL_SRC_DIR,;t t +s,@TCL_BIN_DIR@,$TCL_BIN_DIR,;t t +s,@TCL_DBGX@,$TCL_DBGX,;t t +s,@CFG_TCL_SHARED_LIB_SUFFIX@,$CFG_TCL_SHARED_LIB_SUFFIX,;t t +s,@CFG_TCL_UNSHARED_LIB_SUFFIX@,$CFG_TCL_UNSHARED_LIB_SUFFIX,;t t +s,@CFG_TCL_EXPORT_FILE_SUFFIX@,$CFG_TCL_EXPORT_FILE_SUFFIX,;t t +s,@EXTRA_CFLAGS@,$EXTRA_CFLAGS,;t t +s,@DEPARG@,$DEPARG,;t t +s,@CC_OBJNAME@,$CC_OBJNAME,;t t +s,@CC_EXENAME@,$CC_EXENAME,;t t +s,@LDFLAGS_DEBUG@,$LDFLAGS_DEBUG,;t t +s,@LDFLAGS_OPTIMIZE@,$LDFLAGS_OPTIMIZE,;t t +s,@LDFLAGS_CONSOLE@,$LDFLAGS_CONSOLE,;t t +s,@LDFLAGS_WINDOW@,$LDFLAGS_WINDOW,;t t +s,@STLIB_LD@,$STLIB_LD,;t t +s,@SHLIB_LD@,$SHLIB_LD,;t t +s,@SHLIB_LD_LIBS@,$SHLIB_LD_LIBS,;t t +s,@SHLIB_CFLAGS@,$SHLIB_CFLAGS,;t t +s,@SHLIB_SUFFIX@,$SHLIB_SUFFIX,;t t +s,@TCL_SHARED_BUILD@,$TCL_SHARED_BUILD,;t t +s,@LIBS_GUI@,$LIBS_GUI,;t t +s,@DLLSUFFIX@,$DLLSUFFIX,;t t +s,@LIBPREFIX@,$LIBPREFIX,;t t +s,@LIBSUFFIX@,$LIBSUFFIX,;t t +s,@EXESUFFIX@,$EXESUFFIX,;t t +s,@LIBRARIES@,$LIBRARIES,;t t +s,@MAKE_LIB@,$MAKE_LIB,;t t +s,@POST_MAKE_LIB@,$POST_MAKE_LIB,;t t +s,@MAKE_DLL@,$MAKE_DLL,;t t +s,@MAKE_EXE@,$MAKE_EXE,;t t +s,@TCL_BUILD_LIB_SPEC@,$TCL_BUILD_LIB_SPEC,;t t +s,@TCL_LD_SEARCH_FLAGS@,$TCL_LD_SEARCH_FLAGS,;t t +s,@TCL_NEEDS_EXP_FILE@,$TCL_NEEDS_EXP_FILE,;t t +s,@TCL_BUILD_EXP_FILE@,$TCL_BUILD_EXP_FILE,;t t +s,@TCL_EXP_FILE@,$TCL_EXP_FILE,;t t +s,@TCL_LIB_VERSIONS_OK@,$TCL_LIB_VERSIONS_OK,;t t +s,@TCL_PACKAGE_PATH@,$TCL_PACKAGE_PATH,;t t +s,@TCL_DDE_VERSION@,$TCL_DDE_VERSION,;t t +s,@TCL_DDE_MAJOR_VERSION@,$TCL_DDE_MAJOR_VERSION,;t t +s,@TCL_DDE_MINOR_VERSION@,$TCL_DDE_MINOR_VERSION,;t t +s,@TCL_DDE_PATCH_LEVEL@,$TCL_DDE_PATCH_LEVEL,;t t +s,@TCL_REG_VERSION@,$TCL_REG_VERSION,;t t +s,@TCL_REG_MAJOR_VERSION@,$TCL_REG_MAJOR_VERSION,;t t +s,@TCL_REG_MINOR_VERSION@,$TCL_REG_MINOR_VERSION,;t t +s,@TCL_REG_PATCH_LEVEL@,$TCL_REG_PATCH_LEVEL,;t t +s,@RC_OUT@,$RC_OUT,;t t +s,@RC_TYPE@,$RC_TYPE,;t t +s,@RC_INCLUDE@,$RC_INCLUDE,;t t +s,@RC_DEFINE@,$RC_DEFINE,;t t +s,@RC_DEFINES@,$RC_DEFINES,;t t +s,@RES@,$RES,;t t +s,@LIBOBJS@,$LIBOBJS,;t t +s,@LTLIBOBJS@,$LTLIBOBJS,;t t +CEOF + +_ACEOF + + cat >>$CONFIG_STATUS <<\_ACEOF + # Split the substitutions into bite-sized pieces for seds with + # small command number limits, like on Digital OSF/1 and HP-UX. + ac_max_sed_lines=48 + ac_sed_frag=1 # Number of current file. + ac_beg=1 # First line for current file. + ac_end=$ac_max_sed_lines # Line after last line for current file. + ac_more_lines=: + ac_sed_cmds= + while $ac_more_lines; do + if test $ac_beg -gt 1; then + sed "1,${ac_beg}d; ${ac_end}q" $tmp/subs.sed >$tmp/subs.frag + else + sed "${ac_end}q" $tmp/subs.sed >$tmp/subs.frag + fi + if test ! -s $tmp/subs.frag; then + ac_more_lines=false + else + # The purpose of the label and of the branching condition is to + # speed up the sed processing (if there are no `@' at all, there + # is no need to browse any of the substitutions). + # These are the two extra sed commands mentioned above. + (echo ':t + /@[a-zA-Z_][a-zA-Z_0-9]*@/!b' && cat $tmp/subs.frag) >$tmp/subs-$ac_sed_frag.sed + if test -z "$ac_sed_cmds"; then + ac_sed_cmds="sed -f $tmp/subs-$ac_sed_frag.sed" + else + ac_sed_cmds="$ac_sed_cmds | sed -f $tmp/subs-$ac_sed_frag.sed" + fi + ac_sed_frag=`expr $ac_sed_frag + 1` + ac_beg=$ac_end + ac_end=`expr $ac_end + $ac_max_sed_lines` + fi + done + if test -z "$ac_sed_cmds"; then + ac_sed_cmds=cat fi +fi # test -n "$CONFIG_FILES" - case "$ac_given_srcdir" in - .) srcdir=. - if test -z "$ac_dots"; then top_srcdir=. - else top_srcdir=`echo $ac_dots|sed 's%/$%%'`; fi ;; - /*) srcdir="$ac_given_srcdir$ac_dir_suffix"; top_srcdir="$ac_given_srcdir" ;; - *) # Relative path. - srcdir="$ac_dots$ac_given_srcdir$ac_dir_suffix" - top_srcdir="$ac_dots$ac_given_srcdir" ;; +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF +for ac_file in : $CONFIG_FILES; do test "x$ac_file" = x: && continue + # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in". + case $ac_file in + - | *:- | *:-:* ) # input from stdin + cat >$tmp/stdin + ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'` + ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;; + *:* ) ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'` + ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;; + * ) ac_file_in=$ac_file.in ;; esac + # Compute @srcdir@, @top_srcdir@, and @INSTALL@ for subdirectories. + ac_dir=`(dirname "$ac_file") 2>/dev/null || +$as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$ac_file" : 'X\(//\)[^/]' \| \ + X"$ac_file" : 'X\(//\)$' \| \ + X"$ac_file" : 'X\(/\)' \| \ + . : '\(.\)' 2>/dev/null || +echo X"$ac_file" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; } + /^X\(\/\/\)[^/].*/{ s//\1/; q; } + /^X\(\/\/\)$/{ s//\1/; q; } + /^X\(\/\).*/{ s//\1/; q; } + s/.*/./; q'` + { if $as_mkdir_p; then + mkdir -p "$ac_dir" + else + as_dir="$ac_dir" + as_dirs= + while test ! -d "$as_dir"; do + as_dirs="$as_dir $as_dirs" + as_dir=`(dirname "$as_dir") 2>/dev/null || +$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$as_dir" : 'X\(//\)[^/]' \| \ + X"$as_dir" : 'X\(//\)$' \| \ + X"$as_dir" : 'X\(/\)' \| \ + . : '\(.\)' 2>/dev/null || +echo X"$as_dir" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; } + /^X\(\/\/\)[^/].*/{ s//\1/; q; } + /^X\(\/\/\)$/{ s//\1/; q; } + /^X\(\/\).*/{ s//\1/; q; } + s/.*/./; q'` + done + test ! -n "$as_dirs" || mkdir $as_dirs + fi || { { echo "$as_me:$LINENO: error: cannot create directory \"$ac_dir\"" >&5 +echo "$as_me: error: cannot create directory \"$ac_dir\"" >&2;} + { (exit 1); exit 1; }; }; } - echo creating "$ac_file" - rm -f "$ac_file" - configure_input="Generated automatically from `echo $ac_file_in|sed 's%.*/%%'` by configure." - case "$ac_file" in - *Makefile*) ac_comsub="1i\\ -# $configure_input" ;; - *) ac_comsub= ;; - esac + ac_builddir=. - ac_file_inputs=`echo $ac_file_in|sed -e "s%^%$ac_given_srcdir/%" -e "s%:% $ac_given_srcdir/%g"` - sed -e "$ac_comsub -s%@configure_input@%$configure_input%g -s%@srcdir@%$srcdir%g -s%@top_srcdir@%$top_srcdir%g -" $ac_file_inputs | (eval "$ac_sed_cmds") > $ac_file -fi; done -rm -f conftest.s* +if test "$ac_dir" != .; then + ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'` + # A "../" for each directory in $ac_dir_suffix. + ac_top_builddir=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,../,g'` +else + ac_dir_suffix= ac_top_builddir= +fi -EOF -cat >> $CONFIG_STATUS <<EOF +case $srcdir in + .) # No --srcdir option. We are building in place. + ac_srcdir=. + if test -z "$ac_top_builddir"; then + ac_top_srcdir=. + else + ac_top_srcdir=`echo $ac_top_builddir | sed 's,/$,,'` + fi ;; + [\\/]* | ?:[\\/]* ) # Absolute path. + ac_srcdir=$srcdir$ac_dir_suffix; + ac_top_srcdir=$srcdir ;; + *) # Relative path. + ac_srcdir=$ac_top_builddir$srcdir$ac_dir_suffix + ac_top_srcdir=$ac_top_builddir$srcdir ;; +esac + +# Do not use `cd foo && pwd` to compute absolute paths, because +# the directories may not exist. +case `pwd` in +.) ac_abs_builddir="$ac_dir";; +*) + case "$ac_dir" in + .) ac_abs_builddir=`pwd`;; + [\\/]* | ?:[\\/]* ) ac_abs_builddir="$ac_dir";; + *) ac_abs_builddir=`pwd`/"$ac_dir";; + esac;; +esac +case $ac_abs_builddir in +.) ac_abs_top_builddir=${ac_top_builddir}.;; +*) + case ${ac_top_builddir}. in + .) ac_abs_top_builddir=$ac_abs_builddir;; + [\\/]* | ?:[\\/]* ) ac_abs_top_builddir=${ac_top_builddir}.;; + *) ac_abs_top_builddir=$ac_abs_builddir/${ac_top_builddir}.;; + esac;; +esac +case $ac_abs_builddir in +.) ac_abs_srcdir=$ac_srcdir;; +*) + case $ac_srcdir in + .) ac_abs_srcdir=$ac_abs_builddir;; + [\\/]* | ?:[\\/]* ) ac_abs_srcdir=$ac_srcdir;; + *) ac_abs_srcdir=$ac_abs_builddir/$ac_srcdir;; + esac;; +esac +case $ac_abs_builddir in +.) ac_abs_top_srcdir=$ac_top_srcdir;; +*) + case $ac_top_srcdir in + .) ac_abs_top_srcdir=$ac_abs_builddir;; + [\\/]* | ?:[\\/]* ) ac_abs_top_srcdir=$ac_top_srcdir;; + *) ac_abs_top_srcdir=$ac_abs_builddir/$ac_top_srcdir;; + esac;; +esac + + + + if test x"$ac_file" != x-; then + { echo "$as_me:$LINENO: creating $ac_file" >&5 +echo "$as_me: creating $ac_file" >&6;} + rm -f "$ac_file" + fi + # Let's still pretend it is `configure' which instantiates (i.e., don't + # use $as_me), people would be surprised to read: + # /* config.h. Generated by config.status. */ + if test x"$ac_file" = x-; then + configure_input= + else + configure_input="$ac_file. " + fi + configure_input=$configure_input"Generated from `echo $ac_file_in | + sed 's,.*/,,'` by configure." + + # First look for the input files in the build tree, otherwise in the + # src tree. + ac_file_inputs=`IFS=: + for f in $ac_file_in; do + case $f in + -) echo $tmp/stdin ;; + [\\/$]*) + # Absolute (can't be DOS-style, as IFS=:) + test -f "$f" || { { echo "$as_me:$LINENO: error: cannot find input file: $f" >&5 +echo "$as_me: error: cannot find input file: $f" >&2;} + { (exit 1); exit 1; }; } + echo "$f";; + *) # Relative + if test -f "$f"; then + # Build tree + echo "$f" + elif test -f "$srcdir/$f"; then + # Source tree + echo "$srcdir/$f" + else + # /dev/null tree + { { echo "$as_me:$LINENO: error: cannot find input file: $f" >&5 +echo "$as_me: error: cannot find input file: $f" >&2;} + { (exit 1); exit 1; }; } + fi;; + esac + done` || { (exit 1); exit 1; } +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF + sed "$ac_vpsub +$extrasub +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF +:t +/@[a-zA-Z_][a-zA-Z_0-9]*@/!b +s,@configure_input@,$configure_input,;t t +s,@srcdir@,$ac_srcdir,;t t +s,@abs_srcdir@,$ac_abs_srcdir,;t t +s,@top_srcdir@,$ac_top_srcdir,;t t +s,@abs_top_srcdir@,$ac_abs_top_srcdir,;t t +s,@builddir@,$ac_builddir,;t t +s,@abs_builddir@,$ac_abs_builddir,;t t +s,@top_builddir@,$ac_top_builddir,;t t +s,@abs_top_builddir@,$ac_abs_top_builddir,;t t +" $ac_file_inputs | (eval "$ac_sed_cmds") >$tmp/out + rm -f $tmp/stdin + if test x"$ac_file" != x-; then + mv $tmp/out $ac_file + else + cat $tmp/out + rm -f $tmp/out + fi -EOF -cat >> $CONFIG_STATUS <<\EOF +done +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF -exit 0 -EOF +{ (exit 0); exit 0; } +_ACEOF chmod +x $CONFIG_STATUS -rm -fr confdefs* $ac_clean_files -test "$no_create" = yes || ${CONFIG_SHELL-/bin/sh} $CONFIG_STATUS || exit 1 +ac_clean_files=$ac_clean_files_save + + +# configure is writing to config.log, and then calls config.status. +# config.status does its own redirection, appending to config.log. +# Unfortunately, on DOS this fails, as config.log is still kept open +# by configure, so config.status won't be able to write to it; its +# output is simply discarded. So we exec the FD to /dev/null, +# effectively closing config.log, so it can be properly (re)opened and +# appended to by config.status. When coming back to configure, we +# need to make the FD available again. +if test "$no_create" != yes; then + ac_cs_success=: + ac_config_status_args= + test "$silent" = yes && + ac_config_status_args="$ac_config_status_args --quiet" + exec 5>/dev/null + $SHELL $CONFIG_STATUS $ac_config_status_args || ac_cs_success=false + exec 5>>config.log + # Use ||, not &&, to avoid exiting from the if with $? = 1, which + # would make configure fail if this is the last instruction. + $ac_cs_success || { (exit 1); exit 1; } +fi diff --git a/win/configure.in b/win/configure.in index 47b6a4f..791d96a 100644 --- a/win/configure.in +++ b/win/configure.in @@ -4,22 +4,29 @@ # to configure the system for the local environment. AC_INIT(../generic/tcl.h) -AC_PREREQ(2.13) +AC_PREREQ(2.59) -TCL_VERSION=8.4 +# The following define is needed when building with Cygwin since newer +# versions of autoconf incorrectly set SHELL to /bin/bash instead of +# /bin/sh. The bash shell seems to suffer from some strange failures. +SHELL=/bin/sh + +TCL_VERSION=8.5 TCL_MAJOR_VERSION=8 -TCL_MINOR_VERSION=4 -TCL_PATCH_LEVEL=".19" +TCL_MINOR_VERSION=5 +TCL_PATCH_LEVEL=".10" VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION -TCL_DDE_VERSION=1.2 +TCL_DDE_VERSION=1.3 TCL_DDE_MAJOR_VERSION=1 -TCL_DDE_MINOR_VERSION=2 +TCL_DDE_MINOR_VERSION=3 +TCL_DDE_PATCH_LEVEL="2" DDEVER=$TCL_DDE_MAJOR_VERSION$TCL_DDE_MINOR_VERSION -TCL_REG_VERSION=1.1 +TCL_REG_VERSION=1.2 TCL_REG_MAJOR_VERSION=1 -TCL_REG_MINOR_VERSION=1 +TCL_REG_MINOR_VERSION=2 +TCL_REG_PATCH_LEVEL="1" REGVER=$TCL_REG_MAJOR_VERSION$TCL_REG_MINOR_VERSION #------------------------------------------------------------------------ @@ -46,32 +53,12 @@ if test "${CFLAGS+set}" != "set" ; then fi AC_PROG_CC +AC_C_INLINE +AC_HEADER_STDC -# To properly support cross-compilation, one would -# need to use these tool checks instead of -# the ones below and reconfigure with -# autoconf 2.50. You can also just set -# the CC, AR, RANLIB, and RC environment -# variables if you want to cross compile. -dnl AC_CHECK_TOOL(AR, ar) -dnl AC_CHECK_TOOL(RANLIB, ranlib) -dnl AC_CHECK_TOOL(RC, windres) - -if test "${GCC}" = "yes" ; then - AC_CHECK_PROG(AR, ar, ar) - AC_CHECK_PROG(RANLIB, ranlib, ranlib) - AC_CHECK_PROG(RC, windres, windres) - - if test "${AR}" = "" ; then - AC_MSG_ERROR([Required archive tool 'ar' not found on PATH.]) - fi - if test "${RANLIB}" = "" ; then - AC_MSG_ERROR([Required archive index tool 'ranlib' not found on PATH.]) - fi - if test "${RC}" = "" ; then - AC_MSG_ERROR([Required resource tool 'windres' not found on PATH.]) - fi -fi +AC_CHECK_TOOL(AR, ar) +AC_CHECK_TOOL(RANLIB, ranlib) +AC_CHECK_TOOL(RC, windres) #-------------------------------------------------------------------- # Checks to see if the make program sets the $MAKE variable. @@ -83,8 +70,22 @@ AC_PROG_MAKE_SET # Perform additinal compiler tests. #-------------------------------------------------------------------- -AC_CYGWIN +dnl Currently AC_CYGWIN is disabled since it invokes AC_CANONICAL_HOST +dnl under autoconf 2.5X. +dnl +dnl AC_CYGWIN +AC_CACHE_CHECK(for Cygwin version of gcc, + ac_cv_cygwin, +AC_TRY_COMPILE([ +#ifdef __CYGWIN__ +#error cygwin +#endif +], +[], + ac_cv_cygwin=no, + ac_cv_cygwin=yes) +) if test "$ac_cv_cygwin" = "yes" ; then AC_MSG_ERROR([Compiling under Cygwin is not currently supported. A maintainer for the Cygwin port of Tcl/Tk is needed. See the README @@ -260,6 +261,50 @@ if test "$tcl_struct_stat32i64" = "yes" ; then fi +# See if declarations like FINDEX_INFO_LEVELS are +# missing from winbase.h. This is known to be +# a problem with VC++ 5.2. + +AC_CACHE_CHECK(for FINDEX_INFO_LEVELS in winbase.h, + tcl_cv_findex_enums, +AC_TRY_COMPILE([ +#define WIN32_LEAN_AND_MEAN +#include <windows.h> +#undef WIN32_LEAN_AND_MEAN +], +[ + FINDEX_INFO_LEVELS i; + FINDEX_SEARCH_OPS j; +], + tcl_cv_findex_enums=yes, + tcl_cv_findex_enums=no) +) +if test "$tcl_cv_findex_enums" = "no"; then + AC_DEFINE(HAVE_NO_FINDEX_ENUMS, 1, + [Defined when enums are missing from winbase.h]) +fi + +# See if MWMO_ALERTABLE is missing from winuser.h +# This is known to be a problem with Mingw. + +AC_CACHE_CHECK(for MWMO_ALERTABLE in winuser.h, + tcl_cv_mwmo_alertable, +AC_TRY_COMPILE([ +#define WIN32_LEAN_AND_MEAN +#include <windows.h> +#undef WIN32_LEAN_AND_MEAN +], +[ + int i = MWMO_ALERTABLE; +], + tcl_cv_mwmo_alertable=yes, + tcl_cv_mwmo_alertable=no) +) +if test "$tcl_cv_mwmo_alertable" = "no"; then + AC_DEFINE(HAVE_NO_MWMO_ALERTABLE, 1, + [Defined when MWMO_ALERTABLE is missing from winuser.h]) +fi + #-------------------------------------------------------------------- # Determines the correct binary file extension (.o, .obj, .exe etc.) #-------------------------------------------------------------------- @@ -273,6 +318,12 @@ AC_EXEEXT SC_ENABLE_THREADS +#------------------------------------------------------------------------ +# Embedded configuration information, encoding to use for the values, TIP #59 +#------------------------------------------------------------------------ + +SC_TCL_CFG_ENCODING + #-------------------------------------------------------------------- # The statements below define a collection of symbols related to # building libtcl as a shared library instead of a static library. @@ -288,6 +339,37 @@ SC_ENABLE_SHARED SC_CONFIG_CFLAGS +AC_CHECK_TYPE([intptr_t], [ + AC_DEFINE([HAVE_INTPTR_T], 1, [Do we have the intptr_t type?])], [ + AC_CACHE_CHECK([for pointer-size signed integer type], tcl_cv_intptr_t, [ + for tcl_cv_intptr_t in "int" "long" "long long" none; do + if test "$tcl_cv_intptr_t" != none; then + AC_COMPILE_IFELSE([AC_LANG_BOOL_COMPILE_TRY([AC_INCLUDES_DEFAULT], + [[sizeof (void *) <= sizeof ($tcl_cv_intptr_t)]])], + [tcl_ok=yes], [tcl_ok=no]) + test "$tcl_ok" = yes && break; fi + done]) + if test "$tcl_cv_intptr_t" != none; then + AC_DEFINE_UNQUOTED([intptr_t], [$tcl_cv_intptr_t], [Signed integer + type wide enough to hold a pointer.]) + fi +]) +AC_CHECK_TYPE([uintptr_t], [ + AC_DEFINE([HAVE_UINTPTR_T], 1, [Do we have the uintptr_t type?])], [ + AC_CACHE_CHECK([for pointer-size unsigned integer type], tcl_cv_uintptr_t, [ + for tcl_cv_uintptr_t in "unsigned int" "unsigned long" "unsigned long long" \ + none; do + if test "$tcl_cv_uintptr_t" != none; then + AC_COMPILE_IFELSE([AC_LANG_BOOL_COMPILE_TRY([AC_INCLUDES_DEFAULT], + [[sizeof (void *) <= sizeof ($tcl_cv_uintptr_t)]])], + [tcl_ok=yes], [tcl_ok=no]) + test "$tcl_ok" = yes && break; fi + done]) + if test "$tcl_cv_uintptr_t" != none; then + AC_DEFINE_UNQUOTED([uintptr_t], [$tcl_cv_uintptr_t], [Unsigned integer + type wide enough to hold a pointer.]) + fi +]) #-------------------------------------------------------------------- # Set the default compiler switches based on the --enable-symbols # option. This macro depends on C flags, and should be called @@ -299,11 +381,10 @@ SC_ENABLE_SYMBOLS TCL_DBGX=${DBGX} #-------------------------------------------------------------------- -# man2tcl needs this so that it can use errno.h +# Embed the manifest if we can determine how #-------------------------------------------------------------------- -AC_CHECK_HEADER(errno.h, , MAN2TCLFLAGS="-DNO_ERRNO_H") -AC_SUBST(MAN2TCLFLAGS) +SC_EMBED_MANIFEST #------------------------------------------------------------------------ # tclConfig.sh refers to this by a different name @@ -449,7 +530,6 @@ AC_SUBST(TCL_NEEDS_EXP_FILE) AC_SUBST(TCL_BUILD_EXP_FILE) AC_SUBST(TCL_EXP_FILE) AC_SUBST(DL_LIBS) -AC_SUBST(LIBOBJS) AC_SUBST(TCL_LIB_VERSIONS_OK) AC_SUBST(TCL_PACKAGE_PATH) @@ -457,9 +537,11 @@ AC_SUBST(TCL_PACKAGE_PATH) AC_SUBST(TCL_DDE_VERSION) AC_SUBST(TCL_DDE_MAJOR_VERSION) AC_SUBST(TCL_DDE_MINOR_VERSION) +AC_SUBST(TCL_DDE_PATCH_LEVEL) AC_SUBST(TCL_REG_VERSION) AC_SUBST(TCL_REG_MAJOR_VERSION) AC_SUBST(TCL_REG_MINOR_VERSION) +AC_SUBST(TCL_REG_PATCH_LEVEL) AC_SUBST(RC) AC_SUBST(RC_OUT) diff --git a/win/makefile.bc b/win/makefile.bc index 3c0ea73..6ba4420 100644 --- a/win/makefile.bc +++ b/win/makefile.bc @@ -7,7 +7,17 @@ # # Copyright (c) 1995-1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. + +# TIP #59 information. +# +# This makefile does not set the following configuration cpp +# defines. Behind the defines are the makefile variables listed to set +# to -D... when that feature is enabled. # +# - TCL_CFG_PROFILED PROFDEFINES +# - TCL_CFG_OPTIMIZED OPTDEFINES +# - TCL_CFG_DO64BIT SIXFOURDEFINES + # Have a look at the complete description on how to build and test Tcl with # the current Borland compilers at www.ratiosoft.com/tcl/borland. # @@ -88,6 +98,13 @@ libpath32 = -L"$(TOOLS32)\lib" NODEBUG = 1 !endif +# CFG_ENCODING=encoding +# name of encoding for configuration information. Defaults +# to cp1252 +!if !defined(CFG_ENCODING) +CFG_ENCODING = \"cp1252\" +!endif + # The following defines can be used to control the amount of debugging # code that is added to the compilation. # @@ -107,23 +124,25 @@ NODEBUG = 1 NAMEPREFIX = tcl STUBPREFIX = $(NAMEPREFIX)stub -DOTVERSION = 8.4 -VERSION = 84 +DOTVERSION = 8.5 +VERSION = 85 -DDEVERSION = 12 -DDEDOTVERSION = 1.2 +DDEVERSION = 13 +DDEDOTVERSION = 1.3 -REGVERSION = 11 -REGDOTVERSION = 1.1 +REGVERSION = 12 +REGDOTVERSION = 1.2 BINROOT = .. !IF "$(NODEBUG)" == "1" TMPDIRNAME = Release DBGX = +SYMDEFINES = !ELSE TMPDIRNAME = Debug #DBGX = d DBGX = +SYMDEFINES = -DTCL_CFG_DEBUG !ENDIF TMPDIR = $(BINROOT)\$(TMPDIRNAME) OUTDIRNAME = $(TMPDIRNAME) @@ -174,9 +193,6 @@ TCLOBJS = \ $(TMPDIR)\regexec.obj \ $(TMPDIR)\regfree.obj \ $(TMPDIR)\regerror.obj \ - $(TMPDIR)\strftime.obj \ - $(TMPDIR)\strtoll.obj \ - $(TMPDIR)\strtoull.obj \ $(TMPDIR)\tclAlloc.obj \ $(TMPDIR)\tclAsync.obj \ $(TMPDIR)\tclBasic.obj \ @@ -189,7 +205,9 @@ TCLOBJS = \ $(TMPDIR)\tclCompCmds.obj \ $(TMPDIR)\tclCompExpr.obj \ $(TMPDIR)\tclCompile.obj \ + $(TMPDIR)\tclConfig.obj \ $(TMPDIR)\tclDate.obj \ + $(TMPDIR)\tclDictObj.obj \ $(TMPDIR)\tclEncoding.obj \ $(TMPDIR)\tclEnv.obj \ $(TMPDIR)\tclEvent.obj \ @@ -216,9 +234,9 @@ TCLOBJS = \ $(TMPDIR)\tclObj.obj \ $(TMPDIR)\tclPanic.obj \ $(TMPDIR)\tclParse.obj \ - $(TMPDIR)\tclParseExpr.obj \ $(TMPDIR)\tclPipe.obj \ $(TMPDIR)\tclPkg.obj \ + $(TMPDIR)\tclPkgConfig.obj \ $(TMPDIR)\tclPosixStr.obj \ $(TMPDIR)\tclPreserve.obj \ $(TMPDIR)\tclProc.obj \ @@ -232,6 +250,7 @@ TCLOBJS = \ $(TMPDIR)\tclThread.obj \ $(TMPDIR)\tclThreadJoin.obj \ $(TMPDIR)\tclTimer.obj \ + $(TMPDIR)\tclTrace.obj \ $(TMPDIR)\tclUtf.obj \ $(TMPDIR)\tclUtil.obj \ $(TMPDIR)\tclVar.obj \ @@ -244,7 +263,6 @@ TCLOBJS = \ $(TMPDIR)\tclWinFile.obj \ $(TMPDIR)\tclWinInit.obj \ $(TMPDIR)\tclWinLoad.obj \ - $(TMPDIR)\tclWinMtherr.obj \ $(TMPDIR)\tclWinNotify.obj \ $(TMPDIR)\tclWinPipe.obj \ $(TMPDIR)\tclWinSock.obj \ @@ -257,7 +275,9 @@ WINDIR = $(ROOT)\win GENERICDIR = $(ROOT)\generic TCL_INCLUDES = -I"$(WINDIR)" -I"$(GENERICDIR)" -TCL_DEFINES = $(DEBUGDEFINES) $(THREADDEFINES) +TCL_DEFINES = $(DEBUGDEFINES) $(THREADDEFINES) $(SYMDEFINES) \ + $(PROFDEFINES) $(OPTDEFINES) $(SIXFOURDEFINES) \ + -DTCL_CFGVAL_ENCODING=${CFG_ENCODING} ###################################################################### # Compiler flags @@ -400,30 +420,35 @@ install-libraries: -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\http1.0" -@copy "$(ROOT)\library\http1.0\http.tcl" "$(SCRIPT_INSTALL_DIR)\http1.0" -@copy "$(ROOT)\library\http1.0\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\http1.0" - @echo installing http2.5 - -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\http2.5" - -@copy "$(ROOT)\library\http\http.tcl" "$(SCRIPT_INSTALL_DIR)\http2.5" - -@copy "$(ROOT)\library\http\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\http2.5" + @echo installing http2.7 + -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\http2.7" + -@copy "$(ROOT)\library\http\http.tcl" "$(SCRIPT_INSTALL_DIR)\http2.7" + -@copy "$(ROOT)\library\http\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\http2.7" @echo installing opt0.4 -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\opt0.4" -@copy "$(ROOT)\library\opt\optparse.tcl" "$(SCRIPT_INSTALL_DIR)\opt0.4" -@copy "$(ROOT)\library\opt\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\opt0.4" - @echo installing msgcat1.3 - -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\msgcat1.3" - -@copy "$(ROOT)\library\msgcat\msgcat.tcl" "$(SCRIPT_INSTALL_DIR)\msgcat1.3" - -@copy "$(ROOT)\library\msgcat\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\msgcat1.3" - @echo installing tcltest2.2 - -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\tcltest2.2" - -@copy "$(ROOT)\library\tcltest\tcltest.tcl" "$(SCRIPT_INSTALL_DIR)\tcltest2.2" - -@copy "$(ROOT)\library\tcltest\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\tcltest2.2" + @echo installing msgcat1.4 + -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\msgcat1.4" + -@copy "$(ROOT)\library\msgcat\msgcat.tcl" "$(SCRIPT_INSTALL_DIR)\msgcat1.4" + -@copy "$(ROOT)\library\msgcat\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\msgcat1.4" + @echo installing tcltest2.3 + -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\tcltest2.3" + -@copy "$(ROOT)\library\tcltest\tcltest.tcl" "$(SCRIPT_INSTALL_DIR)\tcltest2.3" + -@copy "$(ROOT)\library\tcltest\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\tcltest2.3" + @echo installing platform1.0 + -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\platform1.0" + -@copy "$(ROOT)\library\platform\platform.tcl" "$(SCRIPT_INSTALL_DIR)\platform1.0" + -@copy "$(ROOT)\library\platform\shell.tcl" "$(SCRIPT_INSTALL_DIR)\platform1.0" + -@copy "$(ROOT)\library\platform\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\platform1.0" @echo installing $(TCLDDEDLLNAME) - -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\dde1.1" - -@copy "$(TCLDDEDLL)" "$(SCRIPT_INSTALL_DIR)\dde1.1" - -@copy "$(ROOT)\library\dde\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\dde1.1" + -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\dde1.3" + -@copy "$(TCLDDEDLL)" "$(SCRIPT_INSTALL_DIR)\dde1.3" + -@copy "$(ROOT)\library\dde\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\dde1.3" @echo installing $(TCLREGDLLNAME) - -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\reg1.1" - -@copy "$(TCLREGDLL)" "$(SCRIPT_INSTALL_DIR)\reg1.1" - -@copy "$(ROOT)\library\reg\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\reg1.1" + -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\reg1.2" + -@copy "$(TCLREGDLL)" "$(SCRIPT_INSTALL_DIR)\reg1.2" + -@copy "$(ROOT)\library\reg\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\reg1.2" @echo installing encoding files -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\encoding" -@copy "$(ROOT)\library\encoding\*.enc" "$(SCRIPT_INSTALL_DIR)\encoding" @@ -433,7 +458,6 @@ install-libraries: -@copy "$(GENERICDIR)\tclPlatDecls.h" "$(INCLUDE_INSTALL_DIR)" -@copy "$(ROOT)\library\history.tcl" "$(SCRIPT_INSTALL_DIR)" -@copy "$(ROOT)\library\init.tcl" "$(SCRIPT_INSTALL_DIR)" - -@copy "$(ROOT)\library\ldAout.tcl" "$(SCRIPT_INSTALL_DIR)" -@copy "$(ROOT)\library\parray.tcl" "$(SCRIPT_INSTALL_DIR)" -@copy "$(ROOT)\library\safe.tcl" "$(SCRIPT_INSTALL_DIR)" -@copy "$(ROOT)\library\tclIndex" "$(SCRIPT_INSTALL_DIR)" @@ -490,6 +514,14 @@ $(TMPDIR)\tclTestObj.obj: $(GENERICDIR)\tclTestObj.c $(TMPDIR)\tclWinTest.obj: $(WINDIR)\tclWinTest.c $(cc32) $(TCL_CFLAGS) -o$(TMPDIR)\$@ $? +$(TMP_DIR)\tclPkgConfig.obj: $(GENERICDIR)\tclPkgConfig.c + $(cc32) $(TCL_CFLAGS) \ + -DCFG_INSTALL_EXEC_PREFIX=\"$(INSTALL_EXEC_PREFIX)\" \ + -DCFG_INSTALL_PREFIX=\"$(INSTALL_PREFIX)\" \ + -DCFG_RUNTIME_EXEC_PREFIX=\"$(RUNTIME_EXEC_PREFIX)\" \ + -DCFG_RUNTIME_PREFIX=\"$(RUNTIME_PREFIX)\" \ + -o$(TMPDIR)\$@ $? + $(TMPDIR)\tclAppInit.obj : $(WINDIR)\tclAppInit.c $(cc32) $(TCL_CFLAGS) -o$(TMPDIR)\$@ $? diff --git a/win/makefile.vc b/win/makefile.vc index 426c907..d982284 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -1,4 +1,4 @@ -#------------------------------------------------------------------------------ +#------------------------------------------------------------- -*- makefile -*- # makefile.vc -- # # Microsoft Visual C++ makefile for use with nmake.exe v1.62+ (VC++ 5.0+) @@ -9,7 +9,8 @@ # Copyright (c) 1995-1996 Sun Microsystems, Inc. # Copyright (c) 1998-2000 Ajuba Solutions. # Copyright (c) 2001-2005 ActiveState Corporation. -# Copyright (c) 2001-2002 David Gravereaux. +# Copyright (c) 2001-2004 David Gravereaux. +# Copyright (c) 2003-2008 Pat Thoyts. #------------------------------------------------------------------------------ # Check to see we are configured to build with MSVC (MSDEVDIR or MSVCDIR) @@ -66,26 +67,30 @@ the build instructions. # Sets where to install Tcl from the built binaries. # C:\Progra~1\Tcl is assumed when not specified. # -# OPTS=static,msvcrt,staticpkg,threads,symbols,profile,loimpact,none +# OPTS=static,msvcrt,staticpkg,threads,symbols,profile,loimpact,unchecked,none # Sets special options for the core. The default is for none. # Any combination of the above may be used (comma separated). # 'none' will over-ride everything to nothing. # # static = Builds a static library of the core instead of a # dll. The shell will be static (and large), as well. -# msvcrt = Effects the static option only to switch it from +# msvcrt = Affects the static option only to switch it from # using libcmt(d) as the C runtime [by default] to # msvcrt(d). This is useful for static embedding # support. -# staticpkg = Effects the static option only to switch +# staticpkg = Affects the static option only to switch # tclshXX.exe to have the dde and reg extension linked # inside it. # threads = Turns on full multithreading support. # thrdalloc = Use the thread allocator (shared global free pool). +# thrdstorage = Use the generic thread storage support. # symbols = Adds symbols for step debugging. # profile = Adds profiling hooks. Map file is assumed. # loimpact = Adds a flag for how NT treats the heap to keep memory # in use, low. This is said to impact alloc performance. +# unchecked = Allows a symbols build to not use the debug +# enabled runtime (msvcrt.dll not msvcrtd.dll +# or libcmt.lib not libcmtd.lib). # # STATS=memdbg,compdbg,none # Sets optional memory and bytecode compiler debugging code added @@ -96,6 +101,15 @@ the build instructions. # memdbg = Enables the debugging memory allocator. # compdbg = Enables byte compilation logging. # +# CHECKS=nodep,fullwarn,64bit,none +# Sets special macros for checking compatability. +# +# nodep = Turns off compatability macros to ensure the core +# isn't being built with deprecated functions. +# fullwarn = Builds with full compiler and link warnings enabled. +# Very verbose. +# 64bit = Enable 64bit portability warnings (if available) +# # MACHINE=(IX86|IA64|AMD64|ALPHA) # Set the machine type used for the compiler, linker, and # resource compiler. This hook is needed to tell the tools @@ -112,6 +126,10 @@ the build instructions. # TESTPAT=<file> # Reads the tests requested to be run from this file. # +# CFG_ENCODING=encoding +# name of encoding for configuration information. Defaults +# to cp1252 +# # 5) Examples: # # Basic syntax of calling nmake looks like this: @@ -156,14 +174,14 @@ Please `cd` to its location first. PROJECT = tcl !include "rules.vc" -STUBPREFIX = $(PROJECT)stub -DOTVERSION = 8.4 -VERSION = $(DOTVERSION:.=) +STUBPREFIX = $(PROJECT)stub +DOTVERSION = $(TCL_MAJOR_VERSION).$(TCL_MINOR_VERSION) +VERSION = $(TCL_MAJOR_VERSION)$(TCL_MINOR_VERSION) -DDEDOTVERSION = 1.2 +DDEDOTVERSION = 1.3 DDEVERSION = $(DDEDOTVERSION:.=) -REGDOTVERSION = 1.1 +REGDOTVERSION = 1.2 REGVERSION = $(REGDOTVERSION:.=) BINROOT = . @@ -190,6 +208,15 @@ TCLDDELIB = $(OUT_DIR)\$(TCLDDELIBNAME) TCLTEST = $(OUT_DIR)\$(PROJECT)test.exe CAT32 = $(OUT_DIR)\cat32.exe +# Can we run what we build? IX86 runs on all architectures. +!ifndef TCLSH_NATIVE +!if "$(MACHINE)" == "IX86" || "$(MACHINE)" == "$(NATIVE_ARCH)" +TCLSH_NATIVE = $(TCLSH) +!else +!error You must explicitly set TCLSH_NATIVE for cross-compilation +!endif +!endif + ### Make sure we use backslash only. LIB_INSTALL_DIR = $(_INSTALLDIR)\lib BIN_INSTALL_DIR = $(_INSTALLDIR)\bin @@ -222,9 +249,6 @@ TCLOBJS = \ $(TMP_DIR)\regerror.obj \ $(TMP_DIR)\regexec.obj \ $(TMP_DIR)\regfree.obj \ - $(TMP_DIR)\strftime.obj \ - $(TMP_DIR)\strtoll.obj \ - $(TMP_DIR)\strtoull.obj \ $(TMP_DIR)\tclAlloc.obj \ $(TMP_DIR)\tclAsync.obj \ $(TMP_DIR)\tclBasic.obj \ @@ -237,7 +261,9 @@ TCLOBJS = \ $(TMP_DIR)\tclCompCmds.obj \ $(TMP_DIR)\tclCompExpr.obj \ $(TMP_DIR)\tclCompile.obj \ + $(TMP_DIR)\tclConfig.obj \ $(TMP_DIR)\tclDate.obj \ + $(TMP_DIR)\tclDictObj.obj \ $(TMP_DIR)\tclEncoding.obj \ $(TMP_DIR)\tclEnv.obj \ $(TMP_DIR)\tclEvent.obj \ @@ -254,6 +280,7 @@ TCLOBJS = \ $(TMP_DIR)\tclIOGT.obj \ $(TMP_DIR)\tclIOSock.obj \ $(TMP_DIR)\tclIOUtil.obj \ + $(TMP_DIR)\tclIORChan.obj \ $(TMP_DIR)\tclLink.obj \ $(TMP_DIR)\tclListObj.obj \ $(TMP_DIR)\tclLiteral.obj \ @@ -264,9 +291,10 @@ TCLOBJS = \ $(TMP_DIR)\tclObj.obj \ $(TMP_DIR)\tclPanic.obj \ $(TMP_DIR)\tclParse.obj \ - $(TMP_DIR)\tclParseExpr.obj \ + $(TMP_DIR)\tclPathObj.obj \ $(TMP_DIR)\tclPipe.obj \ $(TMP_DIR)\tclPkg.obj \ + $(TMP_DIR)\tclPkgConfig.obj \ $(TMP_DIR)\tclPosixStr.obj \ $(TMP_DIR)\tclPreserve.obj \ $(TMP_DIR)\tclProc.obj \ @@ -275,12 +303,16 @@ TCLOBJS = \ $(TMP_DIR)\tclResult.obj \ $(TMP_DIR)\tclScan.obj \ $(TMP_DIR)\tclStringObj.obj \ + $(TMP_DIR)\tclStrToD.obj \ $(TMP_DIR)\tclStubInit.obj \ $(TMP_DIR)\tclStubLib.obj \ $(TMP_DIR)\tclThread.obj \ $(TMP_DIR)\tclThreadAlloc.obj \ $(TMP_DIR)\tclThreadJoin.obj \ + $(TMP_DIR)\tclThreadStorage.obj \ $(TMP_DIR)\tclTimer.obj \ + $(TMP_DIR)\tclTomMathInterface.obj \ + $(TMP_DIR)\tclTrace.obj \ $(TMP_DIR)\tclUtf.obj \ $(TMP_DIR)\tclUtil.obj \ $(TMP_DIR)\tclVar.obj \ @@ -293,12 +325,75 @@ TCLOBJS = \ $(TMP_DIR)\tclWinFile.obj \ $(TMP_DIR)\tclWinInit.obj \ $(TMP_DIR)\tclWinLoad.obj \ - $(TMP_DIR)\tclWinMtherr.obj \ $(TMP_DIR)\tclWinNotify.obj \ $(TMP_DIR)\tclWinPipe.obj \ $(TMP_DIR)\tclWinSock.obj \ $(TMP_DIR)\tclWinThrd.obj \ $(TMP_DIR)\tclWinTime.obj \ + $(TMP_DIR)\bncore.obj \ + $(TMP_DIR)\bn_reverse.obj \ + $(TMP_DIR)\bn_fast_s_mp_mul_digs.obj \ + $(TMP_DIR)\bn_fast_s_mp_sqr.obj \ + $(TMP_DIR)\bn_mp_add.obj \ + $(TMP_DIR)\bn_mp_add_d.obj \ + $(TMP_DIR)\bn_mp_and.obj \ + $(TMP_DIR)\bn_mp_clamp.obj \ + $(TMP_DIR)\bn_mp_clear.obj \ + $(TMP_DIR)\bn_mp_clear_multi.obj \ + $(TMP_DIR)\bn_mp_cmp.obj \ + $(TMP_DIR)\bn_mp_cmp_d.obj \ + $(TMP_DIR)\bn_mp_cmp_mag.obj \ + $(TMP_DIR)\bn_mp_cnt_lsb.obj \ + $(TMP_DIR)\bn_mp_copy.obj \ + $(TMP_DIR)\bn_mp_count_bits.obj \ + $(TMP_DIR)\bn_mp_div.obj \ + $(TMP_DIR)\bn_mp_div_d.obj \ + $(TMP_DIR)\bn_mp_div_2.obj \ + $(TMP_DIR)\bn_mp_div_2d.obj \ + $(TMP_DIR)\bn_mp_div_3.obj \ + $(TMP_DIR)\bn_mp_exch.obj \ + $(TMP_DIR)\bn_mp_expt_d.obj \ + $(TMP_DIR)\bn_mp_grow.obj \ + $(TMP_DIR)\bn_mp_init.obj \ + $(TMP_DIR)\bn_mp_init_copy.obj \ + $(TMP_DIR)\bn_mp_init_multi.obj \ + $(TMP_DIR)\bn_mp_init_set.obj \ + $(TMP_DIR)\bn_mp_init_set_int.obj \ + $(TMP_DIR)\bn_mp_init_size.obj \ + $(TMP_DIR)\bn_mp_karatsuba_mul.obj \ + $(TMP_DIR)\bn_mp_karatsuba_sqr.obj \ + $(TMP_DIR)\bn_mp_lshd.obj \ + $(TMP_DIR)\bn_mp_mod.obj \ + $(TMP_DIR)\bn_mp_mod_2d.obj \ + $(TMP_DIR)\bn_mp_mul.obj \ + $(TMP_DIR)\bn_mp_mul_2.obj \ + $(TMP_DIR)\bn_mp_mul_2d.obj \ + $(TMP_DIR)\bn_mp_mul_d.obj \ + $(TMP_DIR)\bn_mp_neg.obj \ + $(TMP_DIR)\bn_mp_or.obj \ + $(TMP_DIR)\bn_mp_radix_size.obj \ + $(TMP_DIR)\bn_mp_radix_smap.obj \ + $(TMP_DIR)\bn_mp_read_radix.obj \ + $(TMP_DIR)\bn_mp_rshd.obj \ + $(TMP_DIR)\bn_mp_set.obj \ + $(TMP_DIR)\bn_mp_set_int.obj \ + $(TMP_DIR)\bn_mp_shrink.obj \ + $(TMP_DIR)\bn_mp_sqr.obj \ + $(TMP_DIR)\bn_mp_sqrt.obj \ + $(TMP_DIR)\bn_mp_sub.obj \ + $(TMP_DIR)\bn_mp_sub_d.obj \ + $(TMP_DIR)\bn_mp_to_unsigned_bin.obj \ + $(TMP_DIR)\bn_mp_to_unsigned_bin_n.obj \ + $(TMP_DIR)\bn_mp_toom_mul.obj \ + $(TMP_DIR)\bn_mp_toom_sqr.obj \ + $(TMP_DIR)\bn_mp_toradix_n.obj \ + $(TMP_DIR)\bn_mp_unsigned_bin_size.obj \ + $(TMP_DIR)\bn_mp_xor.obj \ + $(TMP_DIR)\bn_mp_zero.obj \ + $(TMP_DIR)\bn_s_mp_add.obj \ + $(TMP_DIR)\bn_s_mp_mul_digs.obj \ + $(TMP_DIR)\bn_s_mp_sqr.obj \ + $(TMP_DIR)\bn_s_mp_sub.obj \ !if !$(STATIC_BUILD) $(TMP_DIR)\tcl.res !endif @@ -309,6 +404,7 @@ TCLSTUBOBJS = $(TMP_DIR)\tclStubLib.obj COMPATDIR = $(ROOT)\compat DOCDIR = $(ROOT)\doc GENERICDIR = $(ROOT)\generic +TOMMATHDIR = $(ROOT)\libtommath TOOLSDIR = $(ROOT)\tools WINDIR = $(ROOT)\win @@ -324,6 +420,9 @@ cdebug = -O2 $(OPTIMIZATIONS) !else cdebug = !endif +!if $(SYMBOLS) +cdebug = $(cdebug) -Zi +!endif !else if "$(MACHINE)" == "IA64" || "$(MACHINE)" == "AMD64" ### Warnings are too many, can't support warnings into errors. cdebug = -Zi -Od $(DEBUGFLAGS) @@ -332,34 +431,30 @@ cdebug = -Zi -WX $(DEBUGFLAGS) !endif ### Declarations common to all compiler options -cwarn = -D _CRT_SECURE_NO_DEPRECATE -D _CRT_NONSTDC_NO_DEPRECATE +cwarn = $(WARNINGS) -D _CRT_SECURE_NO_DEPRECATE -D _CRT_NONSTDC_NO_DEPRECATE cflags = -nologo -c $(COMPILERFLAGS) $(cwarn) -Fp$(TMP_DIR)^\ -!if $(FULLWARNINGS) -cflags = $(cflags) -W4 -!else -cflags = $(cflags) -W3 -!endif - !if $(MSVCRT) -!if "$(DBGX)" == "" -crt = -MD -!else +!if $(DEBUG) && !$(UNCHECKED) crt = -MDd -!endif !else -!if "$(DBGX)" == "" -crt = -MT +crt = -MD +!endif !else +!if $(DEBUG) && !$(UNCHECKED) crt = -MTd +!else +crt = -MT !endif !endif -TCL_INCLUDES = -I"$(WINDIR)" -I"$(GENERICDIR)" -BASE_CFLAGS = $(cflags) $(cdebug) $(crt) $(TCL_INCLUDES) \ - -DTCL_PIPE_DLL=\"$(TCLPIPEDLLNAME)\" +TCL_INCLUDES = -I"$(WINDIR)" -I"$(GENERICDIR)" -I"$(TOMMATHDIR)" +TCL_DEFINES = -DTCL_PIPE_DLL=\"$(TCLPIPEDLLNAME)\" -DTCL_TOMMATH -DMP_PREC=4 -Dinline=__inline +BASE_CFLAGS = $(cflags) $(cdebug) $(crt) $(TCL_INCLUDES) $(TCL_DEFINES) CON_CFLAGS = $(cflags) $(cdebug) $(crt) -DCONSOLE TCL_CFLAGS = $(BASE_CFLAGS) $(OPTDEFINES) +### Stubs files should not be compiled with -GL +STUB_CFLAGS = $(cflags) $(cdebug:-GL=) $(OPTDEFINES) #--------------------------------------------------------------------- @@ -370,15 +465,14 @@ TCL_CFLAGS = $(BASE_CFLAGS) $(OPTDEFINES) ldebug = -debug -debugtype:cv !else ldebug = -release -opt:ref -opt:icf,3 +!if $(SYMBOLS) +ldebug = $(ldebug) -debug -debugtype:cv +!endif !endif ### Declarations common to all linker options lflags = -nologo -machine:$(MACHINE) $(LINKERFLAGS) $(ldebug) -!if $(FULLWARNINGS) -lflags = $(lflags) -warn:3 -!endif - !if $(PROFILE) lflags = $(lflags) -profile !endif @@ -399,12 +493,14 @@ dlllflags = $(lflags) -dll conlflags = $(lflags) -subsystem:console guilflags = $(lflags) -subsystem:windows -baselibs = kernel32.lib advapi32.lib user32.lib +baselibs = kernel32.lib user32.lib ws2_32.lib # Avoid 'unresolved external symbol __security_cookie' errors. # c.f. http://support.microsoft.com/?id=894573 !if "$(MACHINE)" == "IA64" || "$(MACHINE)" == "AMD64" +!if $(VCVERSION) > 1399 && $(VCVERSION) < 1500 baselibs = $(baselibs) bufferoverflowU.lib !endif +!endif #--------------------------------------------------------------------- # TclTest flags @@ -431,15 +527,22 @@ install: install-binaries install-libraries install-docs test: setup $(TCLTEST) dlls $(CAT32) set TCL_LIBRARY=$(ROOT)/library !if "$(OS)" == "Windows_NT" || "$(MSVCDIR)" == "IDE" - $(TCLTEST) "$(ROOT)/tests/all.tcl" $(TESTFLAGS) + $(TCLTEST) "$(ROOT)/tests/all.tcl" $(TESTFLAGS) -loadfile << + set ::ddelib [file normalize $(TCLDDELIB:\=/)] + set ::reglib [file normalize $(TCLREGLIB:\=/)] +<< !else - $(TCLTEST) "$(ROOT)/tests/all.tcl" $(TESTFLAGS) > tests.log + @echo Please wait while the tests are collected... + $(TCLTEST) "$(ROOT)/tests/all.tcl" $(TESTFLAGS) -loadfile << > tests.log + set ::ddelib [file normalize $(TCLDDELIB:\=/)] + set ::reglib [file normalize $(TCLREGLIB:\=/)] +<< type tests.log | more !endif runtest: setup $(TCLTEST) dlls $(CAT32) set TCL_LIBRARY=$(ROOT)/library - $(TCLTEST) + $(DEBUGGER) $(TCLTEST) setup: @if not exist $(OUT_DIR)\nul mkdir $(OUT_DIR) @@ -481,7 +584,7 @@ $(TCLPIPEDLL): $(WINDIR)\stub16.c !if $(STATIC_BUILD) $(TCLDDELIB): $(TMP_DIR)\tclWinDde.obj - $(lib32) -nologo -out:$@ $(TMP_DIR)\tclWinDde.obj + $(lib32) -nologo -out:$@ $** !else $(TCLDDELIB): $(TMP_DIR)\tclWinDde.obj $(TCLSTUBLIB) $(link32) $(dlllflags) -base:@$(WINDIR)\coffbase.txt,tcldde -out:$@ \ @@ -493,7 +596,7 @@ $(TCLDDELIB): $(TMP_DIR)\tclWinDde.obj $(TCLSTUBLIB) !if $(STATIC_BUILD) $(TCLREGLIB): $(TMP_DIR)\tclWinReg.obj - $(lib32) -nologo -out:$@ $(TMP_DIR)\tclWinReg.obj + $(lib32) -nologo -out:$@ $** !else $(TCLREGLIB): $(TMP_DIR)\tclWinReg.obj $(TCLSTUBLIB) $(link32) $(dlllflags) -base:@$(WINDIR)\coffbase.txt,tclreg -out:$@ \ @@ -517,27 +620,27 @@ genstubs: !if !exist($(TCLSH)) @echo Build tclsh first! !else - $(TCLSH) $(TOOLSDIR:\=/)\genStubs.tcl $(GENERICDIR:\=/) \ - $(GENERICDIR:\=/)/tcl.decls $(GENERICDIR:\=/)/tclInt.decls + $(TCLSH) $(TOOLSDIR:\=/)/genStubs.tcl $(GENERICDIR:\=/) \ + $(GENERICDIR:\=/)/tcl.decls $(GENERICDIR:\=/)/tclInt.decls \ + $(GENERICDIR:\=/)/tclTomMath.decls !endif -#--------------------------------------------------------------------- -# Generate the makefile depedancies. -#--------------------------------------------------------------------- +#---------------------------------------------------------------------- +# The following target generates the file generic/tclTomMath.h. +# It needs to be run (and the results checked) after updating +# to a new release of libtommath. +#---------------------------------------------------------------------- -depend: +gentommath_h: !if !exist($(TCLSH)) @echo Build tclsh first! !else - $(TCLSH) $(TOOLSDIR:\=/)/mkdepend.tcl -vc32 -out:"$(OUT_DIR)\depend.mk" \ - -passthru:"-DBUILD_tcl $(TCL_INCLUDES:"="")" $(GENERICDIR) \ - $(COMPATDIR) $(WINDIR) @<< -$(TCLOBJS) -<< + $(TCLSH) "$(TOOLSDIR:\=/)/fix_tommath_h.tcl" \ + "$(TOMMATHDIR:\=/)/tommath.h" \ + > "$(GENERICDIR)\tclTomMath.h" !endif - #--------------------------------------------------------------------- # Build the windows help file. #--------------------------------------------------------------------- @@ -604,17 +707,91 @@ install-docs: @$(CPY) "$(HELPCNT)" "$(DOC_INSTALL_DIR)\" !endif +#--------------------------------------------------------------------- +# Build tclConfig.sh for the TEA build system. +#--------------------------------------------------------------------- + +tclConfig: $(OUT_DIR)\tclConfig.sh + +$(OUT_DIR)\tclConfig.sh: $(WINDIR)\tclConfig.sh.in + @echo Creating tclConfig.sh + @nmakehlp -s << $** >$@ +@TCL_DLL_FILE@ $(TCLLIBNAME) +@TCL_VERSION@ $(DOTVERSION) +@TCL_MAJOR_VERSION@ $(TCL_MAJOR_VERSION) +@TCL_MINOR_VERSION@ $(TCL_MINOR_VERSION) +@TCL_PATCH_LEVEL@ $(TCL_PATCH_LEVEL) +@CC@ $(CC) +@DEFS@ $(TCL_CFLAGS) +@CFLAGS_DEBUG@ -nologo -c -W3 -YX -Fp$(TMP_DIR)\ -MDd +@CFLAGS_OPTIMIZE@ -nologo -c -W3 -YX -Fp$(TMP_DIR)\ -MD +@LDFLAGS_DEBUG@ -nologo -machine:$(MACHINE) -debug -debugtype:cv +@LDFLAGS_OPTIMIZE@ -nologo -machine:$(MACHINE) -release -opt:ref -opt:icf,3 +@TCL_DBGX@ $(SUFX) +@TCL_LIB_FILE@ $(PROJECT)$(VERSION)$(SUFX).lib +@TCL_NEEDS_EXP_FILE@ +@LIBS@ $(baselibs) +@prefix@ $(_INSTALLDIR) +@exec_prefix@ $(BIN_INSTALL_DIR) +@SHLIB_CFLAGS@ +@STLIB_CFLAGS@ +@CFLAGS_WARNING@ -W3 +@EXTRA_CFLAGS@ -YX +@SHLIB_LD@ $(link32) $(dlllflags) +@STLIB_LD@ $(lib32) -nologo +@SHLIB_LD_LIBS@ $(baselibs) +@SHLIB_SUFFIX@ .dll +@DL_LIBS@ +@LDFLAGS@ +@TCL_LD_SEARCH_FLAGS@ +@LIBOBJS@ +@RANLIB@ +@TCL_LIB_FLAG@ +@TCL_BUILD_LIB_SPEC@ +@TCL_LIB_SPEC@ $(LIB_INSTALL_DIR)\$(PROJECT)$(VERSION)$(SUFX).lib +@TCL_INCLUDE_SPEC@ -I$(INCLUDE_INSTALL_DIR) +@TCL_LIB_VERSIONS_OK@ +@TCL_SRC_DIR@ $(ROOT) +@TCL_PACKAGE_PATH@ +@TCL_STUB_LIB_FILE@ $(TCLSTUBLIBNAME) +@TCL_STUB_LIB_FLAG@ $(TCLSTUBLIBNAME) +@TCL_STUB_LIB_SPEC@ -L$(LIB_INSTALL_DIR) $(TCLSTUBLIBNAME) +@TCL_THREADS@ $(TCL_THREADS) +@TCL_BUILD_STUB_LIB_SPEC@ -L$(OUT_DIR) $(TCLSTUBLIBNAME) +@TCL_BUILD_STUB_LIB_PATH@ $(TCLSTUBLIB) +@TCL_STUB_LIB_PATH@ $(LIB_INSTALL_DIR)\$(TCLSTUBLIBNAME) +@CFG_TCL_EXPORT_FILE_SUFFIX@ $(VERSION)$(SUFX).lib +@CFG_TCL_SHARED_LIB_SUFFIX@ $(VERSION)$(SUFX).dll +@CFG_TCL_UNSHARED_LIB_SUFFIX@ $(VERSION)$(SUFX).lib +!if $(STATIC_BUILD) +@TCL_SHARED_BUILD@ 0 +!else +@TCL_SHARED_BUILD@ 1 +!endif +<< + + +#--------------------------------------------------------------------- +# The following target generates the file generic/tclDate.c +# from the yacc grammar found in generic/tclGetDate.y. This is +# only run by hand as yacc is not available in all environments. +# The name of the .c file is different than the name of the .y file +# so that make doesn't try to automatically regenerate the .c file. +#--------------------------------------------------------------------- + +gendate: + bison --output-file=$(GENERICDIR)/tclDate.c \ + --name-prefix=TclDate \ + $(GENERICDIR)/tclGetDate.y #--------------------------------------------------------------------- # Special case object file targets #--------------------------------------------------------------------- $(TMP_DIR)\testMain.obj: $(WINDIR)\tclAppInit.c -!if $(TCL_USE_STATIC_PACKAGES) - $(cc32) $(TCL_CFLAGS) -DTCL_TEST -DTCL_USE_STATIC_PACKAGES -Fo$@ $? -!else - $(cc32) $(TCL_CFLAGS) -DTCL_TEST -Fo$@ $? -!endif + $(cc32) $(TCL_CFLAGS) -DTCL_TEST \ + -DTCL_USE_STATIC_PACKAGES=$(TCL_USE_STATIC_PACKAGES) \ + -Fo$@ $? $(TMP_DIR)\tclTest.obj: $(GENERICDIR)\tclTest.c $(cc32) $(TCL_CFLAGS) -Fo$@ $? @@ -625,66 +802,77 @@ $(TMP_DIR)\tclTestObj.obj: $(GENERICDIR)\tclTestObj.c $(TMP_DIR)\tclWinTest.obj: $(WINDIR)\tclWinTest.c $(cc32) $(TCL_CFLAGS) -Fo$@ $? +$(TMP_DIR)\tclPkgConfig.obj: $(GENERICDIR)\tclPkgConfig.c + $(cc32) -DBUILD_tcl $(TCL_CFLAGS) \ + -DCFG_INSTALL_LIBDIR="\"$(LIB_INSTALL_DIR:\=\\)\"" \ + -DCFG_INSTALL_BINDIR="\"$(BIN_INSTALL_DIR:\=\\)\"" \ + -DCFG_INSTALL_SCRDIR="\"$(SCRIPT_INSTALL_DIR:\=\\)\"" \ + -DCFG_INSTALL_INCDIR="\"$(INCLUDE_INSTALL_DIR:\=\\)\"" \ + -DCFG_INSTALL_DOCDIR="\"$(DOC_INSTALL_DIR:\=\\)\"" \ + -DCFG_RUNTIME_LIBDIR="\"$(LIB_INSTALL_DIR:\=\\)\"" \ + -DCFG_RUNTIME_BINDIR="\"$(BIN_INSTALL_DIR:\=\\)\"" \ + -DCFG_RUNTIME_SCRDIR="\"$(SCRIPT_INSTALL_DIR:\=\\)\"" \ + -DCFG_RUNTIME_INCDIR="\"$(INCLUDE_INSTALL_DIR:\=\\)\"" \ + -DCFG_RUNTIME_DOCDIR="\"$(DOC_INSTALL_DIR:\=\\)\"" \ + -Fo$@ $? + $(TMP_DIR)\tclAppInit.obj: $(WINDIR)\tclAppInit.c -!if $(TCL_USE_STATIC_PACKAGES) - $(cc32) $(TCL_CFLAGS) -DTCL_USE_STATIC_PACKAGES -Fo$@ $? -!else - $(cc32) $(TCL_CFLAGS) -Fo$@ $? -!endif + $(cc32) $(TCL_CFLAGS) \ + -DTCL_USE_STATIC_PACKAGES=$(TCL_USE_STATIC_PACKAGES) \ + -Fo$@ $? ### The following objects should be built using the stub interfaces ### *ALL* extensions need to built with -DTCL_THREADS=1 $(TMP_DIR)\tclWinReg.obj: $(WINDIR)\tclWinReg.c !if $(STATIC_BUILD) - $(cc32) $(BASE_CFLAGS) -DTCL_THREADS=1 -DSTATIC_BUILD -Fo$@ $? + $(cc32) $(TCL_CFLAGS) -DTCL_THREADS=1 -DSTATIC_BUILD -Fo$@ $? !else - $(cc32) $(BASE_CFLAGS) -DTCL_THREADS=1 -DUSE_TCL_STUBS -Fo$@ $? + $(cc32) $(TCL_CFLAGS) -DTCL_THREADS=1 -DUSE_TCL_STUBS -Fo$@ $? !endif $(TMP_DIR)\tclWinDde.obj: $(WINDIR)\tclWinDde.c !if $(STATIC_BUILD) - $(cc32) $(BASE_CFLAGS) -DTCL_THREADS=1 -DSTATIC_BUILD -Fo$@ $? + $(cc32) $(TCL_CFLAGS) -DTCL_THREADS=1 -DSTATIC_BUILD -Fo$@ $? !else - $(cc32) $(BASE_CFLAGS) -DTCL_THREADS=1 -DUSE_TCL_STUBS -Fo$@ $? + $(cc32) $(TCL_CFLAGS) -DTCL_THREADS=1 -DUSE_TCL_STUBS -Fo$@ $? !endif ### The following objects are part of the stub library and should not -### be built as DLL objects. -Zl is used to avoid a dependancy on any +### be built as DLL objects. -Zl is used to avoid a dependency on any ### specific C run-time. $(TMP_DIR)\tclStubLib.obj: $(GENERICDIR)\tclStubLib.c - $(cc32) $(cdebug) $(cflags) -Zl -DSTATIC_BUILD $(TCL_INCLUDES) -Fo$@ $? - + $(cc32) $(STUB_CFLAGS) -Zl -DSTATIC_BUILD $(TCL_INCLUDES) -Fo$@ $? #--------------------------------------------------------------------- -# Dedependency rules +# Generate the source dependencies. Having dependency rules will +# improve incremental build accuracy without having to resort to a +# full rebuild just because some non-global header file like +# tclCompile.h was changed. These rules aren't needed when building +# from scratch. #--------------------------------------------------------------------- -$(GENERICDIR)\regcomp.c: \ - $(GENERICDIR)\regguts.h \ - $(GENERICDIR)\regc_lex.c \ - $(GENERICDIR)\regc_color.c \ - $(GENERICDIR)\regc_nfa.c \ - $(GENERICDIR)\regc_cvec.c \ - $(GENERICDIR)\regc_locale.c -$(GENERICDIR)\regcustom.h: \ - $(GENERICDIR)\tclInt.h \ - $(GENERICDIR)\tclPort.h \ - $(GENERICDIR)\regex.h -$(GENERICDIR)\regexec.c: \ - $(GENERICDIR)\rege_dfa.c \ - $(GENERICDIR)\regguts.h -$(GENERICDIR)\regerror.c: $(GENERICDIR)\regguts.h -$(GENERICDIR)\regfree.c: $(GENERICDIR)\regguts.h -$(GENERICDIR)\regfronts.c: $(GENERICDIR)\regguts.h -$(GENERICDIR)\regguts.h: $(GENERICDIR)\regcustom.h +depend: +!if !exist($(TCLSH)) + @echo Build tclsh first! +!else + $(TCLSH) $(TOOLSDIR:\=/)/mkdepend.tcl -vc32 -out:"$(OUT_DIR)\depend.mk" \ + -passthru:"-DBUILD_tcl $(TCL_INCLUDES)" $(GENERICDIR),$$(GENERICDIR) \ + $(COMPATDIR),$$(COMPATDIR) $(TOMMATHDIR),$$(TOMMATHDIR) $(WINDIR),$$(WINDIR) @<< +$(TCLOBJS) +<< +!endif + +#--------------------------------------------------------------------- +# Dependency rules +#--------------------------------------------------------------------- !if exist("$(OUT_DIR)\depend.mk") !include "$(OUT_DIR)\depend.mk" -!message *** Dependency rules in effect. +!message *** Dependency rules in use. !else !message *** Dependency rules are not being used. !endif @@ -698,32 +886,31 @@ $(GENERICDIR)\regguts.h: $(GENERICDIR)\regcustom.h #--------------------------------------------------------------------- {$(WINDIR)}.c{$(TMP_DIR)}.obj:: - $(cc32) $(TCL_CFLAGS) -DBUILD_tcl -Fo$(TMP_DIR)\ @<< + $(cc32) $(TCL_CFLAGS) -DBUILD_tcl -Fo$(TMP_DIR)\ @<< +$< +<< + +{$(TOMMATHDIR)}.c{$(TMP_DIR)}.obj:: + $(cc32) $(TCL_CFLAGS) -DBUILD_tcl -Fo$(TMP_DIR)\ @<< $< << {$(GENERICDIR)}.c{$(TMP_DIR)}.obj:: - $(cc32) $(TCL_CFLAGS) -DBUILD_tcl -Fo$(TMP_DIR)\ @<< + $(cc32) $(TCL_CFLAGS) -DBUILD_tcl -Fo$(TMP_DIR)\ @<< $< << {$(COMPATDIR)}.c{$(TMP_DIR)}.obj:: - $(cc32) $(TCL_CFLAGS) -DBUILD_tcl -Fo$(TMP_DIR)\ @<< + $(cc32) $(TCL_CFLAGS) -DBUILD_tcl -Fo$(TMP_DIR)\ @<< $< << {$(WINDIR)}.rc{$(TMP_DIR)}.res: - $(rc32) -fo $@ -r -i "$(GENERICDIR)" -D__WIN32__ \ -!if $(DEBUG) - -d DEBUG \ -!endif -!if $(TCL_THREADS) - -d TCL_THREADS \ -!endif -!if $(STATIC_BUILD) - -d STATIC_BUILD \ -!endif - $< + $(rc32) -fo $@ -r -i "$(GENERICDIR)" \ + -d DEBUG=$(DEBUG) -d UNCHECKED=$(UNCHECKED) \ + -d TCL_THREADS=$(TCL_THREADS) \ + -d STATIC_BUILD=$(STATIC_BUILD) \ + $< .SUFFIXES: .SUFFIXES:.c .rc @@ -735,79 +922,129 @@ $< install-binaries: @echo Installing to '$(_INSTALLDIR)' - @echo installing $(TCLLIBNAME) + @echo Installing $(TCLLIBNAME) !if "$(TCLLIB)" != "$(TCLIMPLIB)" @$(CPY) "$(TCLLIB)" "$(BIN_INSTALL_DIR)\" !endif @$(CPY) "$(TCLIMPLIB)" "$(LIB_INSTALL_DIR)\" !if exist($(TCLSH)) - @echo installing $(TCLSHNAME) + @echo Installing $(TCLSHNAME) @$(CPY) "$(TCLSH)" "$(BIN_INSTALL_DIR)\" !endif !if exist($(TCLPIPEDLL)) - @echo installing $(TCLPIPEDLLNAME) + @echo Installing $(TCLPIPEDLLNAME) @$(CPY) "$(TCLPIPEDLL)" "$(BIN_INSTALL_DIR)\" !endif - @echo installing $(TCLSTUBLIBNAME) + @echo Installing $(TCLSTUBLIBNAME) @$(CPY) "$(TCLSTUBLIB)" "$(LIB_INSTALL_DIR)\" -install-libraries: - @echo installing http1.0 +#" emacs fix + +install-libraries: tclConfig install-msgs install-tzdata + @if not exist "$(SCRIPT_INSTALL_DIR)$(NULL)" \ + $(MKDIR) "$(SCRIPT_INSTALL_DIR)" + @if not exist "$(SCRIPT_INSTALL_DIR)\..\tcl8$(NULL)" \ + $(MKDIR) "$(SCRIPT_INSTALL_DIR)\..\tcl8" + @if not exist "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.2$(NULL)" \ + $(MKDIR) "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.2" + @if not exist "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.3$(NULL)" \ + $(MKDIR) "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.3" + @if not exist "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.4$(NULL)" \ + $(MKDIR) "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.4" + @if not exist "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.4\platform$(NULL)" \ + $(MKDIR) "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.4\platform" + @if not exist "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.5$(NULL)" \ + $(MKDIR) "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.5" + @echo Installing header files + @$(CPY) "$(GENERICDIR)\tcl.h" "$(INCLUDE_INSTALL_DIR)\" + @$(CPY) "$(GENERICDIR)\tclDecls.h" "$(INCLUDE_INSTALL_DIR)\" + @$(CPY) "$(GENERICDIR)\tclPlatDecls.h" "$(INCLUDE_INSTALL_DIR)\" + @$(CPY) "$(GENERICDIR)\tclTomMath.h" "$(INCLUDE_INSTALL_DIR)\" + @$(CPY) "$(GENERICDIR)\tclTomMathDecls.h" "$(INCLUDE_INSTALL_DIR)\" + @$(CPY) "$(TOMMATHDIR)\tommath_class.h" "$(INCLUDE_INSTALL_DIR)\" + @$(CPY) "$(TOMMATHDIR)\tommath_superclass.h" "$(INCLUDE_INSTALL_DIR)\" + @echo Installing library files to $(SCRIPT_INSTALL_DIR) + @$(CPY) "$(ROOT)\library\history.tcl" "$(SCRIPT_INSTALL_DIR)\" + @$(CPY) "$(ROOT)\library\init.tcl" "$(SCRIPT_INSTALL_DIR)\" + @$(CPY) "$(ROOT)\library\clock.tcl" "$(SCRIPT_INSTALL_DIR)\" + @$(CPY) "$(ROOT)\library\tm.tcl" "$(SCRIPT_INSTALL_DIR)\" + @$(CPY) "$(ROOT)\library\parray.tcl" "$(SCRIPT_INSTALL_DIR)\" + @$(CPY) "$(ROOT)\library\safe.tcl" "$(SCRIPT_INSTALL_DIR)\" + @$(CPY) "$(ROOT)\library\tclIndex" "$(SCRIPT_INSTALL_DIR)\" + @$(CPY) "$(ROOT)\library\package.tcl" "$(SCRIPT_INSTALL_DIR)\" + @$(CPY) "$(ROOT)\library\word.tcl" "$(SCRIPT_INSTALL_DIR)\" + @$(CPY) "$(ROOT)\library\auto.tcl" "$(SCRIPT_INSTALL_DIR)\" + @$(CPY) "$(OUT_DIR)\tclConfig.sh" "$(LIB_INSTALL_DIR)\" + @echo Installing library http1.0 directory @$(CPY) "$(ROOT)\library\http1.0\*.tcl" \ - "$(SCRIPT_INSTALL_DIR)\http1.0\" - @echo installing http2.5 - @$(CPY) "$(ROOT)\library\http\*.tcl" \ - "$(SCRIPT_INSTALL_DIR)\http2.5\" - @echo installing opt0.4 + "$(SCRIPT_INSTALL_DIR)\http1.0\" + @echo Installing library opt0.4 directory @$(CPY) "$(ROOT)\library\opt\*.tcl" \ - "$(SCRIPT_INSTALL_DIR)\opt0.4\" - @echo installing msgcat1.3 - @$(CPY) "$(ROOT)\library\msgcat\*.tcl" \ - "$(SCRIPT_INSTALL_DIR)\msgcat1.3\" - @echo installing tcltest2.2 - @$(CPY) "$(ROOT)\library\tcltest\*.tcl" \ - "$(SCRIPT_INSTALL_DIR)\tcltest2.2\" - @echo installing $(TCLDDELIBNAME) + "$(SCRIPT_INSTALL_DIR)\opt0.4\" + @echo Installing package http $(PKG_HTTP_VER) as a Tcl Module + @$(COPY) "$(ROOT)\library\http\http.tcl" \ + "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.4\http-$(PKG_HTTP_VER).tm" + @echo Installing package msgcat $(PKG_MSGCAT_VER) as a Tcl Module + @$(COPY) "$(ROOT)\library\msgcat\msgcat.tcl" \ + "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.5\msgcat-$(PKG_MSGCAT_VER).tm" + @echo Installing package tcltest $(PKG_TCLTEST_VER) as a Tcl Module + @$(COPY) "$(ROOT)\library\tcltest\tcltest.tcl" \ + "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.5\tcltest-$(PKG_TCLTEST_VER).tm" + @echo Installing package platform $(PKG_PLATFORM_VER) as a Tcl Module + @$(COPY) "$(ROOT)\library\platform\platform.tcl" \ + "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.4\platform-$(PKG_PLATFORM_VER).tm" + @echo Installing package platform::shell $(PKG_SHELL_VER) as a Tcl Module + @$(COPY) "$(ROOT)\library\platform\shell.tcl" \ + "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.4\platform\shell-$(PKG_SHELL_VER).tm" + @echo Installing $(TCLDDELIBNAME) !if $(STATIC_BUILD) +!if !$(TCL_USE_STATIC_PACKAGES) @$(CPY) "$(TCLDDELIB)" "$(LIB_INSTALL_DIR)\" +!endif !else @$(CPY) "$(TCLDDELIB)" "$(LIB_INSTALL_DIR)\dde$(DDEDOTVERSION)\" @$(CPY) "$(ROOT)\library\dde\pkgIndex.tcl" \ "$(LIB_INSTALL_DIR)\dde$(DDEDOTVERSION)\" !endif - @echo installing $(TCLREGLIBNAME) + @echo Installing $(TCLREGLIBNAME) !if $(STATIC_BUILD) +!if !$(TCL_USE_STATIC_PACKAGES) @$(CPY) "$(TCLREGLIB)" "$(LIB_INSTALL_DIR)\" +!endif !else @$(CPY) "$(TCLREGLIB)" "$(LIB_INSTALL_DIR)\reg$(REGDOTVERSION)\" @$(CPY) "$(ROOT)\library\reg\pkgIndex.tcl" \ "$(LIB_INSTALL_DIR)\reg$(REGDOTVERSION)\" !endif - @echo installing encoding files + @echo Installing encodings @$(CPY) "$(ROOT)\library\encoding\*.enc" \ "$(SCRIPT_INSTALL_DIR)\encoding\" - @echo installing library files - @$(CPY) "$(GENERICDIR)\tcl.h" "$(INCLUDE_INSTALL_DIR)\" - @$(CPY) "$(GENERICDIR)\tclDecls.h" "$(INCLUDE_INSTALL_DIR)\" - @$(CPY) "$(GENERICDIR)\tclPlatDecls.h" "$(INCLUDE_INSTALL_DIR)\" - @$(CPY) "$(ROOT)\library\history.tcl" "$(SCRIPT_INSTALL_DIR)\" - @$(CPY) "$(ROOT)\library\init.tcl" "$(SCRIPT_INSTALL_DIR)\" - @$(CPY) "$(ROOT)\library\ldAout.tcl" "$(SCRIPT_INSTALL_DIR)\" - @$(CPY) "$(ROOT)\library\parray.tcl" "$(SCRIPT_INSTALL_DIR)\" - @$(CPY) "$(ROOT)\library\safe.tcl" "$(SCRIPT_INSTALL_DIR)\" - @$(CPY) "$(ROOT)\library\tclIndex" "$(SCRIPT_INSTALL_DIR)\" - @$(CPY) "$(ROOT)\library\package.tcl" "$(SCRIPT_INSTALL_DIR)\" - @$(CPY) "$(ROOT)\library\word.tcl" "$(SCRIPT_INSTALL_DIR)\" - @$(CPY) "$(ROOT)\library\auto.tcl" "$(SCRIPT_INSTALL_DIR)\" +#" emacs fix + +install-tzdata: + @echo Installing time zone data + @set TCL_LIBRARY=$(ROOT)/library + @$(TCLSH_NATIVE) "$(ROOT)/tools/installData.tcl" \ + "$(ROOT)/library/tzdata" "$(SCRIPT_INSTALL_DIR)/tzdata" + +install-msgs: + @echo Installing message catalogs + @set TCL_LIBRARY=$(ROOT)/library + @$(TCLSH_NATIVE) "$(ROOT)/tools/installData.tcl" \ + "$(ROOT)/library/msgs" "$(SCRIPT_INSTALL_DIR)/msgs" #--------------------------------------------------------------------- # Clean up #--------------------------------------------------------------------- tidy: +!if "$(TCLLIB)" != "$(TCLIMPLIB)" @echo Removing $(TCLLIB) ... @if exist $(TCLLIB) del $(TCLLIB) +!endif + @echo Removing $(TCLIMPLIB) ... + @if exist $(TCLIMPLIB) del $(TCLIMPLIB) @echo Removing $(TCLSH) ... @if exist $(TCLSH) del $(TCLSH) @echo Removing $(TCLTEST) ... @@ -820,6 +1057,18 @@ tidy: clean: @echo Cleaning $(TMP_DIR)\* ... @if exist $(TMP_DIR)\nul $(RMDIR) $(TMP_DIR) + @echo Cleaning $(WINDIR)\nmakehlp.obj ... + @if exist $(WINDIR)\nmakehlp.obj del $(WINDIR)\nmakehlp.obj + @echo Cleaning $(WINDIR)\nmakehlp.exe ... + @if exist $(WINDIR)\nmakehlp.exe del $(WINDIR)\nmakehlp.exe + @echo Cleaning $(WINDIR)\_junk.pch ... + @if exist $(WINDIR)\_junk.pch del $(WINDIR)\_junk.pch + @echo Cleaning $(WINDIR)\vercl.x ... + @if exist $(WINDIR)\vercl.x del $(WINDIR)\vercl.x + @echo Cleaning $(WINDIR)\vercl.i ... + @if exist $(WINDIR)\vercl.i del $(WINDIR)\vercl.i + @echo Cleaning $(WINDIR)\versions.vc ... + @if exist $(WINDIR)\versions.vc del $(WINDIR)\versions.vc hose: @echo Hosing $(OUT_DIR)\* ... diff --git a/win/nmakehlp.c b/win/nmakehlp.c index 4657c81..f1b5f34 100644 --- a/win/nmakehlp.c +++ b/win/nmakehlp.c @@ -5,9 +5,10 @@ * This is used to fix limitations within nmake and the environment. * * Copyright (c) 2002 by David Gravereaux. + * Copyright (c) 2006 by Pat Thoyts * - * See the file "license.terms" for information on usage and redistribution - * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. * ---------------------------------------------------------------------------- */ @@ -17,9 +18,15 @@ #pragma comment (lib, "kernel32.lib") #include <stdio.h> #include <math.h> + +/* + * This library is required for x64 builds with _some_ versions + */ #if defined(_M_IA64) || defined(_M_AMD64) +#if _MSC_FULL_VER > 140000000 && _MSC_FULL_VER <= 140040310 #pragma comment(lib, "bufferoverflowU") #endif +#endif /* ISO hack for dumb VC++ */ #ifdef _MSC_VER @@ -34,6 +41,8 @@ int CheckForCompilerFeature(const char *option); int CheckForLinkerFeature(const char *option); int IsIn(const char *string, const char *substring); int GrepForDefine(const char *file, const char *string); +int SubstituteFile(const char *substs, const char *filename); +const char * GetVersionFromFile(const char *filename, const char *match); DWORD WINAPI ReadFromPipe(LPVOID args); /* globals */ @@ -128,10 +137,35 @@ main( return 2; } return GrepForDefine(argv[2], argv[3]); + case 's': + if (argc == 2) { + chars = snprintf(msg, sizeof(msg) - 1, + "usage: %s -s <substitutions file> <file>\n" + "Perform a set of string map type substutitions on a file\n" + "exitcodes: 0\n", + argv[0]); + WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars, + &dwWritten, NULL); + return 2; + } + return SubstituteFile(argv[2], argv[3]); + case 'V': + if (argc != 4) { + chars = snprintf(msg, sizeof(msg) - 1, + "usage: %s -V filename matchstring\n" + "Extract a version from a file:\n" + "eg: pkgIndex.tcl \"package ifneeded http\"", + argv[0]); + WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars, + &dwWritten, NULL); + return 0; + } + printf("%s\n", GetVersionFromFile(argv[2], argv[3])); + return 0; } } chars = snprintf(msg, sizeof(msg) - 1, - "usage: %s -c|-l|-f ...\n" + "usage: %s -c|-l|-f|-g|-V ...\n" "This is a little helper app to equalize shell differences between WinNT and\n" "Win9x and get nmake.exe to accomplish its job.\n", argv[0]); @@ -190,7 +224,7 @@ CheckForCompilerFeature( * Base command line. */ - lstrcpy(cmdline, "cl.exe -nologo -c -TC -Zs -X "); + lstrcpy(cmdline, "cl.exe -nologo -c -TC -Zs -X -Fp.\\_junk.pch "); /* * Append our option for testing @@ -224,7 +258,7 @@ CheckForCompilerFeature( FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM|FORMAT_MESSAGE_IGNORE_INSERTS| FORMAT_MESSAGE_MAX_WIDTH_MASK, 0L, err, 0, (LPVOID)&msg[chars], (300-chars), 0); - WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, lstrlen(msg), &err,NULL); + WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg,lstrlen(msg), &err,NULL); return 2; } @@ -268,7 +302,9 @@ CheckForCompilerFeature( return !(strstr(Out.buffer, "D4002") != NULL || strstr(Err.buffer, "D4002") != NULL || strstr(Out.buffer, "D9002") != NULL - || strstr(Err.buffer, "D9002") != NULL); + || strstr(Err.buffer, "D9002") != NULL + || strstr(Out.buffer, "D2021") != NULL + || strstr(Err.buffer, "D2021") != NULL); } int @@ -350,7 +386,7 @@ CheckForLinkerFeature( FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM|FORMAT_MESSAGE_IGNORE_INSERTS| FORMAT_MESSAGE_MAX_WIDTH_MASK, 0L, err, 0, (LPVOID)&msg[chars], (300-chars), 0); - WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, lstrlen(msg), &err,NULL); + WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg,lstrlen(msg), &err,NULL); return 2; } @@ -391,9 +427,9 @@ CheckForLinkerFeature( */ return !(strstr(Out.buffer, "LNK1117") != NULL || - strstr(Err.buffer, "LNK1117") != NULL || - strstr(Out.buffer, "LNK4044") != NULL || - strstr(Err.buffer, "LNK4044") != NULL); + strstr(Err.buffer, "LNK1117") != NULL || + strstr(Out.buffer, "LNK4044") != NULL || + strstr(Err.buffer, "LNK4044") != NULL); } DWORD WINAPI @@ -440,18 +476,16 @@ GrepForDefine( const char *file, const char *string) { - FILE *f; char s1[51], s2[51], s3[51]; - int r = 0; - double d1; + FILE *f = fopen(file, "rt"); - f = fopen(file, "rt"); if (f == NULL) { return 0; } do { - r = fscanf(f, "%50s", s1); + int r = fscanf(f, "%50s", s1); + if (r == 1 && !strcmp(s1, "#define")) { /* * Get next two words. @@ -467,6 +501,8 @@ GrepForDefine( */ if (!strcmp(s2, string)) { + double d1; + fclose(f); /* @@ -485,3 +521,203 @@ GrepForDefine( fclose(f); return 0; } + +/* + * GetVersionFromFile -- + * Looks for a match string in a file and then returns the version + * following the match where a version is anything acceptable to + * package provide or package ifneeded. + */ + +const char * +GetVersionFromFile( + const char *filename, + const char *match) +{ + size_t cbBuffer = 100; + static char szBuffer[100]; + char *szResult = NULL; + FILE *fp = fopen(filename, "rt"); + + if (fp != NULL) { + /* + * Read data until we see our match string. + */ + + while (fgets(szBuffer, cbBuffer, fp) != NULL) { + LPSTR p, q; + + p = strstr(szBuffer, match); + if (p != NULL) { + /* + * Skip to first digit. + */ + + while (*p && !isdigit(*p)) { + ++p; + } + + /* + * Find ending whitespace. + */ + + q = p; + while (*q && (isalnum(*q) || *q == '.')) { + ++q; + } + + memcpy(szBuffer, p, q - p); + szBuffer[q-p] = 0; + szResult = szBuffer; + break; + } + } + fclose(fp); + } + return szResult; +} + +/* + * List helpers for the SubstituteFile function + */ + +typedef struct list_item_t { + struct list_item_t *nextPtr; + char * key; + char * value; +} list_item_t; + +/* insert a list item into the list (list may be null) */ +static list_item_t * +list_insert(list_item_t **listPtrPtr, const char *key, const char *value) +{ + list_item_t *itemPtr = malloc(sizeof(list_item_t)); + if (itemPtr) { + itemPtr->key = strdup(key); + itemPtr->value = strdup(value); + itemPtr->nextPtr = NULL; + + while(*listPtrPtr) { + listPtrPtr = &(*listPtrPtr)->nextPtr; + } + *listPtrPtr = itemPtr; + } + return itemPtr; +} + +static void +list_free(list_item_t **listPtrPtr) +{ + list_item_t *tmpPtr, *listPtr = *listPtrPtr; + while (listPtr) { + tmpPtr = listPtr; + listPtr = listPtr->nextPtr; + free(tmpPtr->key); + free(tmpPtr->value); + free(tmpPtr); + } +} + +/* + * SubstituteFile -- + * As windows doesn't provide anything useful like sed and it's unreliable + * to use the tclsh you are building against (consider x-platform builds - + * eg compiling AMD64 target from IX86) we provide a simple substitution + * option here to handle autoconf style substitutions. + * The substitution file is whitespace and line delimited. The file should + * consist of lines matching the regular expression: + * \s*\S+\s+\S*$ + * + * Usage is something like: + * nmakehlp -S << $** > $@ + * @PACKAGE_NAME@ $(PACKAGE_NAME) + * @PACKAGE_VERSION@ $(PACKAGE_VERSION) + * << + */ + +int +SubstituteFile( + const char *substitutions, + const char *filename) +{ + size_t cbBuffer = 1024; + static char szBuffer[1024], szCopy[1024]; + char *szResult = NULL; + list_item_t *substPtr = NULL; + FILE *fp, *sp; + + fp = fopen(filename, "rt"); + if (fp != NULL) { + + /* + * Build a list of substutitions from the first filename + */ + + sp = fopen(substitutions, "rt"); + if (sp != NULL) { + while (fgets(szBuffer, cbBuffer, sp) != NULL) { + char *ks, *ke, *vs, *ve; + ks = szBuffer; + while (ks && *ks && isspace(*ks)) ++ks; + ke = ks; + while (ke && *ke && !isspace(*ke)) ++ke; + vs = ke; + while (vs && *vs && isspace(*vs)) ++vs; + ve = vs; + while (ve && *ve && !(*ve == '\r' || *ve == '\n')) ++ve; + *ke = 0, *ve = 0; + list_insert(&substPtr, ks, vs); + } + fclose(sp); + } + + /* debug: dump the list */ +#ifdef _DEBUG + { + int n = 0; + list_item_t *p = NULL; + for (p = substPtr; p != NULL; p = p->nextPtr, ++n) { + fprintf(stderr, "% 3d '%s' => '%s'\n", n, p->key, p->value); + } + } +#endif + + /* + * Run the substitutions over each line of the input + */ + + while (fgets(szBuffer, cbBuffer, fp) != NULL) { + list_item_t *p = NULL; + for (p = substPtr; p != NULL; p = p->nextPtr) { + char *m = strstr(szBuffer, p->key); + if (m) { + char *cp, *op, *sp; + cp = szCopy; + op = szBuffer; + while (op != m) *cp++ = *op++; + sp = p->value; + while (sp && *sp) *cp++ = *sp++; + op += strlen(p->key); + while (*op) *cp++ = *op++; + *cp = 0; + memcpy(szBuffer, szCopy, sizeof(szCopy)); + } + } + printf(szBuffer); + } + + list_free(&substPtr); + } + fclose(fp); + return 0; +} + +/* + * Local variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * indent-tabs-mode: t + * tab-width: 8 + * End: + */ diff --git a/win/rules.vc b/win/rules.vc index 4b07d06..e18dca9 100644 --- a/win/rules.vc +++ b/win/rules.vc @@ -8,7 +8,7 @@ # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # Copyright (c) 2001-2003 David Gravereaux. -# Copyright (c) 2003-2006 Patrick Thoyts +# Copyright (c) 2003-2007 Patrick Thoyts #------------------------------------------------------------------------------ !ifndef _RULES_VC @@ -27,18 +27,6 @@ _INSTALLDIR = C:\Program Files\Tcl _INSTALLDIR = $(INSTALLDIR:/=\) !endif -!ifndef MACHINE -!if "$(CPU)" == "" || "$(CPU)" == "i386" -MACHINE = IX86 -!else -MACHINE = $(CPU) -!endif -!endif - -!ifndef CFG_ENCODING -CFG_ENCODING = \"cp1252\" -!endif - #---------------------------------------------------------- # Set the proper copy method to avoid overwrite questions # to the user when copying files and selecting the right @@ -47,17 +35,66 @@ CFG_ENCODING = \"cp1252\" !if "$(OS)" == "Windows_NT" RMDIR = rmdir /S /Q +ERRNULL = 2>NUL !if ![ver | find "4.0" > nul] -CPY = echo y | xcopy /i +CPY = echo y | xcopy /i >NUL +COPY = copy >NUL !else CPY = xcopy /i /y >NUL +COPY = copy /y >NUL !endif -!else -CPY = xcopy /i +!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 MKDIR = mkdir -COPY = copy /y >NUL + +#------------------------------------------------------------------------------ +# Determine the host and target architectures and compiler version. +#------------------------------------------------------------------------------ + +_HASH=^# +_VC_MANIFEST_EMBED_EXE= +_VC_MANIFEST_EMBED_DLL= +VCVER=0 +!if ![echo VCVERSION=_MSC_VER > vercl.x] \ + && ![echo $(_HASH)if defined(_M_IX86) >> vercl.x] \ + && ![echo ARCH=IX86 >> vercl.x] \ + && ![echo $(_HASH)elif defined(_M_AMD64) >> vercl.x] \ + && ![echo ARCH=AMD64 >> vercl.x] \ + && ![echo $(_HASH)endif >> vercl.x] \ + && ![cl -nologo -TC -P vercl.x $(ERRNULL)] +!include vercl.i +!if ![echo VCVER= ^\> vercl.vc] \ + && ![set /a $(VCVERSION) / 100 - 6 >> vercl.vc] +!include vercl.vc +!endif +!endif +!if ![del $(ERRNUL) /q/f vercl.x vercl.i vercl.vc] +!endif + +!if ![reg query HKLM\Hardware\Description\System\CentralProcessor\0 /v Identifier | findstr /i x86] +NATIVE_ARCH=IX86 +!else +NATIVE_ARCH=AMD64 +!endif + +# Since MSVC8 we must deal with manifest resources. +!if $(VCVERSION) >= 1400 +_VC_MANIFEST_EMBED_EXE=if exist $@.manifest mt -nologo -manifest $@.manifest -outputresource:$@;1 +_VC_MANIFEST_EMBED_DLL=if exist $@.manifest mt -nologo -manifest $@.manifest -outputresource:$@;2 +!endif + +!ifndef MACHINE +MACHINE=$(ARCH) +!endif + +!ifndef CFG_ENCODING +CFG_ENCODING = \"cp1252\" +!endif !message =============================================================================== @@ -116,14 +153,11 @@ OPTIMIZATIONS = $(OPTIMIZATIONS) -GL DEBUGFLAGS = -# the platform SDK has broken headers that break the runtime checks for amd64 -!if "$(MACHINE)" != "AMD64" !if [nmakehlp -c -RTC1] DEBUGFLAGS = $(DEBUGFLAGS) -RTC1 !elseif [nmakehlp -c -GZ] DEBUGFLAGS = $(DEBUGFLAGS) -GZ !endif -!endif COMPILERFLAGS =-W3 @@ -174,36 +208,6 @@ LINKERFLAGS =-ltcg !endif #---------------------------------------------------------- -# MSVC8 (ships with Visual Studio 2005) generates a manifest -# file that we should link into the binaries. This is how. -#---------------------------------------------------------- - -_VC_MANIFEST_EMBED_EXE= -_VC_MANIFEST_EMBED_DLL= -VCVER=0 -!if ![echo VCVERSION=_MSC_VER > vercl.x] \ - && ![cl -nologo -TC -P vercl.x $(ERRNULL)] -!include vercl.i -!if $(VCVERSION) >= 1600 -VCVER=10 -!elseif $(VCVERSION) >= 1500 -VCVER=9 -!elseif $(VCVERSION) >= 1400 -VCVER=8 -!elseif $(VCVERSION) >= 1300 -VCVER=7 -!elseif $(VCVERSION) >= 1200 -VCVER=6 -!endif -!endif - -# Since MSVC8 we must deal with manifest resources. -!if $(VCVERSION) >= 1400 -_VC_MANIFEST_EMBED_EXE=if exist $@.manifest mt -nologo -manifest $@.manifest -outputresource:$@;1 -_VC_MANIFEST_EMBED_DLL=if exist $@.manifest mt -nologo -manifest $@.manifest -outputresource:$@;2 -!endif - -#---------------------------------------------------------- # Decode the options requested. #---------------------------------------------------------- @@ -211,6 +215,7 @@ _VC_MANIFEST_EMBED_DLL=if exist $@.manifest mt -nologo -manifest $@.manifest -ou STATIC_BUILD = 0 TCL_THREADS = 0 DEBUG = 0 +SYMBOLS = 0 PROFILE = 0 MSVCRT = 0 LOIMPACT = 0 @@ -248,6 +253,12 @@ DEBUG = 1 !else DEBUG = 0 !endif +!if [nmakehlp -f $(OPTS) "pdbs"] +!message *** Doing pdbs +SYMBOLS = 1 +!else +SYMBOLS = 0 +!endif !if [nmakehlp -f $(OPTS) "profile"] !message *** Doing profile PROFILE = 1 @@ -303,11 +314,8 @@ SUFX = tsgx !if $(DEBUG) BUILDDIRTOP = Debug -DBGX = g !else BUILDDIRTOP = Release -DBGX = -SUFX = $(SUFX:g=) !endif !if "$(MACHINE)" != "IX86" @@ -317,6 +325,10 @@ BUILDDIRTOP =$(BUILDDIRTOP)_$(MACHINE) BUILDDIRTOP =$(BUILDDIRTOP)_VC$(VCVER) !endif +!if !$(DEBUG) || $(DEBUG) && $(UNCHECKED) +SUFX = $(SUFX:g=) +!endif + TMP_DIRFULL = .\$(BUILDDIRTOP)\$(PROJECT)_ThreadedDynamicStaticX !if !$(STATIC_BUILD) @@ -375,13 +387,14 @@ TCL_COMPILE_DEBUG = 0 !endif !endif + #---------------------------------------------------------- # Decode the checks requested. #---------------------------------------------------------- !if "$(CHECKS)" == "" || [nmakehlp -f "$(CHECKS)" "none"] TCL_NO_DEPRECATED = 0 -FULLWARNINGS = 0 +WARNINGS = -W3 !else !if [nmakehlp -f $(CHECKS) "nodep"] !message *** Doing nodep check @@ -391,9 +404,16 @@ TCL_NO_DEPRECATED = 0 !endif !if [nmakehlp -f $(CHECKS) "fullwarn"] !message *** Doing full warnings check -FULLWARNINGS = 1 +WARNINGS = -W4 +!if [nmakehlp -l -warn:3] +LINKERFLAGS = $(LINKERFLAGS) -warn:3 +!endif !else -FULLWARNINGS = 0 +WARNINGS = -W3 +!endif +!if [nmakehlp -f $(CHECKS) "64bit"] && [nmakehlp -c -Wp64] +!message *** Doing 64bit portability warnings +WARNINGS = $(WARNINGS) -Wp64 !endif !endif @@ -401,7 +421,8 @@ FULLWARNINGS = 0 # Set our defines now armed with our options. #---------------------------------------------------------- -OPTDEFINES = +OPTDEFINES = -DTCL_CFGVAL_ENCODING=$(CFG_ENCODING) -DSTDC_HEADERS + !if $(TCL_MEM_DEBUG) OPTDEFINES = $(OPTDEFINES) -DTCL_MEM_DEBUG !endif @@ -417,6 +438,9 @@ OPTDEFINES = $(OPTDEFINES) -DUSE_THREAD_ALLOC=1 !if $(STATIC_BUILD) OPTDEFINES = $(OPTDEFINES) -DSTATIC_BUILD !endif +!if $(TCL_NO_DEPRECATED) +OPTDEFINES = $(OPTDEFINES) -DTCL_NO_DEPRECATED +!endif !if $(DEBUG) OPTDEFINES = $(OPTDEFINES) -DTCL_CFG_DEBUG @@ -432,16 +456,26 @@ OPTDEFINES = $(OPTDEFINES) -DTCL_CFG_DO64BIT #---------------------------------------------------------- -# Get common info used when building extensions. +# Locate the Tcl headers to build against #---------------------------------------------------------- -!if "$(PROJECT)" != "tcl" +!if "$(PROJECT)" == "tcl" -!if !defined(TCLDIR) +_TCL_H = ..\generic\tcl.h + +!else + +# If INSTALLDIR set to tcl root dir then reset to the lib dir. !if exist("$(_INSTALLDIR)\include\tcl.h") -TCLH = "$(_INSTALLDIR)\include\tcl.h" +_INSTALLDIR=$(_INSTALLDIR)\lib +!endif + +!if !defined(TCLDIR) +!if exist("$(_INSTALLDIR)\..\include\tcl.h") TCLINSTALL = 1 -_TCLDIR = $(_INSTALLDIR) +_TCLDIR = $(_INSTALLDIR)\.. +_TCL_H = $(_INSTALLDIR)\..\include\tcl.h +TCLDIR = $(_INSTALLDIR)\.. !else MSG=^ Failed to find tcl.h. Set the TCLDIR macro. @@ -450,53 +484,181 @@ Failed to find tcl.h. Set the TCLDIR macro. !else _TCLDIR = $(TCLDIR:/=\) !if exist("$(_TCLDIR)\include\tcl.h") -TCLH = "$(_TCLDIR)\include\tcl.h" TCLINSTALL = 1 +_TCL_H = $(_TCLDIR)\include\tcl.h !elseif exist("$(_TCLDIR)\generic\tcl.h") -TCLH = "$(_TCLDIR)\generic\tcl.h" TCLINSTALL = 0 +_TCL_H = $(_TCLDIR)\generic\tcl.h !else MSG =^ Failed to find tcl.h. The TCLDIR macro does not appear correct. !error $(MSG) !endif !endif +!endif + +#-------------------------------------------------------------- +# Extract various version numbers from tcl headers +# The generated file is then included in the makefile. +#-------------------------------------------------------------- + +!if [echo REM = This file is generated from rules.vc > versions.vc] +!endif +!if [echo TCL_MAJOR_VERSION = \>> versions.vc] \ + && [nmakehlp -V "$(_TCL_H)" TCL_MAJOR_VERSION >> versions.vc] +!endif +!if [echo TCL_MINOR_VERSION = \>> versions.vc] \ + && [nmakehlp -V "$(_TCL_H)" TCL_MINOR_VERSION >> versions.vc] +!endif +!if [echo TCL_PATCH_LEVEL = \>> versions.vc] \ + && [nmakehlp -V "$(_TCL_H)" TCL_PATCH_LEVEL >> versions.vc] +!endif + +# If building the tcl core then we need additional package versions +!if "$(PROJECT)" == "tcl" +!if [echo PKG_HTTP_VER = \>> versions.vc] \ + && [nmakehlp -V ..\library\http\pkgIndex.tcl http >> versions.vc] +!endif +!if [echo PKG_TCLTEST_VER = \>> versions.vc] \ + && [nmakehlp -V ..\library\tcltest\pkgIndex.tcl tcltest >> versions.vc] +!endif +!if [echo PKG_MSGCAT_VER = \>> versions.vc] \ + && [nmakehlp -V ..\library\msgcat\pkgIndex.tcl msgcat >> versions.vc] +!endif +!if [echo PKG_PLATFORM_VER = \>> versions.vc] \ + && [nmakehlp -V ..\library\platform\pkgIndex.tcl "platform " >> versions.vc] +!endif +!if [echo PKG_SHELL_VER = \>> versions.vc] \ + && [nmakehlp -V ..\library\platform\pkgIndex.tcl "platform::shell" >> versions.vc] +!endif +!if [echo PKG_DDE_VER = \>> versions.vc] \ + && [nmakehlp -V ..\library\dde\pkgIndex.tcl "dde " >> versions.vc] +!endif +!if [echo PKG_REG_VER =\>> versions.vc] \ + && [nmakehlp -V ..\library\reg\pkgIndex.tcl registry >> versions.vc] +!endif +!endif + +!include versions.vc -### TODO: add a command to nmakehlp.c to grep for Tcl's version from tcl.h. -### Because nmake can't return a string, we'll need to play games with return -### codes. It might look something like this: -#!if [nmakehlp -g $(TCL.H)] == 81 -#TCL_DOTVERSION = 8.1 -#!elseif [nmakehlp -g $(TCL.H)] == 82 -#TCL_DOTVERSION = 8.2 -#... -#!endif +#-------------------------------------------------------------- +# Setup tcl version dependent stuff headers +#-------------------------------------------------------------- -TCL_DOTVERSION = 8.4 -TCL_VERSION = $(TCL_DOTVERSION:.=) +!if "$(PROJECT)" != "tcl" + +TCL_VERSION = $(TCL_MAJOR_VERSION)$(TCL_MINOR_VERSION) + +!if $(TCL_VERSION) < 81 +TCL_DOES_STUBS = 0 +!else +TCL_DOES_STUBS = 1 +!endif !if $(TCLINSTALL) -TCLSH = "$(_INSTALLDIR)\bin\tclsh$(TCL_VERSION)$(SUFX).exe" -TCLSTUBLIB = "$(_INSTALLDIR)\lib\tclstub$(TCL_VERSION).lib" -TCLIMPLIB = "$(_INSTALLDIR)\lib\tcl$(TCL_VERSION)$(SUFX).lib" -TCL_LIBRARY = $(_INSTALLDIR)\lib -TCLREGLIB = "$(_INSTALLDIR)\lib\tclreg11$(SUFX:t=).lib" -TCLDDELIB = "$(_INSTALLDIR)\lib\tcldde12$(SUFX:t=).lib" +TCLSH = "$(_TCLDIR)\bin\tclsh$(TCL_VERSION)$(SUFX).exe" +!if !exist($(TCLSH)) && $(TCL_THREADS) +TCLSH = "$(_TCLDIR)\bin\tclsh$(TCL_VERSION)t$(SUFX).exe" +!endif +TCLSTUBLIB = "$(_TCLDIR)\lib\tclstub$(TCL_VERSION).lib" +TCLIMPLIB = "$(_TCLDIR)\lib\tcl$(TCL_VERSION)$(SUFX).lib" +TCL_LIBRARY = $(_TCLDIR)\lib +TCLREGLIB = "$(_TCLDIR)\lib\tclreg12$(SUFX:t=).lib" +TCLDDELIB = "$(_TCLDIR)\lib\tcldde13$(SUFX:t=).lib" COFFBASE = \must\have\tcl\sources\to\build\this\target TCLTOOLSDIR = \must\have\tcl\sources\to\build\this\target +TCL_INCLUDES = -I"$(_TCLDIR)\include" !else TCLSH = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclsh$(TCL_VERSION)$(SUFX).exe" +!if !exist($(TCLSH)) && $(TCL_THREADS) +TCLSH = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclsh$(TCL_VERSION)t$(SUFX).exe" +!endif TCLSTUBLIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclstub$(TCL_VERSION).lib" TCLIMPLIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tcl$(TCL_VERSION)$(SUFX).lib" TCL_LIBRARY = $(_TCLDIR)\library -TCLREGLIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclreg11$(SUFX:t=).lib" -TCLDDELIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tcldde12$(SUFX:t=).lib" +TCLREGLIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclreg12$(SUFX:t=).lib" +TCLDDELIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tcldde13$(SUFX:t=).lib" COFFBASE = "$(_TCLDIR)\win\coffbase.txt" TCLTOOLSDIR = $(_TCLDIR)\tools +TCL_INCLUDES = -I"$(_TCLDIR)\generic" -I"$(_TCLDIR)\win" +!endif + !endif +#------------------------------------------------------------------------- +# Locate the Tk headers to build against +#------------------------------------------------------------------------- + +!if "$(PROJECT)" == "tk" +_TK_H = ..\generic\tk.h +_INSTALLDIR = $(_INSTALLDIR)\.. !endif +!ifdef PROJECT_REQUIRES_TK +!if !defined(TKDIR) +!if exist("$(_INSTALLDIR)\..\include\tk.h") +TKINSTALL = 1 +_TKDIR = $(_INSTALLDIR)\.. +_TK_H = $(_TKDIR)\include\tk.h +TKDIR = $(_TKDIR) +!elseif exist("$(_TCLDIR)\include\tk.h") +TKINSTALL = 1 +_TKDIR = $(_TCLDIR) +_TK_H = $(_TKDIR)\include\tk.h +TKDIR = $(_TKDIR) +!endif +!else +_TKDIR = $(TKDIR:/=\) +!if exist("$(_TKDIR)\include\tk.h") +TKINSTALL = 1 +_TK_H = $(_TKDIR)\include\tk.h +!elseif exist("$(_TKDIR)\generic\tk.h") +TKINSTALL = 0 +_TK_H = $(_TKDIR)\generic\tk.h +!else +MSG =^ +Failed to find tk.h. The TKDIR macro does not appear correct. +!error $(MSG) +!endif +!endif +!endif + +#------------------------------------------------------------------------- +# Extract Tk version numbers +#------------------------------------------------------------------------- + +!if defined(PROJECT_REQUIRES_TK) || "$(PROJECT)" == "tk" + +!if [echo TK_MAJOR_VERSION = \>> versions.vc] \ + && [nmakehlp -V $(_TK_H) TK_MAJOR_VERSION >> versions.vc] +!endif +!if [echo TK_MINOR_VERSION = \>> versions.vc] \ + && [nmakehlp -V $(_TK_H) TK_MINOR_VERSION >> versions.vc] +!endif +!if [echo TK_PATCH_LEVEL = \>> versions.vc] \ + && [nmakehlp -V $(_TK_H) TK_PATCH_LEVEL >> versions.vc] +!endif + +!include versions.vc + +TK_DOTVERSION = $(TK_MAJOR_VERSION).$(TK_MINOR_VERSION) +TK_VERSION = $(TK_MAJOR_VERSION)$(TK_MINOR_VERSION) + +!if "$(PROJECT)" != "tk" +!if $(TKINSTALL) +WISH = "$(_TKDIR)\bin\wish$(TK_VERSION)$(SUFX).exe" +TKSTUBLIB = "$(_TKDIR)\lib\tkstub$(TK_VERSION).lib" +TKIMPLIB = "$(_TKDIR)\lib\tk$(TK_VERSION)$(SUFX).lib" +TK_INCLUDES = -I"$(_TKDIR)\include" +!else +WISH = "$(_TKDIR)\win\$(BUILDDIRTOP)\wish$(TCL_VERSION)$(SUFX).exe" +TKSTUBLIB = "$(_TKDIR)\win\$(BUILDDIRTOP)\tkstub$(TCL_VERSION).lib" +TKIMPLIB = "$(_TKDIR)\win\$(BUILDDIRTOP)\tk$(TCL_VERSION)$(SUFX).lib" +TK_INCLUDES = -I"$(_TKDIR)\generic" -I"$(_TKDIR)\win" -I"$(_TKDIR)\xlib" +!endif +!endif + +!endif #---------------------------------------------------------- # Display stats being used. @@ -506,8 +668,9 @@ TCLTOOLSDIR = $(_TCLDIR)\tools !message *** Output directory will be '$(OUT_DIR)' !message *** Suffix for binaries will be '$(SUFX)' !message *** Optional defines are '$(OPTDEFINES)' -!message *** Compiler version $(VCVER) -!message *** Compiler options '$(OPTIMIZATIONS) $(DEBUGFLAGS)' +!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 diff --git a/win/stub16.c b/win/stub16.c index aa42c58..70fc051 100644 --- a/win/stub16.c +++ b/win/stub16.c @@ -1,13 +1,13 @@ -/* - * stub16.c +/* + * stub16.c * * A helper program used for running 16-bit DOS applications under * Windows 95. * * Copyright (c) 1996 by Sun Microsystems, Inc. * - * See the file "license.terms" for information on usage and redistribution - * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #define STRICT @@ -16,32 +16,31 @@ #include <stdio.h> static HANDLE CreateTempFile(void); - + /* *--------------------------------------------------------------------------- * * main * - * Entry point for the 32-bit console mode app used by Windows 95 to - * help run the 16-bit program specified on the command line. + * Entry point for the 32-bit console mode app used by Windows 95 to help + * run the 16-bit program specified on the command line. + * + * 1. EOF on a pipe that connects a detached 16-bit process and a 32-bit + * process is never seen. So, this process runs the 16-bit process + * _attached_, and then it is run detached from the calling 32-bit + * process. * - * 1. EOF on a pipe that connects a detached 16-bit process and a - * 32-bit process is never seen. So, this process runs the 16-bit - * process _attached_, and then it is run detached from the calling - * 32-bit process. - * - * 2. If a 16-bit process blocks reading from or writing to a pipe, - * it never wakes up, and eventually brings the whole system down - * with it if you try to kill the process. This app simulates - * pipes. If any of the stdio handles is a pipe, this program - * accumulates information into temp files and forwards it to or - * from the DOS application as appropriate. This means that this - * program must receive EOF from a stdin pipe before it will actually - * start the DOS app, and the DOS app must finish generating stdout - * or stderr before the data will be sent to the next stage of the - * pipe. If the stdio handles are not pipes, no accumulation occurs - * and the data is passed straight through to and from the DOS - * application. + * 2. If a 16-bit process blocks reading from or writing to a pipe, it + * never wakes up, and eventually brings the whole system down with it if + * you try to kill the process. This app simulates pipes. If any of the + * stdio handles is a pipe, this program accumulates information into + * temp files and forwards it to or from the DOS application as + * appropriate. This means that this program must receive EOF from a + * stdin pipe before it will actually start the DOS app, and the DOS app + * must finish generating stdout or stderr before the data will be sent + * to the next stage of the pipe. If the stdio handles are not pipes, no + * accumulation occurs and the data is passed straight through to and + * from the DOS application. * * Results: * None. @@ -54,7 +53,7 @@ static HANDLE CreateTempFile(void); */ int -main() +main(void) { DWORD dwRead, dwWrite; char *cmdLine; @@ -72,10 +71,10 @@ main() /* * Don't get command line from argc, argv, because the command line - * tokenizer will have stripped off all the escape sequences needed - * for quotes and backslashes, and then we'd have to put them all - * back in again. Get the raw command line and parse off what we - * want ourselves. The command line should be of the form: + * tokenizer will have stripped off all the escape sequences needed for + * quotes and backslashes, and then we'd have to put them all back in + * again. Get the raw command line and parse off what we want ourselves. + * The command line should be of the form: * * stub16.exe program arg1 arg2 ... */ @@ -123,7 +122,7 @@ main() ZeroMemory(&si, sizeof(si)); si.cb = sizeof(si); - if (CreateProcess(NULL, cmdLine, NULL, NULL, TRUE, 0, NULL, NULL, &si, + if (CreateProcess(NULL, cmdLine, NULL, NULL, TRUE, 0, NULL, NULL, &si, &pi) == FALSE) { goto cleanup; } @@ -157,7 +156,7 @@ main() } } -cleanup: + cleanup: if (hFileInput != INVALID_HANDLE_VALUE) { CloseHandle(hFileInput); } @@ -175,7 +174,7 @@ cleanup: } static HANDLE -CreateTempFile() +CreateTempFile(void) { char name[MAX_PATH]; SECURITY_ATTRIBUTES sa; @@ -190,7 +189,7 @@ CreateTempFile() sa.nLength = sizeof(sa); sa.lpSecurityDescriptor = NULL; sa.bInheritHandle = TRUE; - return CreateFile(name, GENERIC_READ | GENERIC_WRITE, 0, &sa, + return CreateFile(name, GENERIC_READ | GENERIC_WRITE, 0, &sa, CREATE_ALWAYS, FILE_ATTRIBUTE_TEMPORARY | FILE_FLAG_DELETE_ON_CLOSE, NULL); } diff --git a/win/tcl.dsp b/win/tcl.dsp index 2d99988..b3de0ff 100644 --- a/win/tcl.dsp +++ b/win/tcl.dsp @@ -36,16 +36,16 @@ CFG=tcl - Win32 Debug Static # PROP BASE Intermediate_Dir "Release\tcl_Dynamic" # PROP BASE Cmd_Line "nmake -nologo -f makefile.vc OPTS=none MSVCDIR=IDE" # PROP BASE Rebuild_Opt "-a" -# PROP BASE Target_File "Release\tclsh84.exe" +# PROP BASE Target_File "Release\tclsh85.exe" # PROP BASE Bsc_Name "" # PROP BASE Target_Dir "" # PROP Use_MFC 0 # PROP Use_Debug_Libraries 0 # PROP Output_Dir "Release" # PROP Intermediate_Dir "Release\tcl_Dynamic" -# PROP Cmd_Line "nmake -nologo -f makefile.vc OPTS=none MSVCDIR=IDE" -# PROP Rebuild_Opt "-a" -# PROP Target_File "Release\tclsh84.exe" +# PROP Cmd_Line "nmake -nologo -f makefile.vc OPTS=threads MSVCDIR=IDE" +# PROP Rebuild_Opt "clean release" +# PROP Target_File "Release\tclsh85t.exe" # PROP Bsc_Name "" # PROP Target_Dir "" @@ -57,16 +57,16 @@ CFG=tcl - Win32 Debug Static # PROP BASE Intermediate_Dir "Debug\tcl_Dynamic" # PROP BASE Cmd_Line "nmake -nologo -f makefile.vc OPTS=symbols MSVCDIR=IDE" # PROP BASE Rebuild_Opt "-a" -# PROP BASE Target_File "Debug\tclsh84d.exe" +# PROP BASE Target_File "Debug\tclsh85g.exe" # PROP BASE Bsc_Name "" # PROP BASE Target_Dir "" # PROP Use_MFC 0 # PROP Use_Debug_Libraries 1 # PROP Output_Dir "Debug" # PROP Intermediate_Dir "Debug\tcl_Dynamic" -# PROP Cmd_Line "nmake -nologo -f makefile.vc OPTS=symbols MSVCDIR=IDE" -# PROP Rebuild_Opt "-a" -# PROP Target_File "Debug\tclsh84d.exe" +# PROP Cmd_Line "nmake -nologo -f makefile.vc OPTS=threads,symbols MSVCDIR=IDE" +# PROP Rebuild_Opt "clean release" +# PROP Target_File "Debug\tclsh85tg.exe" # PROP Bsc_Name "" # PROP Target_Dir "" @@ -78,7 +78,7 @@ CFG=tcl - Win32 Debug Static # PROP BASE Intermediate_Dir "Debug\tcl_Static" # PROP BASE Cmd_Line "nmake -nologo -f makefile.vc OPTS=symbols,static MSVCDIR=IDE" # PROP BASE Rebuild_Opt "-a" -# PROP BASE Target_File "Debug\tclsh84d.exe" +# PROP BASE Target_File "Debug\tclsh85sg.exe" # PROP BASE Bsc_Name "" # PROP BASE Target_Dir "" # PROP Use_MFC 0 @@ -87,7 +87,7 @@ CFG=tcl - Win32 Debug Static # PROP Intermediate_Dir "Debug\tcl_Static" # PROP Cmd_Line "nmake -nologo -f makefile.vc OPTS=symbols,static MSVCDIR=IDE" # PROP Rebuild_Opt "-a" -# PROP Target_File "Debug\tclsh84sd.exe" +# PROP Target_File "Debug\tclsh85sg.exe" # PROP Bsc_Name "" # PROP Target_Dir "" @@ -99,7 +99,7 @@ CFG=tcl - Win32 Debug Static # PROP BASE Intermediate_Dir "Release\tcl_Static" # PROP BASE Cmd_Line "nmake -nologo -f makefile.vc OPTS=static MSVCDIR=IDE" # PROP BASE Rebuild_Opt "-a" -# PROP BASE Target_File "Release\tclsh84.exe" +# PROP BASE Target_File "Release\tclsh85s.exe" # PROP BASE Bsc_Name "" # PROP BASE Target_Dir "" # PROP Use_MFC 0 @@ -108,7 +108,7 @@ CFG=tcl - Win32 Debug Static # PROP Intermediate_Dir "Release\tcl_Static" # PROP Cmd_Line "nmake -nologo -f makefile.vc OPTS=static MSVCDIR=IDE" # PROP Rebuild_Opt "-a" -# PROP Target_File "Release\tclsh84s.exe" +# PROP Target_File "Release\tclsh85s.exe" # PROP Bsc_Name "" # PROP Target_Dir "" @@ -180,10 +180,6 @@ SOURCE=..\compat\stdlib.h # End Source File # Begin Source File -SOURCE=..\compat\strftime.c -# End Source File -# Begin Source File - SOURCE=..\compat\string.h # End Source File # Begin Source File @@ -212,10 +208,6 @@ SOURCE=..\compat\tclErrno.h # End Source File # Begin Source File -SOURCE=..\compat\tmpnam.c -# End Source File -# Begin Source File - SOURCE=..\compat\unistd.h # End Source File # Begin Source File @@ -652,10 +644,6 @@ SOURCE=..\doc\lsort.n # End Source File # Begin Source File -SOURCE=..\doc\Macintosh.3 -# End Source File -# Begin Source File - SOURCE=..\doc\man.macros # End Source File # Begin Source File @@ -780,10 +768,6 @@ SOURCE=..\doc\rename.n # End Source File # Begin Source File -SOURCE=..\doc\resource.n -# End Source File -# Begin Source File - SOURCE=..\doc\return.n # End Source File # Begin Source File @@ -1168,10 +1152,6 @@ SOURCE=..\generic\tclIndexObj.c # End Source File # Begin Source File -SOURCE=..\generic\tclInitScript.h -# End Source File -# Begin Source File - SOURCE=..\generic\tclInt.decls # End Source File # Begin Source File @@ -1240,10 +1220,6 @@ SOURCE=..\generic\tclMain.c # End Source File # Begin Source File -SOURCE=..\generic\tclMath.h -# End Source File -# Begin Source File - SOURCE=..\generic\tclNamesp.c # End Source File # Begin Source File @@ -1264,10 +1240,6 @@ SOURCE=..\generic\tclParse.c # End Source File # Begin Source File -SOURCE=..\generic\tclParseExpr.c -# End Source File -# Begin Source File - SOURCE=..\generic\tclPipe.c # End Source File # Begin Source File @@ -1552,10 +1524,6 @@ SOURCE=.\tclWinLoad.c # End Source File # Begin Source File -SOURCE=.\tclWinMtherr.c -# End Source File -# Begin Source File - SOURCE=.\tclWinNotify.c # End Source File # Begin Source File diff --git a/win/tcl.hpj.in b/win/tcl.hpj.in index 2a8c94a..0d01f35 100644 --- a/win/tcl.hpj.in +++ b/win/tcl.hpj.in @@ -5,9 +5,9 @@ HCW=0 LCID=0x409 0x0 0x0 ;English (United States) REPORT=Yes TITLE=Tcl/Tk Reference Manual -CNT=tcl84.cnt +CNT=tcl85.cnt COPYRIGHT=Copyright © 2000 Ajuba Solutions -HLP=tcl84.hlp +HLP=tcl85.hlp [FILES] tcl.rtf @@ -20,15 +20,15 @@ AC_DEFUN([SC_PATH_TCLCONFIG], [ AC_MSG_CHECKING([the location of tclConfig.sh]) - if test -d ../../tcl8.4$1/win; then - TCL_BIN_DIR_DEFAULT=../../tcl8.4$1/win - elif test -d ../../tcl8.4/win; then - TCL_BIN_DIR_DEFAULT=../../tcl8.4/win + if test -d ../../tcl8.5$1/win; then + TCL_BIN_DIR_DEFAULT=../../tcl8.5$1/win + elif test -d ../../tcl8.5/win; then + TCL_BIN_DIR_DEFAULT=../../tcl8.5/win else TCL_BIN_DIR_DEFAULT=../../tcl/win fi - AC_ARG_WITH(tcl, [ --with-tcl=DIR use Tcl 8.4 binaries from DIR], + AC_ARG_WITH(tcl, [ --with-tcl=DIR use Tcl 8.5 binaries from DIR], TCL_BIN_DIR=$withval, TCL_BIN_DIR=`cd $TCL_BIN_DIR_DEFAULT; pwd`) if test ! -d $TCL_BIN_DIR; then AC_MSG_ERROR(Tcl directory $TCL_BIN_DIR does not exist) @@ -60,15 +60,15 @@ AC_DEFUN([SC_PATH_TCLCONFIG], [ AC_DEFUN([SC_PATH_TKCONFIG], [ AC_MSG_CHECKING([the location of tkConfig.sh]) - if test -d ../../tk8.4$1/win; then - TK_BIN_DIR_DEFAULT=../../tk8.4$1/win - elif test -d ../../tk8.4/win; then - TK_BIN_DIR_DEFAULT=../../tk8.4/win + if test -d ../../tk8.5$1/win; then + TK_BIN_DIR_DEFAULT=../../tk8.5$1/win + elif test -d ../../tk8.5/win; then + TK_BIN_DIR_DEFAULT=../../tk8.5/win else TK_BIN_DIR_DEFAULT=../../tk/win fi - AC_ARG_WITH(tk, [ --with-tk=DIR use Tk 8.4 binaries from DIR], + AC_ARG_WITH(tk, [ --with-tk=DIR use Tk 8.5 binaries from DIR], TK_BIN_DIR=$withval, TK_BIN_DIR=`cd $TK_BIN_DIR_DEFAULT; pwd`) if test ! -d $TK_BIN_DIR; then AC_MSG_ERROR(Tk directory $TK_BIN_DIR does not exist) @@ -301,6 +301,8 @@ AC_DEFUN([SC_ENABLE_SYMBOLS], [ LDFLAGS_DEFAULT='$(LDFLAGS_OPTIMIZE)' DBGX="" AC_MSG_RESULT([no]) + + AC_DEFINE(TCL_CFG_OPTIMIZED) else CFLAGS_DEFAULT='$(CFLAGS_DEBUG)' LDFLAGS_DEFAULT='$(LDFLAGS_DEBUG)' @@ -311,6 +313,7 @@ AC_DEFUN([SC_ENABLE_SYMBOLS], [ fi AC_SUBST(CFLAGS_DEFAULT) AC_SUBST(LDFLAGS_DEFAULT) + AC_DEFINE(TCL_CFG_DEBUG) if test "$tcl_ok" = "mem" -o "$tcl_ok" = "all"; then AC_DEFINE(TCL_MEM_DEBUG) @@ -445,8 +448,9 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ if test "${GCC}" = "yes" ; then SHLIB_LD="" SHLIB_LD_LIBS="" - LIBS="" - LIBS_GUI="-lgdi32 -lcomdlg32 -limm32 -lcomctl32 -lshell32" + LIBS="-lws2_32" + # mingw needs to link ole32 and oleaut32 for [send], but MSVC doesn't + LIBS_GUI="-lgdi32 -lcomdlg32 -limm32 -lcomctl32 -lshell32 -luuid -lole32 -loleaut32" STLIB_LD='${AR} cr' RC_OUT=-o RC_TYPE= @@ -519,7 +523,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ CFLAGS_DEBUG=-g CFLAGS_OPTIMIZE="-O2 -fomit-frame-pointer" - CFLAGS_WARNING="-Wall -fno-strict-aliasing" + CFLAGS_WARNING="-Wall" LDFLAGS_DEBUG= LDFLAGS_OPTIMIZE= @@ -624,13 +628,17 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ fi fi - LIBS="user32.lib advapi32.lib" + LIBS="user32.lib advapi32.lib ws2_32.lib" if test "$do64bit" != "no" ; then # The space-based-path will work for the Makefile, but will # not work if AC_TRY_COMPILE is called. TEA has the # TEA_PATH_NOSPACE to avoid this issue. - CC="\"${PATH64}/cl.exe\" -I\"${MSSDK}/Include\" \ - -I\"${MSSDK}/Include/crt\" -I\"${MSSDK}/Include/crt/sys\"" + # Check if _WIN64 is already recognized, and if so we don't + # need to modify CC. + AC_CHECK_DECL([_WIN64], [], + [CC="\"${PATH64}/cl.exe\" -I\"${MSSDK}/Include\" \ + -I\"${MSSDK}/Include/crt\" \ + -I\"${MSSDK}/Include/crt/sys\""]) RC="\"${MSSDK}/bin/rc.exe\"" CFLAGS_DEBUG="-nologo -Zi -Od ${runtime}d" # Do not use -O2 for Win64 - this has proved buggy in code gen. @@ -741,7 +749,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ LIBS="$LIBS \"\${CELIB_DIR}/wince-${ARCH}-pocket-wce300-release/celib.lib\"" LIBS_GUI="commctrl.lib commdlg.lib" else - LIBS_GUI="gdi32.lib comdlg32.lib imm32.lib comctl32.lib shell32.lib" + LIBS_GUI="gdi32.lib comdlg32.lib imm32.lib comctl32.lib shell32.lib uuid.lib" fi SHLIB_LD="${LINKBIN} -dll -incremental:no ${lflags}" @@ -780,6 +788,10 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ fi fi + if test "$do64bit" != "no" ; then + AC_DEFINE(TCL_CFG_DO64BIT) + fi + # DL_LIBS is empty, but then we match the Unix version AC_SUBST(DL_LIBS) AC_SUBST(CFLAGS_DEBUG) @@ -805,13 +817,13 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ #------------------------------------------------------------------------ AC_DEFUN([SC_WITH_TCL], [ - if test -d ../../tcl8.4$1/win; then - TCL_BIN_DEFAULT=../../tcl8.4$1/win + if test -d ../../tcl8.5$1/win; then + TCL_BIN_DEFAULT=../../tcl8.5$1/win else - TCL_BIN_DEFAULT=../../tcl8.4/win + TCL_BIN_DEFAULT=../../tcl8.5/win fi - AC_ARG_WITH(tcl, [ --with-tcl=DIR use Tcl 8.4 binaries from DIR], + AC_ARG_WITH(tcl, [ --with-tcl=DIR use Tcl 8.5 binaries from DIR], TCL_BIN_DIR=$withval, TCL_BIN_DIR=`cd $TCL_BIN_DEFAULT; pwd`) if test ! -d $TCL_BIN_DIR; then AC_MSG_ERROR(Tcl directory $TCL_BIN_DIR does not exist) @@ -898,6 +910,34 @@ AC_DEFUN([SC_BUILD_TCLSH], [ ]) #-------------------------------------------------------------------- +# SC_TCL_CFG_ENCODING TIP #59 +# +# Declare the encoding to use for embedded configuration information. +# +# Arguments: +# None. +# +# Results: +# Might append to the following vars: +# DEFS (implicit) +# +# Will define the following vars: +# TCL_CFGVAL_ENCODING +# +#-------------------------------------------------------------------- + +AC_DEFUN([SC_TCL_CFG_ENCODING], [ + AC_ARG_WITH(encoding, [ --with-encoding encoding for configuration values], with_tcencoding=${withval}) + + if test x"${with_tcencoding}" != x ; then + AC_DEFINE_UNQUOTED(TCL_CFGVAL_ENCODING,"${with_tcencoding}") + else + # Default encoding on windows is not "iso8859-1" + AC_DEFINE(TCL_CFGVAL_ENCODING,"cp1252") + fi +]) + +#-------------------------------------------------------------------- # SC_EMBED_MANIFEST # # Figure out if we can embed the manifest where necessary @@ -915,7 +955,8 @@ AC_DEFUN([SC_BUILD_TCLSH], [ AC_DEFUN([SC_EMBED_MANIFEST], [ AC_MSG_CHECKING(whether to embed manifest) AC_ARG_ENABLE(embedded-manifest, - [ --enable-embedded-manifest embed manifest if possible (default: yes)], + AC_HELP_STRING([--enable-embedded-manifest], + [embed manifest if possible (default: yes)]), [embed_ok=$enableval], [embed_ok=yes]) VC_MANIFEST_EMBED_DLL= @@ -932,8 +973,11 @@ print("manifest needed") # Could do a CHECK_PROG for mt, but should always be with MSVC8+ # Could add 'if test -f' check, but manifest should be created # in this compiler case - VC_MANIFEST_EMBED_DLL="mt.exe -nologo -manifest \[$]@.manifest $1 -outputresource:\[$]@\;2" - VC_MANIFEST_EMBED_EXE="mt.exe -nologo -manifest \[$]@.manifest $1 -outputresource:\[$]@\;1" + # Add in a manifest argument that may be specified + # XXX Needs improvement so that the test for existence accounts + # XXX for a provided (known) manifest + VC_MANIFEST_EMBED_DLL="if test -f \[$]@.manifest ; then mt.exe -nologo -manifest \[$]@.manifest $1 -outputresource:\[$]@\;2 ; fi" + VC_MANIFEST_EMBED_EXE="if test -f \[$]@.manifest ; then mt.exe -nologo -manifest \[$]@.manifest $1 -outputresource:\[$]@\;1 ; fi" result=yes if test "x$1" != x ; then result="yes ($1)" @@ -7,14 +7,14 @@ // // build-up the name suffix that defines the type of build this is. // -#ifdef TCL_THREADS +#if TCL_THREADS #define SUFFIX_THREADS "t" #else #define SUFFIX_THREADS "" #endif -#ifdef DEBUG -#define SUFFIX_DEBUG "d" +#if DEBUG && !UNCHECKED +#define SUFFIX_DEBUG "g" #else #define SUFFIX_DEBUG "" #endif @@ -42,7 +42,7 @@ BEGIN BLOCK "040904b0" /* LANG_ENGLISH/SUBLANG_ENGLISH_US, Unicode CP */ BEGIN VALUE "FileDescription", "Tcl DLL\0" - VALUE "OriginalFilename", "tcl" STRINGIFY(JOIN(TCL_MAJOR_VERSION,TCL_MINOR_VERSION)) SUFFIX ".dll\0" + VALUE "OriginalFilename", "tcl" STRINGIFY(TCL_MAJOR_VERSION) STRINGIFY(TCL_MINOR_VERSION) SUFFIX ".dll\0" VALUE "CompanyName", "ActiveState Corporation\0" VALUE "FileVersion", TCL_PATCH_LEVEL VALUE "LegalCopyright", "Copyright \251 2001 by ActiveState Corporation, et al\0" diff --git a/win/tclAppInit.c b/win/tclAppInit.c index 4578ea8..289a3c3 100644 --- a/win/tclAppInit.c +++ b/win/tclAppInit.c @@ -2,14 +2,14 @@ * tclAppInit.c -- * * Provides a default version of the main program and Tcl_AppInit - * procedure for Tcl applications (without Tk). Note that this - * program must be built in Win32 console mode to work properly. + * function for Tcl applications (without Tk). Note that this program + * must be built in Win32 console mode to work properly. * * Copyright (c) 1996-1997 by Sun Microsystems, Inc. * Copyright (c) 1998-1999 by Scriptics Corporation. * - * See the file "license.terms" for information on usage and redistribution - * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tcl.h" @@ -17,24 +17,15 @@ #include <locale.h> #ifdef TCL_TEST -extern int Procbodytest_Init _ANSI_ARGS_((Tcl_Interp *interp)); -extern int Procbodytest_SafeInit _ANSI_ARGS_((Tcl_Interp *interp)); -extern int Tcltest_Init _ANSI_ARGS_((Tcl_Interp *interp)); -extern int TclObjTest_Init _ANSI_ARGS_((Tcl_Interp *interp)); -#ifdef TCL_THREADS -extern int TclThread_Init _ANSI_ARGS_((Tcl_Interp *interp)); -#endif +extern Tcl_PackageInitProc Procbodytest_Init; +extern Tcl_PackageInitProc Procbodytest_SafeInit; +extern Tcl_PackageInitProc Tcltest_Init; +extern Tcl_PackageInitProc TclObjTest_Init; #endif /* TCL_TEST */ -static void setargv _ANSI_ARGS_((int *argcPtr, char ***argvPtr)); -static BOOL __stdcall sigHandler (DWORD fdwCtrlType); -static Tcl_AsyncProc asyncExit; -static void AppInitExitHandler(ClientData clientData); - -static char ** argvSave = NULL; -static Tcl_AsyncHandler exitToken = NULL; -static DWORD exitErrorCode = 0; - +#if defined(__GNUC__) +static void setargv(int *argcPtr, char ***argvPtr); +#endif /* __GNUC__ */ /* *---------------------------------------------------------------------- @@ -44,8 +35,8 @@ static DWORD exitErrorCode = 0; * This is the main program for the application. * * Results: - * None: Tcl_Main never returns here, so this procedure never - * returns either. + * None: Tcl_Main never returns here, so this function never returns + * either. * * Side effects: * Whatever the application does. @@ -54,15 +45,15 @@ static DWORD exitErrorCode = 0; */ int -main(argc, argv) - int argc; /* Number of command-line arguments. */ - char **argv; /* Values of command-line arguments. */ +main( + int argc, + char *argv[]) { /* - * The following #if block allows you to change the AppInit - * function by using a #define of TCL_LOCAL_APPINIT instead - * of rewriting this entire file. The #if checks for that - * #define and uses Tcl_AppInit if it doesn't exist. + * The following #if block allows you to change the AppInit function by + * using a #define of TCL_LOCAL_APPINIT instead of rewriting this entire + * file. The #if checks for that #define and uses Tcl_AppInit if it + * doesn't exist. */ #ifndef TCL_LOCAL_APPINIT @@ -80,29 +71,23 @@ main(argc, argv) extern int TCL_LOCAL_MAIN_HOOK _ANSI_ARGS_((int *argc, char ***argv)); #endif - char buffer[MAX_PATH +1]; char *p; + /* - * Set up the default locale to be standard "C" locale so parsing - * is performed correctly. + * Set up the default locale to be standard "C" locale so parsing is + * performed correctly. */ +#if defined(__GNUC__) + setargv( &argc, &argv ); +#endif setlocale(LC_ALL, "C"); - setargv(&argc, &argv); /* - * Save this for later, so we can free it. + * Forward slashes substituted for backslashes. */ - argvSave = argv; - /* - * Replace argv[0] with full pathname of executable, and forward - * slashes substituted for backslashes. - */ - - GetModuleFileName(NULL, buffer, sizeof(buffer)); - argv[0] = buffer; - for (p = buffer; *p != '\0'; p++) { + for (p = argv[0]; *p != '\0'; p++) { if (*p == '\\') { *p = '/'; } @@ -116,20 +101,19 @@ main(argc, argv) return 0; /* Needed only to prevent compiler warning. */ } - /* *---------------------------------------------------------------------- * * Tcl_AppInit -- * - * This procedure performs application-specific initialization. - * Most applications, especially those that incorporate additional - * packages, will have their own version of this procedure. + * This function performs application-specific initialization. Most + * applications, especially those that incorporate additional packages, + * will have their own version of this function. * * Results: - * Returns a standard Tcl completion code, and leaves an error - * message in the interp's result if an error occurs. + * Returns a standard Tcl completion code, and leaves an error message in + * the interp's result if an error occurs. * * Side effects: * Depends on the startup script. @@ -138,50 +122,33 @@ main(argc, argv) */ int -Tcl_AppInit(interp) - Tcl_Interp *interp; /* Interpreter for application. */ +Tcl_AppInit( + Tcl_Interp *interp) /* Interpreter for application. */ { if (Tcl_Init(interp) == TCL_ERROR) { return TCL_ERROR; } - /* - * Install a signal handler to the win32 console tclsh is running in. - */ - SetConsoleCtrlHandler(sigHandler, TRUE); - exitToken = Tcl_AsyncCreate(asyncExit, NULL); - - /* - * This exit handler will be used to free the - * resources allocated in this file. - */ - Tcl_CreateExitHandler(AppInitExitHandler, NULL); - #ifdef TCL_TEST if (Tcltest_Init(interp) == TCL_ERROR) { return TCL_ERROR; } - Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init, - (Tcl_PackageInitProc *) NULL); + Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init, NULL); if (TclObjTest_Init(interp) == TCL_ERROR) { return TCL_ERROR; } -#ifdef TCL_THREADS - if (TclThread_Init(interp) == TCL_ERROR) { - return TCL_ERROR; - } -#endif if (Procbodytest_Init(interp) == TCL_ERROR) { return TCL_ERROR; } Tcl_StaticPackage(interp, "procbodytest", Procbodytest_Init, - Procbodytest_SafeInit); + Procbodytest_SafeInit); #endif /* TCL_TEST */ -#if defined(STATIC_BUILD) && defined(TCL_USE_STATIC_PACKAGES) +#if defined(STATIC_BUILD) && TCL_USE_STATIC_PACKAGES { extern Tcl_PackageInitProc Registry_Init; extern Tcl_PackageInitProc Dde_Init; + extern Tcl_PackageInitProc Dde_SafeInit; if (Registry_Init(interp) == TCL_ERROR) { return TCL_ERROR; @@ -191,13 +158,13 @@ Tcl_AppInit(interp) if (Dde_Init(interp) == TCL_ERROR) { return TCL_ERROR; } - Tcl_StaticPackage(interp, "dde", Dde_Init, NULL); + Tcl_StaticPackage(interp, "dde", Dde_Init, Dde_SafeInit); } #endif /* - * Call the init procedures for included packages. Each call should - * look like this: + * Call the init functions for included packages. Each call should look + * like this: * * if (Mod_Init(interp) == TCL_ERROR) { * return TCL_ERROR; @@ -207,15 +174,15 @@ Tcl_AppInit(interp) */ /* - * Call Tcl_CreateCommand for application-specific commands, if - * they weren't already created by the init procedures called above. + * Call Tcl_CreateCommand for application-specific commands, if they + * weren't already created by the init functions called above. */ /* - * Specify a user-specific startup file to invoke if the application - * is run interactively. Typically the startup file is "~/.apprc" - * where "app" is the name of the application. If this line is deleted - * then no user-specific startup file will be run under any conditions. + * Specify a user-specific startup file to invoke if the application is + * run interactively. Typically the startup file is "~/.apprc" where "app" + * is the name of the application. If this line is deleted then no + * user-specific startup file will be run under any conditions. */ Tcl_SetVar(interp, "tcl_rcFileName", "~/tclshrc.tcl", TCL_GLOBAL_ONLY); @@ -223,50 +190,14 @@ Tcl_AppInit(interp) } /* - *---------------------------------------------------------------------- - * - * AppInitExitHandler -- - * - * This function is called to cleanup the app init resources before - * Tcl is unloaded. - * - * Results: - * None. - * - * Side effects: - * Frees the saved argv and deletes the async exit handler. - * - *---------------------------------------------------------------------- - */ - -static void -AppInitExitHandler( - ClientData clientData) -{ - if (argvSave != NULL) { - ckfree((char *)argvSave); - argvSave = NULL; - } - - if (exitToken != NULL) { - /* - * This should be safe to do even if we - * are in an async exit right now. - */ - Tcl_AsyncDelete(exitToken); - exitToken = NULL; - } -} - -/* *------------------------------------------------------------------------- * * setargv -- * - * Parse the Windows command line string into argc/argv. Done here - * because we don't trust the builtin argument parser in crt0. - * Windows applications are responsible for breaking their command - * line into arguments. + * Parse the Windows command line string into argc/argv. Done here + * because we don't trust the builtin argument parser in crt0. Windows + * applications are responsible for breaking their command line into + * arguments. * * 2N backslashes + quote -> N backslashes + begin quoted string * 2N + 1 backslashes + quote -> literal @@ -276,8 +207,8 @@ AppInitExitHandler( * quote -> begin quoted string * * Results: - * Fills argcPtr with the number of arguments and argvPtr with the - * array of arguments. + * Fills argcPtr with the number of arguments and argvPtr with the array + * of arguments. * * Side effects: * Memory allocated. @@ -285,10 +216,11 @@ AppInitExitHandler( *-------------------------------------------------------------------------- */ +#if defined(__GNUC__) static void -setargv(argcPtr, argvPtr) - int *argcPtr; /* Filled with number of argument strings. */ - char ***argvPtr; /* Filled with argument strings (malloc'd). */ +setargv( + int *argcPtr, /* Filled with number of argument strings. */ + char ***argvPtr) /* Filled with argument strings (malloc'd). */ { char *cmdLine, *p, *arg, *argSpace; char **argv; @@ -297,8 +229,8 @@ setargv(argcPtr, argvPtr) cmdLine = GetCommandLine(); /* INTL: BUG */ /* - * Precompute an overly pessimistic guess at the number of arguments - * in the command line by counting non-space spans. + * Precompute an overly pessimistic guess at the number of arguments in + * the command line by counting non-space spans. */ size = 2; @@ -346,18 +278,18 @@ setargv(argcPtr, argvPtr) } else { inquote = !inquote; } - } - slashes >>= 1; - } + } + slashes >>= 1; + } - while (slashes) { + while (slashes) { *arg = '\\'; arg++; slashes--; } - if ((*p == '\0') - || (!inquote && ((*p == ' ') || (*p == '\t')))) { /* INTL: ISO space. */ + if ((*p == '\0') || (!inquote && + ((*p == ' ') || (*p == '\t')))) { /* INTL: ISO space. */ break; } if (copy != 0) { @@ -365,7 +297,7 @@ setargv(argcPtr, argvPtr) arg++; } p++; - } + } *arg = '\0'; argSpace = arg + 1; } @@ -374,80 +306,12 @@ setargv(argcPtr, argvPtr) *argcPtr = argc; *argvPtr = argv; } +#endif /* __GNUC__ */ /* - *---------------------------------------------------------------------- - * - * asyncExit -- - * - * The AsyncProc for the exitToken. - * - * Results: - * doesn't actually return. - * - * Side effects: - * tclsh cleanly exits. - * - *---------------------------------------------------------------------- + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: */ - -int -asyncExit (ClientData clientData, Tcl_Interp *interp, int code) -{ - Tcl_Exit((int)exitErrorCode); - - /* NOTREACHED */ - return code; -} - -/* - *---------------------------------------------------------------------- - * - * sigHandler -- - * - * Signal handler for the Win32 OS. Catches Ctrl+C, Ctrl+Break and - * other exits. This is needed so tclsh can do it's real clean-up - * and not an unclean crash terminate. - * - * Results: - * TRUE. - * - * Side effects: - * Effects the way the app exits from a signal. This is an - * operating system supplied thread and unsafe to call ANY - * Tcl commands except for Tcl_AsyncMark. - * - *---------------------------------------------------------------------- - */ - -BOOL __stdcall -sigHandler(DWORD fdwCtrlType) -{ - HANDLE hStdIn; - - if (!exitToken) { - /* Async token must have been destroyed, punt gracefully. */ - return FALSE; - } - - /* - * If Tcl is currently executing some bytecode or in the eventloop, - * this will cause Tcl to enter asyncExit at the next command - * boundry. - */ - exitErrorCode = fdwCtrlType; - Tcl_AsyncMark(exitToken); - - /* - * This will cause Tcl_Gets in Tcl_Main() to drop-out with an <EOF> - * should it be blocked on input and our Tcl_AsyncMark didn't grab - * the attention of the interpreter. - */ - hStdIn = GetStdHandle(STD_INPUT_HANDLE); - if (hStdIn) { - CloseHandle(hStdIn); - } - - /* indicate to the OS not to call the default terminator */ - return TRUE; -} diff --git a/win/tclWin32Dll.c b/win/tclWin32Dll.c index ba3af7c..6c863b9 100644 --- a/win/tclWin32Dll.c +++ b/win/tclWin32Dll.c @@ -1,20 +1,31 @@ -/* +/* * tclWin32Dll.c -- * - * This file contains the DLL entry point. + * This file contains the DLL entry point and other low-level bit bashing + * code that needs inline assembly. * * Copyright (c) 1995-1996 Sun Microsystems, Inc. * Copyright (c) 1998-2000 Scriptics Corporation. * - * See the file "license.terms" for information on usage and redistribution - * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclWinInt.h" +#ifndef TCL_NO_STACK_CHECK +/* + * The following functions implement stack depth checking + */ +typedef struct ThreadSpecificData { + int *stackBound; /* The current stack boundary */ +} ThreadSpecificData; +static Tcl_ThreadDataKey dataKey; +#endif /* TCL_NO_STACK_CHECK */ + /* - * The following data structures are used when loading the thunking - * library for execing child processes under Win32s. + * The following data structures are used when loading the thunking library + * for execing child processes under Win32s. */ typedef DWORD (WINAPI UT32PROC)(LPVOID lpBuff, DWORD dwUserDefined, @@ -26,41 +37,38 @@ typedef BOOL (WINAPI UTREGISTER)(HANDLE hModule, LPCSTR SixteenBitDLL, typedef VOID (WINAPI UTUNREGISTER)(HANDLE hModule); -/* - * The following variables keep track of information about this DLL - * on a per-instance basis. Each time this DLL is loaded, it gets its own - * new data segment with its own copy of all static and global information. +/* + * The following variables keep track of information about this DLL on a + * per-instance basis. Each time this DLL is loaded, it gets its own new data + * segment with its own copy of all static and global information. */ static HINSTANCE hInstance; /* HINSTANCE of this DLL. */ static int platformId; /* Running under NT, or 95/98? */ #ifdef HAVE_NO_SEH - /* - * Unlike Borland and Microsoft, we don't register exception handlers - * by pushing registration records onto the runtime stack. Instead, we - * register them by creating an EXCEPTION_REGISTRATION within the activation - * record. + * Unlike Borland and Microsoft, we don't register exception handlers by + * pushing registration records onto the runtime stack. Instead, we register + * them by creating an EXCEPTION_REGISTRATION within the activation record. */ typedef struct EXCEPTION_REGISTRATION { - struct EXCEPTION_REGISTRATION* link; - EXCEPTION_DISPOSITION (*handler)( struct _EXCEPTION_RECORD*, void*, - struct _CONTEXT*, void* ); - void* ebp; - void* esp; + struct EXCEPTION_REGISTRATION *link; + EXCEPTION_DISPOSITION (*handler)( + struct _EXCEPTION_RECORD*, void*, struct _CONTEXT*, void*); + void *ebp; + void *esp; int status; } EXCEPTION_REGISTRATION; - #endif /* - * VC++ 5.x has no 'cpuid' assembler instruction, so we - * must emulate it + * VC++ 5.x has no 'cpuid' assembler instruction, so we must emulate it */ -#if defined(_MSC_VER) && ( _MSC_VER <= 1100 ) -#define cpuid __asm __emit 0fh __asm __emit 0a2h + +#if defined(_MSC_VER) && (_MSC_VER <= 1100) +#define cpuid __asm __emit 0fh __asm __emit 0a2h #endif /* @@ -76,10 +84,10 @@ static TclWinProcs asciiProcs = { (TCHAR *(WINAPI *)(TCHAR *)) CharLowerA, (BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR *, BOOL)) CopyFileA, (BOOL (WINAPI *)(CONST TCHAR *, LPSECURITY_ATTRIBUTES)) CreateDirectoryA, - (HANDLE (WINAPI *)(CONST TCHAR *, DWORD, DWORD, SECURITY_ATTRIBUTES *, + (HANDLE (WINAPI *)(CONST TCHAR *, DWORD, DWORD, SECURITY_ATTRIBUTES *, DWORD, DWORD, HANDLE)) CreateFileA, - (BOOL (WINAPI *)(CONST TCHAR *, TCHAR *, LPSECURITY_ATTRIBUTES, - LPSECURITY_ATTRIBUTES, BOOL, DWORD, LPVOID, CONST TCHAR *, + (BOOL (WINAPI *)(CONST TCHAR *, TCHAR *, LPSECURITY_ATTRIBUTES, + LPSECURITY_ATTRIBUTES, BOOL, DWORD, LPVOID, CONST TCHAR *, LPSTARTUPINFOA, LPPROCESS_INFORMATION)) CreateProcessA, (BOOL (WINAPI *)(CONST TCHAR *)) DeleteFileA, (HANDLE (WINAPI *)(CONST TCHAR *, WIN32_FIND_DATAT *)) FindFirstFileA, @@ -87,33 +95,35 @@ static TclWinProcs asciiProcs = { (BOOL (WINAPI *)(WCHAR *, LPDWORD)) GetComputerNameA, (DWORD (WINAPI *)(DWORD, WCHAR *)) GetCurrentDirectoryA, (DWORD (WINAPI *)(CONST TCHAR *)) GetFileAttributesA, - (DWORD (WINAPI *)(CONST TCHAR *, DWORD nBufferLength, WCHAR *, + (DWORD (WINAPI *)(CONST TCHAR *, DWORD nBufferLength, WCHAR *, TCHAR **)) GetFullPathNameA, (DWORD (WINAPI *)(HMODULE, WCHAR *, int)) GetModuleFileNameA, (DWORD (WINAPI *)(CONST TCHAR *, WCHAR *, DWORD)) GetShortPathNameA, - (UINT (WINAPI *)(CONST TCHAR *, CONST TCHAR *, UINT uUnique, + (UINT (WINAPI *)(CONST TCHAR *, CONST TCHAR *, UINT uUnique, WCHAR *)) GetTempFileNameA, (DWORD (WINAPI *)(DWORD, WCHAR *)) GetTempPathA, (BOOL (WINAPI *)(CONST TCHAR *, WCHAR *, DWORD, LPDWORD, LPDWORD, LPDWORD, WCHAR *, DWORD)) GetVolumeInformationA, - (HINSTANCE (WINAPI *)(const TCHAR *, HANDLE, DWORD)) LoadLibraryExA, + (HINSTANCE (WINAPI *)(CONST TCHAR *, HANDLE, DWORD)) LoadLibraryExA, (TCHAR (WINAPI *)(WCHAR *, CONST TCHAR *)) lstrcpyA, (BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR *)) MoveFileA, (BOOL (WINAPI *)(CONST TCHAR *)) RemoveDirectoryA, - (DWORD (WINAPI *)(CONST TCHAR *, CONST TCHAR *, CONST TCHAR *, DWORD, + (DWORD (WINAPI *)(CONST TCHAR *, CONST TCHAR *, CONST TCHAR *, DWORD, WCHAR *, TCHAR **)) SearchPathA, (BOOL (WINAPI *)(CONST TCHAR *)) SetCurrentDirectoryA, (BOOL (WINAPI *)(CONST TCHAR *, DWORD)) SetFileAttributesA, - /* + + /* * The three NULL function pointers will only be set when - * Tcl_FindExecutable is called. If you don't ever call that - * function, the application will crash whenever WinTcl tries to call - * functions through these null pointers. That is not a bug in Tcl - * -- Tcl_FindExecutable is obligatory in recent Tcl releases. + * Tcl_FindExecutable is called. If you don't ever call that function, the + * application will crash whenever WinTcl tries to call functions through + * these null pointers. That is not a bug in Tcl - Tcl_FindExecutable is + * mandatory in recent Tcl releases. */ + NULL, NULL, - (int (__cdecl*)(CONST TCHAR *, struct _utimbuf *)) _utime, + /* deleted (int (__cdecl*)(CONST TCHAR *, struct _utimbuf *)) _utime, */ NULL, NULL, /* getLongPathNameProc */ @@ -122,7 +132,8 @@ static TclWinProcs asciiProcs = { NULL, NULL, NULL, NULL, NULL, NULL, /* ReadConsole and WriteConsole */ (BOOL (WINAPI *)(HANDLE, LPVOID, DWORD, LPDWORD, LPVOID)) ReadConsoleA, - (BOOL (WINAPI *)(HANDLE, const VOID*, DWORD, LPDWORD, LPVOID)) WriteConsoleA + (BOOL (WINAPI *)(HANDLE, const VOID*, DWORD, LPDWORD, LPVOID)) WriteConsoleA, + (BOOL (WINAPI *)(LPTSTR, LPDWORD)) GetUserNameA }; static TclWinProcs unicodeProcs = { @@ -132,10 +143,10 @@ static TclWinProcs unicodeProcs = { (TCHAR *(WINAPI *)(TCHAR *)) CharLowerW, (BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR *, BOOL)) CopyFileW, (BOOL (WINAPI *)(CONST TCHAR *, LPSECURITY_ATTRIBUTES)) CreateDirectoryW, - (HANDLE (WINAPI *)(CONST TCHAR *, DWORD, DWORD, SECURITY_ATTRIBUTES *, + (HANDLE (WINAPI *)(CONST TCHAR *, DWORD, DWORD, SECURITY_ATTRIBUTES *, DWORD, DWORD, HANDLE)) CreateFileW, - (BOOL (WINAPI *)(CONST TCHAR *, TCHAR *, LPSECURITY_ATTRIBUTES, - LPSECURITY_ATTRIBUTES, BOOL, DWORD, LPVOID, CONST TCHAR *, + (BOOL (WINAPI *)(CONST TCHAR *, TCHAR *, LPSECURITY_ATTRIBUTES, + LPSECURITY_ATTRIBUTES, BOOL, DWORD, LPVOID, CONST TCHAR *, LPSTARTUPINFOA, LPPROCESS_INFORMATION)) CreateProcessW, (BOOL (WINAPI *)(CONST TCHAR *)) DeleteFileW, (HANDLE (WINAPI *)(CONST TCHAR *, WIN32_FIND_DATAT *)) FindFirstFileW, @@ -143,33 +154,35 @@ static TclWinProcs unicodeProcs = { (BOOL (WINAPI *)(WCHAR *, LPDWORD)) GetComputerNameW, (DWORD (WINAPI *)(DWORD, WCHAR *)) GetCurrentDirectoryW, (DWORD (WINAPI *)(CONST TCHAR *)) GetFileAttributesW, - (DWORD (WINAPI *)(CONST TCHAR *, DWORD nBufferLength, WCHAR *, + (DWORD (WINAPI *)(CONST TCHAR *, DWORD nBufferLength, WCHAR *, TCHAR **)) GetFullPathNameW, (DWORD (WINAPI *)(HMODULE, WCHAR *, int)) GetModuleFileNameW, (DWORD (WINAPI *)(CONST TCHAR *, WCHAR *, DWORD)) GetShortPathNameW, - (UINT (WINAPI *)(CONST TCHAR *, CONST TCHAR *, UINT uUnique, + (UINT (WINAPI *)(CONST TCHAR *, CONST TCHAR *, UINT uUnique, WCHAR *)) GetTempFileNameW, (DWORD (WINAPI *)(DWORD, WCHAR *)) GetTempPathW, - (BOOL (WINAPI *)(CONST TCHAR *, WCHAR *, DWORD, LPDWORD, LPDWORD, LPDWORD, + (BOOL (WINAPI *)(CONST TCHAR *, WCHAR *, DWORD, LPDWORD, LPDWORD, LPDWORD, WCHAR *, DWORD)) GetVolumeInformationW, - (HINSTANCE (WINAPI *)(const TCHAR *, HANDLE, DWORD)) LoadLibraryExW, + (HINSTANCE (WINAPI *)(CONST TCHAR *, HANDLE, DWORD)) LoadLibraryExW, (TCHAR (WINAPI *)(WCHAR *, CONST TCHAR *)) lstrcpyW, (BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR *)) MoveFileW, (BOOL (WINAPI *)(CONST TCHAR *)) RemoveDirectoryW, - (DWORD (WINAPI *)(CONST TCHAR *, CONST TCHAR *, CONST TCHAR *, DWORD, + (DWORD (WINAPI *)(CONST TCHAR *, CONST TCHAR *, CONST TCHAR *, DWORD, WCHAR *, TCHAR **)) SearchPathW, (BOOL (WINAPI *)(CONST TCHAR *)) SetCurrentDirectoryW, (BOOL (WINAPI *)(CONST TCHAR *, DWORD)) SetFileAttributesW, - /* + + /* * The three NULL function pointers will only be set when - * Tcl_FindExecutable is called. If you don't ever call that - * function, the application will crash whenever WinTcl tries to call - * functions through these null pointers. That is not a bug in Tcl - * -- Tcl_FindExecutable is obligatory in recent Tcl releases. + * Tcl_FindExecutable is called. If you don't ever call that function, the + * application will crash whenever WinTcl tries to call functions through + * these null pointers. That is not a bug in Tcl - Tcl_FindExecutable is + * mandatory in recent Tcl releases. */ + NULL, NULL, - (int (__cdecl*)(CONST TCHAR *, struct _utimbuf *)) _wutime, + /* deleted (int (__cdecl*)(CONST TCHAR *, struct _utimbuf *)) _wutime, */ NULL, NULL, /* getLongPathNameProc */ @@ -178,70 +191,70 @@ static TclWinProcs unicodeProcs = { NULL, NULL, NULL, NULL, NULL, NULL, /* ReadConsole and WriteConsole */ (BOOL (WINAPI *)(HANDLE, LPVOID, DWORD, LPDWORD, LPVOID)) ReadConsoleW, - (BOOL (WINAPI *)(HANDLE, const VOID*, DWORD, LPDWORD, LPVOID)) WriteConsoleW + (BOOL (WINAPI *)(HANDLE, const VOID*, DWORD, LPDWORD, LPVOID)) WriteConsoleW, + (BOOL (WINAPI *)(LPTSTR, LPDWORD)) GetUserNameW }; TclWinProcs *tclWinProcs; static Tcl_Encoding tclWinTCharEncoding; - #ifdef HAVE_NO_SEH - -/* Need to add noinline flag to DllMain declaration so that gcc -O3 - * does not inline asm code into DllEntryPoint and cause a - * compile time error because of redefined local labels. +/* + * Need to add noinline flag to DllMain declaration so that gcc -O3 does not + * inline asm code into DllEntryPoint and cause a compile time error because + * of redefined local labels. */ -BOOL APIENTRY DllMain(HINSTANCE hInst, DWORD reason, - LPVOID reserved) - __attribute__ ((noinline)); - +BOOL APIENTRY DllMain(HINSTANCE hInst, DWORD reason, + LPVOID reserved) __attribute__ ((noinline)); #else - /* * The following declaration is for the VC++ DLL entry point. */ -BOOL APIENTRY DllMain(HINSTANCE hInst, DWORD reason, - LPVOID reserved); +BOOL APIENTRY DllMain(HINSTANCE hInst, DWORD reason, + LPVOID reserved); #endif /* HAVE_NO_SEH */ - /* * The following structure and linked list is to allow us to map between - * volume mount points and drive letters on the fly (no Win API exists - * for this). + * volume mount points and drive letters on the fly (no Win API exists for + * this). */ + typedef struct MountPointMap { - CONST WCHAR* volumeName; /* Native wide string volume name */ - char driveLetter; /* Drive letter corresponding to - * the volume name. */ - struct MountPointMap* nextPtr; /* Pointer to next structure in list, - * or NULL */ + CONST WCHAR *volumeName; /* Native wide string volume name. */ + char driveLetter; /* Drive letter corresponding to the volume + * name. */ + struct MountPointMap *nextPtr; + /* Pointer to next structure in list, or + * NULL. */ } MountPointMap; -/* - * This is the head of the linked list, which is protected by the - * mutex which follows, for thread-enabled builds. +/* + * This is the head of the linked list, which is protected by the mutex which + * follows, for thread-enabled builds. */ + MountPointMap *driveLetterLookup = NULL; TCL_DECLARE_MUTEX(mountPointMap) -/* We will need this below */ +/* + * We will need this below. + */ + extern Tcl_FSDupInternalRepProc TclNativeDupInternalRep; #ifdef __WIN32__ #ifndef STATIC_BUILD - /* *---------------------------------------------------------------------- * * DllEntryPoint -- * - * This wrapper function is used by Borland to invoke the - * initialization code for Tcl. It simply calls the DllMain - * routine. + * This wrapper function is used by Borland to invoke the initialization + * code for Tcl. It simply calls the DllMain routine. * * Results: * See DllMain. @@ -253,10 +266,10 @@ extern Tcl_FSDupInternalRepProc TclNativeDupInternalRep; */ BOOL APIENTRY -DllEntryPoint(hInst, reason, reserved) - HINSTANCE hInst; /* Library instance handle. */ - DWORD reason; /* Reason this function is being called. */ - LPVOID reserved; /* Not used. */ +DllEntryPoint( + HINSTANCE hInst, /* Library instance handle. */ + DWORD reason, /* Reason this function is being called. */ + LPVOID reserved) /* Not used. */ { return DllMain(hInst, reason, reserved); } @@ -266,23 +279,27 @@ DllEntryPoint(hInst, reason, reserved) * * DllMain -- * - * This routine is called by the VC++ C run time library init - * code, or the DllEntryPoint routine. It is responsible for - * initializing various dynamically loaded libraries. + * This routine is called by the VC++ C run time library init code, or + * the DllEntryPoint routine. It is responsible for initializing various + * dynamically loaded libraries. * * Results: * TRUE on sucess, FALSE on failure. * * Side effects: - * Establishes 32-to-16 bit thunk and initializes sockets library. + * Establishes 32-to-16 bit thunk and initializes sockets library. This + * might call some sycronization functions, but MSDN documentation + * states: "Waiting on synchronization objects in DllMain can cause a + * deadlock." * *---------------------------------------------------------------------- */ + BOOL APIENTRY -DllMain(hInst, reason, reserved) - HINSTANCE hInst; /* Library instance handle. */ - DWORD reason; /* Reason this function is being called. */ - LPVOID reserved; /* Not used. */ +DllMain( + HINSTANCE hInst, /* Library instance handle. */ + DWORD reason, /* Reason this function is being called. */ + LPVOID reserved) /* Not used. */ { #if defined(HAVE_NO_SEH) && !defined(_WIN64) EXCEPTION_REGISTRATION registration; @@ -407,7 +424,7 @@ DllMain(hInst, reason, reserved) */ HINSTANCE -TclWinGetTclInstance() +TclWinGetTclInstance(void) { return hInstance; } @@ -429,8 +446,8 @@ TclWinGetTclInstance() */ void -TclWinInit(hInst) - HINSTANCE hInst; /* Library instance handle. */ +TclWinInit( + HINSTANCE hInst) /* Library instance handle. */ { OSVERSIONINFO os; @@ -440,12 +457,12 @@ TclWinInit(hInst) platformId = os.dwPlatformId; /* - * We no longer support Win32s, so just in case someone manages to - * get a runtime there, make sure they know that. + * We no longer support Win32s, so just in case someone manages to get a + * runtime there, make sure they know that. */ if (platformId == VER_PLATFORM_WIN32s) { - panic("Win32s is not a supported platform"); + Tcl_Panic("Win32s is not a supported platform"); } tclWinProcs = &asciiProcs; @@ -456,14 +473,14 @@ TclWinInit(hInst) * * TclWinGetPlatformId -- * - * Determines whether running under NT, 95, or Win32s, to allow - * runtime conditional code. + * Determines whether running under NT, 95, or Win32s, to allow runtime + * conditional code. * * Results: * The return value is one of: * VER_PLATFORM_WIN32s Win32s on Windows 3.1. (not supported) - * VER_PLATFORM_WIN32_WINDOWS Win32 on Windows 95. - * VER_PLATFORM_WIN32_NT Win32 on Windows NT + * VER_PLATFORM_WIN32_WINDOWS Win32 on Windows 95, 98, ME. + * VER_PLATFORM_WIN32_NT Win32 on Windows NT, 2000, XP * * Side effects: * None. @@ -471,8 +488,8 @@ TclWinInit(hInst) *---------------------------------------------------------------------- */ -int -TclWinGetPlatformId() +int +TclWinGetPlatformId(void) { return platformId; } @@ -511,168 +528,93 @@ TclWinNoBackslash( /* *---------------------------------------------------------------------- * - * TclpCheckStackSpace -- + * TclpGetStackParams -- * - * Detect if we are about to blow the stack. Called before an - * evaluation can happen when nesting depth is checked. + * Determine the stack params for the current thread: in which + * direction does the stack grow, and what is the stack lower (resp. + * upper) bound for safe invocation of a new command? This is used to + * cache the values needed for an efficient computation of + * TclpCheckStackSpace() when the interp is known. * * Results: - * 1 if there is enough stack space to continue; 0 if not. - * - * Side effects: - * None. + * Returns 1 if the stack grows down, in which case a stack lower bound + * is stored at stackBoundPtr. If the stack grows up, 0 is returned and + * an upper bound is stored at stackBoundPtr. If a bound cannot be + * determined NULL is stored at stackBoundPtr. * *---------------------------------------------------------------------- */ +#ifndef TCL_NO_STACK_CHECK int -TclpCheckStackSpace() +TclpGetCStackParams( + int **stackBoundPtr) { + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + SYSTEM_INFO si; /* The system information, used to + * determine the page size */ + MEMORY_BASIC_INFORMATION mbi; + /* The information about the memory + * area in which the stack resides */ + + if (!tsdPtr->stackBound + || ((UINT_PTR)&tsdPtr < (UINT_PTR)tsdPtr->stackBound)) { + + /* + * Either we haven't determined the stack bound in this thread, + * or else we've overflowed the bound that we previously + * determined. We need to find a new stack bound from + * Windows. + */ -#if defined(HAVE_NO_SEH) && !defined(__WIN64__) - EXCEPTION_REGISTRATION registration; -#endif - int retval = 0; - - /* - * We can recurse only if there is at least TCL_WIN_STACK_THRESHOLD - * bytes of stack space left. alloca() is cheap on windows; basically - * it just subtracts from the stack pointer causing the OS to throw an - * exception if the stack pointer is set below the bottom of the stack. - */ + GetSystemInfo(&si); + if (VirtualQuery((LPCVOID) &tsdPtr, &mbi, sizeof(mbi)) == 0) { -#ifdef HAVE_NO_SEH -# ifdef __WIN64__ + /* For some reason, the system didn't let us query the + * stack size. Nevertheless, we got here and haven't + * blown up yet. Don't update the calculated stack bound. + * If there is no calculated stack bound yet, set it to + * the base of the current page of stack. */ - /* TODO: How to call allocal on Win64? */ - retval = 1; + if (!tsdPtr->stackBound) { + tsdPtr->stackBound = + (int*) ((UINT_PTR)(&tsdPtr) + & ~ (UINT_PTR)(si.dwPageSize - 1)); + } -# else - __asm__ __volatile__ ( - - /* - * Construct an EXCEPTION_REGISTRATION to protect the - * call to __alloca - */ - "leal %[registration], %%edx" "\n\t" - "movl %%fs:0, %%eax" "\n\t" - "movl %%eax, 0x0(%%edx)" "\n\t" /* link */ - "leal 1f, %%eax" "\n\t" - "movl %%eax, 0x4(%%edx)" "\n\t" /* handler */ - "movl %%ebp, 0x8(%%edx)" "\n\t" /* ebp */ - "movl %%esp, 0xc(%%edx)" "\n\t" /* esp */ - "movl %[error], 0x10(%%edx)" "\n\t" /* status */ - - /* - * Link the EXCEPTION_REGISTRATION on the chain - */ - "movl %%edx, %%fs:0" "\n\t" - - /* - * Attempt a call to __alloca, to determine whether there's - * sufficient memory to be had. - */ - - "movl %[size], %%eax" "\n\t" - "pushl %%eax" "\n\t" - "call __alloca" "\n\t" - - /* - * Come here on a normal exit. Recover the EXCEPTION_REGISTRATION - * and store a TCL_OK status - */ - "movl %%fs:0, %%edx" "\n\t" - "movl %[ok], %%eax" "\n\t" - "movl %%eax, 0x10(%%edx)" "\n\t" - "jmp 2f" "\n" - - /* - * Come here on an exception. Get the EXCEPTION_REGISTRATION - * that we previously put on the chain. - */ - "1:" "\t" - "movl %%fs:0, %%edx" "\n\t" - "movl 0x8(%%edx), %%edx" "\n\t" - - /* - * Come here however we exited. Restore context from the - * EXCEPTION_REGISTRATION in case the stack is unbalanced. - */ - - "2:" "\t" - "movl 0xc(%%edx), %%esp" "\n\t" - "movl 0x8(%%edx), %%ebp" "\n\t" - "movl 0x0(%%edx), %%eax" "\n\t" - "movl %%eax, %%fs:0" "\n\t" - - : - /* No outputs */ - : - [registration] "m" (registration), - [ok] "i" (TCL_OK), - [error] "i" (TCL_ERROR), - [size] "i" (TCL_WIN_STACK_THRESHOLD) - : - "%eax", "%ebx", "%ecx", "%edx", "%esi", "%edi", "memory" - ); - retval = (registration.status == TCL_OK); + } else { -# endif -#else /* !HAVE_NO_SEH */ - __try { -#ifdef HAVE_ALLOCA_GCC_INLINE - __asm__ __volatile__ ( - "movl %0, %%eax" "\n\t" - "call __alloca" "\n\t" - : - : "i"(TCL_WIN_STACK_THRESHOLD) - : "%eax"); -#else - alloca(TCL_WIN_STACK_THRESHOLD); -#endif /* HAVE_ALLOCA_GCC_INLINE */ - retval = 1; - } __except (EXCEPTION_EXECUTE_HANDLER) {} -#endif /* HAVE_NO_SEH */ + /* The allocation base of the stack segment has to be advanced + * by one page (to allow for the guard page maintained in the + * C runtime) and then by TCL_WIN_STACK_THRESHOLD (to allow + * for the amount of stack that Tcl needs). + */ - return retval; + tsdPtr->stackBound = + (int*) ((UINT_PTR)(mbi.AllocationBase) + + (UINT_PTR)(si.dwPageSize) + + TCL_WIN_STACK_THRESHOLD); + } + } + *stackBoundPtr = tsdPtr->stackBound; + return 1; } - -/* - *---------------------------------------------------------------------- - * - * TclWinGetPlatform -- - * - * This is a kludge that allows the test library to get access - * the internal tclPlatform variable. - * - * Results: - * Returns a pointer to the tclPlatform variable. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ +#endif -TclPlatformType * -TclWinGetPlatform() -{ - return &tclPlatform; -} /* *--------------------------------------------------------------------------- * * TclWinSetInterfaces -- * - * A helper proc that allows the test library to change the - * tclWinProcs structure to dispatch to either the wide-character - * or multi-byte versions of the operating system calls, depending - * on whether Unicode is the system encoding. - * - * As well as this, we can also try to load in some additional - * procs which may/may not be present depending on the current - * Windows version (e.g. Win95 will not have the procs below). + * A helper proc that allows the test library to change the tclWinProcs + * structure to dispatch to either the wide-character or multi-byte + * versions of the operating system calls, depending on whether Unicode + * is the system encoding. + * + * As well as this, we can also try to load in some additional procs + * which may/may not be present depending on the current Windows version + * (e.g. Win95 will not have the procs below). * * Results: * None. @@ -696,21 +638,25 @@ TclWinSetInterfaces( if (tclWinProcs->getFileAttributesExProc == NULL) { HINSTANCE hInstance = LoadLibraryA("kernel32"); if (hInstance != NULL) { - tclWinProcs->getFileAttributesExProc = - (BOOL (WINAPI *)(CONST TCHAR *, GET_FILEEX_INFO_LEVELS, - LPVOID)) GetProcAddress(hInstance, "GetFileAttributesExW"); - tclWinProcs->createHardLinkProc = - (BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR*, - LPSECURITY_ATTRIBUTES)) GetProcAddress(hInstance, - "CreateHardLinkW"); - tclWinProcs->findFirstFileExProc = - (HANDLE (WINAPI *)(CONST TCHAR*, UINT, - LPVOID, UINT, LPVOID, DWORD)) GetProcAddress(hInstance, - "FindFirstFileExW"); - tclWinProcs->getVolumeNameForVMPProc = - (BOOL (WINAPI *)(CONST TCHAR*, TCHAR*, - DWORD)) GetProcAddress(hInstance, - "GetVolumeNameForVolumeMountPointW"); + tclWinProcs->getFileAttributesExProc = + (BOOL (WINAPI *)(CONST TCHAR *, GET_FILEEX_INFO_LEVELS, + LPVOID)) GetProcAddress(hInstance, + "GetFileAttributesExW"); + tclWinProcs->createHardLinkProc = + (BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR*, + LPSECURITY_ATTRIBUTES)) GetProcAddress(hInstance, + "CreateHardLinkW"); + tclWinProcs->findFirstFileExProc = + (HANDLE (WINAPI *)(CONST TCHAR*, UINT, LPVOID, UINT, + LPVOID, DWORD)) GetProcAddress(hInstance, + "FindFirstFileExW"); + tclWinProcs->getVolumeNameForVMPProc = + (BOOL (WINAPI *)(CONST TCHAR*, TCHAR*, + DWORD)) GetProcAddress(hInstance, + "GetVolumeNameForVolumeMountPointW"); + tclWinProcs->getLongPathNameProc = + (DWORD (WINAPI *)(CONST TCHAR*, TCHAR*, + DWORD)) GetProcAddress(hInstance, "GetLongPathNameW"); FreeLibrary(hInstance); } hInstance = LoadLibraryA("advapi32"); @@ -750,22 +696,31 @@ TclWinSetInterfaces( if (tclWinProcs->getFileAttributesExProc == NULL) { HINSTANCE hInstance = LoadLibraryA("kernel32"); if (hInstance != NULL) { - tclWinProcs->getFileAttributesExProc = - (BOOL (WINAPI *)(CONST TCHAR *, GET_FILEEX_INFO_LEVELS, - LPVOID)) GetProcAddress(hInstance, "GetFileAttributesExA"); - tclWinProcs->createHardLinkProc = - (BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR*, - LPSECURITY_ATTRIBUTES)) GetProcAddress(hInstance, - "CreateHardLinkA"); - tclWinProcs->findFirstFileExProc = - (HANDLE (WINAPI *)(CONST TCHAR*, UINT, - LPVOID, UINT, LPVOID, DWORD)) GetProcAddress(hInstance, - "FindFirstFileExA"); + tclWinProcs->getFileAttributesExProc = + (BOOL (WINAPI *)(CONST TCHAR *, GET_FILEEX_INFO_LEVELS, + LPVOID)) GetProcAddress(hInstance, + "GetFileAttributesExA"); + tclWinProcs->createHardLinkProc = + (BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR*, + LPSECURITY_ATTRIBUTES)) GetProcAddress(hInstance, + "CreateHardLinkA"); + tclWinProcs->findFirstFileExProc = NULL; tclWinProcs->getLongPathNameProc = NULL; - tclWinProcs->getVolumeNameForVMPProc = - (BOOL (WINAPI *)(CONST TCHAR*, TCHAR*, - DWORD)) GetProcAddress(hInstance, - "GetVolumeNameForVolumeMountPointA"); + /* + * The 'findFirstFileExProc' function exists on some of + * 95/98/ME, but it seems not to work as anticipated. + * Therefore we don't set this function pointer. The relevant + * code will fall back on a slower approach using the normal + * findFirstFileProc. + * + * (HANDLE (WINAPI *)(CONST TCHAR*, UINT, + * LPVOID, UINT, LPVOID, DWORD)) GetProcAddress(hInstance, + * "FindFirstFileExA"); + */ + tclWinProcs->getVolumeNameForVMPProc = + (BOOL (WINAPI *)(CONST TCHAR*, TCHAR*, + DWORD)) GetProcAddress(hInstance, + "GetVolumeNameForVolumeMountPointA"); FreeLibrary(hInstance); } } @@ -777,15 +732,14 @@ TclWinSetInterfaces( * * TclWinResetInterfaceEncodings -- * - * Called during finalization to free up any encodings we use. - * The tclWinProcs-> look up table is still ok to use after - * this call, provided no encoding conversion is required. + * Called during finalization to free up any encodings we use. The + * tclWinProcs-> look up table is still ok to use after this call, + * provided no encoding conversion is required. + * + * We also clean up any memory allocated in our mount point map which is + * used to follow certain kinds of symlinks. That code should never be + * used once encodings are taken down. * - * We also clean up any memory allocated in our mount point - * map which is used to follow certain kinds of symlinks. - * That code should never be used once encodings are taken - * down. - * * Results: * None. * @@ -794,17 +748,22 @@ TclWinSetInterfaces( * *--------------------------------------------------------------------------- */ + void -TclWinResetInterfaceEncodings() +TclWinResetInterfaceEncodings(void) { MountPointMap *dlIter, *dlIter2; if (tclWinTCharEncoding != NULL) { Tcl_FreeEncoding(tclWinTCharEncoding); tclWinTCharEncoding = NULL; } - /* Clean up the mount point map */ + + /* + * Clean up the mount point map. + */ + Tcl_MutexLock(&mountPointMap); - dlIter = driveLetterLookup; + dlIter = driveLetterLookup; while (dlIter != NULL) { dlIter2 = dlIter->nextPtr; ckfree((char*)dlIter->volumeName); @@ -820,8 +779,8 @@ TclWinResetInterfaceEncodings() * TclWinResetInterfaces -- * * Called during finalization to reset us to a safe state for reuse. - * After this call, it is best not to use the tclWinProcs-> look - * up table since it is likely to be different to what is expected. + * After this call, it is best not to use the tclWinProcs-> look up table + * since it is likely to be different to what is expected. * * Results: * None. @@ -832,7 +791,7 @@ TclWinResetInterfaceEncodings() *--------------------------------------------------------------------------- */ void -TclWinResetInterfaces() +TclWinResetInterfaces(void) { tclWinProcs = &asciiProcs; } @@ -842,64 +801,76 @@ TclWinResetInterfaces() * * TclWinDriveLetterForVolMountPoint * - * Unfortunately, Windows provides no easy way at all to get hold - * of the drive letter for a volume mount point, but we need that - * information to understand paths correctly. So, we have to - * build an associated array to find these correctly, and allow - * quick and easy lookup from volume mount points to drive letters. - * - * We assume here that we are running on a system for which the wide - * character interfaces are used, which is valid for Win 2000 and WinXP - * which are the only systems on which this function will ever be called. - * - * Result: the drive letter, or -1 if no drive letter corresponds to - * the given mount point. - * + * Unfortunately, Windows provides no easy way at all to get hold of the + * drive letter for a volume mount point, but we need that information to + * understand paths correctly. So, we have to build an associated array + * to find these correctly, and allow quick and easy lookup from volume + * mount points to drive letters. + * + * We assume here that we are running on a system for which the wide + * character interfaces are used, which is valid for Win 2000 and WinXP + * which are the only systems on which this function will ever be called. + * + * Result: + * The drive letter, or -1 if no drive letter corresponds to the given + * mount point. + * *-------------------------------------------------------------------- */ -char -TclWinDriveLetterForVolMountPoint(CONST WCHAR *mountPoint) + +char +TclWinDriveLetterForVolMountPoint( + CONST WCHAR *mountPoint) { MountPointMap *dlIter, *dlPtr2; - WCHAR Target[55]; /* Target of mount at mount point */ + WCHAR Target[55]; /* Target of mount at mount point */ WCHAR drive[4] = { L'A', L':', L'\\', L'\0' }; - - /* - * Detect the volume mounted there. Unfortunately, there is no - * simple way to map a unique volume name to a DOS drive letter. - * So, we have to build an associative array. + + /* + * Detect the volume mounted there. Unfortunately, there is no simple way + * to map a unique volume name to a DOS drive letter. So, we have to build + * an associative array. */ - + Tcl_MutexLock(&mountPointMap); - dlIter = driveLetterLookup; + dlIter = driveLetterLookup; while (dlIter != NULL) { if (wcscmp(dlIter->volumeName, mountPoint) == 0) { - /* - * We need to check whether this information is - * still valid, since either the user or various - * programs could have adjusted the mount points on - * the fly. + /* + * We need to check whether this information is still valid, since + * either the user or various programs could have adjusted the + * mount points on the fly. */ + drive[0] = L'A' + (dlIter->driveLetter - 'A'); - /* Try to read the volume mount point and see where it points */ - if ((*tclWinProcs->getVolumeNameForVMPProc)((TCHAR*)drive, - (TCHAR*)Target, 55) != 0) { + + /* + * Try to read the volume mount point and see where it points. + */ + + if ((*tclWinProcs->getVolumeNameForVMPProc)((TCHAR*)drive, + (TCHAR*)Target, 55) != 0) { if (wcscmp((WCHAR*)dlIter->volumeName, Target) == 0) { - /* Nothing has changed */ + /* + * Nothing has changed. + */ + Tcl_MutexUnlock(&mountPointMap); return dlIter->driveLetter; } } - /* - * If we reach here, unfortunately, this mount point is - * no longer valid at all + + /* + * If we reach here, unfortunately, this mount point is no longer + * valid at all. */ + if (driveLetterLookup == dlIter) { dlPtr2 = dlIter; driveLetterLookup = dlIter->nextPtr; } else { - for (dlPtr2 = driveLetterLookup; - dlPtr2 != NULL; dlPtr2 = dlPtr2->nextPtr) { + for (dlPtr2 = driveLetterLookup; + dlPtr2 != NULL; dlPtr2 = dlPtr2->nextPtr) { if (dlPtr2->nextPtr == dlIter) { dlPtr2->nextPtr = dlIter->nextPtr; dlPtr2 = dlIter; @@ -907,36 +878,48 @@ TclWinDriveLetterForVolMountPoint(CONST WCHAR *mountPoint) } } } - /* Now dlPtr2 points to the structure to free */ + + /* + * Now dlPtr2 points to the structure to free. + */ + ckfree((char*)dlPtr2->volumeName); ckfree((char*)dlPtr2); - /* - * Restart the loop --- we could try to be clever - * and continue half way through, but the logic is a - * bit messy, so it's cleanest just to restart + + /* + * Restart the loop - we could try to be clever and continue half + * way through, but the logic is a bit messy, so it's cleanest + * just to restart. */ + dlIter = driveLetterLookup; continue; } dlIter = dlIter->nextPtr; } - - /* We couldn't find it, so we must iterate over the letters */ - + + /* + * We couldn't find it, so we must iterate over the letters. + */ + for (drive[0] = L'A'; drive[0] <= L'Z'; drive[0]++) { - /* Try to read the volume mount point and see where it points */ - if ((*tclWinProcs->getVolumeNameForVMPProc)((TCHAR*)drive, - (TCHAR*)Target, 55) != 0) { + /* + * Try to read the volume mount point and see where it points. + */ + + if ((*tclWinProcs->getVolumeNameForVMPProc)((TCHAR*)drive, + (TCHAR*)Target, 55) != 0) { int alreadyStored = 0; - for (dlIter = driveLetterLookup; dlIter != NULL; - dlIter = dlIter->nextPtr) { + + for (dlIter = driveLetterLookup; dlIter != NULL; + dlIter = dlIter->nextPtr) { if (wcscmp((WCHAR*)dlIter->volumeName, Target) == 0) { alreadyStored = 1; break; } } if (!alreadyStored) { - dlPtr2 = (MountPointMap*) ckalloc(sizeof(MountPointMap)); + dlPtr2 = (MountPointMap *) ckalloc(sizeof(MountPointMap)); dlPtr2->volumeName = TclNativeDupInternalRep(Target); dlPtr2->driveLetter = 'A' + (drive[0] - L'A'); dlPtr2->nextPtr = driveLetterLookup; @@ -944,19 +927,24 @@ TclWinDriveLetterForVolMountPoint(CONST WCHAR *mountPoint) } } } - /* Try again */ - for (dlIter = driveLetterLookup; dlIter != NULL; - dlIter = dlIter->nextPtr) { + + /* + * Try again. + */ + + for (dlIter = driveLetterLookup; dlIter != NULL; + dlIter = dlIter->nextPtr) { if (wcscmp(dlIter->volumeName, mountPoint) == 0) { Tcl_MutexUnlock(&mountPointMap); return dlIter->driveLetter; } } - /* - * The volume doesn't appear to correspond to a drive letter -- we - * remember that fact and store '-1' so we don't have to look it - * up each time. + + /* + * The volume doesn't appear to correspond to a drive letter - we remember + * that fact and store '-1' so we don't have to look it up each time. */ + dlPtr2 = (MountPointMap*) ckalloc(sizeof(MountPointMap)); dlPtr2->volumeName = TclNativeDupInternalRep((ClientData)mountPoint); dlPtr2->driveLetter = -1; @@ -971,26 +959,24 @@ TclWinDriveLetterForVolMountPoint(CONST WCHAR *mountPoint) * * Tcl_WinUtfToTChar, Tcl_WinTCharToUtf -- * - * Convert between UTF-8 and Unicode when running Windows NT or - * the current ANSI code page when running Windows 95. + * Convert between UTF-8 and Unicode when running Windows NT or the + * current ANSI code page when running Windows 95. * - * On Mac, Unix, and Windows 95, all strings exchanged between Tcl - * and the OS are "char" oriented. We need only one Tcl_Encoding to - * convert between UTF-8 and the system's native encoding. We use - * NULL to represent that encoding. + * On Mac, Unix, and Windows 95, all strings exchanged between Tcl and + * the OS are "char" oriented. We need only one Tcl_Encoding to convert + * between UTF-8 and the system's native encoding. We use NULL to + * represent that encoding. * * On NT, some strings exchanged between Tcl and the OS are "char" - * oriented, while others are in Unicode. We need two Tcl_Encoding - * APIs depending on whether we are targeting a "char" or Unicode - * interface. - * - * Calling Tcl_UtfToExternal() or Tcl_ExternalToUtf() with an - * encoding of NULL should always used to convert between UTF-8 - * and the system's "char" oriented encoding. The following two - * functions are used in Windows-specific code to convert between - * UTF-8 and Unicode strings (NT) or "char" strings(95). This saves - * you the trouble of writing the following type of fragment over and - * over: + * oriented, while others are in Unicode. We need two Tcl_Encoding APIs + * depending on whether we are targeting a "char" or Unicode interface. + * + * Calling Tcl_UtfToExternal() or Tcl_ExternalToUtf() with an encoding of + * NULL should always used to convert between UTF-8 and the system's + * "char" oriented encoding. The following two functions are used in + * Windows-specific code to convert between UTF-8 and Unicode strings + * (NT) or "char" strings(95). This saves you the trouble of writing the + * following type of fragment over and over: * * if (running NT) { * encoding <- Tcl_GetEncoding("unicode"); @@ -1000,19 +986,17 @@ TclWinDriveLetterForVolMountPoint(CONST WCHAR *mountPoint) * nativeBuffer <- UtfToExternal(NULL, utfBuffer); * } * - * By convention, in Windows a TCHAR is a character in the ANSI code - * page on Windows 95, a Unicode character on Windows NT. If you - * plan on targeting a Unicode interfaces when running on NT and a - * "char" oriented interface while running on 95, these functions - * should be used. If you plan on targetting the same "char" - * oriented function on both 95 and NT, use Tcl_UtfToExternal() - * with an encoding of NULL. + * By convention, in Windows a TCHAR is a character in the ANSI code page + * on Windows 95, a Unicode character on Windows NT. If you plan on + * targeting a Unicode interfaces when running on NT and a "char" + * oriented interface while running on 95, these functions should be + * used. If you plan on targetting the same "char" oriented function on + * both 95 and NT, use Tcl_UtfToExternal() with an encoding of NULL. * * Results: - * The result is a pointer to the string in the desired target - * encoding. Storage for the result string is allocated in - * dsPtr; the caller must call Tcl_DStringFree() when the result - * is no longer needed. + * The result is a pointer to the string in the desired target encoding. + * Storage for the result string is allocated in dsPtr; the caller must + * call Tcl_DStringFree() when the result is no longer needed. * * Side effects: * None. @@ -1021,27 +1005,27 @@ TclWinDriveLetterForVolMountPoint(CONST WCHAR *mountPoint) */ TCHAR * -Tcl_WinUtfToTChar(string, len, dsPtr) - CONST char *string; /* Source string in UTF-8. */ - int len; /* Source string length in bytes, or < 0 for +Tcl_WinUtfToTChar( + CONST char *string, /* Source string in UTF-8. */ + int len, /* Source string length in bytes, or < 0 for * strlen(). */ - Tcl_DString *dsPtr; /* Uninitialized or free DString in which - * the converted string is stored. */ + Tcl_DString *dsPtr) /* Uninitialized or free DString in which the + * converted string is stored. */ { - return (TCHAR *) Tcl_UtfToExternalDString(tclWinTCharEncoding, + return (TCHAR *) Tcl_UtfToExternalDString(tclWinTCharEncoding, string, len, dsPtr); } char * -Tcl_WinTCharToUtf(string, len, dsPtr) - CONST TCHAR *string; /* Source string in Unicode when running - * NT, ANSI when running 95. */ - int len; /* Source string length in bytes, or < 0 for +Tcl_WinTCharToUtf( + CONST TCHAR *string, /* Source string in Unicode when running NT, + * ANSI when running 95. */ + int len, /* Source string length in bytes, or < 0 for * platform-specific string length. */ - Tcl_DString *dsPtr; /* Uninitialized or free DString in which - * the converted string is stored. */ + Tcl_DString *dsPtr) /* Uninitialized or free DString in which the + * converted string is stored. */ { - return Tcl_ExternalToUtfDString(tclWinTCharEncoding, + return Tcl_ExternalToUtfDString(tclWinTCharEncoding, (CONST char *) string, len, dsPtr); } diff --git a/win/tclWinChan.c b/win/tclWinChan.c index d06ff50..0f17834 100644 --- a/win/tclWinChan.c +++ b/win/tclWinChan.c @@ -1,13 +1,13 @@ -/* +/* * tclWinChan.c * - * Channel drivers for Windows channels based on files, command - * pipes and TCP sockets. + * Channel drivers for Windows channels based on files, command pipes and + * TCP sockets. * * Copyright (c) 1995-1997 Sun Microsystems, Inc. * - * See the file "license.terms" for information on usage and redistribution - * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclWinInt.h" @@ -39,8 +39,8 @@ typedef struct FileInfo { int flags; /* State flags, see above for a list. */ HANDLE handle; /* Input/output file. */ struct FileInfo *nextPtr; /* Pointer to next registered file. */ - int dirty; /* Boolean flag. Set if the OS may have data - * pending on the channel */ + int dirty; /* Boolean flag. Set if the OS may have data + * pending on the channel. */ } FileInfo; typedef struct ThreadSpecificData { @@ -54,16 +54,16 @@ typedef struct ThreadSpecificData { static Tcl_ThreadDataKey dataKey; /* - * The following structure is what is added to the Tcl event queue when - * file events are generated. + * The following structure is what is added to the Tcl event queue when file + * events are generated. */ typedef struct FileEvent { - Tcl_Event header; /* Information that is standard for - * all events. */ - FileInfo *infoPtr; /* Pointer to file info structure. Note - * that we still have to verify that the - * file exists before dereferencing this + Tcl_Event header; /* Information that is standard for all + * events. */ + FileInfo *infoPtr; /* Pointer to file info structure. Note that + * we still have to verify that the file + * exists before dereferencing this * pointer. */ } FileEvent; @@ -71,34 +71,30 @@ typedef struct FileEvent { * Static routines for this file: */ -static int FileBlockProc _ANSI_ARGS_((ClientData instanceData, - int mode)); -static void FileChannelExitHandler _ANSI_ARGS_(( - ClientData clientData)); -static void FileCheckProc _ANSI_ARGS_((ClientData clientData, - int flags)); -static int FileCloseProc _ANSI_ARGS_((ClientData instanceData, - Tcl_Interp *interp)); -static int FileEventProc _ANSI_ARGS_((Tcl_Event *evPtr, - int flags)); -static int FileGetHandleProc _ANSI_ARGS_((ClientData instanceData, - int direction, ClientData *handlePtr)); -static ThreadSpecificData *FileInit _ANSI_ARGS_((void)); -static int FileInputProc _ANSI_ARGS_((ClientData instanceData, - char *buf, int toRead, int *errorCode)); -static int FileOutputProc _ANSI_ARGS_((ClientData instanceData, - CONST char *buf, int toWrite, int *errorCode)); -static int FileSeekProc _ANSI_ARGS_((ClientData instanceData, - long offset, int mode, int *errorCode)); -static Tcl_WideInt FileWideSeekProc _ANSI_ARGS_((ClientData instanceData, - Tcl_WideInt offset, int mode, int *errorCode)); -static void FileSetupProc _ANSI_ARGS_((ClientData clientData, - int flags)); -static void FileWatchProc _ANSI_ARGS_((ClientData instanceData, - int mask)); -static void FileThreadActionProc _ANSI_ARGS_ (( - ClientData instanceData, int action)); -static DWORD FileGetType _ANSI_ARGS_((HANDLE handle)); +static int FileBlockProc(ClientData instanceData, int mode); +static void FileChannelExitHandler(ClientData clientData); +static void FileCheckProc(ClientData clientData, int flags); +static int FileCloseProc(ClientData instanceData, + Tcl_Interp *interp); +static int FileEventProc(Tcl_Event *evPtr, int flags); +static int FileGetHandleProc(ClientData instanceData, + int direction, ClientData *handlePtr); +static ThreadSpecificData *FileInit(void); +static int FileInputProc(ClientData instanceData, char *buf, + int toRead, int *errorCode); +static int FileOutputProc(ClientData instanceData, + CONST char *buf, int toWrite, int *errorCode); +static int FileSeekProc(ClientData instanceData, long offset, + int mode, int *errorCode); +static Tcl_WideInt FileWideSeekProc(ClientData instanceData, + Tcl_WideInt offset, int mode, int *errorCode); +static void FileSetupProc(ClientData clientData, int flags); +static void FileWatchProc(ClientData instanceData, int mask); +static void FileThreadActionProc(ClientData instanceData, + int action); +static int FileTruncateProc(ClientData instanceData, + Tcl_WideInt length); +static DWORD FileGetType(HANDLE handle); /* * This structure describes the channel type structure for file based IO. @@ -106,7 +102,7 @@ static DWORD FileGetType _ANSI_ARGS_((HANDLE handle)); static Tcl_ChannelType fileChannelType = { "file", /* Type name. */ - TCL_CHANNEL_VERSION_4, /* v4 channel */ + TCL_CHANNEL_VERSION_5, /* v5 channel */ FileCloseProc, /* Close proc. */ FileInputProc, /* Input proc. */ FileOutputProc, /* Output proc. */ @@ -121,26 +117,24 @@ static Tcl_ChannelType fileChannelType = { NULL, /* handler proc. */ FileWideSeekProc, /* Wide seek proc. */ FileThreadActionProc, /* Thread action proc. */ + FileTruncateProc, /* Truncate proc. */ }; #ifdef HAVE_NO_SEH - /* - * Unlike Borland and Microsoft, we don't register exception handlers - * by pushing registration records onto the runtime stack. Instead, we - * register them by creating an EXCEPTION_REGISTRATION within the activation - * record. + * Unlike Borland and Microsoft, we don't register exception handlers by + * pushing registration records onto the runtime stack. Instead, we register + * them by creating an EXCEPTION_REGISTRATION within the activation record. */ typedef struct EXCEPTION_REGISTRATION { struct EXCEPTION_REGISTRATION* link; - EXCEPTION_DISPOSITION (*handler)( struct _EXCEPTION_RECORD*, void*, - struct _CONTEXT*, void* ); + EXCEPTION_DISPOSITION (*handler)( + struct _EXCEPTION_RECORD*, void*, struct _CONTEXT*, void*); void* ebp; void* esp; int status; } EXCEPTION_REGISTRATION; - #endif /* @@ -154,16 +148,17 @@ typedef struct EXCEPTION_REGISTRATION { * None. * * Side effects: - * Creates a new window and creates an exit handler. + * Creates a new window and creates an exit handler. * *---------------------------------------------------------------------- */ static ThreadSpecificData * -FileInit() +FileInit(void) { ThreadSpecificData *tsdPtr = - (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); + (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); + if (tsdPtr == NULL) { tsdPtr = TCL_TSD_INIT(&dataKey); tsdPtr->firstFilePtr = NULL; @@ -178,8 +173,8 @@ FileInit() * * FileChannelExitHandler -- * - * This function is called to cleanup the channel driver before - * Tcl is unloaded. + * This function is called to cleanup the channel driver before Tcl is + * unloaded. * * Results: * None. @@ -191,8 +186,8 @@ FileInit() */ static void -FileChannelExitHandler(clientData) - ClientData clientData; /* Old window proc */ +FileChannelExitHandler( + ClientData clientData) /* Old window proc */ { Tcl_DeleteEventSource(FileSetupProc, FileCheckProc, NULL); } @@ -202,8 +197,8 @@ FileChannelExitHandler(clientData) * * FileSetupProc -- * - * This procedure is invoked before Tcl_DoOneEvent blocks waiting - * for an event. + * This function is invoked before Tcl_DoOneEvent blocks waiting for an + * event. * * Results: * None. @@ -215,9 +210,9 @@ FileChannelExitHandler(clientData) */ void -FileSetupProc(data, flags) - ClientData data; /* Not used. */ - int flags; /* Event flags as passed to Tcl_DoOneEvent. */ +FileSetupProc( + ClientData data, /* Not used. */ + int flags) /* Event flags as passed to Tcl_DoOneEvent. */ { FileInfo *infoPtr; Tcl_Time blockTime = { 0, 0 }; @@ -226,12 +221,12 @@ FileSetupProc(data, flags) if (!(flags & TCL_FILE_EVENTS)) { return; } - + /* - * Check to see if there is a ready file. If so, poll. + * Check to see if there is a ready file. If so, poll. */ - for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL; + for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL; infoPtr = infoPtr->nextPtr) { if (infoPtr->watchMask) { Tcl_SetMaxBlockTime(&blockTime); @@ -245,8 +240,8 @@ FileSetupProc(data, flags) * * FileCheckProc -- * - * This procedure is called by Tcl_DoOneEvent to check the file - * event source for events. + * This function is called by Tcl_DoOneEvent to check the file event + * source for events. * * Results: * None. @@ -258,9 +253,9 @@ FileSetupProc(data, flags) */ static void -FileCheckProc(data, flags) - ClientData data; /* Not used. */ - int flags; /* Event flags as passed to Tcl_DoOneEvent. */ +FileCheckProc( + ClientData data, /* Not used. */ + int flags) /* Event flags as passed to Tcl_DoOneEvent. */ { FileEvent *evPtr; FileInfo *infoPtr; @@ -269,14 +264,13 @@ FileCheckProc(data, flags) if (!(flags & TCL_FILE_EVENTS)) { return; } - + /* - * Queue events for any ready files that don't already have events - * queued (caused by persistent states that won't generate WinSock - * events). + * Queue events for any ready files that don't already have events queued + * (caused by persistent states that won't generate WinSock events). */ - for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL; + for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL; infoPtr = infoPtr->nextPtr) { if (infoPtr->watchMask && !(infoPtr->flags & FILE_PENDING)) { infoPtr->flags |= FILE_PENDING; @@ -288,19 +282,20 @@ FileCheckProc(data, flags) } } -/*---------------------------------------------------------------------- +/* + *---------------------------------------------------------------------- * * FileEventProc -- * - * This function is invoked by Tcl_ServiceEvent when a file event - * reaches the front of the event queue. This procedure invokes - * Tcl_NotifyChannel on the file. + * This function is invoked by Tcl_ServiceEvent when a file event reaches + * the front of the event queue. This function invokes Tcl_NotifyChannel + * on the file. * * Results: - * Returns 1 if the event was handled, meaning it should be removed - * from the queue. Returns 0 if the event was not handled, meaning - * it should stay on the queue. The only time the event isn't - * handled is if the TCL_FILE_EVENTS flag bit isn't set. + * Returns 1 if the event was handled, meaning it should be removed from + * the queue. Returns 0 if the event was not handled, meaning it should + * stay on the queue. The only time the event isn't handled is if the + * TCL_FILE_EVENTS flag bit isn't set. * * Side effects: * Whatever the notifier callback does. @@ -309,10 +304,10 @@ FileCheckProc(data, flags) */ static int -FileEventProc(evPtr, flags) - Tcl_Event *evPtr; /* Event to service. */ - int flags; /* Flags that indicate what events to - * handle, such as TCL_FILE_EVENTS. */ +FileEventProc( + Tcl_Event *evPtr, /* Event to service. */ + int flags) /* Flags that indicate what events to handle, + * such as TCL_FILE_EVENTS. */ { FileEvent *fileEvPtr = (FileEvent *)evPtr; FileInfo *infoPtr; @@ -324,9 +319,9 @@ FileEventProc(evPtr, flags) /* * Search through the list of watched files for the one whose handle - * matches the event. We do this rather than simply dereferencing - * the handle in the event so that files can be deleted while the - * event is in the queue. + * matches the event. We do this rather than simply dereferencing the + * handle in the event so that files can be deleted while the event is in + * the queue. */ for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL; @@ -357,13 +352,13 @@ FileEventProc(evPtr, flags) */ static int -FileBlockProc(instanceData, mode) - ClientData instanceData; /* Instance data for channel. */ - int mode; /* TCL_MODE_BLOCKING or - * TCL_MODE_NONBLOCKING. */ +FileBlockProc( + ClientData instanceData, /* Instance data for channel. */ + int mode) /* TCL_MODE_BLOCKING or + * TCL_MODE_NONBLOCKING. */ { FileInfo *infoPtr = (FileInfo *) instanceData; - + /* * Files on Windows can not be switched between blocking and nonblocking, * hence we have to emulate the behavior. This is done in the input @@ -396,9 +391,9 @@ FileBlockProc(instanceData, mode) */ static int -FileCloseProc(instanceData, interp) - ClientData instanceData; /* Pointer to FileInfo structure. */ - Tcl_Interp *interp; /* Not used. */ +FileCloseProc( + ClientData instanceData, /* Pointer to FileInfo structure. */ + Tcl_Interp *interp) /* Not used. */ { FileInfo *fileInfoPtr = (FileInfo *) instanceData; FileInfo *infoPtr; @@ -412,15 +407,15 @@ FileCloseProc(instanceData, interp) FileWatchProc(instanceData, 0); /* - * Don't close the Win32 handle if the handle is a standard channel - * during the thread exit process. Otherwise, one thread may kill - * the stdio of another. + * Don't close the Win32 handle if the handle is a standard channel during + * the thread exit process. Otherwise, one thread may kill the stdio of + * another. */ - if (!TclInThreadExit() + if (!TclInThreadExit() || ((GetStdHandle(STD_INPUT_HANDLE) != fileInfoPtr->handle) - && (GetStdHandle(STD_OUTPUT_HANDLE) != fileInfoPtr->handle) - && (GetStdHandle(STD_ERROR_HANDLE) != fileInfoPtr->handle))) { + && (GetStdHandle(STD_OUTPUT_HANDLE) != fileInfoPtr->handle) + && (GetStdHandle(STD_ERROR_HANDLE) != fileInfoPtr->handle))) { if (CloseHandle(fileInfoPtr->handle) == FALSE) { TclWinConvertError(GetLastError()); errorCode = errno; @@ -430,19 +425,21 @@ FileCloseProc(instanceData, interp) /* * See if this FileInfo* is still on the thread local list. */ + tsdPtr = TCL_TSD_INIT(&dataKey); - for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL; + for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL; infoPtr = infoPtr->nextPtr) { if (infoPtr == fileInfoPtr) { - /* - * This channel exists on the thread local list. It should - * have been removed by an earlier Thread Action call, - * but do that now since just deallocating fileInfoPtr would - * leave an deallocated pointer on the thread local list. - */ + /* + * This channel exists on the thread local list. It should have + * been removed by an earlier Threadaction call, but do that now + * since just deallocating fileInfoPtr would leave an deallocated + * pointer on the thread local list. + */ + FileThreadActionProc(fileInfoPtr,TCL_CHANNEL_THREAD_REMOVE); - break; - } + break; + } } ckfree((char *)fileInfoPtr); return errorCode; @@ -456,44 +453,45 @@ FileCloseProc(instanceData, interp) * Seeks on a file-based channel. Returns the new position. * * Results: - * -1 if failed, the new position if successful. If failed, it - * also sets *errorCodePtr to the error code. + * -1 if failed, the new position if successful. If failed, it also sets + * *errorCodePtr to the error code. * * Side effects: - * Moves the location at which the channel will be accessed in - * future operations. + * Moves the location at which the channel will be accessed in future + * operations. * *---------------------------------------------------------------------- */ static int -FileSeekProc(instanceData, offset, mode, errorCodePtr) - ClientData instanceData; /* File state. */ - long offset; /* Offset to seek to. */ - int mode; /* Relative to where should we seek? */ - int *errorCodePtr; /* To store error code. */ +FileSeekProc( + ClientData instanceData, /* File state. */ + long offset, /* Offset to seek to. */ + int mode, /* Relative to where should we seek? */ + int *errorCodePtr) /* To store error code. */ { FileInfo *infoPtr = (FileInfo *) instanceData; - DWORD moveMethod; LONG newPos, newPosHigh, oldPos, oldPosHigh; + DWORD moveMethod; *errorCodePtr = 0; if (mode == SEEK_SET) { - moveMethod = FILE_BEGIN; + moveMethod = FILE_BEGIN; } else if (mode == SEEK_CUR) { - moveMethod = FILE_CURRENT; + moveMethod = FILE_CURRENT; } else { - moveMethod = FILE_END; + moveMethod = FILE_END; } /* * Save our current place in case we need to roll-back the seek. */ - oldPosHigh = (DWORD)0; - oldPos = SetFilePointer(infoPtr->handle, (LONG)0, &oldPosHigh, - FILE_CURRENT); - if (oldPos == INVALID_SET_FILE_POINTER) { + + oldPosHigh = 0; + oldPos = SetFilePointer(infoPtr->handle, 0, &oldPosHigh, FILE_CURRENT); + if (oldPos == (LONG)INVALID_SET_FILE_POINTER) { DWORD winError = GetLastError(); + if (winError != NO_ERROR) { TclWinConvertError(winError); *errorCodePtr = errno; @@ -501,11 +499,11 @@ FileSeekProc(instanceData, offset, mode, errorCodePtr) } } - newPosHigh = (DWORD)(offset < 0 ? -1 : 0); - newPos = SetFilePointer(infoPtr->handle, (LONG) offset, &newPosHigh, - moveMethod); - if (newPos == INVALID_SET_FILE_POINTER) { + newPosHigh = (offset < 0 ? -1 : 0); + newPos = SetFilePointer(infoPtr->handle, offset, &newPosHigh, moveMethod); + if (newPos == (LONG)INVALID_SET_FILE_POINTER) { DWORD winError = GetLastError(); + if (winError != NO_ERROR) { TclWinConvertError(winError); *errorCodePtr = errno; @@ -516,9 +514,10 @@ FileSeekProc(instanceData, offset, mode, errorCodePtr) /* * Check for expressability in our return type, and roll-back otherwise. */ + if (newPosHigh != 0) { *errorCodePtr = EOVERFLOW; - SetFilePointer(infoPtr->handle, (LONG)oldPos, &oldPosHigh, FILE_BEGIN); + SetFilePointer(infoPtr->handle, oldPos, &oldPosHigh, FILE_BEGIN); return -1; } return (int) newPos; @@ -532,22 +531,22 @@ FileSeekProc(instanceData, offset, mode, errorCodePtr) * Seeks on a file-based channel. Returns the new position. * * Results: - * -1 if failed, the new position if successful. If failed, it - * also sets *errorCodePtr to the error code. + * -1 if failed, the new position if successful. If failed, it also sets + * *errorCodePtr to the error code. * * Side effects: - * Moves the location at which the channel will be accessed in - * future operations. + * Moves the location at which the channel will be accessed in future + * operations. * *---------------------------------------------------------------------- */ static Tcl_WideInt -FileWideSeekProc(instanceData, offset, mode, errorCodePtr) - ClientData instanceData; /* File state. */ - Tcl_WideInt offset; /* Offset to seek to. */ - int mode; /* Relative to where should we seek? */ - int *errorCodePtr; /* To store error code. */ +FileWideSeekProc( + ClientData instanceData, /* File state. */ + Tcl_WideInt offset, /* Offset to seek to. */ + int mode, /* Relative to where should we seek? */ + int *errorCodePtr) /* To store error code. */ { FileInfo *infoPtr = (FileInfo *) instanceData; DWORD moveMethod; @@ -555,18 +554,19 @@ FileWideSeekProc(instanceData, offset, mode, errorCodePtr) *errorCodePtr = 0; if (mode == SEEK_SET) { - moveMethod = FILE_BEGIN; + moveMethod = FILE_BEGIN; } else if (mode == SEEK_CUR) { - moveMethod = FILE_CURRENT; + moveMethod = FILE_CURRENT; } else { - moveMethod = FILE_END; + moveMethod = FILE_END; } - newPosHigh = (DWORD)(offset >> 32); - newPos = SetFilePointer(infoPtr->handle, (LONG) offset, &newPosHigh, - moveMethod); - if (newPos == INVALID_SET_FILE_POINTER) { + newPosHigh = Tcl_WideAsLong(offset >> 32); + newPos = SetFilePointer(infoPtr->handle, Tcl_WideAsLong(offset), + &newPosHigh, moveMethod); + if (newPos == (LONG)INVALID_SET_FILE_POINTER) { DWORD winError = GetLastError(); + if (winError != NO_ERROR) { TclWinConvertError(winError); *errorCodePtr = errno; @@ -579,10 +579,82 @@ FileWideSeekProc(instanceData, offset, mode, errorCodePtr) /* *---------------------------------------------------------------------- * + * FileTruncateProc -- + * + * Truncates a file-based channel. Returns the error code. + * + * Results: + * 0 if successful, POSIX-y error code if it failed. + * + * Side effects: + * Truncates the file, may move file pointers too. + * + *---------------------------------------------------------------------- + */ + +static int +FileTruncateProc( + ClientData instanceData, /* File state. */ + Tcl_WideInt length) /* Length to truncate at. */ +{ + FileInfo *infoPtr = (FileInfo *) instanceData; + LONG newPos, newPosHigh, oldPos, oldPosHigh; + + /* + * Save where we were... + */ + + oldPosHigh = 0; + oldPos = SetFilePointer(infoPtr->handle, 0, &oldPosHigh, FILE_CURRENT); + if (oldPos == (LONG)INVALID_SET_FILE_POINTER) { + DWORD winError = GetLastError(); + if (winError != NO_ERROR) { + TclWinConvertError(winError); + return errno; + } + } + + /* + * Move to where we want to truncate + */ + + newPosHigh = Tcl_WideAsLong(length >> 32); + newPos = SetFilePointer(infoPtr->handle, Tcl_WideAsLong(length), + &newPosHigh, FILE_BEGIN); + if (newPos == (LONG)INVALID_SET_FILE_POINTER) { + DWORD winError = GetLastError(); + if (winError != NO_ERROR) { + TclWinConvertError(winError); + return errno; + } + } + + /* + * Perform the truncation (unlike POSIX ftruncate(), we needed to move to + * the location to truncate at first). + */ + + if (!SetEndOfFile(infoPtr->handle)) { + TclWinConvertError(GetLastError()); + return errno; + } + + /* + * Move back. If this last step fails, we don't care; it's just a "best + * effort" attempt to restore our file pointer to where it was. + */ + + SetFilePointer(infoPtr->handle, oldPos, &oldPosHigh, FILE_BEGIN); + return 0; +} + +/* + *---------------------------------------------------------------------- + * * FileInputProc -- * - * Reads input from the IO channel into the buffer given. Returns - * count of how many bytes were actually read, and an error indication. + * Reads input from the IO channel into the buffer given. Returns count + * of how many bytes were actually read, and an error indication. * * Results: * A count of how many bytes were read is returned and an error @@ -595,12 +667,11 @@ FileWideSeekProc(instanceData, offset, mode, errorCodePtr) */ static int -FileInputProc(instanceData, buf, bufSize, errorCode) - ClientData instanceData; /* File state. */ - char *buf; /* Where to store data read. */ - int bufSize; /* How much space is available - * in the buffer? */ - int *errorCode; /* Where to store error code. */ +FileInputProc( + ClientData instanceData, /* File state. */ + char *buf, /* Where to store data read. */ + int bufSize, /* Num bytes available in buffer. */ + int *errorCode) /* Where to store error code. */ { FileInfo *infoPtr; DWORD bytesRead; @@ -609,18 +680,18 @@ FileInputProc(instanceData, buf, bufSize, errorCode) infoPtr = (FileInfo *) instanceData; /* - * Note that we will block on reads from a console buffer until a - * full line has been entered. The only way I know of to get - * around this is to write a console driver. We should probably - * do this at some point, but for now, we just block. The same - * problem exists for files being read over the network. + * Note that we will block on reads from a console buffer until a full + * line has been entered. The only way I know of to get around this is to + * write a console driver. We should probably do this at some point, but + * for now, we just block. The same problem exists for files being read + * over the network. */ if (ReadFile(infoPtr->handle, (LPVOID) buf, (DWORD) bufSize, &bytesRead, - (LPOVERLAPPED) NULL) != FALSE) { + (LPOVERLAPPED) NULL) != FALSE) { return bytesRead; } - + TclWinConvertError(GetLastError()); *errorCode = errno; if (errno == EPIPE) { @@ -634,12 +705,12 @@ FileInputProc(instanceData, buf, bufSize, errorCode) * * FileOutputProc -- * - * Writes the given output on the IO channel. Returns count of how - * many characters were actually written, and an error indication. + * Writes the given output on the IO channel. Returns count of how many + * characters were actually written, and an error indication. * * Results: - * A count of how many characters were written is returned and an - * error indication is returned in an output argument. + * A count of how many characters were written is returned and an error + * indication is returned in an output argument. * * Side effects: * Writes output on the actual channel. @@ -648,15 +719,15 @@ FileInputProc(instanceData, buf, bufSize, errorCode) */ static int -FileOutputProc(instanceData, buf, toWrite, errorCode) - ClientData instanceData; /* File state. */ - CONST char *buf; /* The data buffer. */ - int toWrite; /* How many bytes to write? */ - int *errorCode; /* Where to store error code. */ +FileOutputProc( + ClientData instanceData, /* File state. */ + CONST char *buf, /* The data buffer. */ + int toWrite, /* How many bytes to write? */ + int *errorCode) /* Where to store error code. */ { FileInfo *infoPtr = (FileInfo *) instanceData; DWORD bytesWritten; - + *errorCode = 0; /* @@ -665,14 +736,14 @@ FileOutputProc(instanceData, buf, toWrite, errorCode) */ if (infoPtr->flags & FILE_APPEND) { - SetFilePointer(infoPtr->handle, 0, NULL, FILE_END); + SetFilePointer(infoPtr->handle, 0, NULL, FILE_END); } - if (WriteFile(infoPtr->handle, (LPVOID) buf, (DWORD) toWrite, &bytesWritten, - (LPOVERLAPPED) NULL) == FALSE) { - TclWinConvertError(GetLastError()); - *errorCode = errno; - return -1; + if (WriteFile(infoPtr->handle, (LPVOID) buf, (DWORD) toWrite, + &bytesWritten, (LPOVERLAPPED) NULL) == FALSE) { + TclWinConvertError(GetLastError()); + *errorCode = errno; + return -1; } infoPtr->dirty = 1; return bytesWritten; @@ -683,8 +754,7 @@ FileOutputProc(instanceData, buf, toWrite, errorCode) * * FileWatchProc -- * - * Called by the notifier to set up to watch for events on this - * channel. + * Called by the notifier to set up to watch for events on this channel. * * Results: * None. @@ -696,18 +766,18 @@ FileOutputProc(instanceData, buf, toWrite, errorCode) */ static void -FileWatchProc(instanceData, mask) - ClientData instanceData; /* File state. */ - int mask; /* What events to watch for; OR-ed - * combination of TCL_READABLE, - * TCL_WRITABLE and TCL_EXCEPTION. */ +FileWatchProc( + ClientData instanceData, /* File state. */ + int mask) /* What events to watch for; OR-ed combination + * of TCL_READABLE, TCL_WRITABLE and + * TCL_EXCEPTION. */ { FileInfo *infoPtr = (FileInfo *) instanceData; Tcl_Time blockTime = { 0, 0 }; /* - * Since the file is always ready for events, we set the block time - * to zero so we will poll. + * Since the file is always ready for events, we set the block time to + * zero so we will poll. */ infoPtr->watchMask = mask & infoPtr->validMask; @@ -721,12 +791,12 @@ FileWatchProc(instanceData, mask) * * FileGetHandleProc -- * - * Called from Tcl_GetChannelHandle to retrieve OS handles from - * a file based channel. + * Called from Tcl_GetChannelHandle to retrieve OS handles from a file + * based channel. * * Results: - * Returns TCL_OK with the fd in handlePtr, or TCL_ERROR if - * there is no handle for the specified direction. + * Returns TCL_OK with the fd in handlePtr, or TCL_ERROR if there is no + * handle for the specified direction. * * Side effects: * None. @@ -735,10 +805,10 @@ FileWatchProc(instanceData, mask) */ static int -FileGetHandleProc(instanceData, direction, handlePtr) - ClientData instanceData; /* The file state. */ - int direction; /* TCL_READABLE or TCL_WRITABLE */ - ClientData *handlePtr; /* Where to store the handle. */ +FileGetHandleProc( + ClientData instanceData, /* The file state. */ + int direction, /* TCL_READABLE or TCL_WRITABLE */ + ClientData *handlePtr) /* Where to store the handle. */ { FileInfo *infoPtr = (FileInfo *) instanceData; @@ -749,7 +819,6 @@ FileGetHandleProc(instanceData, direction, handlePtr) return TCL_ERROR; } } - /* *---------------------------------------------------------------------- @@ -759,25 +828,24 @@ FileGetHandleProc(instanceData, direction, handlePtr) * Open an File based channel on Unix systems. * * Results: - * The new channel or NULL. If NULL, the output argument - * errorCodePtr is set to a POSIX error. + * The new channel or NULL. If NULL, the output argument errorCodePtr is + * set to a POSIX error. * * Side effects: - * May open the channel and may cause creation of a file on the - * file system. + * May open the channel and may cause creation of a file on the file + * system. * *---------------------------------------------------------------------- */ Tcl_Channel -TclpOpenFileChannel(interp, pathPtr, mode, permissions) - Tcl_Interp *interp; /* Interpreter for error reporting; - * can be NULL. */ - Tcl_Obj *pathPtr; /* Name of file to open. */ - int mode; /* POSIX mode. */ - int permissions; /* If the open involves creating a - * file, with what modes to create - * it? */ +TclpOpenFileChannel( + Tcl_Interp *interp, /* Interpreter for error reporting; can be + * NULL. */ + Tcl_Obj *pathPtr, /* Name of file to open. */ + int mode, /* POSIX mode. */ + int permissions) /* If the open involves creating a file, with + * what modes to create it? */ { Tcl_Channel channel = 0; int channelPermissions = 0; @@ -785,30 +853,29 @@ TclpOpenFileChannel(interp, pathPtr, mode, permissions) CONST TCHAR *nativeName; HANDLE handle; char channelName[16 + TCL_INTEGER_SPACE]; - TclFile readFile = NULL; - TclFile writeFile = NULL; + TclFile readFile = NULL, writeFile = NULL; nativeName = (TCHAR*) Tcl_FSGetNativePath(pathPtr); if (nativeName == NULL) { return NULL; } - + switch (mode & (O_RDONLY | O_WRONLY | O_RDWR)) { - case O_RDONLY: - accessMode = GENERIC_READ; - channelPermissions = TCL_READABLE; - break; - case O_WRONLY: - accessMode = GENERIC_WRITE; - channelPermissions = TCL_WRITABLE; - break; - case O_RDWR: - accessMode = (GENERIC_READ | GENERIC_WRITE); - channelPermissions = (TCL_READABLE | TCL_WRITABLE); - break; - default: - panic("TclpOpenFileChannel: invalid mode value"); - break; + case O_RDONLY: + accessMode = GENERIC_READ; + channelPermissions = TCL_READABLE; + break; + case O_WRONLY: + accessMode = GENERIC_WRITE; + channelPermissions = TCL_WRITABLE; + break; + case O_RDWR: + accessMode = (GENERIC_READ | GENERIC_WRITE); + channelPermissions = (TCL_READABLE | TCL_WRITABLE); + break; + default: + Tcl_Panic("TclpOpenFileChannel: invalid mode value"); + break; } /* @@ -816,23 +883,23 @@ TclpOpenFileChannel(interp, pathPtr, mode, permissions) */ switch (mode & (O_CREAT | O_EXCL | O_TRUNC)) { - case (O_CREAT | O_EXCL): - case (O_CREAT | O_EXCL | O_TRUNC): - createMode = CREATE_NEW; - break; - case (O_CREAT | O_TRUNC): - createMode = CREATE_ALWAYS; - break; - case O_CREAT: - createMode = OPEN_ALWAYS; - break; - case O_TRUNC: - case (O_TRUNC | O_EXCL): - createMode = TRUNCATE_EXISTING; - break; - default: - createMode = OPEN_EXISTING; - break; + case (O_CREAT | O_EXCL): + case (O_CREAT | O_EXCL | O_TRUNC): + createMode = CREATE_NEW; + break; + case (O_CREAT | O_TRUNC): + createMode = CREATE_ALWAYS; + break; + case O_CREAT: + createMode = OPEN_ALWAYS; + break; + case O_TRUNC: + case (O_TRUNC | O_EXCL): + createMode = TRUNCATE_EXISTING; + break; + default: + createMode = OPEN_EXISTING; + break; } /* @@ -841,14 +908,14 @@ TclpOpenFileChannel(interp, pathPtr, mode, permissions) */ if (mode & O_CREAT) { - if (permissions & S_IWRITE) { - flags = FILE_ATTRIBUTE_NORMAL; - } else { - flags = FILE_ATTRIBUTE_READONLY; - } + if (permissions & S_IWRITE) { + flags = FILE_ATTRIBUTE_NORMAL; + } else { + flags = FILE_ATTRIBUTE_READONLY; + } } else { flags = (*tclWinProcs->getFileAttributesProc)(nativeName); - if (flags == 0xFFFFFFFF) { + if (flags == 0xFFFFFFFF) { flags = 0; } } @@ -863,48 +930,48 @@ TclpOpenFileChannel(interp, pathPtr, mode, permissions) * Now we get to create the file. */ - handle = (*tclWinProcs->createFileProc)(nativeName, accessMode, + handle = (*tclWinProcs->createFileProc)(nativeName, accessMode, shareMode, NULL, createMode, flags, (HANDLE) NULL); if (handle == INVALID_HANDLE_VALUE) { - DWORD err; - err = GetLastError(); + DWORD err = GetLastError(); + if ((err & 0xffffL) == ERROR_OPEN_FAILED) { err = (mode & O_CREAT) ? ERROR_FILE_EXISTS : ERROR_FILE_NOT_FOUND; } - TclWinConvertError(err); + TclWinConvertError(err); if (interp != (Tcl_Interp *) NULL) { - Tcl_AppendResult(interp, "couldn't open \"", - Tcl_GetString(pathPtr), "\": ", - Tcl_PosixError(interp), (char *) NULL); - } - return NULL; + Tcl_AppendResult(interp, "couldn't open \"", TclGetString(pathPtr), + "\": ", Tcl_PosixError(interp), NULL); + } + return NULL; } - + channel = NULL; - switch ( FileGetType(handle) ) { + switch (FileGetType(handle)) { case FILE_TYPE_SERIAL: /* - * Reopen channel for OVERLAPPED operation - * Normally this shouldn't fail, because the channel exists + * Reopen channel for OVERLAPPED operation. Normally this shouldn't + * fail, because the channel exists. */ + handle = TclWinSerialReopen(handle, nativeName, accessMode); if (handle == INVALID_HANDLE_VALUE) { TclWinConvertError(GetLastError()); if (interp != (Tcl_Interp *) NULL) { Tcl_AppendResult(interp, "couldn't reopen serial \"", - Tcl_GetString(pathPtr), "\": ", - Tcl_PosixError(interp), (char *) NULL); + TclGetString(pathPtr), "\": ", + Tcl_PosixError(interp), NULL); } return NULL; } channel = TclWinOpenSerialChannel(handle, channelName, - channelPermissions); + channelPermissions); break; case FILE_TYPE_CONSOLE: channel = TclWinOpenConsoleChannel(handle, channelName, - channelPermissions); + channelPermissions); break; case FILE_TYPE_PIPE: if (channelPermissions & TCL_READABLE) { @@ -919,20 +986,18 @@ TclpOpenFileChannel(interp, pathPtr, mode, permissions) case FILE_TYPE_DISK: case FILE_TYPE_UNKNOWN: channel = TclWinOpenFileChannel(handle, channelName, - channelPermissions, - (mode & O_APPEND) ? FILE_APPEND : 0); + channelPermissions, (mode & O_APPEND) ? FILE_APPEND : 0); break; default: /* - * The handle is of an unknown type, probably /dev/nul equivalent - * or possibly a closed handle. + * The handle is of an unknown type, probably /dev/nul equivalent or + * possibly a closed handle. */ - + channel = NULL; - Tcl_AppendResult(interp, "couldn't open \"", - Tcl_GetString(pathPtr), "\": ", - "bad file type", (char *) NULL); + Tcl_AppendResult(interp, "couldn't open \"", TclGetString(pathPtr), + "\": bad file type", NULL); break; } @@ -944,8 +1009,7 @@ TclpOpenFileChannel(interp, pathPtr, mode, permissions) * * Tcl_MakeFileChannel -- * - * Creates a Tcl_Channel from an existing platform specific file - * handle. + * Creates a Tcl_Channel from an existing platform specific file handle. * * Results: * The Tcl_Channel created around the preexisting file. @@ -957,10 +1021,10 @@ TclpOpenFileChannel(interp, pathPtr, mode, permissions) */ Tcl_Channel -Tcl_MakeFileChannel(rawHandle, mode) - ClientData rawHandle; /* OS level handle */ - int mode; /* ORed combination of TCL_READABLE and - * TCL_WRITABLE to indicate file mode. */ +Tcl_MakeFileChannel( + ClientData rawHandle, /* OS level handle */ + int mode) /* ORed combination of TCL_READABLE and + * TCL_WRITABLE to indicate file mode. */ { #if defined(HAVE_NO_SEH) && !defined(_WIN64) EXCEPTION_REGISTRATION registration; @@ -969,16 +1033,14 @@ Tcl_MakeFileChannel(rawHandle, mode) Tcl_Channel channel = NULL; HANDLE handle = (HANDLE) rawHandle; HANDLE dupedHandle; - TclFile readFile = NULL; - TclFile writeFile = NULL; + TclFile readFile = NULL, writeFile = NULL; BOOL result; if (mode == 0) { return NULL; } - switch (FileGetType(handle)) - { + switch (FileGetType(handle)) { case FILE_TYPE_SERIAL: channel = TclWinOpenSerialChannel(handle, channelName, mode); break; @@ -986,12 +1048,10 @@ Tcl_MakeFileChannel(rawHandle, mode) channel = TclWinOpenConsoleChannel(handle, channelName, mode); break; case FILE_TYPE_PIPE: - if (mode & TCL_READABLE) - { + if (mode & TCL_READABLE) { readFile = TclWinMakeFile(handle); } - if (mode & TCL_WRITABLE) - { + if (mode & TCL_WRITABLE) { writeFile = TclWinMakeFile(handle); } channel = TclpCreateCommandChannel(readFile, writeFile, NULL, 0, NULL); @@ -1001,14 +1061,14 @@ Tcl_MakeFileChannel(rawHandle, mode) case FILE_TYPE_CHAR: channel = TclWinOpenFileChannel(handle, channelName, mode, 0); break; - + case FILE_TYPE_UNKNOWN: default: /* - * The handle is of an unknown type. Test the validity of this OS - * handle by duplicating it, then closing the dupe. The Win32 API + * The handle is of an unknown type. Test the validity of this OS + * handle by duplicating it, then closing the dupe. The Win32 API * doesn't provide an IsValidHandle() function, so we have to emulate - * it here. This test will not work on a console handle reliably, + * it here. This test will not work on a console handle reliably, * which is why we can't test every handle that comes into this * function in this way. */ @@ -1018,7 +1078,7 @@ Tcl_MakeFileChannel(rawHandle, mode) DUPLICATE_SAME_ACCESS); if (result == 0) { - /* + /* * Unable to make a duplicate. It's definately invalid at this * point. */ @@ -1034,12 +1094,11 @@ Tcl_MakeFileChannel(rawHandle, mode) result = 0; #if defined(HAVE_NO_SEH) && !defined(_WIN64) /* - * Don't have SEH available, do things the hard way. - * Note that this needs to be one block of asm, to avoid stack - * imbalance; also, it is illegal for one asm block to contain - * a jump to another. + * Don't have SEH available, do things the hard way. Note that this + * needs to be one block of asm, to avoid stack imbalance; also, it is + * illegal for one asm block to contain a jump to another. */ - + __asm__ __volatile__ ( /* @@ -1049,9 +1108,10 @@ Tcl_MakeFileChannel(rawHandle, mode) "movl %[dupedHandle], %%ebx" "\n\t" /* - * Construct an EXCEPTION_REGISTRATION to protect the - * call to CloseHandle + * Construct an EXCEPTION_REGISTRATION to protect the call to + * CloseHandle. */ + "leal %[registration], %%edx" "\n\t" "movl %%fs:0, %%eax" "\n\t" "movl %%eax, 0x0(%%edx)" "\n\t" /* link */ @@ -1060,45 +1120,49 @@ Tcl_MakeFileChannel(rawHandle, mode) "movl %%ebp, 0x8(%%edx)" "\n\t" /* ebp */ "movl %%esp, 0xc(%%edx)" "\n\t" /* esp */ "movl $0, 0x10(%%edx)" "\n\t" /* status */ - - /* Link the EXCEPTION_REGISTRATION on the chain */ - + + /* + * Link the EXCEPTION_REGISTRATION on the chain. + */ + "movl %%edx, %%fs:0" "\n\t" - - /* Call CloseHandle( dupedHandle ) */ - + + /* + * Call CloseHandle(dupedHandle). + */ + "pushl %%ebx" "\n\t" "call _CloseHandle@4" "\n\t" - - /* - * Come here on normal exit. Recover the EXCEPTION_REGISTRATION + + /* + * Come here on normal exit. Recover the EXCEPTION_REGISTRATION * and put a TRUE status return into it. */ - + "movl %%fs:0, %%edx" "\n\t" "movl $1, %%eax" "\n\t" "movl %%eax, 0x10(%%edx)" "\n\t" "jmp 2f" "\n" - + /* - * Come here on an exception. Recover the EXCEPTION_REGISTRATION + * Come here on an exception. Recover the EXCEPTION_REGISTRATION */ - + "1:" "\t" "movl %%fs:0, %%edx" "\n\t" "movl 0x8(%%edx), %%edx" "\n\t" - - /* - * Come here however we exited. Restore context from the + + /* + * Come here however we exited. Restore context from the * EXCEPTION_REGISTRATION in case the stack is unbalanced. */ - + "2:" "\t" "movl 0xc(%%edx), %%esp" "\n\t" "movl 0x8(%%edx), %%ebp" "\n\t" "movl 0x0(%%edx), %%eax" "\n\t" "movl %%eax, %%fs:0" "\n\t" - + : /* No outputs */ : @@ -1108,7 +1172,6 @@ Tcl_MakeFileChannel(rawHandle, mode) "%eax", "%ebx", "%ecx", "%edx", "%esi", "%edi", "memory" ); result = registration.status; - #else #ifndef HAVE_NO_SEH __try { @@ -1123,9 +1186,9 @@ Tcl_MakeFileChannel(rawHandle, mode) return NULL; } - /* Fall through, the handle is valid. */ - /* + * Fall through, the handle is valid. + * * Create the undefined channel, anyways, because we know the handle * is valid to something. */ @@ -1147,42 +1210,42 @@ Tcl_MakeFileChannel(rawHandle, mode) * Returns the specified default standard channel, or NULL. * * Side effects: - * May cause the creation of a standard channel and the underlying - * file. + * May cause the creation of a standard channel and the underlying file. * *---------------------------------------------------------------------- */ Tcl_Channel -TclpGetDefaultStdChannel(type) - int type; /* One of TCL_STDIN, TCL_STDOUT, TCL_STDERR. */ +TclpGetDefaultStdChannel( + int type) /* One of TCL_STDIN, TCL_STDOUT, or + * TCL_STDERR. */ { Tcl_Channel channel; HANDLE handle; int mode = -1; char *bufMode = NULL; - DWORD handleId = (DWORD)INVALID_HANDLE_VALUE; + DWORD handleId = (DWORD)-1; /* Standard handle to retrieve. */ switch (type) { - case TCL_STDIN: - handleId = STD_INPUT_HANDLE; - mode = TCL_READABLE; - bufMode = "line"; - break; - case TCL_STDOUT: - handleId = STD_OUTPUT_HANDLE; - mode = TCL_WRITABLE; - bufMode = "line"; - break; - case TCL_STDERR: - handleId = STD_ERROR_HANDLE; - mode = TCL_WRITABLE; - bufMode = "none"; - break; - default: - panic("TclGetDefaultStdChannel: Unexpected channel type"); - break; + case TCL_STDIN: + handleId = STD_INPUT_HANDLE; + mode = TCL_READABLE; + bufMode = "line"; + break; + case TCL_STDOUT: + handleId = STD_OUTPUT_HANDLE; + mode = TCL_WRITABLE; + bufMode = "line"; + break; + case TCL_STDERR: + handleId = STD_ERROR_HANDLE; + mode = TCL_WRITABLE; + bufMode = "none"; + break; + default: + Tcl_Panic("TclGetDefaultStdChannel: Unexpected channel type"); + break; } handle = GetStdHandle(handleId); @@ -1207,126 +1270,121 @@ TclpGetDefaultStdChannel(type) * Set up the normal channel options for stdio handles. */ - if ((Tcl_SetChannelOption((Tcl_Interp *) NULL, channel, "-translation", - "auto") == TCL_ERROR) - || (Tcl_SetChannelOption((Tcl_Interp *) NULL, channel, "-eofchar", - "\032 {}") == TCL_ERROR) - || (Tcl_SetChannelOption((Tcl_Interp *) NULL, channel, - "-buffering", bufMode) == TCL_ERROR)) { - Tcl_Close((Tcl_Interp *) NULL, channel); - return (Tcl_Channel) NULL; + if (Tcl_SetChannelOption(NULL,channel,"-translation","auto")!=TCL_OK || + Tcl_SetChannelOption(NULL,channel,"-eofchar","\032 {}")!=TCL_OK || + Tcl_SetChannelOption(NULL,channel,"-buffering",bufMode)!=TCL_OK) { + Tcl_Close(NULL, channel); + return (Tcl_Channel) NULL; } return channel; } - - /* *---------------------------------------------------------------------- * * TclWinOpenFileChannel -- * - * Constructs a File channel for the specified standard OS handle. - * This is a helper function to break up the construction of - * channels into File, Console, or Serial. + * Constructs a File channel for the specified standard OS handle. This + * is a helper function to break up the construction of channels into + * File, Console, or Serial. * * Results: * Returns the new channel, or NULL. * * Side effects: - * May open the channel and may cause creation of a file on the - * file system. + * May open the channel and may cause creation of a file on the file + * system. * *---------------------------------------------------------------------- */ Tcl_Channel -TclWinOpenFileChannel(handle, channelName, permissions, appendMode) - HANDLE handle; - char *channelName; - int permissions; - int appendMode; +TclWinOpenFileChannel( + HANDLE handle, /* Win32 HANDLE to swallow */ + char *channelName, /* Buffer to receive channel name */ + int permissions, /* OR'ed combination of TCL_READABLE, + * TCL_WRITABLE, or TCL_EXCEPTION, indicating + * which operations are valid on the file. */ + int appendMode) /* OR'ed combination of bits indicating what + * additional configuration of the channel is + * present. */ { FileInfo *infoPtr; - ThreadSpecificData *tsdPtr; - - tsdPtr = FileInit(); + ThreadSpecificData *tsdPtr = FileInit(); /* * See if a channel with this handle already exists. */ - - for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL; - infoPtr = infoPtr->nextPtr) { + + for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL; + infoPtr = infoPtr->nextPtr) { if (infoPtr->handle == (HANDLE) handle) { - return (permissions == infoPtr->validMask) ? infoPtr->channel : NULL; + return (permissions==infoPtr->validMask) ? infoPtr->channel : NULL; } } infoPtr = (FileInfo *) ckalloc((unsigned) sizeof(FileInfo)); - /* TIP #218. Removed the code inserting the new structure - * into the global list. This is now handled in the thread - * action callbacks, and only there. + + /* + * TIP #218. Removed the code inserting the new structure into the global + * list. This is now handled in the thread action callbacks, and only + * there. */ + infoPtr->nextPtr = NULL; infoPtr->validMask = permissions; infoPtr->watchMask = 0; infoPtr->flags = appendMode; infoPtr->handle = handle; infoPtr->dirty = 0; - wsprintfA(channelName, "file%lx", (int) infoPtr); - + wsprintfA(channelName, "file%lx", PTR2INT(infoPtr)); + infoPtr->channel = Tcl_CreateChannel(&fileChannelType, channelName, (ClientData) infoPtr, permissions); - + /* - * Files have default translation of AUTO and ^Z eof char, which - * means that a ^Z will be accepted as EOF when reading. + * Files have default translation of AUTO and ^Z eof char, which means + * that a ^Z will be accepted as EOF when reading. */ - + Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto"); Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "\032 {}"); return infoPtr->channel; } - - + /* *---------------------------------------------------------------------- * * TclWinFlushDirtyChannels -- * - * Flush all dirty channels to disk, so that requesting the - * size of any file returns the correct value. + * Flush all dirty channels to disk, so that requesting the size of any + * file returns the correct value. * * Results: * None. * * Side effects: - * Information is actually written to disk now, rather than - * later. Don't call this too often, or there will be a - * performance hit (i.e. only call when we need to ask for - * the size of a file). + * Information is actually written to disk now, rather than later. Don't + * call this too often, or there will be a performance hit (i.e. only + * call when we need to ask for the size of a file). * *---------------------------------------------------------------------- */ void -TclWinFlushDirtyChannels () +TclWinFlushDirtyChannels(void) { FileInfo *infoPtr; - ThreadSpecificData *tsdPtr; - - tsdPtr = FileInit(); + ThreadSpecificData *tsdPtr = FileInit(); /* - * Flush all channels which are dirty, i.e. may have data pending - * in the OS + * Flush all channels which are dirty, i.e. may have data pending in the + * OS. */ - - for (infoPtr = tsdPtr->firstFilePtr; - infoPtr != NULL; - infoPtr = infoPtr->nextPtr) { + + for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL; + infoPtr = infoPtr->nextPtr) { if (infoPtr->dirty) { FlushFileBuffers(infoPtr->handle); infoPtr->dirty = 0; @@ -1351,42 +1409,41 @@ TclWinFlushDirtyChannels () */ static void -FileThreadActionProc (instanceData, action) - ClientData instanceData; - int action; +FileThreadActionProc( + ClientData instanceData, + int action) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); FileInfo *infoPtr = (FileInfo *) instanceData; if (action == TCL_CHANNEL_THREAD_INSERT) { - infoPtr->nextPtr = tsdPtr->firstFilePtr; + infoPtr->nextPtr = tsdPtr->firstFilePtr; tsdPtr->firstFilePtr = infoPtr; } else { - FileInfo **nextPtrPtr; + FileInfo **nextPtrPtr; int removed = 0; for (nextPtrPtr = &(tsdPtr->firstFilePtr); (*nextPtrPtr) != NULL; - nextPtrPtr = &((*nextPtrPtr)->nextPtr)) { + nextPtrPtr = &((*nextPtrPtr)->nextPtr)) { if ((*nextPtrPtr) == infoPtr) { - (*nextPtrPtr) = infoPtr->nextPtr; + (*nextPtrPtr) = infoPtr->nextPtr; removed = 1; break; } } /* - * This could happen if the channel was created in one thread - * and then moved to another without updating the thread - * local data in each thread. + * This could happen if the channel was created in one thread and then + * moved to another without updating the thread local data in each + * thread. */ if (!removed) { - panic("file info ptr not on thread channel list"); + Tcl_Panic("file info ptr not on thread channel list"); } } } - - + /* *---------------------------------------------------------------------- * @@ -1404,31 +1461,42 @@ FileThreadActionProc (instanceData, action) */ DWORD -FileGetType(handle) - HANDLE handle; /* Opened file handle */ -{ +FileGetType( + HANDLE handle) /* Opened file handle */ +{ DWORD type; - DWORD consoleParams; - DCB dcb; type = GetFileType(handle); /* - * If the file is a character device, we need to try to figure out - * whether it is a serial port, a console, or something else. We - * test for the console case first because this is more common. + * If the file is a character device, we need to try to figure out whether + * it is a serial port, a console, or something else. We test for the + * console case first because this is more common. */ - - if (type == FILE_TYPE_CHAR || (type == FILE_TYPE_UNKNOWN && !GetLastError())) { - if (GetConsoleMode(handle, &consoleParams)) { - type = FILE_TYPE_CONSOLE; - } else { - dcb.DCBlength = sizeof( DCB ) ; - if (GetCommState(handle, &dcb)) { - type = FILE_TYPE_SERIAL; - } - } + + if ((type == FILE_TYPE_CHAR) + || ((type == FILE_TYPE_UNKNOWN) && !GetLastError())) { + DWORD consoleParams; + + if (GetConsoleMode(handle, &consoleParams)) { + type = FILE_TYPE_CONSOLE; + } else { + DCB dcb; + + dcb.DCBlength = sizeof(DCB); + if (GetCommState(handle, &dcb)) { + type = FILE_TYPE_SERIAL; + } + } } return type; } + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ diff --git a/win/tclWinConsole.c b/win/tclWinConsole.c index f0dd62c..8be8e09 100644 --- a/win/tclWinConsole.c +++ b/win/tclWinConsole.c @@ -1,13 +1,13 @@ -/* +/* * tclWinConsole.c -- * - * This file implements the Windows-specific console functions, - * and the "console" channel driver. + * This file implements the Windows-specific console functions, and the + * "console" channel driver. * * Copyright (c) 1999 by Scriptics Corp. * - * See the file "license.terms" for information on usage and redistribution - * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclWinInt.h" @@ -43,10 +43,11 @@ TCL_DECLARE_MUTEX(consoleMutex) */ #define CONSOLE_EOF (1<<2) /* Console has reached EOF. */ -#define CONSOLE_BUFFERED (1<<3) /* data was read into a buffer by the reader - thread */ +#define CONSOLE_BUFFERED (1<<3) /* Data was read into a buffer by the reader + * thread. */ #define CONSOLE_BUFFER_SIZE (8*1024) + /* * This structure describes per-instance data for a console based channel. */ @@ -69,52 +70,47 @@ typedef struct ConsoleInfo { HANDLE writeThread; /* Handle to writer thread. */ HANDLE readThread; /* Handle to reader thread. */ HANDLE writable; /* Manual-reset event to signal when the - * writer thread has finished waiting for - * the current buffer to be written. */ + * writer thread has finished waiting for the + * current buffer to be written. */ HANDLE readable; /* Manual-reset event to signal when the * reader thread has finished waiting for * input. */ HANDLE startWriter; /* Auto-reset event used by the main thread to - * signal when the writer thread should attempt - * to write to the console. */ + * signal when the writer thread should + * attempt to write to the console. */ HANDLE stopWriter; /* Auto-reset event used by the main thread to - * signal when the writer thread should exit. - */ + * signal when the writer thread should exit */ HANDLE startReader; /* Auto-reset event used by the main thread to - * signal when the reader thread should attempt - * to read from the console. */ + * signal when the reader thread should + * attempt to read from the console. */ HANDLE stopReader; /* Auto-reset event used by the main thread to - * signal when the reader thread should exit. - */ + * signal when the reader thread should exit */ DWORD writeError; /* An error caused by the last background - * write. Set to 0 if no error has been - * detected. This word is shared with the + * write. Set to 0 if no error has been + * detected. This word is shared with the * writer thread so access must be - * synchronized with the writable object. - */ - char *writeBuf; /* Current background output buffer. - * Access is synchronized with the writable - * object. */ - int writeBufLen; /* Size of write buffer. Access is - * synchronized with the writable - * object. */ - int toWrite; /* Current amount to be written. Access is + * synchronized with the writable object. */ + char *writeBuf; /* Current background output buffer. Access is + * synchronized with the writable object. */ + int writeBufLen; /* Size of write buffer. Access is + * synchronized with the writable object. */ + int toWrite; /* Current amount to be written. Access is * synchronized with the writable object. */ int readFlags; /* Flags that are shared with the reader - * thread. Access is synchronized with the - * readable object. */ - int bytesRead; /* number of bytes in the buffer */ - int offset; /* number of bytes read out of the buffer */ + * thread. Access is synchronized with the + * readable object. */ + int bytesRead; /* number of bytes in the buffer */ + int offset; /* number of bytes read out of the buffer */ char buffer[CONSOLE_BUFFER_SIZE]; - /* Data consumed by reader thread. */ + /* Data consumed by reader thread. */ } ConsoleInfo; typedef struct ThreadSpecificData { /* - * The following pointer refers to the head of the list of consoles - * that are being watched for file events. + * The following pointer refers to the head of the list of consoles that + * are being watched for file events. */ - + ConsoleInfo *firstConsolePtr; } ThreadSpecificData; @@ -126,9 +122,9 @@ static Tcl_ThreadDataKey dataKey; */ typedef struct ConsoleEvent { - Tcl_Event header; /* Information that is standard for - * all events. */ - ConsoleInfo *infoPtr; /* Pointer to console info structure. Note + Tcl_Event header; /* Information that is standard for all + * events. */ + ConsoleInfo *infoPtr; /* Pointer to console info structure. Note * that we still have to verify that the * console exists before dereferencing this * pointer. */ @@ -138,7 +134,7 @@ typedef struct ConsoleEvent { * Declarations for functions used only in this file. */ -static int ConsoleBlockModeProc(ClientData instanceData, int mode); +static int ConsoleBlockModeProc(ClientData instanceData,int mode); static void ConsoleCheckProc(ClientData clientData, int flags); static int ConsoleCloseProc(ClientData instanceData, Tcl_Interp *interp); @@ -146,7 +142,7 @@ static int ConsoleEventProc(Tcl_Event *evPtr, int flags); static void ConsoleExitHandler(ClientData clientData); static int ConsoleGetHandleProc(ClientData instanceData, int direction, ClientData *handlePtr); -static void ConsoleInit(void); +static void ConsoleInit(void); static int ConsoleInputProc(ClientData instanceData, char *buf, int toRead, int *errorCode); static int ConsoleOutputProc(ClientData instanceData, @@ -157,9 +153,8 @@ static void ConsoleWatchProc(ClientData instanceData, int mask); static DWORD WINAPI ConsoleWriterThread(LPVOID arg); static void ProcExitHandler(ClientData clientData); static int WaitForRead(ConsoleInfo *infoPtr, int blocking); - -static void ConsoleThreadActionProc _ANSI_ARGS_ (( - ClientData instanceData, int action)); +static void ConsoleThreadActionProc(ClientData instanceData, + int action); /* * This structure describes the channel type structure for command console @@ -168,7 +163,7 @@ static void ConsoleThreadActionProc _ANSI_ARGS_ (( static Tcl_ChannelType consoleChannelType = { "console", /* Type name. */ - TCL_CHANNEL_VERSION_4, /* v4 channel */ + TCL_CHANNEL_VERSION_5, /* v5 channel */ ConsoleCloseProc, /* Close proc. */ ConsoleInputProc, /* Input proc. */ ConsoleOutputProc, /* Output proc. */ @@ -181,13 +176,57 @@ static Tcl_ChannelType consoleChannelType = { ConsoleBlockModeProc, /* Set blocking or non-blocking mode.*/ NULL, /* flush proc. */ NULL, /* handler proc. */ - NULL, /* wide seek proc */ + NULL, /* wide seek proc */ ConsoleThreadActionProc, /* thread action proc */ + NULL, /* truncation */ }; /* *---------------------------------------------------------------------- * + * readConsoleBytes, writeConsoleBytes -- + * Wrapper for ReadConsole{A,W}, that takes and returns number of bytes + * instead of number of TCHARS + */ +static BOOL +readConsoleBytes( + HANDLE hConsole, + LPVOID lpBuffer, + DWORD nbytes, + LPDWORD nbytesread) +{ + DWORD ntchars; + BOOL result; + int tcharsize; + tcharsize = tclWinProcs->useWide? 2 : 1; + result = tclWinProcs->readConsoleProc( + hConsole, lpBuffer, nbytes / tcharsize, &ntchars, NULL); + if (nbytesread) + *nbytesread = (ntchars*tcharsize); + return result; +} + +static BOOL +writeConsoleBytes( + HANDLE hConsole, + const VOID *lpBuffer, + DWORD nbytes, + LPDWORD nbyteswritten) +{ + DWORD ntchars; + BOOL result; + int tcharsize; + tcharsize = tclWinProcs->useWide? 2 : 1; + result = tclWinProcs->writeConsoleProc( + hConsole, lpBuffer, nbytes / tcharsize, &ntchars, NULL); + if (nbyteswritten) + *nbyteswritten = (ntchars*tcharsize); + return result; +} + +/* + *---------------------------------------------------------------------- + * * ConsoleInit -- * * This function initializes the static variables for this file. @@ -202,13 +241,13 @@ static Tcl_ChannelType consoleChannelType = { */ static void -ConsoleInit() +ConsoleInit(void) { ThreadSpecificData *tsdPtr; /* - * Check the initialized flag first, then check again in the mutex. - * This is a speed enhancement. + * Check the initialized flag first, then check again in the mutex. This + * is a speed enhancement. */ if (!initialized) { @@ -234,8 +273,8 @@ ConsoleInit() * * ConsoleExitHandler -- * - * This function is called to cleanup the console module before - * Tcl is unloaded. + * This function is called to cleanup the console module before Tcl is + * unloaded. * * Results: * None. @@ -258,8 +297,8 @@ ConsoleExitHandler( * * ProcExitHandler -- * - * This function is called to cleanup the process list before - * Tcl is unloaded. + * This function is called to cleanup the process list before Tcl is + * unloaded. * * Results: * None. @@ -284,8 +323,8 @@ ProcExitHandler( * * ConsoleSetupProc -- * - * This procedure is invoked before Tcl_DoOneEvent blocks waiting - * for an event. + * This procedure is invoked before Tcl_DoOneEvent blocks waiting for an + * event. * * Results: * None. @@ -309,12 +348,12 @@ ConsoleSetupProc( if (!(flags & TCL_FILE_EVENTS)) { return; } - + /* - * Look to see if any events are already pending. If they are, poll. + * Look to see if any events are already pending. If they are, poll. */ - for (infoPtr = tsdPtr->firstConsolePtr; infoPtr != NULL; + for (infoPtr = tsdPtr->firstConsolePtr; infoPtr != NULL; infoPtr = infoPtr->nextPtr) { if (infoPtr->watchMask & TCL_WRITABLE) { if (WaitForSingleObject(infoPtr->writable, 0) != WAIT_TIMEOUT) { @@ -337,8 +376,8 @@ ConsoleSetupProc( * * ConsoleCheckProc -- * - * This procedure is called by Tcl_DoOneEvent to check the console - * event source for events. + * This procedure is called by Tcl_DoOneEvent to check the console event + * source for events. * * Results: * None. @@ -362,18 +401,18 @@ ConsoleCheckProc( if (!(flags & TCL_FILE_EVENTS)) { return; } - + /* * Queue events for any ready consoles that don't already have events * queued. */ - for (infoPtr = tsdPtr->firstConsolePtr; infoPtr != NULL; + for (infoPtr = tsdPtr->firstConsolePtr; infoPtr != NULL; infoPtr = infoPtr->nextPtr) { if (infoPtr->flags & CONSOLE_PENDING) { continue; } - + /* * Queue an event if the console is signaled for reading or writing. */ @@ -384,7 +423,7 @@ ConsoleCheckProc( needEvent = 1; } } - + if (infoPtr->watchMask & TCL_READABLE) { if (WaitForRead(infoPtr, 0) >= 0) { needEvent = 1; @@ -422,15 +461,16 @@ static int ConsoleBlockModeProc( ClientData instanceData, /* Instance data for channel. */ int mode) /* TCL_MODE_BLOCKING or - * TCL_MODE_NONBLOCKING. */ + * TCL_MODE_NONBLOCKING. */ { ConsoleInfo *infoPtr = (ConsoleInfo *) instanceData; - + /* - * Consoles on Windows can not be switched between blocking and nonblocking, - * hence we have to emulate the behavior. This is done in the input - * function by checking against a bit in the state. We set or unset the - * bit here to cause the input function to emulate the correct behavior. + * Consoles on Windows can not be switched between blocking and + * nonblocking, hence we have to emulate the behavior. This is done in the + * input function by checking against a bit in the state. We set or unset + * the bit here to cause the input function to emulate the correct + * behavior. */ if (mode == TCL_MODE_NONBLOCKING) { @@ -469,27 +509,25 @@ ConsoleCloseProc( DWORD exitCode; errorCode = 0; - + /* - * Clean up the background thread if necessary. Note that this - * must be done before we can close the file, since the - * thread may be blocking trying to read from the console. + * Clean up the background thread if necessary. Note that this must be + * done before we can close the file, since the thread may be blocking + * trying to read from the console. */ - - if (consolePtr->readThread) { + if (consolePtr->readThread) { /* - * The thread may already have closed on it's own. Check it's - * exit code. + * The thread may already have closed on it's own. Check it's exit + * code. */ GetExitCodeThread(consolePtr->readThread, &exitCode); if (exitCode == STILL_ACTIVE) { - /* - * Set the stop event so that if the reader thread is blocked - * in ConsoleReaderThread on WaitForMultipleEvents, it will exit + * Set the stop event so that if the reader thread is blocked in + * ConsoleReaderThread on WaitForMultipleEvents, it will exit * cleanly. */ @@ -502,11 +540,10 @@ ConsoleCloseProc( if (WaitForSingleObject(consolePtr->readThread, 20) == WAIT_TIMEOUT) { /* - * Forcibly terminate the background thread as a last - * resort. Note that we need to guard against - * terminating the thread while it is in the middle of - * Tcl_ThreadAlert because it won't be able to release - * the notifier lock. + * Forcibly terminate the background thread as a last resort. + * Note that we need to guard against terminating the thread + * while it is in the middle of Tcl_ThreadAlert because it + * won't be able to release the notifier lock. */ Tcl_MutexLock(&consoleMutex); @@ -526,32 +563,33 @@ ConsoleCloseProc( consolePtr->validMask &= ~TCL_READABLE; /* - * Wait for the writer thread to finish the current buffer, then - * terminate the thread and close the handles. If the channel is - * nonblocking, there should be no pending write operations. + * Wait for the writer thread to finish the current buffer, then terminate + * the thread and close the handles. If the channel is nonblocking, there + * should be no pending write operations. */ - + if (consolePtr->writeThread) { if (consolePtr->toWrite) { /* - * We only need to wait if there is something to write. - * This may prevent infinite wait on exit. [python bug 216289] + * We only need to wait if there is something to write. This may + * prevent infinite wait on exit. [python bug 216289] */ + WaitForSingleObject(consolePtr->writable, INFINITE); } /* - * The thread may already have closed on it's own. Check it's - * exit code. + * The thread may already have closed on it's own. Check it's exit + * code. */ GetExitCodeThread(consolePtr->writeThread, &exitCode); if (exitCode == STILL_ACTIVE) { /* - * Set the stop event so that if the reader thread is blocked - * in ConsoleWriterThread on WaitForMultipleEvents, it will - * exit cleanly. + * Set the stop event so that if the reader thread is blocked in + * ConsoleWriterThread on WaitForMultipleEvents, it will exit + * cleanly. */ SetEvent(consolePtr->stopWriter); @@ -563,11 +601,10 @@ ConsoleCloseProc( if (WaitForSingleObject(consolePtr->writeThread, 20) == WAIT_TIMEOUT) { /* - * Forcibly terminate the background thread as a last - * resort. Note that we need to guard against - * terminating the thread while it is in the middle of - * Tcl_ThreadAlert because it won't be able to release - * the notifier lock. + * Forcibly terminate the background thread as a last resort. + * Note that we need to guard against terminating the thread + * while it is in the middle of Tcl_ThreadAlert because it + * won't be able to release the notifier lock. */ Tcl_MutexLock(&consoleMutex); @@ -588,12 +625,12 @@ ConsoleCloseProc( /* - * Don't close the Win32 handle if the handle is a standard channel - * during the thread exit process. Otherwise, one thread may kill - * the stdio of another. + * Don't close the Win32 handle if the handle is a standard channel during + * the thread exit process. Otherwise, one thread may kill the stdio of + * another. */ - if (!TclInThreadExit() + if (!TclInThreadExit() || ((GetStdHandle(STD_INPUT_HANDLE) != consolePtr->handle) && (GetStdHandle(STD_OUTPUT_HANDLE) != consolePtr->handle) && (GetStdHandle(STD_ERROR_HANDLE) != consolePtr->handle))) { @@ -602,7 +639,7 @@ ConsoleCloseProc( errorCode = errno; } } - + consolePtr->watchMask &= consolePtr->validMask; /* @@ -631,8 +668,8 @@ ConsoleCloseProc( * * ConsoleInputProc -- * - * Reads input from the IO channel into the buffer given. Returns - * count of how many bytes were actually read, and an error indication. + * Reads input from the IO channel into the buffer given. Returns count + * of how many bytes were actually read, and an error indication. * * Results: * A count of how many bytes were read is returned and an error @@ -646,11 +683,11 @@ ConsoleCloseProc( static int ConsoleInputProc( - ClientData instanceData, /* Console state. */ - char *buf, /* Where to store data read. */ - int bufSize, /* How much space is available - * in the buffer? */ - int *errorCode) /* Where to store error code. */ + ClientData instanceData, /* Console state. */ + char *buf, /* Where to store data read. */ + int bufSize, /* How much space is available in the + * buffer? */ + int *errorCode) /* Where to store error code. */ { ConsoleInfo *infoPtr = (ConsoleInfo *) instanceData; DWORD count, bytesRead = 0; @@ -661,13 +698,13 @@ ConsoleInputProc( /* * Synchronize with the reader thread. */ - + result = WaitForRead(infoPtr, (infoPtr->flags & CONSOLE_ASYNC) ? 0 : 1); - + /* * If an error occurred, return immediately. */ - + if (result == -1) { *errorCode = errno; return -1; @@ -689,22 +726,22 @@ ConsoleInputProc( /* * Reset the buffer */ - + infoPtr->readFlags &= ~CONSOLE_BUFFERED; infoPtr->offset = 0; } return bytesRead; } - + /* - * Attempt to read bufSize bytes. The read will return immediately - * if there is any data available. Otherwise it will block until - * at least one byte is available or an EOF occurs. + * Attempt to read bufSize bytes. The read will return immediately if + * there is any data available. Otherwise it will block until at least one + * byte is available or an EOF occurs. */ - if (ReadConsole(infoPtr->handle, (LPVOID) buf, (DWORD) bufSize, &count, - NULL) == TRUE) { + if (readConsoleBytes(infoPtr->handle, (LPVOID) buf, (DWORD) bufSize, &count) + == TRUE) { buf[count] = '\0'; return count; } @@ -717,12 +754,12 @@ ConsoleInputProc( * * ConsoleOutputProc -- * - * Writes the given output on the IO channel. Returns count of how - * many characters were actually written, and an error indication. + * Writes the given output on the IO channel. Returns count of how many + * characters were actually written, and an error indication. * * Results: - * A count of how many characters were written is returned and an - * error indication is returned in an output argument. + * A count of how many characters were written is returned and an error + * indication is returned in an output argument. * * Side effects: * Writes output on the actual channel. @@ -732,26 +769,26 @@ ConsoleInputProc( static int ConsoleOutputProc( - ClientData instanceData, /* Console state. */ - CONST char *buf, /* The data buffer. */ - int toWrite, /* How many bytes to write? */ - int *errorCode) /* Where to store error code. */ + ClientData instanceData, /* Console state. */ + CONST char *buf, /* The data buffer. */ + int toWrite, /* How many bytes to write? */ + int *errorCode) /* Where to store error code. */ { ConsoleInfo *infoPtr = (ConsoleInfo *) instanceData; DWORD bytesWritten, timeout; - + *errorCode = 0; timeout = (infoPtr->flags & CONSOLE_ASYNC) ? 0 : INFINITE; if (WaitForSingleObject(infoPtr->writable, timeout) == WAIT_TIMEOUT) { /* - * The writer thread is blocked waiting for a write to complete - * and the channel is in non-blocking mode. + * The writer thread is blocked waiting for a write to complete and + * the channel is in non-blocking mode. */ errno = EAGAIN; goto error; } - + /* * Check for a background error on the last write. */ @@ -777,31 +814,31 @@ ConsoleOutputProc( ckfree(infoPtr->writeBuf); } infoPtr->writeBufLen = toWrite; - infoPtr->writeBuf = ckalloc((unsigned int) toWrite); + infoPtr->writeBuf = ckalloc((size_t)toWrite); } - memcpy(infoPtr->writeBuf, buf, (size_t) toWrite); + memcpy(infoPtr->writeBuf, buf, (size_t)toWrite); infoPtr->toWrite = toWrite; ResetEvent(infoPtr->writable); SetEvent(infoPtr->startWriter); bytesWritten = toWrite; } else { /* - * In the blocking case, just try to write the buffer directly. - * This avoids an unnecessary copy. + * In the blocking case, just try to write the buffer directly. This + * avoids an unnecessary copy. */ - if (WriteFile(infoPtr->handle, (LPVOID) buf, (DWORD) toWrite, - &bytesWritten, (LPOVERLAPPED) NULL) == FALSE) { + if (writeConsoleBytes(infoPtr->handle, buf, (DWORD)toWrite, + &bytesWritten) + == FALSE) { TclWinConvertError(GetLastError()); goto error; } } return bytesWritten; - error: + error: *errorCode = errno; return -1; - } /* @@ -809,15 +846,15 @@ ConsoleOutputProc( * * ConsoleEventProc -- * - * This function is invoked by Tcl_ServiceEvent when a file event - * reaches the front of the event queue. This procedure invokes - * Tcl_NotifyChannel on the console. + * This function is invoked by Tcl_ServiceEvent when a file event reaches + * the front of the event queue. This procedure invokes Tcl_NotifyChannel + * on the console. * * Results: - * Returns 1 if the event was handled, meaning it should be removed - * from the queue. Returns 0 if the event was not handled, meaning - * it should stay on the queue. The only time the event isn't - * handled is if the TCL_FILE_EVENTS flag bit isn't set. + * Returns 1 if the event was handled, meaning it should be removed from + * the queue. Returns 0 if the event was not handled, meaning it should + * stay on the queue. The only time the event isn't handled is if the + * TCL_FILE_EVENTS flag bit isn't set. * * Side effects: * Whatever the notifier callback does. @@ -828,8 +865,8 @@ ConsoleOutputProc( static int ConsoleEventProc( Tcl_Event *evPtr, /* Event to service. */ - int flags) /* Flags that indicate what events to - * handle, such as TCL_FILE_EVENTS. */ + int flags) /* Flags that indicate what events to handle, + * such as TCL_FILE_EVENTS. */ { ConsoleEvent *consoleEvPtr = (ConsoleEvent *)evPtr; ConsoleInfo *infoPtr; @@ -842,9 +879,9 @@ ConsoleEventProc( /* * Search through the list of watched consoles for the one whose handle - * matches the event. We do this rather than simply dereferencing - * the handle in the event so that consoles can be deleted while the - * event is in the queue. + * matches the event. We do this rather than simply dereferencing the + * handle in the event so that consoles can be deleted while the event is + * in the queue. */ for (infoPtr = tsdPtr->firstConsolePtr; infoPtr != NULL; @@ -864,9 +901,9 @@ ConsoleEventProc( } /* - * Check to see if the console is readable. Note - * that we can't tell if a console is writable, so we always report it - * as being writable unless we have detected EOF. + * Check to see if the console is readable. Note that we can't tell if a + * console is writable, so we always report it as being writable unless we + * have detected EOF. */ mask = 0; @@ -883,7 +920,7 @@ ConsoleEventProc( } else { mask |= TCL_READABLE; } - } + } } /* @@ -899,8 +936,7 @@ ConsoleEventProc( * * ConsoleWatchProc -- * - * Called by the notifier to set up to watch for events on this - * channel. + * Called by the notifier to set up to watch for events on this channel. * * Results: * None. @@ -913,10 +949,10 @@ ConsoleEventProc( static void ConsoleWatchProc( - ClientData instanceData, /* Console state. */ - int mask) /* What events to watch for, OR-ed - * combination of TCL_READABLE, - * TCL_WRITABLE and TCL_EXCEPTION. */ + ClientData instanceData, /* Console state. */ + int mask) /* What events to watch for, OR-ed combination + * of TCL_READABLE, TCL_WRITABLE and + * TCL_EXCEPTION. */ { ConsoleInfo **nextPtrPtr, *ptr; ConsoleInfo *infoPtr = (ConsoleInfo *) instanceData; @@ -924,9 +960,8 @@ ConsoleWatchProc( ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); /* - * Since most of the work is handled by the background threads, - * we just need to update the watchMask and then force the notifier - * to poll once. + * Since most of the work is handled by the background threads, we just + * need to update the watchMask and then force the notifier to poll once. */ infoPtr->watchMask = mask & infoPtr->validMask; @@ -937,19 +972,17 @@ ConsoleWatchProc( tsdPtr->firstConsolePtr = infoPtr; } Tcl_SetMaxBlockTime(&blockTime); - } else { - if (oldMask) { - /* - * Remove the console from the list of watched consoles. - */ + } else if (oldMask) { + /* + * Remove the console from the list of watched consoles. + */ - for (nextPtrPtr = &(tsdPtr->firstConsolePtr), ptr = *nextPtrPtr; - ptr != NULL; - nextPtrPtr = &ptr->nextPtr, ptr = *nextPtrPtr) { - if (infoPtr == ptr) { - *nextPtrPtr = ptr->nextPtr; - break; - } + for (nextPtrPtr = &(tsdPtr->firstConsolePtr), ptr = *nextPtrPtr; + ptr != NULL; + nextPtrPtr = &ptr->nextPtr, ptr = *nextPtrPtr) { + if (infoPtr == ptr) { + *nextPtrPtr = ptr->nextPtr; + break; } } } @@ -960,12 +993,12 @@ ConsoleWatchProc( * * ConsoleGetHandleProc -- * - * Called from Tcl_GetChannelHandle to retrieve OS handles from - * inside a command consoleline based channel. + * Called from Tcl_GetChannelHandle to retrieve OS handles from inside a + * command consoleline based channel. * * Results: - * Returns TCL_OK with the fd in handlePtr, or TCL_ERROR if - * there is no handle for the specified direction. + * Returns TCL_OK with the fd in handlePtr, or TCL_ERROR if there is no + * handle for the specified direction. * * Side effects: * None. @@ -977,7 +1010,7 @@ static int ConsoleGetHandleProc( ClientData instanceData, /* The console state. */ int direction, /* TCL_READABLE or TCL_WRITABLE */ - ClientData *handlePtr) /* Where to store the handle. */ + ClientData *handlePtr) /* Where to store the handle. */ { ConsoleInfo *infoPtr = (ConsoleInfo *) instanceData; @@ -990,69 +1023,68 @@ ConsoleGetHandleProc( * * WaitForRead -- * - * Wait until some data is available, the console is at - * EOF or the reader thread is blocked waiting for data (if the - * channel is in non-blocking mode). + * Wait until some data is available, the console is at EOF or the reader + * thread is blocked waiting for data (if the channel is in non-blocking + * mode). * * Results: - * Returns 1 if console is readable. Returns 0 if there is no data - * on the console, but there is buffered data. Returns -1 if an - * error occurred. If an error occurred, the threads may not - * be synchronized. + * Returns 1 if console is readable. Returns 0 if there is no data on the + * console, but there is buffered data. Returns -1 if an error occurred. + * If an error occurred, the threads may not be synchronized. * * Side effects: - * Updates the shared state flags. If no error occurred, - * the reader thread is blocked waiting for a signal from the - * main thread. + * Updates the shared state flags. If no error occurred, the reader + * thread is blocked waiting for a signal from the main thread. * *---------------------------------------------------------------------- */ static int WaitForRead( - ConsoleInfo *infoPtr, /* Console state. */ - int blocking) /* Indicates whether call should be - * blocking or not. */ + ConsoleInfo *infoPtr, /* Console state. */ + int blocking) /* Indicates whether call should be blocking + * or not. */ { DWORD timeout, count; HANDLE *handle = infoPtr->handle; INPUT_RECORD input; - + while (1) { /* * Synchronize with the reader thread. */ - + timeout = blocking ? INFINITE : 0; if (WaitForSingleObject(infoPtr->readable, timeout) == WAIT_TIMEOUT) { /* * The reader thread is blocked waiting for data and the channel * is in non-blocking mode. */ + errno = EAGAIN; return -1; } - + /* - * At this point, the two threads are synchronized, so it is safe - * to access shared state. + * At this point, the two threads are synchronized, so it is safe to + * access shared state. */ - + /* * If the console has hit EOF, it is always readable. */ - + if (infoPtr->readFlags & CONSOLE_EOF) { return 1; } - + if (PeekConsoleInput(handle, &input, 1, &count) == FALSE) { - /* + /* * Check to see if the peek failed because of EOF. */ - + TclWinConvertError(GetLastError()); - + if (errno == EOF) { infoPtr->readFlags |= CONSOLE_EOF; return 1; @@ -1061,7 +1093,7 @@ WaitForRead( /* * Ignore errors if there is data in the buffer. */ - + if (infoPtr->readFlags & CONSOLE_BUFFERED) { return 0; } else { @@ -1070,20 +1102,18 @@ WaitForRead( } /* - * If there is data in the buffer, the console must be - * readable (since it is a line-oriented device). + * If there is data in the buffer, the console must be readable (since + * it is a line-oriented device). */ if (infoPtr->readFlags & CONSOLE_BUFFERED) { return 1; } - /* - * There wasn't any data available, so reset the thread and - * try again. + * There wasn't any data available, so reset the thread and try again. */ - + ResetEvent(infoPtr->readable); SetEvent(infoPtr->startReader); } @@ -1094,22 +1124,23 @@ WaitForRead( * * ConsoleReaderThread -- * - * This function runs in a separate thread and waits for input - * to become available on a console. + * This function runs in a separate thread and waits for input to become + * available on a console. * * Results: * None. * * Side effects: - * Signals the main thread when input become available. May - * cause the main thread to wake up by posting a message. May - * one line from the console for each wait operation. + * Signals the main thread when input become available. May cause the + * main thread to wake up by posting a message. May one line from the + * console for each wait operation. * *---------------------------------------------------------------------- */ static DWORD WINAPI -ConsoleReaderThread(LPVOID arg) +ConsoleReaderThread( + LPVOID arg) { ConsoleInfo *infoPtr = (ConsoleInfo *)arg; HANDLE *handle = infoPtr->handle; @@ -1129,49 +1160,53 @@ ConsoleReaderThread(LPVOID arg) if (waitResult != (WAIT_OBJECT_0 + 1)) { /* - * The start event was not signaled. It must be the stop event - * or an error, so exit this thread. + * The start event was not signaled. It must be the stop event or + * an error, so exit this thread. */ break; } - /* - * Look for data on the console, but first ignore any events - * that are not KEY_EVENTs + /* + * Look for data on the console, but first ignore any events that are + * not KEY_EVENTs. */ - if (ReadConsoleA(handle, infoPtr->buffer, CONSOLE_BUFFER_SIZE, - (LPDWORD) &infoPtr->bytesRead, NULL) != FALSE) { + + if (readConsoleBytes(handle, infoPtr->buffer, CONSOLE_BUFFER_SIZE, + (LPDWORD) &infoPtr->bytesRead) != FALSE) { /* * Data was stored in the buffer. */ - + infoPtr->readFlags |= CONSOLE_BUFFERED; } else { DWORD err; err = GetLastError(); - - if (err == EOF) { + + if (err == (DWORD)EOF) { infoPtr->readFlags = CONSOLE_EOF; } } /* - * Signal the main thread by signalling the readable event and - * then waking up the notifier thread. + * Signal the main thread by signalling the readable event and then + * waking up the notifier thread. */ SetEvent(infoPtr->readable); /* - * Alert the foreground thread. Note that we need to treat this like - * a critical section so the foreground thread does not terminate - * this thread while we are holding a mutex in the notifier code. + * Alert the foreground thread. Note that we need to treat this like a + * critical section so the foreground thread does not terminate this + * thread while we are holding a mutex in the notifier code. */ Tcl_MutexLock(&consoleMutex); if (infoPtr->threadId != NULL) { - /* TIP #218. When in flight ignore the event, no one will receive it anyway */ + /* + * TIP #218. When in flight ignore the event, no one will receive + * it anyway. + */ Tcl_ThreadAlert(infoPtr->threadId); } Tcl_MutexUnlock(&consoleMutex); @@ -1185,21 +1220,23 @@ ConsoleReaderThread(LPVOID arg) * * ConsoleWriterThread -- * - * This function runs in a separate thread and writes data - * onto a console. + * This function runs in a separate thread and writes data onto a + * console. * * Results: * Always returns 0. * * Side effects: - * Signals the main thread when an output operation is completed. - * May cause the main thread to wake up by posting a message. + + * Signals the main thread when an output operation is completed. May + * cause the main thread to wake up by posting a message. * *---------------------------------------------------------------------- */ static DWORD WINAPI -ConsoleWriterThread(LPVOID arg) +ConsoleWriterThread( + LPVOID arg) { ConsoleInfo *infoPtr = (ConsoleInfo *)arg; @@ -1221,8 +1258,8 @@ ConsoleWriterThread(LPVOID arg) if (waitResult != (WAIT_OBJECT_0 + 1)) { /* - * The start event was not signaled. It must be the stop event - * or an error, so exit this thread. + * The start event was not signaled. It must be the stop event or + * an error, so exit this thread. */ break; @@ -1236,7 +1273,8 @@ ConsoleWriterThread(LPVOID arg) */ while (toWrite > 0) { - if (WriteConsoleA(handle, buf, toWrite, &count, NULL) == FALSE) { + if (writeConsoleBytes(handle, buf, (DWORD)toWrite, + &count) == FALSE) { infoPtr->writeError = GetLastError(); break; } else { @@ -1246,21 +1284,25 @@ ConsoleWriterThread(LPVOID arg) } /* - * Signal the main thread by signalling the writable event and - * then waking up the notifier thread. + * Signal the main thread by signalling the writable event and then + * waking up the notifier thread. */ - + SetEvent(infoPtr->writable); /* - * Alert the foreground thread. Note that we need to treat this like - * a critical section so the foreground thread does not terminate - * this thread while we are holding a mutex in the notifier code. + * Alert the foreground thread. Note that we need to treat this like a + * critical section so the foreground thread does not terminate this + * thread while we are holding a mutex in the notifier code. */ Tcl_MutexLock(&consoleMutex); if (infoPtr->threadId != NULL) { - /* TIP #218. When in flight ignore the event, no one will receive it anyway */ + /* + * TIP #218. When in flight ignore the event, no one will receive + * it anyway. + */ + Tcl_ThreadAlert(infoPtr->threadId); } Tcl_MutexUnlock(&consoleMutex); @@ -1268,8 +1310,6 @@ ConsoleWriterThread(LPVOID arg) return 0; } - - /* *---------------------------------------------------------------------- @@ -1277,8 +1317,8 @@ ConsoleWriterThread(LPVOID arg) * TclWinOpenConsoleChannel -- * * Constructs a Console channel for the specified standard OS handle. - * This is a helper function to break up the construction of - * channels into File, Console, or Serial. + * This is a helper function to break up the construction of channels + * into File, Console, or Serial. * * Results: * Returns the new channel, or NULL. @@ -1290,10 +1330,10 @@ ConsoleWriterThread(LPVOID arg) */ Tcl_Channel -TclWinOpenConsoleChannel(handle, channelName, permissions) - HANDLE handle; - char *channelName; - int permissions; +TclWinOpenConsoleChannel( + HANDLE handle, + char *channelName, + int permissions) { char encoding[4 + TCL_INTEGER_SPACE]; ConsoleInfo *infoPtr; @@ -1304,7 +1344,7 @@ TclWinOpenConsoleChannel(handle, channelName, permissions) /* * See if a channel with this handle already exists. */ - + infoPtr = (ConsoleInfo *) ckalloc((unsigned) sizeof(ConsoleInfo)); memset(infoPtr, 0, sizeof(ConsoleInfo)); @@ -1317,23 +1357,23 @@ TclWinOpenConsoleChannel(handle, channelName, permissions) infoPtr->threadId = Tcl_GetCurrentThread(); /* - * Use the pointer for the name of the result channel. - * This keeps the channel names unique, since some may share - * handles (stdin/stdout/stderr for instance). + * Use the pointer for the name of the result channel. This keeps the + * channel names unique, since some may share handles (stdin/stdout/stderr + * for instance). */ - wsprintfA(channelName, "file%lx", (int) infoPtr); - + wsprintfA(channelName, "file%lx", PTR2INT(infoPtr)); + infoPtr->channel = Tcl_CreateChannel(&consoleChannelType, channelName, - (ClientData) infoPtr, permissions); + (ClientData) infoPtr, permissions); if (permissions & TCL_READABLE) { /* * Make sure the console input buffer is ready for only character - * input notifications and the buffer is set for line buffering. - * IOW, we only want to catch when complete lines are ready for - * reading. + * input notifications and the buffer is set for line buffering. IOW, + * we only want to catch when complete lines are ready for reading. */ + GetConsoleMode(infoPtr->handle, &modes); modes &= ~(ENABLE_WINDOW_INPUT | ENABLE_MOUSE_INPUT); modes |= ENABLE_LINE_INPUT; @@ -1343,7 +1383,7 @@ TclWinOpenConsoleChannel(handle, channelName, permissions) infoPtr->startReader = CreateEvent(NULL, FALSE, FALSE, NULL); infoPtr->stopReader = CreateEvent(NULL, FALSE, FALSE, NULL); infoPtr->readThread = CreateThread(NULL, 256, ConsoleReaderThread, - infoPtr, 0, &id); + infoPtr, 0, &id); SetThreadPriority(infoPtr->readThread, THREAD_PRIORITY_HIGHEST); } @@ -1352,18 +1392,21 @@ TclWinOpenConsoleChannel(handle, channelName, permissions) infoPtr->startWriter = CreateEvent(NULL, FALSE, FALSE, NULL); infoPtr->stopWriter = CreateEvent(NULL, FALSE, FALSE, NULL); infoPtr->writeThread = CreateThread(NULL, 256, ConsoleWriterThread, - infoPtr, 0, &id); + infoPtr, 0, &id); SetThreadPriority(infoPtr->writeThread, THREAD_PRIORITY_HIGHEST); } /* - * Files have default translation of AUTO and ^Z eof char, which - * means that a ^Z will be accepted as EOF when reading. + * Files have default translation of AUTO and ^Z eof char, which means + * that a ^Z will be accepted as EOF when reading. */ - + Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto"); Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "\032 {}"); - Tcl_SetChannelOption(NULL, infoPtr->channel, "-encoding", encoding); + if (tclWinProcs->useWide) + Tcl_SetChannelOption(NULL, infoPtr->channel, "-encoding", "unicode"); + else + Tcl_SetChannelOption(NULL, infoPtr->channel, "-encoding", encoding); return infoPtr->channel; } @@ -1385,33 +1428,42 @@ TclWinOpenConsoleChannel(handle, channelName, permissions) */ static void -ConsoleThreadActionProc (instanceData, action) - ClientData instanceData; - int action; +ConsoleThreadActionProc( + ClientData instanceData, + int action) { ConsoleInfo *infoPtr = (ConsoleInfo *) instanceData; - /* We do not access firstConsolePtr in the thread structures. This is - * not for all serials managed by the thread, but only those we are - * watching. Removal of the filevent handlers before transfer thus - * takes care of this structure. + /* We do not access firstConsolePtr in the thread structures. This is not + * for all serials managed by the thread, but only those we are watching. + * Removal of the filevent handlers before transfer thus takes care of + * this structure. */ Tcl_MutexLock(&consoleMutex); if (action == TCL_CHANNEL_THREAD_INSERT) { - /* We can't copy the thread information from the channel when - * the channel is created. At this time the channel back - * pointer has not been set yet. However in that case the - * threadId has already been set by TclpCreateCommandChannel - * itself, so the structure is still good. + /* + * We can't copy the thread information from the channel when the + * channel is created. At this time the channel back pointer has not + * been set yet. However in that case the threadId has already been + * set by TclpCreateCommandChannel itself, so the structure is still + * good. */ - ConsoleInit (); - if (infoPtr->channel != NULL) { - infoPtr->threadId = Tcl_GetChannelThread (infoPtr->channel); + ConsoleInit(); + if (infoPtr->channel != NULL) { + infoPtr->threadId = Tcl_GetChannelThread(infoPtr->channel); } } else { infoPtr->threadId = NULL; } Tcl_MutexUnlock(&consoleMutex); } + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ diff --git a/win/tclWinDde.c b/win/tclWinDde.c index d180878..9f39b37 100644 --- a/win/tclWinDde.c +++ b/win/tclWinDde.c @@ -1,31 +1,30 @@ -/* +/* * tclWinDde.c -- * - * This file provides procedures that implement the "send" - * command, allowing commands to be passed from interpreter - * to interpreter. + * This file provides functions that implement the "send" command, + * allowing commands to be passed from interpreter to interpreter. * * Copyright (c) 1997 by Sun Microsystems, Inc. * - * See the file "license.terms" for information on usage and redistribution - * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ -#include "tclPort.h" +#include "tclInt.h" #include <dde.h> #include <ddeml.h> -#include <tchar.h> /* - * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the - * Registry_Init declaration is in the source file itself, which is only - * accessed when we are building a library. + * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the Dde_Init + * declaration is in the source file itself, which is only accessed when we + * are building a library. DO NOT MOVE BEFORE ANY #include LINES. ONLY USE + * EXTERN TO INDICATE EXPORTED FUNCTIONS FROM NOW ON. */ #undef TCL_STORAGE_CLASS #define TCL_STORAGE_CLASS DLLEXPORT -/* +/* * The following structure is used to keep track of the interpreters * registered by this process. */ @@ -35,6 +34,7 @@ typedef struct RegisteredInterp { /* The next interp this application knows * about. */ char *name; /* Interpreter's name (malloc-ed). */ + Tcl_Obj *handlerPtr; /* The server handler command */ Tcl_Interp *interp; /* The interpreter attached to this name. */ } RegisteredInterp; @@ -50,64 +50,77 @@ typedef struct Conversation { Tcl_Obj *returnPackagePtr; /* The result package for this conversation. */ } Conversation; +typedef struct DdeEnumServices { + Tcl_Interp *interp; + int result; + ATOM service; + ATOM topic; + HWND hwnd; +} DdeEnumServices; + typedef struct ThreadSpecificData { Conversation *currentConversations; - /* A list of conversations currently - * being processed. */ + /* A list of conversations currently being + * processed. */ RegisteredInterp *interpListPtr; - /* List of all interpreters registered - * in the current process. */ + /* List of all interpreters registered in the + * current process. */ } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; /* - * The following variables cannot be placed in thread-local storage. - * The Mutex ddeMutex guards access to the ddeInstance. + * The following variables cannot be placed in thread-local storage. The Mutex + * ddeMutex guards access to the ddeInstance. */ + static HSZ ddeServiceGlobal = 0; -static DWORD ddeInstance; /* The application instance handle given - * to us by DdeInitialize. */ +static DWORD ddeInstance; /* The application instance handle given to us + * by DdeInitialize. */ static int ddeIsServer = 0; -#define TCL_DDE_VERSION "1.2.4" -#define TCL_DDE_PACKAGE_NAME "dde" -#define TCL_DDE_SERVICE_NAME "TclEval" +#define TCL_DDE_VERSION "1.3.2" +#define TCL_DDE_PACKAGE_NAME "dde" +#define TCL_DDE_SERVICE_NAME "TclEval" +#define TCL_DDE_EXECUTE_RESULT "$TCLEVAL$EXECUTE$RESULT" TCL_DECLARE_MUTEX(ddeMutex) /* - * Forward declarations for procedures defined later in this file. + * Forward declarations for functions defined later in this file. */ -static void DdeExitProc _ANSI_ARGS_((ClientData clientData)); -static void DeleteProc _ANSI_ARGS_((ClientData clientData)); -static Tcl_Obj * ExecuteRemoteObject _ANSI_ARGS_(( - RegisteredInterp *riPtr, - Tcl_Obj *ddeObjectPtr)); -static int MakeDdeConnection _ANSI_ARGS_((Tcl_Interp *interp, - char *name, HCONV *ddeConvPtr)); -static HDDEDATA CALLBACK DdeServerProc _ANSI_ARGS_((UINT uType, - UINT uFmt, HCONV hConv, HSZ ddeTopic, - HSZ ddeItem, HDDEDATA hData, DWORD dwData1, - DWORD dwData2)); -static void SetDdeError _ANSI_ARGS_((Tcl_Interp *interp)); -static int DdeGetServicesList _ANSI_ARGS_(( - Tcl_Interp *interp, - char *serviceName, - char *topicName)); -int Tcl_DdeObjCmd(ClientData clientData, /* Used only for deletion */ - Tcl_Interp *interp, /* The interp we are sending from */ - int objc, /* Number of arguments */ - Tcl_Obj *CONST objv[]); /* The arguments */ - -EXTERN int Dde_Init(Tcl_Interp *interp); +static LRESULT CALLBACK DdeClientWindowProc(HWND hwnd, UINT uMsg, + WPARAM wParam, LPARAM lParam); +static int DdeCreateClient(struct DdeEnumServices *es); +static BOOL CALLBACK DdeEnumWindowsCallback(HWND hwndTarget, LPARAM lParam); +static void DdeExitProc(ClientData clientData); +static int DdeGetServicesList(Tcl_Interp *interp, + char *serviceName, char *topicName); +static HDDEDATA CALLBACK DdeServerProc(UINT uType, UINT uFmt, HCONV hConv, + HSZ ddeTopic, HSZ ddeItem, HDDEDATA hData, + DWORD dwData1, DWORD dwData2); +static LRESULT DdeServicesOnAck(HWND hwnd, WPARAM wParam, + LPARAM lParam); +static void DeleteProc(ClientData clientData); +static Tcl_Obj * ExecuteRemoteObject(RegisteredInterp *riPtr, + Tcl_Obj *ddeObjectPtr); +static int MakeDdeConnection(Tcl_Interp *interp, char *name, + HCONV *ddeConvPtr); +static void SetDdeError(Tcl_Interp *interp); + +int Tcl_DdeObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[]); + +EXTERN int Dde_Init(Tcl_Interp *interp); +EXTERN int Dde_SafeInit(Tcl_Interp *interp); /* *---------------------------------------------------------------------- * * Dde_Init -- * - * This procedure initializes the dde command. + * This function initializes the dde command. * * Results: * A standard Tcl result. @@ -127,15 +140,40 @@ Dde_Init( } Tcl_CreateObjCommand(interp, "dde", Tcl_DdeObjCmd, NULL, NULL); - Tcl_CreateExitHandler(DdeExitProc, NULL); - return Tcl_PkgProvide(interp, TCL_DDE_PACKAGE_NAME, TCL_DDE_VERSION); } /* *---------------------------------------------------------------------- * + * Dde_SafeInit -- + * + * This function initializes the dde command within a safe interp + * + * Results: + * A standard Tcl result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +int +Dde_SafeInit( + Tcl_Interp *interp) +{ + int result = Dde_Init(interp); + if (result == TCL_OK) { + Tcl_HideCommand(interp, "dde", "dde"); + } + return result; +} + +/* + *---------------------------------------------------------------------- + * * Initialize -- * * Initialize the global DDE instance. @@ -154,11 +192,11 @@ Initialize(void) { int nameFound = 0; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - + /* - * See if the application is already registered; if so, remove its - * current name from the registry. The deletion of the command - * will take care of disposing of this entry. + * See if the application is already registered; if so, remove its current + * name from the registry. The deletion of the command will take care of + * disposing of this entry. */ if (tsdPtr->interpListPtr != NULL) { @@ -166,18 +204,16 @@ Initialize(void) } /* - * Make sure that the DDE server is there. This is done only once, - * add an exit handler tear it down. + * Make sure that the DDE server is there. This is done only once, add an + * exit handler tear it down. */ if (ddeInstance == 0) { Tcl_MutexLock(&ddeMutex); if (ddeInstance == 0) { if (DdeInitialize(&ddeInstance, (PFNCALLBACK) DdeServerProc, - CBF_SKIP_REGISTRATIONS - | CBF_SKIP_UNREGISTRATIONS - | CBF_FAIL_POKES, 0) - != DMLERR_NO_ERROR) { + CBF_SKIP_REGISTRATIONS | CBF_SKIP_UNREGISTRATIONS + | CBF_FAIL_POKES, 0) != DMLERR_NO_ERROR) { ddeInstance = 0; } } @@ -188,7 +224,7 @@ Initialize(void) if ((ddeServiceGlobal == 0) && (nameFound != 0)) { ddeIsServer = 1; Tcl_CreateExitHandler(DdeExitProc, NULL); - ddeServiceGlobal = DdeCreateStringHandle(ddeInstance, \ + ddeServiceGlobal = DdeCreateStringHandle(ddeInstance, TCL_DDE_SERVICE_NAME, 0); DdeNameService(ddeInstance, ddeServiceGlobal, 0L, DNS_REGISTER); } else { @@ -196,53 +232,58 @@ Initialize(void) } Tcl_MutexUnlock(&ddeMutex); } -} +} /* - *-------------------------------------------------------------- + *---------------------------------------------------------------------- * * DdeSetServerName -- * - * This procedure is called to associate an ASCII name with a Dde - * server. If the interpreter has already been named, the - * name replaces the old one. + * This function is called to associate an ASCII name with a Dde server. + * If the interpreter has already been named, the name replaces the old + * one. * * Results: - * The return value is the name actually given to the interp. - * This will normally be the same as name, but if name was already - * in use for a Dde Server then a name of the form "name #2" will - * be chosen, with a high enough number to make the name unique. + * The return value is the name actually given to the interp. This will + * normally be the same as name, but if name was already in use for a Dde + * Server then a name of the form "name #2" will be chosen, with a high + * enough number to make the name unique. * * Side effects: - * Registration info is saved, thereby allowing the "send" command - * to be used later to invoke commands in the application. In - * addition, the "send" command is created in the application's - * interpreter. The registration will be removed automatically - * if the interpreter is deleted or the "send" command is removed. + * Registration info is saved, thereby allowing the "send" command to be + * used later to invoke commands in the application. In addition, the + * "send" command is created in the application's interpreter. The + * registration will be removed automatically if the interpreter is + * deleted or the "send" command is removed. * - *-------------------------------------------------------------- + *---------------------------------------------------------------------- */ static char * DdeSetServerName( Tcl_Interp *interp, - char *name /* The name that will be used to - * refer to the interpreter in later - * "send" commands. Must be globally - * unique. */ - ) + char *name, /* The name that will be used to refer to the + * interpreter in later "send" commands. Must + * be globally unique. */ + int exactName, /* Should we make a unique name? 0 = unique */ + Tcl_Obj *handlerPtr) /* Name of the optional proc/command to handle + * incoming Dde eval's */ { + int suffix, offset; RegisteredInterp *riPtr, *prevPtr; Tcl_DString dString; + char *actualName; + Tcl_Obj *srvListPtr = NULL, **srvPtrPtr = NULL; + int n, srvCount = 0, lastSuffix, r = TCL_OK; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); /* - * See if the application is already registered; if so, remove its - * current name from the registry. The deletion of the command - * will take care of disposing of this entry. + * See if the application is already registered; if so, remove its current + * name from the registry. The deletion of the command will take care of + * disposing of this entry. */ - for (riPtr = tsdPtr->interpListPtr, prevPtr = NULL; riPtr != NULL; + for (riPtr = tsdPtr->interpListPtr, prevPtr = NULL; riPtr != NULL; prevPtr = riPtr, riPtr = riPtr->nextPtr) { if (riPtr->interp == interp) { if (name != NULL) { @@ -254,8 +295,8 @@ DdeSetServerName( break; } else { /* - * the name was NULL, so the caller is asking for - * the name of the current interp. + * The name was NULL, so the caller is asking for the name of + * the current interp. */ return riPtr->name; @@ -265,22 +306,74 @@ DdeSetServerName( if (name == NULL) { /* - * the name was NULL, so the caller is asking for - * the name of the current interp, but it doesn't - * have a name. + * The name was NULL, so the caller is asking for the name of the + * current interp, but it doesn't have a name. */ return ""; } - + /* - * Pick a name to use for the application. Use "name" if it's not - * already in use. Otherwise add a suffix such as " #2", trying - * larger and larger numbers until we eventually find one that is - * unique. + * Get the list of currently registered Tcl interpreters by calling the + * internal implementation of the 'dde services' command. */ Tcl_DStringInit(&dString); + actualName = name; + + if (!exactName) { + r = DdeGetServicesList(interp, TCL_DDE_SERVICE_NAME, NULL); + if (r == TCL_OK) { + srvListPtr = Tcl_GetObjResult(interp); + } + if (r == TCL_OK) { + r = Tcl_ListObjGetElements(interp, srvListPtr, &srvCount, + &srvPtrPtr); + } + if (r != TCL_OK) { + OutputDebugString(Tcl_GetStringResult(interp)); + return NULL; + } + + /* + * Pick a name to use for the application. Use "name" if it's not + * already in use. Otherwise add a suffix such as " #2", trying larger + * and larger numbers until we eventually find one that is unique. + */ + + offset = lastSuffix = 0; + suffix = 1; + + while (suffix != lastSuffix) { + lastSuffix = suffix; + if (suffix > 1) { + if (suffix == 2) { + Tcl_DStringAppend(&dString, name, -1); + Tcl_DStringAppend(&dString, " #", 2); + offset = Tcl_DStringLength(&dString); + Tcl_DStringSetLength(&dString, offset + TCL_INTEGER_SPACE); + actualName = Tcl_DStringValue(&dString); + } + sprintf(Tcl_DStringValue(&dString) + offset, "%d", suffix); + } + + /* + * See if the name is already in use, if so increment suffix. + */ + + for (n = 0; n < srvCount; ++n) { + Tcl_Obj* namePtr; + + Tcl_ListObjIndex(interp, srvPtrPtr[n], 1, &namePtr); + if (strcmp(actualName, Tcl_GetString(namePtr)) == 0) { + suffix++; + break; + } + } + } + Tcl_DStringSetLength(&dString, + offset + (int)strlen(Tcl_DStringValue(&dString)+offset)); + } /* * We have found a unique name. Now add it to the registry. @@ -288,10 +381,18 @@ DdeSetServerName( riPtr = (RegisteredInterp *) ckalloc(sizeof(RegisteredInterp)); riPtr->interp = interp; - riPtr->name = ckalloc((unsigned int) strlen(name) + 1); + riPtr->name = ckalloc((unsigned int) strlen(actualName) + 1); riPtr->nextPtr = tsdPtr->interpListPtr; + riPtr->handlerPtr = handlerPtr; + if (riPtr->handlerPtr != NULL) { + Tcl_IncrRefCount(riPtr->handlerPtr); + } tsdPtr->interpListPtr = riPtr; - strcpy(riPtr->name, name); + strcpy(riPtr->name, actualName); + + if (Tcl_IsSafe(interp)) { + Tcl_ExposeCommand(interp, "dde", "dde"); + } Tcl_CreateObjCommand(interp, "dde", Tcl_DdeObjCmd, (ClientData) riPtr, DeleteProc); @@ -301,19 +402,52 @@ DdeSetServerName( Tcl_DStringFree(&dString); /* - * re-initialize with the new name + * Re-initialize with the new name. */ + Initialize(); - + return riPtr->name; } /* - *-------------------------------------------------------------- + *---------------------------------------------------------------------- + * + * DdeGetRegistrationPtr + * + * Retrieve the registration info for an interpreter. + * + * Results: + * Returns a pointer to the registration structure or NULL + * + * Side effects: + * None + * + *---------------------------------------------------------------------- + */ + +static RegisteredInterp * +DdeGetRegistrationPtr( + Tcl_Interp *interp) +{ + RegisteredInterp *riPtr; + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + + for (riPtr = tsdPtr->interpListPtr; riPtr != NULL; + riPtr = riPtr->nextPtr) { + if (riPtr->interp == interp) { + break; + } + } + return riPtr; +} + +/* + *---------------------------------------------------------------------- * * DeleteProc * - * This procedure is called when the command "dde" is destroyed. + * This function is called when the command "dde" is destroyed. * * Results: * none @@ -321,20 +455,20 @@ DdeSetServerName( * Side effects: * The interpreter given by riPtr is unregistered. * - *-------------------------------------------------------------- + *---------------------------------------------------------------------- */ static void -DeleteProc(clientData) - ClientData clientData; /* The interp we are deleting passed - * as ClientData. */ +DeleteProc( + ClientData clientData) /* The interp we are deleting passed as + * ClientData. */ { RegisteredInterp *riPtr = (RegisteredInterp *) clientData; RegisteredInterp *searchPtr, *prevPtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); for (searchPtr = tsdPtr->interpListPtr, prevPtr = NULL; - (searchPtr != NULL) && (searchPtr != riPtr); + searchPtr != NULL && searchPtr != riPtr; prevPtr = searchPtr, searchPtr = searchPtr->nextPtr) { /* * Empty loop body. @@ -349,31 +483,33 @@ DeleteProc(clientData) } } ckfree(riPtr->name); + if (riPtr->handlerPtr) { + Tcl_DecrRefCount(riPtr->handlerPtr); + } Tcl_EventuallyFree(clientData, TCL_DYNAMIC); } /* - *-------------------------------------------------------------- + *---------------------------------------------------------------------- * * ExecuteRemoteObject -- * - * Takes the package delivered by DDE and executes it in - * the server's interpreter. + * Takes the package delivered by DDE and executes it in the server's + * interpreter. * * Results: - * A list Tcl_Obj * that describes what happened. The first - * element is the numerical return code (TCL_ERROR, etc.). - * The second element is the result of the script. If the - * return result was TCL_ERROR, then the third element - * will be the value of the global "errorCode", and the - * fourth will be the value of the global "errorInfo". - * The return result will have a refCount of 0. + * A list Tcl_Obj * that describes what happened. The first element is + * the numerical return code (TCL_ERROR, etc.). The second element is the + * result of the script. If the return result was TCL_ERROR, then the + * third element will be the value of the global "errorCode", and the + * fourth will be the value of the global "errorInfo". The return result + * will have a refCount of 0. * * Side effects: - * A Tcl script is run, which can cause all kinds of other - * things to happen. + * A Tcl script is run, which can cause all kinds of other things to + * happen. * - *-------------------------------------------------------------- + *---------------------------------------------------------------------- */ static Tcl_Obj * @@ -381,63 +517,86 @@ ExecuteRemoteObject( RegisteredInterp *riPtr, /* Info about this server. */ Tcl_Obj *ddeObjectPtr) /* The object to execute. */ { - Tcl_Obj *errorObjPtr; Tcl_Obj *returnPackagePtr; - int result; + int result = TCL_OK; - result = Tcl_EvalObjEx(riPtr->interp, ddeObjectPtr, TCL_EVAL_GLOBAL); - returnPackagePtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL); - Tcl_ListObjAppendElement(NULL, returnPackagePtr, - Tcl_NewIntObj(result)); + if (riPtr->handlerPtr == NULL && Tcl_IsSafe(riPtr->interp)) { + Tcl_SetObjResult(riPtr->interp, Tcl_NewStringObj("permission denied: " + "a handler procedure must be defined for use in a safe " + "interp", -1)); + result = TCL_ERROR; + } + + if (riPtr->handlerPtr != NULL) { + /* + * Add the dde request data to the handler proc list. + */ + + Tcl_Obj *cmdPtr = Tcl_DuplicateObj(riPtr->handlerPtr); + + result = Tcl_ListObjAppendElement(riPtr->interp, cmdPtr, ddeObjectPtr); + if (result == TCL_OK) { + ddeObjectPtr = cmdPtr; + } + } + + if (result == TCL_OK) { + result = Tcl_EvalObjEx(riPtr->interp, ddeObjectPtr, TCL_EVAL_GLOBAL); + } + + returnPackagePtr = Tcl_NewListObj(0, NULL); + + Tcl_ListObjAppendElement(NULL, returnPackagePtr, Tcl_NewIntObj(result)); Tcl_ListObjAppendElement(NULL, returnPackagePtr, Tcl_GetObjResult(riPtr->interp)); + if (result == TCL_ERROR) { - errorObjPtr = Tcl_GetVar2Ex(riPtr->interp, "errorCode", NULL, + Tcl_Obj *errorObjPtr = Tcl_GetVar2Ex(riPtr->interp, "errorCode", NULL, TCL_GLOBAL_ONLY); - Tcl_ListObjAppendElement(NULL, returnPackagePtr, errorObjPtr); + if (errorObjPtr) { + Tcl_ListObjAppendElement(NULL, returnPackagePtr, errorObjPtr); + } errorObjPtr = Tcl_GetVar2Ex(riPtr->interp, "errorInfo", NULL, TCL_GLOBAL_ONLY); - Tcl_ListObjAppendElement(NULL, returnPackagePtr, errorObjPtr); + if (errorObjPtr) { + Tcl_ListObjAppendElement(NULL, returnPackagePtr, errorObjPtr); + } } return returnPackagePtr; } /* - *-------------------------------------------------------------- + *---------------------------------------------------------------------- * * DdeServerProc -- * - * Handles all transactions for this server. Can handle - * execute, request, and connect protocols. Dde will - * call this routine when a client attempts to run a dde - * command using this server. + * Handles all transactions for this server. Can handle execute, request, + * and connect protocols. Dde will call this routine when a client + * attempts to run a dde command using this server. * * Results: * A DDE Handle with the result of the dde command. * * Side effects: - * Depending on which command is executed, arbitrary - * Tcl scripts can be run. + * Depending on which command is executed, arbitrary Tcl scripts can be + * run. * - *-------------------------------------------------------------- + *---------------------------------------------------------------------- */ static HDDEDATA CALLBACK -DdeServerProc ( - UINT uType, /* The type of DDE transaction we - * are performing. */ - UINT uFmt, /* The format that data is sent or - * received. */ - HCONV hConv, /* The conversation associated with the +DdeServerProc( + UINT uType, /* The type of DDE transaction we are + * performing. */ + UINT uFmt, /* The format that data is sent or received. */ + HCONV hConv, /* The conversation associated with the * current transaction. */ - HSZ ddeTopic, /* A string handle. Transaction-type - * dependent. */ - HSZ ddeItem, /* A string handle. Transaction-type + HSZ ddeTopic, HSZ ddeItem, /* String handles. Transaction-type * dependent. */ HDDEDATA hData, /* DDE data. Transaction-type dependent. */ - DWORD dwData1, /* Transaction-dependent data. */ - DWORD dwData2) /* Transaction-dependent data. */ + DWORD dwData1, DWORD dwData2) + /* Transaction-dependent data. */ { Tcl_DString dString; int len; @@ -450,129 +609,125 @@ DdeServerProc ( ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); switch(uType) { - case XTYP_CONNECT: - - /* - * Dde is trying to initialize a conversation with us. Check - * and make sure we have a valid topic. - */ + case XTYP_CONNECT: + /* + * Dde is trying to initialize a conversation with us. Check and make + * sure we have a valid topic. + */ - len = DdeQueryString(ddeInstance, ddeTopic, NULL, 0, 0); - Tcl_DStringInit(&dString); - Tcl_DStringSetLength(&dString, len); - utilString = Tcl_DStringValue(&dString); - DdeQueryString(ddeInstance, ddeTopic, utilString, (DWORD) len + 1, - CP_WINANSI); + len = DdeQueryString(ddeInstance, ddeTopic, NULL, 0, 0); + Tcl_DStringInit(&dString); + Tcl_DStringSetLength(&dString, len); + utilString = Tcl_DStringValue(&dString); + DdeQueryString(ddeInstance, ddeTopic, utilString, (DWORD) len + 1, + CP_WINANSI); - for (riPtr = tsdPtr->interpListPtr; riPtr != NULL; - riPtr = riPtr->nextPtr) { - if (stricmp(utilString, riPtr->name) == 0) { - Tcl_DStringFree(&dString); - return (HDDEDATA) TRUE; - } + for (riPtr = tsdPtr->interpListPtr; riPtr != NULL; + riPtr = riPtr->nextPtr) { + if (stricmp(utilString, riPtr->name) == 0) { + Tcl_DStringFree(&dString); + return (HDDEDATA) TRUE; } + } - Tcl_DStringFree(&dString); - return (HDDEDATA) FALSE; - - case XTYP_CONNECT_CONFIRM: + Tcl_DStringFree(&dString); + return (HDDEDATA) FALSE; - /* - * Dde has decided that we can connect, so it gives us a - * conversation handle. We need to keep track of it - * so we know which execution result to return in an - * XTYP_REQUEST. - */ + case XTYP_CONNECT_CONFIRM: + /* + * Dde has decided that we can connect, so it gives us a conversation + * handle. We need to keep track of it so we know which execution + * result to return in an XTYP_REQUEST. + */ - len = DdeQueryString(ddeInstance, ddeTopic, NULL, 0, 0); - Tcl_DStringInit(&dString); - Tcl_DStringSetLength(&dString, len); - utilString = Tcl_DStringValue(&dString); - DdeQueryString(ddeInstance, ddeTopic, utilString, (DWORD) len + 1, - CP_WINANSI); - for (riPtr = tsdPtr->interpListPtr; riPtr != NULL; - riPtr = riPtr->nextPtr) { - if (stricmp(riPtr->name, utilString) == 0) { - convPtr = (Conversation *) ckalloc(sizeof(Conversation)); - convPtr->nextPtr = tsdPtr->currentConversations; - convPtr->returnPackagePtr = NULL; - convPtr->hConv = hConv; - convPtr->riPtr = riPtr; - tsdPtr->currentConversations = convPtr; - break; - } + len = DdeQueryString(ddeInstance, ddeTopic, NULL, 0, 0); + Tcl_DStringInit(&dString); + Tcl_DStringSetLength(&dString, len); + utilString = Tcl_DStringValue(&dString); + DdeQueryString(ddeInstance, ddeTopic, utilString, (DWORD) len + 1, + CP_WINANSI); + for (riPtr = tsdPtr->interpListPtr; riPtr != NULL; + riPtr = riPtr->nextPtr) { + if (stricmp(riPtr->name, utilString) == 0) { + convPtr = (Conversation *) ckalloc(sizeof(Conversation)); + convPtr->nextPtr = tsdPtr->currentConversations; + convPtr->returnPackagePtr = NULL; + convPtr->hConv = hConv; + convPtr->riPtr = riPtr; + tsdPtr->currentConversations = convPtr; + break; } - Tcl_DStringFree(&dString); - return (HDDEDATA) TRUE; - - case XTYP_DISCONNECT: + } + Tcl_DStringFree(&dString); + return (HDDEDATA) TRUE; - /* - * The client has disconnected from our server. Forget this - * conversation. - */ + case XTYP_DISCONNECT: + /* + * The client has disconnected from our server. Forget this + * conversation. + */ - for (convPtr = tsdPtr->currentConversations, prevConvPtr = NULL; - convPtr != NULL; - prevConvPtr = convPtr, convPtr = convPtr->nextPtr) { - if (hConv == convPtr->hConv) { - if (prevConvPtr == NULL) { - tsdPtr->currentConversations = convPtr->nextPtr; - } else { - prevConvPtr->nextPtr = convPtr->nextPtr; - } - if (convPtr->returnPackagePtr != NULL) { - Tcl_DecrRefCount(convPtr->returnPackagePtr); - } - ckfree((char *) convPtr); - break; + for (convPtr = tsdPtr->currentConversations, prevConvPtr = NULL; + convPtr != NULL; + prevConvPtr = convPtr, convPtr = convPtr->nextPtr) { + if (hConv == convPtr->hConv) { + if (prevConvPtr == NULL) { + tsdPtr->currentConversations = convPtr->nextPtr; + } else { + prevConvPtr->nextPtr = convPtr->nextPtr; } + if (convPtr->returnPackagePtr != NULL) { + Tcl_DecrRefCount(convPtr->returnPackagePtr); + } + ckfree((char *) convPtr); + break; } - return (HDDEDATA) TRUE; + } + return (HDDEDATA) TRUE; - case XTYP_REQUEST: + case XTYP_REQUEST: + /* + * This could be either a request for a value of a Tcl variable, or it + * could be the send command requesting the results of the last + * execute. + */ + + if (uFmt != CF_TEXT) { + return (HDDEDATA) FALSE; + } + ddeReturn = (HDDEDATA) FALSE; + for (convPtr = tsdPtr->currentConversations; (convPtr != NULL) + && (convPtr->hConv != hConv); convPtr = convPtr->nextPtr) { /* - * This could be either a request for a value of a Tcl variable, - * or it could be the send command requesting the results of the - * last execute. + * Empty loop body. */ + } - if (uFmt != CF_TEXT) { - return (HDDEDATA) FALSE; - } + if (convPtr != NULL) { + BYTE *returnString; - ddeReturn = (HDDEDATA) FALSE; - for (convPtr = tsdPtr->currentConversations; (convPtr != NULL) - && (convPtr->hConv != hConv); convPtr = convPtr->nextPtr) { - /* - * Empty loop body. - */ - } - - if (convPtr != NULL) { - BYTE *returnString; - - len = DdeQueryString(ddeInstance, ddeItem, NULL, 0, - CP_WINANSI); - Tcl_DStringInit(&dString); - Tcl_DStringSetLength(&dString, len); - utilString = Tcl_DStringValue(&dString); - DdeQueryString(ddeInstance, ddeItem, utilString, - (DWORD) len + 1, CP_WINANSI); - if (stricmp(utilString, "$TCLEVAL$EXECUTE$RESULT") == 0) { - returnString = - (BYTE *)Tcl_GetStringFromObj(convPtr->returnPackagePtr, &len); - ddeReturn = DdeCreateDataHandle(ddeInstance, - returnString, (DWORD) len+1, 0, ddeItem, CF_TEXT, - 0); + len = DdeQueryString(ddeInstance, ddeItem, NULL, 0, CP_WINANSI); + Tcl_DStringInit(&dString); + Tcl_DStringSetLength(&dString, len); + utilString = Tcl_DStringValue(&dString); + DdeQueryString(ddeInstance, ddeItem, utilString, (DWORD) len + 1, + CP_WINANSI); + if (stricmp(utilString, TCL_DDE_EXECUTE_RESULT) == 0) { + returnString = (BYTE *) + Tcl_GetStringFromObj(convPtr->returnPackagePtr, &len); + ddeReturn = DdeCreateDataHandle(ddeInstance, returnString, + (DWORD) len+1, 0, ddeItem, CF_TEXT, 0); + } else { + if (Tcl_IsSafe(convPtr->riPtr->interp)) { + ddeReturn = NULL; } else { Tcl_Obj *variableObjPtr = Tcl_GetVar2Ex( - convPtr->riPtr->interp, utilString, NULL, + convPtr->riPtr->interp, utilString, NULL, TCL_GLOBAL_ONLY); if (variableObjPtr != NULL) { - returnString = (BYTE *)Tcl_GetStringFromObj(variableObjPtr, - &len); + returnString = (BYTE *) Tcl_GetStringFromObj( + variableObjPtr, &len); ddeReturn = DdeCreateDataHandle(ddeInstance, returnString, (DWORD) len+1, 0, ddeItem, CF_TEXT, 0); @@ -580,106 +735,101 @@ DdeServerProc ( ddeReturn = NULL; } } - Tcl_DStringFree(&dString); } - return ddeReturn; + Tcl_DStringFree(&dString); + } + return ddeReturn; - case XTYP_EXECUTE: { + case XTYP_EXECUTE: { + /* + * Execute this script. The results will be saved into a list object + * which will be retreived later. See ExecuteRemoteObject. + */ + Tcl_Obj *returnPackagePtr; + + for (convPtr = tsdPtr->currentConversations; (convPtr != NULL) + && (convPtr->hConv != hConv); convPtr = convPtr->nextPtr) { /* - * Execute this script. The results will be saved into - * a list object which will be retreived later. See - * ExecuteRemoteObject. + * Empty loop body. */ + } - Tcl_Obj *returnPackagePtr; - - for (convPtr = tsdPtr->currentConversations; (convPtr != NULL) - && (convPtr->hConv != hConv); convPtr = convPtr->nextPtr) { - /* - * Empty loop body. - */ - - } - - if (convPtr == NULL) { - return (HDDEDATA) DDE_FNOTPROCESSED; - } - - utilString = (char *) DdeAccessData(hData, &dlen); - len = dlen; - ddeObjectPtr = Tcl_NewStringObj(utilString, -1); - Tcl_IncrRefCount(ddeObjectPtr); - DdeUnaccessData(hData); - if (convPtr->returnPackagePtr != NULL) { - Tcl_DecrRefCount(convPtr->returnPackagePtr); - } - convPtr->returnPackagePtr = NULL; - returnPackagePtr = - ExecuteRemoteObject(convPtr->riPtr, ddeObjectPtr); - Tcl_IncrRefCount(returnPackagePtr); - for (convPtr = tsdPtr->currentConversations; (convPtr != NULL) - && (convPtr->hConv != hConv); convPtr = convPtr->nextPtr) { - /* - * Empty loop body. - */ - - } - if (convPtr != NULL) { - convPtr->returnPackagePtr = returnPackagePtr; - } else { - Tcl_DecrRefCount(returnPackagePtr); - } - Tcl_DecrRefCount(ddeObjectPtr); - if (returnPackagePtr == NULL) { - return (HDDEDATA) DDE_FNOTPROCESSED; - } else { - return (HDDEDATA) DDE_FACK; - } + if (convPtr == NULL) { + return (HDDEDATA) DDE_FNOTPROCESSED; } - - case XTYP_WILDCONNECT: { + utilString = (char *) DdeAccessData(hData, &dlen); + len = dlen; + ddeObjectPtr = Tcl_NewStringObj(utilString, -1); + Tcl_IncrRefCount(ddeObjectPtr); + DdeUnaccessData(hData); + if (convPtr->returnPackagePtr != NULL) { + Tcl_DecrRefCount(convPtr->returnPackagePtr); + } + convPtr->returnPackagePtr = NULL; + returnPackagePtr = ExecuteRemoteObject(convPtr->riPtr, ddeObjectPtr); + Tcl_IncrRefCount(returnPackagePtr); + for (convPtr = tsdPtr->currentConversations; (convPtr != NULL) + && (convPtr->hConv != hConv); convPtr = convPtr->nextPtr) { /* - * Dde wants a list of services and topics that we support. + * Empty loop body. */ + } + if (convPtr != NULL) { + convPtr->returnPackagePtr = returnPackagePtr; + } else { + Tcl_DecrRefCount(returnPackagePtr); + } + Tcl_DecrRefCount(ddeObjectPtr); + if (returnPackagePtr == NULL) { + return (HDDEDATA) DDE_FNOTPROCESSED; + } else { + return (HDDEDATA) DDE_FACK; + } + } - HSZPAIR *returnPtr; - int i; - int numItems; + case XTYP_WILDCONNECT: { + /* + * Dde wants a list of services and topics that we support. + */ - for (i = 0, riPtr = tsdPtr->interpListPtr; riPtr != NULL; - i++, riPtr = riPtr->nextPtr) { - /* - * Empty loop body. - */ + HSZPAIR *returnPtr; + int i; + int numItems; - } + for (i = 0, riPtr = tsdPtr->interpListPtr; riPtr != NULL; + i++, riPtr = riPtr->nextPtr) { + /* + * Empty loop body. + */ + } - numItems = i; - ddeReturn = DdeCreateDataHandle(ddeInstance, NULL, - (numItems + 1) * sizeof(HSZPAIR), 0, 0, 0, 0); - returnPtr = (HSZPAIR *) DdeAccessData(ddeReturn, &dlen); - len = dlen; - for (i = 0, riPtr = tsdPtr->interpListPtr; i < numItems; - i++, riPtr = riPtr->nextPtr) { - returnPtr[i].hszSvc = DdeCreateStringHandle( - ddeInstance, "TclEval", CP_WINANSI); - returnPtr[i].hszTopic = DdeCreateStringHandle( - ddeInstance, riPtr->name, CP_WINANSI); - } - returnPtr[i].hszSvc = NULL; - returnPtr[i].hszTopic = NULL; - DdeUnaccessData(ddeReturn); - return ddeReturn; + numItems = i; + ddeReturn = DdeCreateDataHandle(ddeInstance, NULL, + (numItems + 1) * sizeof(HSZPAIR), 0, 0, 0, 0); + returnPtr = (HSZPAIR *) DdeAccessData(ddeReturn, &dlen); + len = dlen; + for (i = 0, riPtr = tsdPtr->interpListPtr; i < numItems; + i++, riPtr = riPtr->nextPtr) { + returnPtr[i].hszSvc = DdeCreateStringHandle(ddeInstance, + TCL_DDE_SERVICE_NAME, CP_WINANSI); + returnPtr[i].hszTopic = DdeCreateStringHandle(ddeInstance, + riPtr->name, CP_WINANSI); } + returnPtr[i].hszSvc = NULL; + returnPtr[i].hszTopic = NULL; + DdeUnaccessData(ddeReturn); + return ddeReturn; + } + default: + return NULL; } - return NULL; } /* - *-------------------------------------------------------------- + *---------------------------------------------------------------------- * * DdeExitProc -- * @@ -691,7 +841,7 @@ DdeServerProc ( * Side effects: * The DDE server is deleted. * - *-------------------------------------------------------------- + *---------------------------------------------------------------------- */ static void @@ -704,21 +854,20 @@ DdeExitProc( } /* - *-------------------------------------------------------------- + *---------------------------------------------------------------------- * * MakeDdeConnection -- * - * This procedure is a utility used to connect to a DDE - * server when given a server name and a topic name. + * This function is a utility used to connect to a DDE server when given + * a server name and a topic name. * * Results: * A standard Tcl result. - * * * Side effects: * Passes back a conversation through ddeConvPtr * - *-------------------------------------------------------------- + *---------------------------------------------------------------------- */ static int @@ -729,9 +878,9 @@ MakeDdeConnection( { HSZ ddeTopic, ddeService; HCONV ddeConv; - - ddeService = DdeCreateStringHandle(ddeInstance, "TclEval", 0); - ddeTopic = DdeCreateStringHandle(ddeInstance, name, 0); + + ddeService = DdeCreateStringHandle(ddeInstance, TCL_DDE_SERVICE_NAME, 0); + ddeTopic = DdeCreateStringHandle(ddeInstance, (void *) name, 0); ddeConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL); DdeFreeStringHandle(ddeInstance, ddeService); @@ -740,7 +889,7 @@ MakeDdeConnection( if (ddeConv == (HCONV) NULL) { if (interp != NULL) { Tcl_AppendResult(interp, "no registered server named \"", - name, "\"", (char *) NULL); + name, "\"", NULL); } return TCL_ERROR; } @@ -750,14 +899,15 @@ MakeDdeConnection( } /* - *-------------------------------------------------------------- + *---------------------------------------------------------------------- * * DdeGetServicesList -- * - * This procedure obtains the list of DDE services. + * This function obtains the list of DDE services. * - * The functions between here and this procedure are all - * involved with handling the DDE callbacks for this. + * The functions between here and this function are all involved with + * handling the DDE callbacks for this. They are: DdeCreateClient, + * DdeClientWindowProc, DdeServicesOnAck, and DdeEnumWindowsCallback * * Results: * A standard Tcl result. @@ -765,24 +915,12 @@ MakeDdeConnection( * Side effects: * Sets the services list into the interp result. * - *-------------------------------------------------------------- + *---------------------------------------------------------------------- */ -typedef struct ddeEnumServices { - Tcl_Interp *interp; - int result; - ATOM service; - ATOM topic; - HWND hwnd; -} ddeEnumServices; - -LRESULT CALLBACK -DdeClientWindowProc(HWND hwnd, UINT uMsg, WPARAM wParam, LPARAM lParam); -static LRESULT -DdeServicesOnAck(HWND hwnd, WPARAM wParam, LPARAM lParam); - static int -DdeCreateClient(ddeEnumServices *es) +DdeCreateClient( + struct DdeEnumServices *es) { WNDCLASSEX wc; static const char *szDdeClientClassName = "TclEval client class"; @@ -792,176 +930,196 @@ DdeCreateClient(ddeEnumServices *es) wc.cbSize = sizeof(wc); wc.lpfnWndProc = DdeClientWindowProc; wc.lpszClassName = szDdeClientClassName; - wc.cbWndExtra = sizeof(ddeEnumServices*); + wc.cbWndExtra = sizeof(struct DdeEnumServices *); + + /* + * Register and create the callback window. + */ - /* register and create the callback window */ RegisterClassEx(&wc); - es->hwnd = CreateWindowEx(0, szDdeClientClassName, - szDdeClientWindowName, - WS_POPUP, 0, 0, 0, 0, NULL, NULL, NULL, - (LPVOID)es); + es->hwnd = CreateWindowEx(0, szDdeClientClassName, szDdeClientWindowName, + WS_POPUP, 0, 0, 0, 0, NULL, NULL, NULL, (LPVOID)es); return TCL_OK; } -LRESULT CALLBACK -DdeClientWindowProc(HWND hwnd, UINT uMsg, WPARAM wParam, LPARAM lParam) +static LRESULT CALLBACK +DdeClientWindowProc( + HWND hwnd, /* What window is the message for */ + UINT uMsg, /* The type of message received */ + WPARAM wParam, + LPARAM lParam) /* (Potentially) our local handle */ { - LRESULT lr = 0L; switch (uMsg) { - case WM_CREATE: { - LPCREATESTRUCT lpcs = (LPCREATESTRUCT)lParam; - ddeEnumServices *es; - es = (ddeEnumServices*)lpcs->lpCreateParams; + case WM_CREATE: { + LPCREATESTRUCT lpcs = (LPCREATESTRUCT) lParam; + struct DdeEnumServices *es = + (struct DdeEnumServices *) lpcs->lpCreateParams; + #ifdef _WIN64 - SetWindowLongPtr(hwnd, GWLP_USERDATA, (long)es); + SetWindowLongPtr(hwnd, GWLP_USERDATA, (LONG_PTR) es); #else - SetWindowLong(hwnd, GWL_USERDATA, (long)es); + SetWindowLong(hwnd, GWL_USERDATA, (long)es); #endif - break; - } - case WM_DDE_ACK: - lr = DdeServicesOnAck(hwnd, wParam, lParam); - break; - default: - lr = DefWindowProc(hwnd, uMsg, wParam, lParam); + return (LRESULT) 0L; + } + case WM_DDE_ACK: + return DdeServicesOnAck(hwnd, wParam, lParam); + break; + default: + return DefWindowProc(hwnd, uMsg, wParam, lParam); } - return lr; } static LRESULT -DdeServicesOnAck(HWND hwnd, WPARAM wParam, LPARAM lParam) +DdeServicesOnAck( + HWND hwnd, + WPARAM wParam, + LPARAM lParam) { HWND hwndRemote = (HWND)wParam; ATOM service = (ATOM)LOWORD(lParam); ATOM topic = (ATOM)HIWORD(lParam); - ddeEnumServices *es; - TCHAR sz[255]; + struct DdeEnumServices *es; + char sz[255]; #ifdef _WIN64 - es = (ddeEnumServices *)GetWindowLongPtr(hwnd, GWLP_USERDATA); + es = (struct DdeEnumServices *) GetWindowLongPtr(hwnd, GWLP_USERDATA); #else - es = (ddeEnumServices *)GetWindowLong(hwnd, GWL_USERDATA); + es = (struct DdeEnumServices *) GetWindowLong(hwnd, GWL_USERDATA); #endif if ((es->service == (ATOM)0 || es->service == service) - && (es->topic == (ATOM)0 || es->topic == topic)) { + && (es->topic == (ATOM)0 || es->topic == topic)) { Tcl_Obj *matchPtr = Tcl_NewListObj(0, NULL); + Tcl_Obj *resultPtr = Tcl_GetObjResult(es->interp); + + GlobalGetAtomNameA(service, sz, 255); + Tcl_ListObjAppendElement(NULL, matchPtr, Tcl_NewStringObj(sz, -1)); + GlobalGetAtomNameA(topic, sz, 255); + Tcl_ListObjAppendElement(NULL, matchPtr, Tcl_NewStringObj(sz, -1)); - GlobalGetAtomName(service, sz, 255); - Tcl_ListObjAppendElement(es->interp, matchPtr, - Tcl_NewStringObj(sz, -1)); - GlobalGetAtomName(topic, sz, 255); - Tcl_ListObjAppendElement(es->interp, matchPtr, - Tcl_NewStringObj(sz, -1)); - /* Adding the hwnd as a third list element provides a unique + /* + * Adding the hwnd as a third list element provides a unique * identifier in the case of multiple servers with the name * application and topic names. */ - /* Needs a TIP though - * Tcl_ListObjAppendElement(es->interp, matchPtr, + /* + * Needs a TIP though: + * Tcl_ListObjAppendElement(NULL, matchPtr, * Tcl_NewLongObj((long)hwndRemote)); */ - Tcl_ListObjAppendElement(es->interp, - Tcl_GetObjResult(es->interp), matchPtr); + + if (Tcl_IsShared(resultPtr)) { + resultPtr = Tcl_DuplicateObj(resultPtr); + } + if (Tcl_ListObjAppendElement(es->interp, resultPtr, + matchPtr) == TCL_OK) { + Tcl_SetObjResult(es->interp, resultPtr); + } } - /* tell the server we are no longer interested */ + /* + * Tell the server we are no longer interested. + */ + PostMessage(hwndRemote, WM_DDE_TERMINATE, (WPARAM)hwnd, 0L); return 0L; } - + static BOOL CALLBACK -DdeEnumWindowsCallback(HWND hwndTarget, LPARAM lParam) +DdeEnumWindowsCallback( + HWND hwndTarget, + LPARAM lParam) { DWORD_PTR dwResult = 0; - ddeEnumServices *es = (ddeEnumServices *)lParam; - SendMessageTimeout(hwndTarget, WM_DDE_INITIATE, - (WPARAM)es->hwnd, - MAKELONG(es->service, es->topic), - SMTO_ABORTIFHUNG, 1000, &dwResult); + struct DdeEnumServices *es = (struct DdeEnumServices *) lParam; + + SendMessageTimeout(hwndTarget, WM_DDE_INITIATE, (WPARAM)es->hwnd, + MAKELONG(es->service, es->topic), SMTO_ABORTIFHUNG, 1000, + &dwResult); return TRUE; } - + static int -DdeGetServicesList(Tcl_Interp *interp, char *serviceName, char *topicName) +DdeGetServicesList( + Tcl_Interp *interp, + char *serviceName, + char *topicName) { - ddeEnumServices es; + struct DdeEnumServices es; + es.interp = interp; es.result = TCL_OK; es.service = (serviceName == NULL) - ? (ATOM)0 : GlobalAddAtom(serviceName); - es.topic = (topicName == NULL) - ? (ATOM)0 : GlobalAddAtom(topicName); - + ? (ATOM)0 : GlobalAddAtom(serviceName); + es.topic = (topicName == NULL) ? (ATOM)0 : GlobalAddAtom(topicName); + Tcl_ResetResult(interp); /* our list is to be appended to result. */ DdeCreateClient(&es); EnumWindows(DdeEnumWindowsCallback, (LPARAM)&es); - - if (IsWindow(es.hwnd)) - DestroyWindow(es.hwnd); - if (es.service != (ATOM)0) + + if (IsWindow(es.hwnd)) { + DestroyWindow(es.hwnd); + } + if (es.service != (ATOM)0) { GlobalDeleteAtom(es.service); - if (es.topic != (ATOM)0) + } + if (es.topic != (ATOM)0) { GlobalDeleteAtom(es.topic); + } return es.result; } /* - *-------------------------------------------------------------- + *---------------------------------------------------------------------- * * SetDdeError -- * - * Sets the interp result to a cogent error message - * describing the last DDE error. + * Sets the interp result to a cogent error message describing the last + * DDE error. * * Results: * None. - * * * Side effects: * The interp's result object is changed. * - *-------------------------------------------------------------- + *---------------------------------------------------------------------- */ static void SetDdeError( - Tcl_Interp *interp) /* The interp to put the message in.*/ + Tcl_Interp *interp) /* The interp to put the message in. */ { - Tcl_Obj *resultPtr = Tcl_GetObjResult(interp); - int err; - - err = DdeGetLastError(ddeInstance); - switch (err) { - case DMLERR_DATAACKTIMEOUT: - case DMLERR_EXECACKTIMEOUT: - case DMLERR_POKEACKTIMEOUT: - Tcl_SetStringObj(resultPtr, - "remote interpreter did not respond", -1); - break; - - case DMLERR_BUSY: - Tcl_SetStringObj(resultPtr, "remote server is busy", -1); - break; - - case DMLERR_NOTPROCESSED: - Tcl_SetStringObj(resultPtr, - "remote server cannot handle this command", -1); - break; - - default: - Tcl_SetStringObj(resultPtr, "dde command failed", -1); + char *errorMessage; + + switch (DdeGetLastError(ddeInstance)) { + case DMLERR_DATAACKTIMEOUT: + case DMLERR_EXECACKTIMEOUT: + case DMLERR_POKEACKTIMEOUT: + errorMessage = "remote interpreter did not respond"; + break; + case DMLERR_BUSY: + errorMessage = "remote server is busy"; + break; + case DMLERR_NOTPROCESSED: + errorMessage = "remote server cannot handle this command"; + break; + default: + errorMessage = "dde command failed"; } + + Tcl_SetObjResult(interp, Tcl_NewStringObj(errorMessage, -1)); } /* - *-------------------------------------------------------------- + *---------------------------------------------------------------------- * * Tcl_DdeObjCmd -- * - * This procedure is invoked to process the "dde" Tcl command. - * See the user documentation for details on what it does. + * This function is invoked to process the "dde" Tcl command. See the + * user documentation for details on what it does. * * Results: * A standard Tcl result. @@ -969,7 +1127,7 @@ SetDdeError( * Side effects: * See the user documentation. * - *-------------------------------------------------------------- + *---------------------------------------------------------------------- */ int @@ -977,49 +1135,45 @@ Tcl_DdeObjCmd( ClientData clientData, /* Used only for deletion */ Tcl_Interp *interp, /* The interp we are sending from */ int objc, /* Number of arguments */ - Tcl_Obj *CONST *objv) /* The arguments */ + Tcl_Obj *CONST * objv) /* The arguments */ { - enum { - DDE_SERVERNAME, - DDE_EXECUTE, - DDE_POKE, - DDE_REQUEST, - DDE_SERVICES, + static CONST char *ddeCommands[] = { + "servername", "execute", "poke", "request", "services", "eval", + (char *) NULL + }; + enum DdeSubcommands { + DDE_SERVERNAME, DDE_EXECUTE, DDE_POKE, DDE_REQUEST, DDE_SERVICES, DDE_EVAL }; + static CONST char *ddeSrvOptions[] = { + "-force", "-handler", "--", NULL + }; + enum DdeSrvOptions { + DDE_SERVERNAME_EXACT, DDE_SERVERNAME_HANDLER, DDE_SERVERNAME_LAST, + }; + static CONST char *ddeExecOptions[] = { + "-async", NULL + }; + static CONST char *ddeReqOptions[] = { + "-binary", NULL + }; - static CONST char *ddeCommands[] = {"servername", "execute", "poke", - "request", "services", "eval", - (char *) NULL}; - static CONST char *ddeOptions[] = {"-async", (char *) NULL}; - static CONST char *ddeReqOptions[] = {"-binary", (char *) NULL}; - int index, argIndex; - int async = 0, binary = 0; - int result = TCL_OK; - HSZ ddeService = NULL; - HSZ ddeTopic = NULL; - HSZ ddeItem = NULL; - HDDEDATA ddeData = NULL; - HDDEDATA ddeItemData = NULL; + int index, i, length; + int async = 0, binary = 0, exact = 0; + int result = TCL_OK, firstArg = 0; + HSZ ddeService = NULL, ddeTopic = NULL, ddeItem = NULL, ddeCookie = NULL; + HDDEDATA ddeData = NULL, ddeItemData = NULL, ddeReturn; HCONV hConv = NULL; - HSZ ddeCookie = 0; - char *serviceName, *topicName = NULL, *itemString; - char *string; - int firstArg = 0, length, dataLength; + char *serviceName = NULL, *topicName = NULL, *string; DWORD ddeResult; - HDDEDATA ddeReturn; - RegisteredInterp *riPtr; - Tcl_Interp *sendInterp; - Tcl_Obj *objPtr; - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + Tcl_Obj *objPtr, *handlerPtr = NULL; /* * Initialize DDE server/client */ - + if (objc < 2) { - Tcl_WrongNumArgs(interp, 1, objv, - "?-async? serviceName topicName value"); + Tcl_WrongNumArgs(interp, 1, objv, "command ?arg ...?"); return TCL_ERROR; } @@ -1028,105 +1182,124 @@ Tcl_DdeObjCmd( return TCL_ERROR; } - switch (index) { - case DDE_SERVERNAME: - if ((objc != 3) && (objc != 2)) { - Tcl_WrongNumArgs(interp, 1, objv, "servername ?serverName?"); - return TCL_ERROR; - } - firstArg = (objc - 1); - break; - case DDE_EXECUTE: - if ((objc < 5) || (objc > 6)) { - Tcl_WrongNumArgs(interp, 1, objv, - "execute ?-async? serviceName topicName value"); - return TCL_ERROR; - } - if (Tcl_GetIndexFromObj(NULL, objv[2], ddeOptions, "option", 0, - &argIndex) != TCL_OK) { - if (objc != 5) { - Tcl_WrongNumArgs(interp, 1, objv, - "execute ?-async? serviceName topicName value"); + switch ((enum DdeSubcommands) index) { + case DDE_SERVERNAME: + for (i = 2; i < objc; i++) { + int argIndex; + if (Tcl_GetIndexFromObj(interp, objv[i], ddeSrvOptions, + "option", 0, &argIndex) != TCL_OK) { + /* + * If it is the last argument, it might be a server name + * instead of a bad argument. + */ + + if (i != objc-1) { return TCL_ERROR; } - async = 0; - firstArg = 2; - } else { - if (objc != 6) { - Tcl_WrongNumArgs(interp, 1, objv, - "execute ?-async? serviceName topicName value"); - return TCL_ERROR; + Tcl_ResetResult(interp); + break; + } + if (argIndex == DDE_SERVERNAME_EXACT) { + exact = 1; + } else if (argIndex == DDE_SERVERNAME_HANDLER) { + if ((objc - i) == 1) { /* return current handler */ + RegisteredInterp *riPtr = DdeGetRegistrationPtr(interp); + + if (riPtr && riPtr->handlerPtr) { + Tcl_SetObjResult(interp, riPtr->handlerPtr); + } else { + Tcl_ResetResult(interp); + } + return TCL_OK; } - async = 1; - firstArg = 3; + handlerPtr = objv[++i]; + } else if (argIndex == DDE_SERVERNAME_LAST) { + i++; + break; } + } + + if ((objc - i) > 1) { + Tcl_ResetResult(interp); + Tcl_WrongNumArgs(interp, 2, objv, + "?-force? ?-handler proc? ?--? ?serverName?"); + return TCL_ERROR; + } + + firstArg = (objc == i) ? 1 : i; + break; + case DDE_EXECUTE: + if (objc == 5) { + firstArg = 2; break; - case DDE_POKE: - if (objc != 6) { - Tcl_WrongNumArgs(interp, 1, objv, - "poke serviceName topicName item value"); - return TCL_ERROR; + } else if (objc == 6) { + int dummy; + if (Tcl_GetIndexFromObj(NULL, objv[2], ddeExecOptions, "option", 0, + &dummy) == TCL_OK) { + async = 1; + firstArg = 3; + break; } + } + /* otherwise... */ + Tcl_WrongNumArgs(interp, 2, objv, + "?-async? serviceName topicName value"); + return TCL_ERROR; + case DDE_POKE: + if (objc != 6) { + Tcl_WrongNumArgs(interp, 2, objv, + "serviceName topicName item value"); + return TCL_ERROR; + } + firstArg = 2; + break; + case DDE_REQUEST: + if (objc == 5) { firstArg = 2; break; - case DDE_REQUEST: - if ((objc < 5) || (objc > 6)) { - Tcl_WrongNumArgs(interp, 1, objv, - "request ?-binary? serviceName topicName value"); - return TCL_ERROR; - } + } else if (objc == 6) { + int dummy; if (Tcl_GetIndexFromObj(NULL, objv[2], ddeReqOptions, "option", 0, - &argIndex) != TCL_OK) { - if (objc != 5) { - Tcl_WrongNumArgs(interp, 1, objv, - "request ?-binary? serviceName topicName value"); - return TCL_ERROR; - } - binary = 0; - firstArg = 2; - } else { - if (objc != 6) { - Tcl_WrongNumArgs(interp, 1, objv, - "request ?-binary? serviceName topicName value"); - return TCL_ERROR; - } + &dummy) == TCL_OK) { binary = 1; firstArg = 3; + break; } - break; - case DDE_SERVICES: - if (objc != 4) { - Tcl_WrongNumArgs(interp, 1, objv, - "services serviceName topicName"); - return TCL_ERROR; - } + } + + /* + * Otherwise ... + */ + + Tcl_WrongNumArgs(interp, 2, objv, + "?-binary? serviceName topicName value"); + return TCL_ERROR; + case DDE_SERVICES: + if (objc != 4) { + Tcl_WrongNumArgs(interp, 2, objv, "serviceName topicName"); + return TCL_ERROR; + } + firstArg = 2; + break; + case DDE_EVAL: + if (objc < 4) { + wrongDdeEvalArgs: + Tcl_WrongNumArgs(interp, 2, objv, "?-async? serviceName args"); + return TCL_ERROR; + } else { + int dummy; + firstArg = 2; - break; - case DDE_EVAL: - if (objc < 4) { - Tcl_WrongNumArgs(interp, 1, objv, - "eval ?-async? serviceName args"); - return TCL_ERROR; - } - if (Tcl_GetIndexFromObj(NULL, objv[2], ddeOptions, "option", 0, - &argIndex) != TCL_OK) { - if (objc < 4) { - Tcl_WrongNumArgs(interp, 1, objv, - "eval ?-async? serviceName args"); - return TCL_ERROR; - } - async = 0; - firstArg = 2; - } else { + if (Tcl_GetIndexFromObj(NULL, objv[2], ddeExecOptions, "option", 0, + &dummy) == TCL_OK) { if (objc < 5) { - Tcl_WrongNumArgs(interp, 1, objv, - "eval ?-async? serviceName args"); - return TCL_ERROR; + goto wrongDdeEvalArgs; } async = 1; - firstArg = 3; + firstArg++; } break; + } } Initialize(); @@ -1140,351 +1313,368 @@ Tcl_DdeObjCmd( if (length == 0) { serviceName = NULL; } else if ((index != DDE_SERVERNAME) && (index != DDE_EVAL)) { - ddeService = DdeCreateStringHandle(ddeInstance, serviceName, + ddeService = DdeCreateStringHandle(ddeInstance, (void *) serviceName, CP_WINANSI); } - if ((index != DDE_SERVERNAME) &&(index != DDE_EVAL)) { + if ((index != DDE_SERVERNAME) && (index != DDE_EVAL)) { topicName = Tcl_GetStringFromObj(objv[firstArg + 1], &length); if (length == 0) { topicName = NULL; } else { - ddeTopic = DdeCreateStringHandle(ddeInstance, - topicName, CP_WINANSI); + ddeTopic = DdeCreateStringHandle(ddeInstance, (void *) topicName, + CP_WINANSI); } } - switch (index) { - case DDE_SERVERNAME: { - serviceName = DdeSetServerName(interp, serviceName); - if (serviceName != NULL) { - Tcl_SetStringObj(Tcl_GetObjResult(interp), - serviceName, -1); - } else { - Tcl_ResetResult(interp); - } + switch ((enum DdeSubcommands) index) { + case DDE_SERVERNAME: + serviceName = DdeSetServerName(interp, serviceName, exact, handlerPtr); + if (serviceName != NULL) { + Tcl_SetObjResult(interp, Tcl_NewStringObj(serviceName, -1)); + } else { + Tcl_ResetResult(interp); + } + break; + + case DDE_EXECUTE: { + int dataLength; + BYTE *dataString = (BYTE *) Tcl_GetStringFromObj( + objv[firstArg + 2], &dataLength); + + if (dataLength == 0) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("cannot execute null data", -1)); + result = TCL_ERROR; break; } - case DDE_EXECUTE: { - BYTE *dataString = (BYTE *) Tcl_GetStringFromObj( - objv[firstArg + 2], &dataLength); - if (dataLength == 0) { - Tcl_SetStringObj(Tcl_GetObjResult(interp), - "cannot execute null data", -1); - result = TCL_ERROR; - break; - } - hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL); - DdeFreeStringHandle(ddeInstance, ddeService); - DdeFreeStringHandle(ddeInstance, ddeTopic); + hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL); + DdeFreeStringHandle(ddeInstance, ddeService); + DdeFreeStringHandle(ddeInstance, ddeTopic); - if (hConv == NULL) { - SetDdeError(interp); - result = TCL_ERROR; - break; + if (hConv == NULL) { + SetDdeError(interp); + result = TCL_ERROR; + break; + } + + ddeData = DdeCreateDataHandle(ddeInstance, dataString, + (DWORD) dataLength+1, 0, 0, CF_TEXT, 0); + if (ddeData != NULL) { + if (async) { + DdeClientTransaction((LPBYTE) ddeData, 0xFFFFFFFF, hConv, 0, + CF_TEXT, XTYP_EXECUTE, TIMEOUT_ASYNC, &ddeResult); + DdeAbandonTransaction(ddeInstance, hConv, ddeResult); + } else { + ddeReturn = DdeClientTransaction((LPBYTE) ddeData, 0xFFFFFFFF, + hConv, 0, CF_TEXT, XTYP_EXECUTE, 30000, NULL); + if (ddeReturn == 0) { + SetDdeError(interp); + result = TCL_ERROR; + } } + DdeFreeDataHandle(ddeData); + } else { + SetDdeError(interp); + result = TCL_ERROR; + } + break; + } + case DDE_REQUEST: { + char *itemString = Tcl_GetStringFromObj(objv[firstArg + 2], &length); + + if (length == 0) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("cannot request value of null data", -1)); + result = TCL_ERROR; + goto cleanup; + } + hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL); + DdeFreeStringHandle(ddeInstance, ddeService); + DdeFreeStringHandle(ddeInstance, ddeTopic); - ddeData = DdeCreateDataHandle(ddeInstance, dataString, - (DWORD) dataLength+1, 0, 0, CF_TEXT, 0); - if (ddeData != NULL) { - if (async) { - DdeClientTransaction((LPBYTE) ddeData, 0xFFFFFFFF, hConv, 0, - CF_TEXT, XTYP_EXECUTE, TIMEOUT_ASYNC, &ddeResult); - DdeAbandonTransaction(ddeInstance, hConv, - ddeResult); + if (hConv == NULL) { + SetDdeError(interp); + result = TCL_ERROR; + } else { + Tcl_Obj *returnObjPtr; + ddeItem = DdeCreateStringHandle(ddeInstance, (void *)itemString, + CP_WINANSI); + if (ddeItem != NULL) { + ddeData = DdeClientTransaction(NULL, 0, hConv, ddeItem, + CF_TEXT, XTYP_REQUEST, 5000, NULL); + if (ddeData == NULL) { + SetDdeError(interp); + result = TCL_ERROR; } else { - ddeReturn = DdeClientTransaction((LPBYTE) ddeData, 0xFFFFFFFF, - hConv, 0, CF_TEXT, XTYP_EXECUTE, 30000, NULL); - if (ddeReturn == 0) { - SetDdeError(interp); - result = TCL_ERROR; + DWORD tmp; + const BYTE *dataString = DdeAccessData(ddeData, &tmp); + + if (binary) { + returnObjPtr = Tcl_NewByteArrayObj(dataString, + (int) tmp); + } else { + returnObjPtr = Tcl_NewStringObj((const char *)dataString, -1); } + DdeUnaccessData(ddeData); + DdeFreeDataHandle(ddeData); + Tcl_SetObjResult(interp, returnObjPtr); } - DdeFreeDataHandle(ddeData); } else { SetDdeError(interp); result = TCL_ERROR; } - break; } - case DDE_REQUEST: { - itemString = Tcl_GetStringFromObj(objv[firstArg + 2], &length); - if (length == 0) { - Tcl_SetStringObj(Tcl_GetObjResult(interp), - "cannot request value of null data", -1); - goto errorNoResult; - } - hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL); - DdeFreeStringHandle(ddeInstance, ddeService); - DdeFreeStringHandle(ddeInstance, ddeTopic); - - if (hConv == NULL) { - SetDdeError(interp); - result = TCL_ERROR; - } else { - Tcl_Obj *returnObjPtr; - ddeItem = DdeCreateStringHandle(ddeInstance, - itemString, CP_WINANSI); - if (ddeItem != NULL) { - ddeData = DdeClientTransaction(NULL, 0, hConv, ddeItem, - CF_TEXT, XTYP_REQUEST, 5000, NULL); - if (ddeData == NULL) { - SetDdeError(interp); - result = TCL_ERROR; - } else { - DWORD tmp; - BYTE *dataString = (BYTE *) DdeAccessData(ddeData, &tmp); - dataLength = tmp; - if (binary) { - returnObjPtr = Tcl_NewByteArrayObj(dataString, - dataLength); - } else { - returnObjPtr = Tcl_NewStringObj((char *) dataString, -1); - } - DdeUnaccessData(ddeData); - DdeFreeDataHandle(ddeData); - Tcl_SetObjResult(interp, returnObjPtr); - } - } else { - SetDdeError(interp); - result = TCL_ERROR; - } - } - break; + break; + } + case DDE_POKE: { + char *itemString = Tcl_GetStringFromObj(objv[firstArg + 2], &length); + BYTE *dataString; + + if (length == 0) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("cannot have a null item", -1)); + result = TCL_ERROR; + goto cleanup; } - case DDE_POKE: { - itemString = Tcl_GetStringFromObj(objv[firstArg + 2], &length); - BYTE *dataString; - if (length == 0) { - Tcl_SetStringObj(Tcl_GetObjResult(interp), - "cannot have a null item", -1); - goto errorNoResult; - } - dataString = (BYTE *) Tcl_GetStringFromObj(objv[firstArg + 3], &length); - - hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL); - DdeFreeStringHandle(ddeInstance, ddeService); - DdeFreeStringHandle(ddeInstance, ddeTopic); + dataString = (BYTE *) Tcl_GetStringFromObj(objv[firstArg + 3], + &length); - if (hConv == NULL) { - SetDdeError(interp); - result = TCL_ERROR; - } else { - ddeItem = DdeCreateStringHandle(ddeInstance, itemString, - CP_WINANSI); - if (ddeItem != NULL) { - ddeData = DdeClientTransaction(dataString, (DWORD) length+1, - hConv, ddeItem, CF_TEXT, XTYP_POKE, 5000, NULL); - if (ddeData == NULL) { - SetDdeError(interp); - result = TCL_ERROR; - } - } else { + hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL); + DdeFreeStringHandle(ddeInstance, ddeService); + DdeFreeStringHandle(ddeInstance, ddeTopic); + + if (hConv == NULL) { + SetDdeError(interp); + result = TCL_ERROR; + } else { + ddeItem = DdeCreateStringHandle(ddeInstance, (void *) itemString, + CP_WINANSI); + if (ddeItem != NULL) { + ddeData = DdeClientTransaction(dataString, (DWORD) length+1, + hConv, ddeItem, CF_TEXT, XTYP_POKE, 5000, NULL); + if (ddeData == NULL) { SetDdeError(interp); result = TCL_ERROR; } + } else { + SetDdeError(interp); + result = TCL_ERROR; } - break; } + break; + } - case DDE_SERVICES: { - result = DdeGetServicesList(interp, serviceName, topicName); - break; + case DDE_SERVICES: + result = DdeGetServicesList(interp, serviceName, topicName); + break; + + case DDE_EVAL: { + RegisteredInterp *riPtr; + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + + if (serviceName == NULL) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("invalid service name \"\"", -1)); + result = TCL_ERROR; + goto cleanup; } - case DDE_EVAL: { - if (serviceName == NULL) { - Tcl_SetStringObj(Tcl_GetObjResult(interp), - "invalid service name \"\"", -1); - goto errorNoResult; + + objc -= (async + 3); + objv += (async + 3); + + /* + * See if the target interpreter is local. If so, execute the command + * directly without going through the DDE server. Don't exchange + * objects between interps. The target interp could compile an object, + * producing a bytecode structure that refers to other objects owned + * by the target interp. If the target interp is then deleted, the + * bytecode structure would be referring to deallocated objects. + */ + + for (riPtr = tsdPtr->interpListPtr; riPtr != NULL; + riPtr = riPtr->nextPtr) { + if (stricmp(serviceName, riPtr->name) == 0) { + break; } + } + + if (riPtr != NULL) { + Tcl_Interp *sendInterp; - objc -= (async + 3); - objv += (async + 3); - - /* - * See if the target interpreter is local. If so, execute - * the command directly without going through the DDE server. - * Don't exchange objects between interps. The target interp could - * compile an object, producing a bytecode structure that refers to - * other objects owned by the target interp. If the target interp - * is then deleted, the bytecode structure would be referring to - * deallocated objects. + /* + * This command is to a local interp. No need to go through the + * server. */ - - for (riPtr = tsdPtr->interpListPtr; riPtr != NULL; - riPtr = riPtr->nextPtr) { - if (stricmp(serviceName, riPtr->name) == 0) { - break; - } - } - if (riPtr != NULL) { - /* - * This command is to a local interp. No need to go through - * the server. - */ - - Tcl_Preserve((ClientData) riPtr); - sendInterp = riPtr->interp; - Tcl_Preserve((ClientData) sendInterp); - - /* - * Don't exchange objects between interps. The target interp - * would compile an object, producing a bytecode structure that - * refers to other objects owned by the target interp. If the - * target interp is then deleted, the bytecode structure would - * be referring to deallocated objects. - */ + Tcl_Preserve((ClientData) riPtr); + sendInterp = riPtr->interp; + Tcl_Preserve((ClientData) sendInterp); - if (objc == 1) { - result = Tcl_EvalObjEx(sendInterp, objv[0], - TCL_EVAL_GLOBAL); - } else { + /* + * Don't exchange objects between interps. The target interp would + * compile an object, producing a bytecode structure that refers + * to other objects owned by the target interp. If the target + * interp is then deleted, the bytecode structure would be + * referring to deallocated objects. + */ + + if (Tcl_IsSafe(riPtr->interp) && riPtr->handlerPtr == NULL) { + Tcl_SetResult(riPtr->interp, "permission denied: " + "a handler procedure must be defined for use in " + "a safe interp", TCL_STATIC); + result = TCL_ERROR; + } + + if (result == TCL_OK) { + if (objc == 1) + objPtr = objv[0]; + else { objPtr = Tcl_ConcatObj(objc, objv); - Tcl_IncrRefCount(objPtr); - result = Tcl_EvalObjEx(sendInterp, objPtr, - TCL_EVAL_GLOBAL); - Tcl_DecrRefCount(objPtr); } - if (interp != sendInterp) { - if (result == TCL_ERROR) { - /* - * An error occurred, so transfer error information - * from the destination interpreter back to our - * interpreter. - */ - - Tcl_ResetResult(interp); - objPtr = Tcl_GetVar2Ex(sendInterp, "errorInfo", NULL, - TCL_GLOBAL_ONLY); + if (riPtr->handlerPtr != NULL) { + /* add the dde request data to the handler proc list */ + /* + *result = Tcl_ListObjReplace(sendInterp, objPtr, 0, 0, 1, + * &(riPtr->handlerPtr)); + */ + Tcl_Obj *cmdPtr = Tcl_DuplicateObj(riPtr->handlerPtr); + result = Tcl_ListObjAppendElement(sendInterp, cmdPtr, + objPtr); + if (result == TCL_OK) { + objPtr = cmdPtr; + } + } + } + if (result == TCL_OK) { + Tcl_IncrRefCount(objPtr); + result = Tcl_EvalObjEx(sendInterp, objPtr, TCL_EVAL_GLOBAL); + Tcl_DecrRefCount(objPtr); + } + if (interp != sendInterp) { + if (result == TCL_ERROR) { + /* + * An error occurred, so transfer error information from + * the destination interpreter back to our interpreter. + */ + + Tcl_ResetResult(interp); + objPtr = Tcl_GetVar2Ex(sendInterp, "errorInfo", NULL, + TCL_GLOBAL_ONLY); + if (objPtr) { string = Tcl_GetStringFromObj(objPtr, &length); Tcl_AddObjErrorInfo(interp, string, length); - - objPtr = Tcl_GetVar2Ex(sendInterp, "errorCode", NULL, - TCL_GLOBAL_ONLY); + } + + objPtr = Tcl_GetVar2Ex(sendInterp, "errorCode", NULL, + TCL_GLOBAL_ONLY); + if (objPtr) { Tcl_SetObjErrorCode(interp, objPtr); } - Tcl_SetObjResult(interp, Tcl_GetObjResult(sendInterp)); } - Tcl_Release((ClientData) riPtr); - Tcl_Release((ClientData) sendInterp); + Tcl_SetObjResult(interp, Tcl_GetObjResult(sendInterp)); + } + Tcl_Release((ClientData) riPtr); + Tcl_Release((ClientData) sendInterp); + } else { + /* + * This is a non-local request. Send the script to the server and + * poll it for a result. + */ + + if (MakeDdeConnection(interp, serviceName, &hConv) != TCL_OK) { + invalidServerResponse: + Tcl_SetObjResult(interp, + Tcl_NewStringObj("invalid data returned from server", + -1)); + result = TCL_ERROR; + goto cleanup; + } + + objPtr = Tcl_ConcatObj(objc, objv); + string = Tcl_GetStringFromObj(objPtr, &length); + ddeItemData = DdeCreateDataHandle(ddeInstance, + (BYTE *) string, (DWORD) length+1, 0, 0, CF_TEXT, 0); + + if (async) { + ddeData = DdeClientTransaction((LPBYTE) ddeItemData, + 0xFFFFFFFF, hConv, 0, + CF_TEXT, XTYP_EXECUTE, TIMEOUT_ASYNC, &ddeResult); + DdeAbandonTransaction(ddeInstance, hConv, ddeResult); } else { + ddeData = DdeClientTransaction((LPBYTE) ddeItemData, + 0xFFFFFFFF, hConv, 0, + CF_TEXT, XTYP_EXECUTE, 30000, NULL); + if (ddeData != 0) { + ddeCookie = DdeCreateStringHandle(ddeInstance, + TCL_DDE_EXECUTE_RESULT, CP_WINANSI); + ddeData = DdeClientTransaction(NULL, 0, hConv, ddeCookie, + CF_TEXT, XTYP_REQUEST, 30000, NULL); + } + } + + Tcl_DecrRefCount(objPtr); + + if (ddeData == 0) { + SetDdeError(interp); + result = TCL_ERROR; + } + + if (async == 0) { + Tcl_Obj *resultPtr; + /* - * This is a non-local request. Send the script to the server - * and poll it for a result. + * The return handle has a two or four element list in it. The + * first element is the return code (TCL_OK, TCL_ERROR, etc.). + * The second is the result of the script. If the return code + * is TCL_ERROR, then the third element is the value of the + * variable "errorCode", and the fourth is the value of the + * variable "errorInfo". */ - - if (MakeDdeConnection(interp, serviceName, &hConv) != TCL_OK) { - goto error; + + resultPtr = Tcl_NewObj(); + length = DdeGetData(ddeData, NULL, 0, 0); + Tcl_SetObjLength(resultPtr, length); + string = Tcl_GetString(resultPtr); + DdeGetData(ddeData, (BYTE *) string, (DWORD) length, 0); + Tcl_SetObjLength(resultPtr, (int) strlen(string)); + + if (Tcl_ListObjIndex(NULL, resultPtr, 0, &objPtr) != TCL_OK) { + Tcl_DecrRefCount(resultPtr); + goto invalidServerResponse; } - - objPtr = Tcl_ConcatObj(objc, objv); - string = Tcl_GetStringFromObj(objPtr, &length); - ddeItemData = DdeCreateDataHandle(ddeInstance, (BYTE *) string, - (DWORD) length+1, 0, 0, CF_TEXT, 0); - - if (async) { - ddeData = DdeClientTransaction((LPBYTE) ddeItemData, - 0xFFFFFFFF, hConv, 0, - CF_TEXT, XTYP_EXECUTE, TIMEOUT_ASYNC, &ddeResult); - DdeAbandonTransaction(ddeInstance, hConv, ddeResult); - } else { - ddeData = DdeClientTransaction((LPBYTE) ddeItemData, - 0xFFFFFFFF, hConv, 0, - CF_TEXT, XTYP_EXECUTE, 30000, NULL); - if (ddeData != 0) { - - ddeCookie = DdeCreateStringHandle(ddeInstance, - "$TCLEVAL$EXECUTE$RESULT", CP_WINANSI); - ddeData = DdeClientTransaction(NULL, 0, hConv, - ddeCookie, CF_TEXT, XTYP_REQUEST, 30000, NULL); - } + if (Tcl_GetIntFromObj(NULL, objPtr, &result) != TCL_OK) { + Tcl_DecrRefCount(resultPtr); + goto invalidServerResponse; } + if (result == TCL_ERROR) { + Tcl_ResetResult(interp); - Tcl_DecrRefCount(objPtr); - - if (ddeData == 0) { - SetDdeError(interp); - goto errorNoResult; - } - - if (async == 0) { - Tcl_Obj *resultPtr; - - /* - * The return handle has a two or four element list in - * it. The first element is the return code (TCL_OK, - * TCL_ERROR, etc.). The second is the result of the - * script. If the return code is TCL_ERROR, then the third - * element is the value of the variable "errorCode", and - * the fourth is the value of the variable "errorInfo". - */ - - resultPtr = Tcl_NewObj(); - length = DdeGetData(ddeData, NULL, 0, 0); - Tcl_SetObjLength(resultPtr, length); - string = Tcl_GetString(resultPtr); - DdeGetData(ddeData, (BYTE *) string, (DWORD) length, 0); - Tcl_SetObjLength(resultPtr, (int) strlen(string)); - - if (Tcl_ListObjIndex(NULL, resultPtr, 0, &objPtr) - != TCL_OK) { + if (Tcl_ListObjIndex(NULL, resultPtr, 3, + &objPtr) != TCL_OK) { Tcl_DecrRefCount(resultPtr); - goto error; + goto invalidServerResponse; } - if (Tcl_GetIntFromObj(NULL, objPtr, &result) != TCL_OK) { - Tcl_DecrRefCount(resultPtr); - goto error; - } - if (result == TCL_ERROR) { - Tcl_ResetResult(interp); + length = -1; + string = Tcl_GetStringFromObj(objPtr, &length); + Tcl_AddObjErrorInfo(interp, string, length); - if (Tcl_ListObjIndex(NULL, resultPtr, 3, &objPtr) - != TCL_OK) { - Tcl_DecrRefCount(resultPtr); - goto error; - } - length = -1; - string = Tcl_GetStringFromObj(objPtr, &length); - Tcl_AddObjErrorInfo(interp, string, length); - - Tcl_ListObjIndex(NULL, resultPtr, 2, &objPtr); - Tcl_SetObjErrorCode(interp, objPtr); - } - if (Tcl_ListObjIndex(NULL, resultPtr, 1, &objPtr) - != TCL_OK) { - Tcl_DecrRefCount(resultPtr); - goto error; - } - Tcl_SetObjResult(interp, objPtr); + Tcl_ListObjIndex(NULL, resultPtr, 2, &objPtr); + Tcl_SetObjErrorCode(interp, objPtr); + } + if (Tcl_ListObjIndex(NULL, resultPtr, 1, &objPtr) != TCL_OK) { Tcl_DecrRefCount(resultPtr); + goto invalidServerResponse; } + Tcl_SetObjResult(interp, objPtr); + Tcl_DecrRefCount(resultPtr); } } } - if (ddeCookie != NULL) { - DdeFreeStringHandle(ddeInstance, ddeCookie); - } - if (ddeItem != NULL) { - DdeFreeStringHandle(ddeInstance, ddeItem); - } - if (ddeItemData != NULL) { - DdeFreeDataHandle(ddeItemData); - } - if (ddeData != NULL) { - DdeFreeDataHandle(ddeData); } - if (hConv != NULL) { - DdeDisconnect(hConv); - } - return result; - error: - Tcl_SetStringObj(Tcl_GetObjResult(interp), - "invalid data returned from server", -1); - - errorNoResult: + cleanup: if (ddeCookie != NULL) { DdeFreeStringHandle(ddeInstance, ddeCookie); } @@ -1500,5 +1690,15 @@ Tcl_DdeObjCmd( if (hConv != NULL) { DdeDisconnect(hConv); } - return TCL_ERROR; + return result; } + +/* + * Local variables: + * mode: c + * indent-tabs-mode: t + * tab-width: 8 + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ diff --git a/win/tclWinError.c b/win/tclWinError.c index da1e335..ca1b0e8 100644 --- a/win/tclWinError.c +++ b/win/tclWinError.c @@ -1,20 +1,19 @@ -/* +/* * tclWinError.c -- * - * This file contains code for converting from Win32 errors to - * errno errors. + * This file contains code for converting from Win32 errors to errno + * errors. * * Copyright (c) 1995-1996 by Sun Microsystems, Inc. * - * See the file "license.terms" for information on usage and redistribution - * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ -#include "tclWinInt.h" +#include "tclInt.h" /* - * The following table contains the mapping from Win32 errors to - * errno errors. + * The following table contains the mapping from Win32 errors to errno errors. */ static char errorTable[] = { @@ -352,8 +351,8 @@ static int wsaErrorTable[] = { */ void -TclWinConvertError(errCode) - DWORD errCode; /* Win32 error code. */ +TclWinConvertError( + unsigned long errCode) /* Win32 error code. */ { if (errCode >= tableLen) { Tcl_SetErrno(EINVAL); @@ -379,8 +378,8 @@ TclWinConvertError(errCode) */ void -TclWinConvertWSAError(errCode) - DWORD errCode; /* Win32 error code. */ +TclWinConvertWSAError( + unsigned long errCode) /* Win32 error code. */ { if ((errCode >= WSAEWOULDBLOCK) && (errCode <= WSAEREMOTE)) { Tcl_SetErrno(wsaErrorTable[errCode - WSAEWOULDBLOCK]); diff --git a/win/tclWinFCmd.c b/win/tclWinFCmd.c index 231e4b7..a1338a7 100644 --- a/win/tclWinFCmd.c +++ b/win/tclWinFCmd.c @@ -1,13 +1,13 @@ /* * tclWinFCmd.c * - * This file implements the Windows specific portion of file manipulation - * subcommands of the "file" command. + * This file implements the Windows specific portion of file manipulation + * subcommands of the "file" command. * * Copyright (c) 1996-1998 Sun Microsystems, Inc. * - * See the file "license.terms" for information on usage and redistribution - * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclWinInt.h" @@ -17,29 +17,25 @@ * TraverseWinTree() calls the traverseProc() */ -#define DOTREE_PRED 1 /* pre-order directory */ -#define DOTREE_POSTD 2 /* post-order directory */ -#define DOTREE_F 3 /* regular file */ +#define DOTREE_PRED 1 /* pre-order directory */ +#define DOTREE_POSTD 2 /* post-order directory */ +#define DOTREE_F 3 /* regular file */ +#define DOTREE_LINK 4 /* symbolic link */ /* * Callbacks for file attributes code. */ -static int GetWinFileAttributes _ANSI_ARGS_((Tcl_Interp *interp, - int objIndex, Tcl_Obj *fileName, - Tcl_Obj **attributePtrPtr)); -static int GetWinFileLongName _ANSI_ARGS_((Tcl_Interp *interp, - int objIndex, Tcl_Obj *fileName, - Tcl_Obj **attributePtrPtr)); -static int GetWinFileShortName _ANSI_ARGS_((Tcl_Interp *interp, - int objIndex, Tcl_Obj *fileName, - Tcl_Obj **attributePtrPtr)); -static int SetWinFileAttributes _ANSI_ARGS_((Tcl_Interp *interp, - int objIndex, Tcl_Obj *fileName, - Tcl_Obj *attributePtr)); -static int CannotSetAttribute _ANSI_ARGS_((Tcl_Interp *interp, - int objIndex, Tcl_Obj *fileName, - Tcl_Obj *attributePtr)); +static int GetWinFileAttributes(Tcl_Interp *interp, int objIndex, + Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr); +static int GetWinFileLongName(Tcl_Interp *interp, int objIndex, + Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr); +static int GetWinFileShortName(Tcl_Interp *interp, int objIndex, + Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr); +static int SetWinFileAttributes(Tcl_Interp *interp, int objIndex, + Tcl_Obj *fileName, Tcl_Obj *attributePtr); +static int CannotSetAttribute(Tcl_Interp *interp, int objIndex, + Tcl_Obj *fileName, Tcl_Obj *attributePtr); /* * Constants and variables necessary for file attributes subcommand. @@ -74,18 +70,17 @@ CONST TclFileAttrProcs tclpFileAttrProcs[] = { #ifdef HAVE_NO_SEH /* - * Unlike Borland and Microsoft, we don't register exception handlers - * by pushing registration records onto the runtime stack. Instead, we - * register them by creating an EXCEPTION_REGISTRATION within the activation - * record. + * Unlike Borland and Microsoft, we don't register exception handlers by + * pushing registration records onto the runtime stack. Instead, we register + * them by creating an EXCEPTION_REGISTRATION within the activation record. */ typedef struct EXCEPTION_REGISTRATION { - struct EXCEPTION_REGISTRATION* link; - EXCEPTION_DISPOSITION (*handler)( struct _EXCEPTION_RECORD*, void*, - struct _CONTEXT*, void* ); - void* ebp; - void* esp; + struct EXCEPTION_REGISTRATION *link; + EXCEPTION_DISPOSITION (*handler)( + struct _EXCEPTION_RECORD *, void *, struct _CONTEXT *, void *); + void *ebp; + void *esp; int status; } EXCEPTION_REGISTRATION; @@ -95,91 +90,91 @@ typedef struct EXCEPTION_REGISTRATION { * Prototype for the TraverseWinTree callback function. */ -typedef int (TraversalProc)(CONST TCHAR *srcPtr, CONST TCHAR *dstPtr, +typedef int (TraversalProc)(CONST TCHAR *srcPtr, CONST TCHAR *dstPtr, int type, Tcl_DString *errorPtr); /* - * Declarations for local procedures defined in this file: + * Declarations for local functions defined in this file: */ static void StatError(Tcl_Interp *interp, Tcl_Obj *fileName); -static int ConvertFileNameFormat(Tcl_Interp *interp, +static int ConvertFileNameFormat(Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, int longShort, Tcl_Obj **attributePtrPtr); static int DoCopyFile(CONST TCHAR *srcPtr, CONST TCHAR *dstPtr); static int DoCreateDirectory(CONST TCHAR *pathPtr); -static int DoRemoveJustDirectory(CONST TCHAR *nativeSrc, +static int DoRemoveJustDirectory(CONST TCHAR *nativeSrc, int ignoreError, Tcl_DString *errorPtr); -static int DoRemoveDirectory(Tcl_DString *pathPtr, int recursive, +static int DoRemoveDirectory(Tcl_DString *pathPtr, int recursive, Tcl_DString *errorPtr); -static int DoRenameFile(CONST TCHAR *nativeSrc, CONST TCHAR *dstPtr); -static int TraversalCopy(CONST TCHAR *srcPtr, CONST TCHAR *dstPtr, - int type, Tcl_DString *errorPtr); -static int TraversalDelete(CONST TCHAR *srcPtr, CONST TCHAR *dstPtr, +static int DoRenameFile(CONST TCHAR *nativeSrc, + CONST TCHAR *dstPtr); +static int TraversalCopy(CONST TCHAR *srcPtr, CONST TCHAR *dstPtr, int type, Tcl_DString *errorPtr); +static int TraversalDelete(CONST TCHAR *srcPtr, + CONST TCHAR *dstPtr, int type, + Tcl_DString *errorPtr); static int TraverseWinTree(TraversalProc *traverseProc, - Tcl_DString *sourcePtr, Tcl_DString *dstPtr, + Tcl_DString *sourcePtr, Tcl_DString *dstPtr, Tcl_DString *errorPtr); - /* *--------------------------------------------------------------------------- * * TclpObjRenameFile, DoRenameFile -- * - * Changes the name of an existing file or directory, from src to dst. - * If src and dst refer to the same file or directory, does nothing - * and returns success. Otherwise if dst already exists, it will be - * deleted and replaced by src subject to the following conditions: + * Changes the name of an existing file or directory, from src to dst. + * If src and dst refer to the same file or directory, does nothing and + * returns success. Otherwise if dst already exists, it will be deleted + * and replaced by src subject to the following conditions: * If src is a directory, dst may be an empty directory. * If src is a file, dst may be a file. - * In any other situation where dst already exists, the rename will - * fail. + * In any other situation where dst already exists, the rename will fail. * * Results: * If the file or directory was successfully renamed, returns TCL_OK. - * Otherwise the return value is TCL_ERROR and errno is set to - * indicate the error. Some possible values for errno are: + * Otherwise the return value is TCL_ERROR and errno is set to indicate + * the error. Some possible values for errno are: * * ENAMETOOLONG: src or dst names are too long. - * EACCES: src or dst parent directory can't be read and/or written. + * EACCES: src or dst parent directory can't be read and/or written. * EEXIST: dst is a non-empty directory. * EINVAL: src is a root directory or dst is a subdirectory of src. * EISDIR: dst is a directory, but src is not. - * ENOENT: src doesn't exist. src or dst is "". - * ENOTDIR: src is a directory, but dst is not. + * ENOENT: src doesn't exist. src or dst is "". + * ENOTDIR: src is a directory, but dst is not. * EXDEV: src and dst are on different filesystems. * - * EACCES: exists an open file already referring to src or dst. - * EACCES: src or dst specify the current working directory (NT). - * EACCES: src specifies a char device (nul:, com1:, etc.) + * EACCES: exists an open file already referring to src or dst. + * EACCES: src or dst specify the current working directory (NT). + * EACCES: src specifies a char device (nul:, com1:, etc.) * EEXIST: dst specifies a char device (nul:, com1:, etc.) (NT) * EACCES: dst specifies a char device (nul:, com1:, etc.) (95) - * + * * Side effects: - * The implementation supports cross-filesystem renames of files, - * but the caller should be prepared to emulate cross-filesystem - * renames of directories if errno is EXDEV. + * The implementation supports cross-filesystem renames of files, but the + * caller should be prepared to emulate cross-filesystem renames of + * directories if errno is EXDEV. * *--------------------------------------------------------------------------- */ -int -TclpObjRenameFile(srcPathPtr, destPathPtr) - Tcl_Obj *srcPathPtr; - Tcl_Obj *destPathPtr; +int +TclpObjRenameFile( + Tcl_Obj *srcPathPtr, + Tcl_Obj *destPathPtr) { - return DoRenameFile(Tcl_FSGetNativePath(srcPathPtr), - Tcl_FSGetNativePath(destPathPtr)); + return DoRenameFile(Tcl_FSGetNativePath(srcPathPtr), + Tcl_FSGetNativePath(destPathPtr)); } static int DoRenameFile( CONST TCHAR *nativeSrc, /* Pathname of file or dir to be renamed - * (native). */ + * (native). */ CONST TCHAR *nativeDst) /* New pathname for file or directory * (native). */ -{ +{ #if defined(HAVE_NO_SEH) && !defined(_WIN64) EXCEPTION_REGISTRATION registration; #endif @@ -187,99 +182,103 @@ DoRenameFile( int retval = -1; /* - * The MoveFile API acts differently under Win95/98 and NT - * WRT NULL and "". Avoid passing these values. + * The MoveFile API acts differently under Win95/98 and NT WRT NULL and + * "". Avoid passing these values. */ if (nativeSrc == NULL || nativeSrc[0] == '\0' || - nativeDst == NULL || nativeDst[0] == '\0') { + nativeDst == NULL || nativeDst[0] == '\0') { Tcl_SetErrno(ENOENT); return TCL_ERROR; } /* - * The MoveFile API would throw an exception under NT - * if one of the arguments is a char block device. + * The MoveFile API would throw an exception under NT if one of the + * arguments is a char block device. */ #if defined(HAVE_NO_SEH) && !defined(_WIN64) - /* - * Don't have SEH available, do things the hard way. - * Note that this needs to be one block of asm, to avoid stack - * imbalance; also, it is illegal for one asm block to contain - * a jump to another. + * Don't have SEH available, do things the hard way. Note that this needs + * to be one block of asm, to avoid stack imbalance; also, it is illegal + * for one asm block to contain a jump to another. */ __asm__ __volatile__ ( /* - * Pick up params before messing with the stack */ + * Pick up params before messing with the stack. + */ "movl %[nativeDst], %%ebx" "\n\t" - "movl %[nativeSrc], %%ecx" "\n\t" + "movl %[nativeSrc], %%ecx" "\n\t" /* - * Construct an EXCEPTION_REGISTRATION to protect the - * call to MoveFile + * Construct an EXCEPTION_REGISTRATION to protect the call to + * MoveFile. */ - "leal %[registration], %%edx" "\n\t" - "movl %%fs:0, %%eax" "\n\t" - "movl %%eax, 0x0(%%edx)" "\n\t" /* link */ - "leal 1f, %%eax" "\n\t" - "movl %%eax, 0x4(%%edx)" "\n\t" /* handler */ - "movl %%ebp, 0x8(%%edx)" "\n\t" /* ebp */ - "movl %%esp, 0xc(%%edx)" "\n\t" /* esp */ - "movl $0, 0x10(%%edx)" "\n\t" /* status */ - - /* Link the EXCEPTION_REGISTRATION on the chain */ - - "movl %%edx, %%fs:0" "\n\t" - - /* Call MoveFile( nativeSrc, nativeDst ) */ - + + "leal %[registration], %%edx" "\n\t" + "movl %%fs:0, %%eax" "\n\t" + "movl %%eax, 0x0(%%edx)" "\n\t" /* link */ + "leal 1f, %%eax" "\n\t" + "movl %%eax, 0x4(%%edx)" "\n\t" /* handler */ + "movl %%ebp, 0x8(%%edx)" "\n\t" /* ebp */ + "movl %%esp, 0xc(%%edx)" "\n\t" /* esp */ + "movl $0, 0x10(%%edx)" "\n\t" /* status */ + + /* + * Link the EXCEPTION_REGISTRATION on the chain. + */ + + "movl %%edx, %%fs:0" "\n\t" + + /* + * Call MoveFile(nativeSrc, nativeDst) + */ + "pushl %%ebx" "\n\t" "pushl %%ecx" "\n\t" "movl %[moveFile], %%eax" "\n\t" "call *%%eax" "\n\t" - - /* - * Come here on normal exit. Recover the EXCEPTION_REGISTRATION - * and put the status return from MoveFile into it. + + /* + * Come here on normal exit. Recover the EXCEPTION_REGISTRATION and + * put the status return from MoveFile into it. */ - + "movl %%fs:0, %%edx" "\n\t" "movl %%eax, 0x10(%%edx)" "\n\t" "jmp 2f" "\n" - + /* - * Come here on an exception. Recover the EXCEPTION_REGISTRATION + * Come here on an exception. Recover the EXCEPTION_REGISTRATION */ - + "1:" "\t" - "movl %%fs:0, %%edx" "\n\t" - "movl 0x8(%%edx), %%edx" "\n\t" - - /* - * Come here however we exited. Restore context from the + "movl %%fs:0, %%edx" "\n\t" + "movl 0x8(%%edx), %%edx" "\n\t" + + /* + * Come here however we exited. Restore context from the * EXCEPTION_REGISTRATION in case the stack is unbalanced. */ - - "2:" "\t" - "movl 0xc(%%edx), %%esp" "\n\t" - "movl 0x8(%%edx), %%ebp" "\n\t" - "movl 0x0(%%edx), %%eax" "\n\t" - "movl %%eax, %%fs:0" "\n\t" - + + "2:" "\t" + "movl 0xc(%%edx), %%esp" "\n\t" + "movl 0x8(%%edx), %%ebp" "\n\t" + "movl 0x0(%%edx), %%eax" "\n\t" + "movl %%eax, %%fs:0" "\n\t" + : /* No outputs */ - : - [registration] "m" (registration), - [nativeDst] "m" (nativeDst), - [nativeSrc] "m" (nativeSrc), - [moveFile] "r" (tclWinProcs->moveFileProc) - : + : + [registration] "m" (registration), + [nativeDst] "m" (nativeDst), + [nativeSrc] "m" (nativeSrc), + [moveFile] "r" (tclWinProcs->moveFileProc) + : "%eax", "%ebx", "%ecx", "%edx", "memory" - ); + ); if (registration.status != FALSE) { retval = TCL_OK; } @@ -295,22 +294,25 @@ DoRenameFile( #endif #endif - if (retval != -1) - return retval; + if (retval != -1) { + return retval; + } TclWinConvertError(GetLastError()); srcAttr = (*tclWinProcs->getFileAttributesProc)(nativeSrc); dstAttr = (*tclWinProcs->getFileAttributesProc)(nativeDst); if (srcAttr == 0xffffffff) { - if ((*tclWinProcs->getFullPathNameProc)(nativeSrc, 0, NULL, NULL) >= MAX_PATH) { + if ((*tclWinProcs->getFullPathNameProc)(nativeSrc, 0, NULL, + NULL) >= MAX_PATH) { errno = ENAMETOOLONG; return TCL_ERROR; } srcAttr = 0; } if (dstAttr == 0xffffffff) { - if ((*tclWinProcs->getFullPathNameProc)(nativeDst, 0, NULL, NULL) >= MAX_PATH) { + if ((*tclWinProcs->getFullPathNameProc)(nativeDst, 0, NULL, + NULL) >= MAX_PATH) { errno = ENAMETOOLONG; return TCL_ERROR; } @@ -322,7 +324,7 @@ DoRenameFile( return TCL_ERROR; } if (errno == EACCES) { - decode: + decode: if (srcAttr & FILE_ATTRIBUTE_DIRECTORY) { TCHAR *nativeSrcRest, *nativeDstRest; CONST char **srcArgv, **dstArgv; @@ -332,12 +334,12 @@ DoRenameFile( Tcl_DString srcString, dstString; CONST char *src, *dst; - size = (*tclWinProcs->getFullPathNameProc)(nativeSrc, MAX_PATH, + size = (*tclWinProcs->getFullPathNameProc)(nativeSrc, MAX_PATH, nativeSrcPath, &nativeSrcRest); if ((size == 0) || (size > MAX_PATH)) { return TCL_ERROR; } - size = (*tclWinProcs->getFullPathNameProc)(nativeDst, MAX_PATH, + size = (*tclWinProcs->getFullPathNameProc)(nativeDst, MAX_PATH, nativeDstPath, &nativeDstRest); if ((size == 0) || (size > MAX_PATH)) { return TCL_ERROR; @@ -347,7 +349,17 @@ DoRenameFile( src = Tcl_WinTCharToUtf((TCHAR *) nativeSrcPath, -1, &srcString); dst = Tcl_WinTCharToUtf((TCHAR *) nativeDstPath, -1, &dstString); - if (strncmp(src, dst, (size_t) Tcl_DStringLength(&srcString)) == 0) { + + /* + * Check whether the destination path is actually inside the + * source path. This is true if the prefix matches, and the next + * character is either end-of-string or a directory separator + */ + + if ((strncmp(src, dst, (size_t) Tcl_DStringLength(&srcString))==0) + && (dst[Tcl_DStringLength(&srcString)] == '\\' + || dst[Tcl_DStringLength(&srcString)] == '/' + || dst[Tcl_DStringLength(&srcString)] == '\0')) { /* * Trying to move a directory into itself. */ @@ -364,22 +376,20 @@ DoRenameFile( if (srcArgc == 1) { /* - * They are trying to move a root directory. Whether - * or not it is across filesystems, this cannot be - * done. + * They are trying to move a root directory. Whether or not it + * is across filesystems, this cannot be done. */ Tcl_SetErrno(EINVAL); } else if ((srcArgc > 0) && (dstArgc > 0) && (strcmp(srcArgv[0], dstArgv[0]) != 0)) { /* - * If src is a directory and dst filesystem != src - * filesystem, errno should be EXDEV. It is very - * important to get this behavior, so that the caller - * can respond to a cross filesystem rename by - * simulating it with copy and delete. The MoveFile - * system call already handles the case of moving a - * file between filesystems. + * If src is a directory and dst filesystem != src filesystem, + * errno should be EXDEV. It is very important to get this + * behavior, so that the caller can respond to a cross + * filesystem rename by simulating it with copy and delete. + * The MoveFile system call already handles the case of moving + * a file between filesystems. */ Tcl_SetErrno(EXDEV); @@ -391,39 +401,40 @@ DoRenameFile( /* * Other types of access failure is that dst is a read-only - * filesystem, that an open file referred to src or dest, or that - * src or dest specified the current working directory on the - * current filesystem. EACCES is returned for those cases. + * filesystem, that an open file referred to src or dest, or that src + * or dest specified the current working directory on the current + * filesystem. EACCES is returned for those cases. */ } else if (Tcl_GetErrno() == EEXIST) { /* - * Reports EEXIST any time the target already exists. If it makes + * Reports EEXIST any time the target already exists. If it makes * sense, remove the old file and try renaming again. */ if (srcAttr & FILE_ATTRIBUTE_DIRECTORY) { if (dstAttr & FILE_ATTRIBUTE_DIRECTORY) { /* - * Overwrite empty dst directory with src directory. The - * following call will remove an empty directory. If it - * fails, it's because it wasn't empty. + * Overwrite empty dst directory with src directory. The + * following call will remove an empty directory. If it fails, + * it's because it wasn't empty. */ if (DoRemoveJustDirectory(nativeDst, 0, NULL) == TCL_OK) { /* * Now that that empty directory is gone, we can try - * renaming again. If that fails, we'll put this empty + * renaming again. If that fails, we'll put this empty * directory back, for completeness. */ - if ((*tclWinProcs->moveFileProc)(nativeSrc, nativeDst) != FALSE) { + if ((*tclWinProcs->moveFileProc)(nativeSrc, + nativeDst) != FALSE) { return TCL_OK; } /* - * Some new error has occurred. Don't know what it - * could be, but report this one. + * Some new error has occurred. Don't know what it could + * be, but report this one. */ TclWinConvertError(GetLastError()); @@ -446,18 +457,18 @@ DoRenameFile( } else { /* * Overwrite existing file by: - * + * * 1. Rename existing file to temp name. * 2. Rename old file to new name. - * 3. If success, delete temp file. If failure, - * put temp file back to old name. + * 3. If success, delete temp file. If failure, put temp file + * back to old name. */ TCHAR *nativeRest, *nativeTmp, *nativePrefix; int result, size; WCHAR tempBuf[MAX_PATH]; - - size = (*tclWinProcs->getFullPathNameProc)(nativeDst, MAX_PATH, + + size = (*tclWinProcs->getFullPathNameProc)(nativeDst, MAX_PATH, tempBuf, &nativeRest); if ((size == 0) || (size > MAX_PATH) || (nativeRest == NULL)) { return TCL_ERROR; @@ -467,9 +478,9 @@ DoRenameFile( ((char *) nativeRest)[1] = '\0'; /* In case it's Unicode. */ result = TCL_ERROR; - nativePrefix = (tclWinProcs->useWide) + nativePrefix = (tclWinProcs->useWide) ? (TCHAR *) L"tclr" : (TCHAR *) "tclr"; - if ((*tclWinProcs->getTempFileNameProc)(nativeTmp, + if ((*tclWinProcs->getTempFileNameProc)(nativeTmp, nativePrefix, 0, tempBuf) != 0) { /* * Strictly speaking, need the following DeleteFile and @@ -477,12 +488,14 @@ DoRenameFile( * other app comes along in the meantime and creates the * same temp file. */ - + nativeTmp = (TCHAR *) tempBuf; (*tclWinProcs->deleteFileProc)(nativeTmp); - if ((*tclWinProcs->moveFileProc)(nativeDst, nativeTmp) != FALSE) { - if ((*tclWinProcs->moveFileProc)(nativeSrc, nativeDst) != FALSE) { - (*tclWinProcs->setFileAttributesProc)(nativeTmp, + if ((*tclWinProcs->moveFileProc)(nativeDst, + nativeTmp) != FALSE) { + if ((*tclWinProcs->moveFileProc)(nativeSrc, + nativeDst) != FALSE) { + (*tclWinProcs->setFileAttributesProc)(nativeTmp, FILE_ATTRIBUTE_NORMAL); (*tclWinProcs->deleteFileProc)(nativeTmp); return TCL_OK; @@ -490,11 +503,11 @@ DoRenameFile( (*tclWinProcs->deleteFileProc)(nativeDst); (*tclWinProcs->moveFileProc)(nativeTmp, nativeDst); } - } + } /* - * Can't backup dst file or move src file. Return that - * error. Could happen if an open file refers to dst. + * Can't backup dst file or move src file. Return that + * error. Could happen if an open file refers to dst. */ TclWinConvertError(GetLastError()); @@ -518,19 +531,19 @@ DoRenameFile( * * TclpObjCopyFile, DoCopyFile -- * - * Copy a single file (not a directory). If dst already exists and - * is not a directory, it is removed. + * Copy a single file (not a directory). If dst already exists and is not + * a directory, it is removed. * * Results: - * If the file was successfully copied, returns TCL_OK. Otherwise - * the return value is TCL_ERROR and errno is set to indicate the - * error. Some possible values for errno are: + * If the file was successfully copied, returns TCL_OK. Otherwise the + * return value is TCL_ERROR and errno is set to indicate the error. + * Some possible values for errno are: * - * EACCES: src or dst parent directory can't be read and/or written. + * EACCES: src or dst parent directory can't be read and/or written. * EISDIR: src or dst is a directory. - * ENOENT: src doesn't exist. src or dst is "". + * ENOENT: src doesn't exist. src or dst is "". * - * EACCES: exists an open file already referring to dst (95). + * EACCES: exists an open file already referring to dst (95). * EACCES: src specifies a char device (nul:, com1:, etc.) (NT) * ENOENT: src specifies a char device (nul:, com1:, etc.) (95) * @@ -540,19 +553,19 @@ DoRenameFile( *--------------------------------------------------------------------------- */ -int -TclpObjCopyFile(srcPathPtr, destPathPtr) - Tcl_Obj *srcPathPtr; - Tcl_Obj *destPathPtr; +int +TclpObjCopyFile( + Tcl_Obj *srcPathPtr, + Tcl_Obj *destPathPtr) { return DoCopyFile(Tcl_FSGetNativePath(srcPathPtr), - Tcl_FSGetNativePath(destPathPtr)); + Tcl_FSGetNativePath(destPathPtr)); } static int DoCopyFile( - CONST TCHAR *nativeSrc, /* Pathname of file to be copied (native). */ - CONST TCHAR *nativeDst) /* Pathname of file to copy to (native). */ + CONST TCHAR *nativeSrc, /* Pathname of file to be copied (native). */ + CONST TCHAR *nativeDst) /* Pathname of file to copy to (native). */ { #if defined(HAVE_NO_SEH) && !defined(_WIN64) EXCEPTION_REGISTRATION registration; @@ -560,28 +573,26 @@ DoCopyFile( int retval = -1; /* - * The CopyFile API acts differently under Win95/98 and NT - * WRT NULL and "". Avoid passing these values. + * The CopyFile API acts differently under Win95/98 and NT WRT NULL and + * "". Avoid passing these values. */ if (nativeSrc == NULL || nativeSrc[0] == '\0' || - nativeDst == NULL || nativeDst[0] == '\0') { + nativeDst == NULL || nativeDst[0] == '\0') { Tcl_SetErrno(ENOENT); return TCL_ERROR; } - + /* - * The CopyFile API would throw an exception under NT if one - * of the arguments is a char block device. + * The CopyFile API would throw an exception under NT if one of the + * arguments is a char block device. */ #if defined(HAVE_NO_SEH) && !defined(_WIN64) - /* - * Don't have SEH available, do things the hard way. - * Note that this needs to be one block of asm, to avoid stack - * imbalance; also, it is illegal for one asm block to contain - * a jump to another. + * Don't have SEH available, do things the hard way. Note that this needs + * to be one block of asm, to avoid stack imbalance; also, it is illegal + * for one asm block to contain a jump to another. */ __asm__ __volatile__ ( @@ -590,71 +601,77 @@ DoCopyFile( * Pick up parameters before messing with the stack */ - "movl %[nativeDst], %%ebx" "\n\t" - "movl %[nativeSrc], %%ecx" "\n\t" + "movl %[nativeDst], %%ebx" "\n\t" + "movl %[nativeSrc], %%ecx" "\n\t" + + /* + * Construct an EXCEPTION_REGISTRATION to protect the call to + * CopyFile. + */ + + "leal %[registration], %%edx" "\n\t" + "movl %%fs:0, %%eax" "\n\t" + "movl %%eax, 0x0(%%edx)" "\n\t" /* link */ + "leal 1f, %%eax" "\n\t" + "movl %%eax, 0x4(%%edx)" "\n\t" /* handler */ + "movl %%ebp, 0x8(%%edx)" "\n\t" /* ebp */ + "movl %%esp, 0xc(%%edx)" "\n\t" /* esp */ + "movl $0, 0x10(%%edx)" "\n\t" /* status */ + /* - * Construct an EXCEPTION_REGISTRATION to protect the - * call to CopyFile + * Link the EXCEPTION_REGISTRATION on the chain. */ - "leal %[registration], %%edx" "\n\t" - "movl %%fs:0, %%eax" "\n\t" - "movl %%eax, 0x0(%%edx)" "\n\t" /* link */ - "leal 1f, %%eax" "\n\t" - "movl %%eax, 0x4(%%edx)" "\n\t" /* handler */ - "movl %%ebp, 0x8(%%edx)" "\n\t" /* ebp */ - "movl %%esp, 0xc(%%edx)" "\n\t" /* esp */ - "movl $0, 0x10(%%edx)" "\n\t" /* status */ - - /* Link the EXCEPTION_REGISTRATION on the chain */ - - "movl %%edx, %%fs:0" "\n\t" - - /* Call CopyFile( nativeSrc, nativeDst, 0 ) */ - + + "movl %%edx, %%fs:0" "\n\t" + + /* + * Call CopyFile(nativeSrc, nativeDst, 0) + */ + "movl %[copyFile], %%eax" "\n\t" - "pushl $0" "\n\t" + "pushl $0" "\n\t" "pushl %%ebx" "\n\t" "pushl %%ecx" "\n\t" "call *%%eax" "\n\t" - - /* - * Come here on normal exit. Recover the EXCEPTION_REGISTRATION - * and put the status return from CopyFile into it. + + /* + * Come here on normal exit. Recover the EXCEPTION_REGISTRATION and + * put the status return from CopyFile into it. */ - + "movl %%fs:0, %%edx" "\n\t" "movl %%eax, 0x10(%%edx)" "\n\t" "jmp 2f" "\n" - + /* - * Come here on an exception. Recover the EXCEPTION_REGISTRATION + * Come here on an exception. Recover the EXCEPTION_REGISTRATION */ - + "1:" "\t" - "movl %%fs:0, %%edx" "\n\t" - "movl 0x8(%%edx), %%edx" "\n\t" - - /* - * Come here however we exited. Restore context from the + "movl %%fs:0, %%edx" "\n\t" + "movl 0x8(%%edx), %%edx" "\n\t" + + /* + * Come here however we exited. Restore context from the * EXCEPTION_REGISTRATION in case the stack is unbalanced. */ - - "2:" "\t" - "movl 0xc(%%edx), %%esp" "\n\t" - "movl 0x8(%%edx), %%ebp" "\n\t" - "movl 0x0(%%edx), %%eax" "\n\t" - "movl %%eax, %%fs:0" "\n\t" - + + "2:" "\t" + "movl 0xc(%%edx), %%esp" "\n\t" + "movl 0x8(%%edx), %%ebp" "\n\t" + "movl 0x0(%%edx), %%eax" "\n\t" + "movl %%eax, %%fs:0" "\n\t" + : /* No outputs */ - : - [registration] "m" (registration), - [nativeDst] "m" (nativeDst), - [nativeSrc] "m" (nativeSrc), - [copyFile] "r" (tclWinProcs->copyFileProc) - : + : + [registration] "m" (registration), + [nativeDst] "m" (nativeDst), + [nativeSrc] "m" (nativeSrc), + [copyFile] "r" (tclWinProcs->copyFileProc) + : "%eax", "%ebx", "%ecx", "%edx", "memory" - ); + ); if (registration.status != FALSE) { retval = TCL_OK; } @@ -670,8 +687,9 @@ DoCopyFile( #endif #endif - if (retval != -1) - return retval; + if (retval != -1) { + return retval; + } TclWinConvertError(GetLastError()); if (Tcl_GetErrno() == EBADF) { @@ -691,21 +709,23 @@ DoCopyFile( (dstAttr & FILE_ATTRIBUTE_DIRECTORY)) { if (srcAttr & FILE_ATTRIBUTE_REPARSE_POINT) { /* Source is a symbolic link -- copy it */ - if (TclWinSymLinkCopyDirectory(nativeSrc, nativeDst) == 0) { - return TCL_OK; + if (TclWinSymLinkCopyDirectory(nativeSrc, nativeDst)==0) { + return TCL_OK; } } Tcl_SetErrno(EISDIR); } if (dstAttr & FILE_ATTRIBUTE_READONLY) { - (*tclWinProcs->setFileAttributesProc)(nativeDst, + (*tclWinProcs->setFileAttributesProc)(nativeDst, dstAttr & ~((DWORD)FILE_ATTRIBUTE_READONLY)); - if ((*tclWinProcs->copyFileProc)(nativeSrc, nativeDst, 0) != FALSE) { + if ((*tclWinProcs->copyFileProc)(nativeSrc, nativeDst, + 0) != FALSE) { return TCL_OK; } + /* - * Still can't copy onto dst. Return that error, and - * restore attributes of dst. + * Still can't copy onto dst. Return that error, and restore + * attributes of dst. */ TclWinConvertError(GetLastError()); @@ -721,29 +741,29 @@ DoCopyFile( * * TclpObjDeleteFile, TclpDeleteFile -- * - * Removes a single file (not a directory). + * Removes a single file (not a directory). * * Results: - * If the file was successfully deleted, returns TCL_OK. Otherwise - * the return value is TCL_ERROR and errno is set to indicate the - * error. Some possible values for errno are: + * If the file was successfully deleted, returns TCL_OK. Otherwise the + * return value is TCL_ERROR and errno is set to indicate the error. + * Some possible values for errno are: * - * EACCES: a parent directory can't be read and/or written. + * EACCES: a parent directory can't be read and/or written. * EISDIR: path is a directory. * ENOENT: path doesn't exist or is "". * - * EACCES: exists an open file already referring to path. + * EACCES: exists an open file already referring to path. * EACCES: path is a char device (nul:, com1:, etc.) * * Side effects: - * The file is deleted, even if it is read-only. + * The file is deleted, even if it is read-only. * *--------------------------------------------------------------------------- */ -int -TclpObjDeleteFile(pathPtr) - Tcl_Obj *pathPtr; +int +TclpObjDeleteFile( + Tcl_Obj *pathPtr) { return TclpDeleteFile(Tcl_FSGetNativePath(pathPtr)); } @@ -755,8 +775,8 @@ TclpDeleteFile( DWORD attr; /* - * The DeleteFile API acts differently under Win95/98 and NT - * WRT NULL and "". Avoid passing these values. + * The DeleteFile API acts differently under Win95/98 and NT WRT NULL and + * "". Avoid passing these values. */ if (nativePath == NULL || nativePath[0] == '\0') { @@ -770,27 +790,30 @@ TclpDeleteFile( TclWinConvertError(GetLastError()); if (Tcl_GetErrno() == EACCES) { - attr = (*tclWinProcs->getFileAttributesProc)(nativePath); + attr = (*tclWinProcs->getFileAttributesProc)(nativePath); if (attr != 0xffffffff) { if (attr & FILE_ATTRIBUTE_DIRECTORY) { if (attr & FILE_ATTRIBUTE_REPARSE_POINT) { - /* It is a symbolic link -- remove it */ + /* + * It is a symbolic link - remove it. + */ if (TclWinSymLinkDelete(nativePath, 0) == 0) { - return TCL_OK; + return TCL_OK; } } - - /* + + /* * If we fall through here, it is a directory. - * + * * Windows NT reports removing a directory as EACCES instead * of EISDIR. */ Tcl_SetErrno(EISDIR); } else if (attr & FILE_ATTRIBUTE_READONLY) { - int res = (*tclWinProcs->setFileAttributesProc)(nativePath, + int res = (*tclWinProcs->setFileAttributesProc)(nativePath, attr & ~((DWORD)FILE_ATTRIBUTE_READONLY)); + if ((res != 0) && ((*tclWinProcs->deleteFileProc)(nativePath) != FALSE)) { return TCL_OK; @@ -802,12 +825,12 @@ TclpDeleteFile( } } } else if (Tcl_GetErrno() == ENOENT) { - attr = (*tclWinProcs->getFileAttributesProc)(nativePath); + attr = (*tclWinProcs->getFileAttributesProc)(nativePath); if (attr != 0xffffffff) { if (attr & FILE_ATTRIBUTE_DIRECTORY) { - /* - * Windows 95 reports removing a directory as ENOENT instead - * of EISDIR. + /* + * Windows 95 reports removing a directory as ENOENT instead + * of EISDIR. */ Tcl_SetErrno(EISDIR); @@ -830,29 +853,29 @@ TclpDeleteFile( * * TclpObjCreateDirectory -- * - * Creates the specified directory. All parent directories of the - * specified directory must already exist. The directory is - * automatically created with permissions so that user can access - * the new directory and create new files or subdirectories in it. + * Creates the specified directory. All parent directories of the + * specified directory must already exist. The directory is automatically + * created with permissions so that user can access the new directory and + * create new files or subdirectories in it. * * Results: - * If the directory was successfully created, returns TCL_OK. - * Otherwise the return value is TCL_ERROR and errno is set to - * indicate the error. Some possible values for errno are: + * If the directory was successfully created, returns TCL_OK. Otherwise + * the return value is TCL_ERROR and errno is set to indicate the error. + * Some possible values for errno are: * - * EACCES: a parent directory can't be read and/or written. + * EACCES: a parent directory can't be read and/or written. * EEXIST: path already exists. * ENOENT: a parent directory doesn't exist. * * Side effects: - * A directory is created. + * A directory is created. * *--------------------------------------------------------------------------- */ -int -TclpObjCreateDirectory(pathPtr) - Tcl_Obj *pathPtr; +int +TclpObjCreateDirectory( + Tcl_Obj *pathPtr) { return DoCreateDirectory(Tcl_FSGetNativePath(pathPtr)); } @@ -866,7 +889,7 @@ DoCreateDirectory( error = GetLastError(); TclWinConvertError(error); return TCL_ERROR; - } + } return TCL_OK; } @@ -875,32 +898,30 @@ DoCreateDirectory( * * TclpObjCopyDirectory -- * - * Recursively copies a directory. The target directory dst must - * not already exist. Note that this function does not merge two - * directory hierarchies, even if the target directory is an an - * empty directory. + * Recursively copies a directory. The target directory dst must not + * already exist. Note that this function does not merge two directory + * hierarchies, even if the target directory is an an empty directory. * * Results: - * If the directory was successfully copied, returns TCL_OK. - * Otherwise the return value is TCL_ERROR, errno is set to indicate - * the error, and the pathname of the file that caused the error - * is stored in errorPtr. See TclpCreateDirectory and TclpCopyFile - * for a description of possible values for errno. + * If the directory was successfully copied, returns TCL_OK. Otherwise + * the return value is TCL_ERROR, errno is set to indicate the error, and + * the pathname of the file that caused the error is stored in errorPtr. + * See TclpCreateDirectory and TclpCopyFile for a description of possible + * values for errno. * * Side effects: - * An exact copy of the directory hierarchy src will be created - * with the name dst. If an error occurs, the error will - * be returned immediately, and remaining files will not be - * processed. + * An exact copy of the directory hierarchy src will be created with the + * name dst. If an error occurs, the error will be returned immediately, + * and remaining files will not be processed. * *--------------------------------------------------------------------------- */ -int -TclpObjCopyDirectory(srcPathPtr, destPathPtr, errorPtr) - Tcl_Obj *srcPathPtr; - Tcl_Obj *destPathPtr; - Tcl_Obj **errorPtr; +int +TclpObjCopyDirectory( + Tcl_Obj *srcPathPtr, + Tcl_Obj *destPathPtr, + Tcl_Obj **errorPtr) { Tcl_DString ds; Tcl_DString srcString, dstString; @@ -908,14 +929,12 @@ TclpObjCopyDirectory(srcPathPtr, destPathPtr, errorPtr) int ret; normSrcPtr = Tcl_FSGetNormalizedPath(NULL,srcPathPtr); - if (normSrcPtr == NULL) { - return TCL_ERROR; - } - Tcl_WinUtfToTChar(Tcl_GetString(normSrcPtr), -1, &srcString); normDestPtr = Tcl_FSGetNormalizedPath(NULL,destPathPtr); - if (normDestPtr == NULL) { + if ((normSrcPtr == NULL) || (normDestPtr == NULL)) { return TCL_ERROR; } + + Tcl_WinUtfToTChar(Tcl_GetString(normSrcPtr), -1, &srcString); Tcl_WinUtfToTChar(Tcl_GetString(normDestPtr), -1, &dstString); ret = TraverseWinTree(TraversalCopy, &srcString, &dstString, &ds); @@ -924,9 +943,9 @@ TclpObjCopyDirectory(srcPathPtr, destPathPtr, errorPtr) Tcl_DStringFree(&dstString); if (ret != TCL_OK) { - if (!strcmp(Tcl_DStringValue(&ds), Tcl_GetString(normSrcPtr))) { + if (!strcmp(Tcl_DStringValue(&ds), TclGetString(normSrcPtr))) { *errorPtr = srcPathPtr; - } else if (!strcmp(Tcl_DStringValue(&ds), Tcl_GetString(normDestPtr))) { + } else if (!strcmp(Tcl_DStringValue(&ds), TclGetString(normDestPtr))) { *errorPtr = destPathPtr; } else { *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1); @@ -940,47 +959,49 @@ TclpObjCopyDirectory(srcPathPtr, destPathPtr, errorPtr) /* *---------------------------------------------------------------------- * - * TclpObjRemoveDirectory, DoRemoveDirectory -- + * TclpObjRemoveDirectory, DoRemoveDirectory -- * * Removes directory (and its contents, if the recursive flag is set). * * Results: - * If the directory was successfully removed, returns TCL_OK. - * Otherwise the return value is TCL_ERROR, errno is set to indicate - * the error, and the pathname of the file that caused the error - * is stored in errorPtr. Some possible values for errno are: + * If the directory was successfully removed, returns TCL_OK. Otherwise + * the return value is TCL_ERROR, errno is set to indicate the error, and + * the pathname of the file that caused the error is stored in errorPtr. + * Some possible values for errno are: * - * EACCES: path directory can't be read and/or written. + * EACCES: path directory can't be read and/or written. * EEXIST: path is a non-empty directory. * EINVAL: path is root directory or current directory. * ENOENT: path doesn't exist or is "". - * ENOTDIR: path is not a directory. + * ENOTDIR: path is not a directory. * * EACCES: path is a char device (nul:, com1:, etc.) (95) * EINVAL: path is a char device (nul:, com1:, etc.) (NT) * * Side effects: - * Directory removed. If an error occurs, the error will be returned + * Directory removed. If an error occurs, the error will be returned * immediately, and remaining files will not be deleted. * *---------------------------------------------------------------------- */ -int -TclpObjRemoveDirectory(pathPtr, recursive, errorPtr) - Tcl_Obj *pathPtr; - int recursive; - Tcl_Obj **errorPtr; +int +TclpObjRemoveDirectory( + Tcl_Obj *pathPtr, + int recursive, + Tcl_Obj **errorPtr) { Tcl_DString ds; Tcl_Obj *normPtr = NULL; int ret; + if (recursive) { - /* + /* * In the recursive case, the string rep is used to construct a - * Tcl_DString which may be used extensively, so we can't - * optimize this case easily. + * Tcl_DString which may be used extensively, so we can't optimize + * this case easily. */ + Tcl_DString native; normPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr); if (normPtr == NULL) { @@ -990,14 +1011,14 @@ TclpObjRemoveDirectory(pathPtr, recursive, errorPtr) ret = DoRemoveDirectory(&native, recursive, &ds); Tcl_DStringFree(&native); } else { - ret = DoRemoveJustDirectory(Tcl_FSGetNativePath(pathPtr), - 0, &ds); + ret = DoRemoveJustDirectory(Tcl_FSGetNativePath(pathPtr), 0, &ds); } + if (ret != TCL_OK) { int len = Tcl_DStringLength(&ds); if (len > 0) { - if (normPtr != NULL - && !strcmp(Tcl_DStringValue(&ds), Tcl_GetString(normPtr))) { + if (normPtr != NULL && + !strcmp(Tcl_DStringValue(&ds), TclGetString(normPtr))) { *errorPtr = pathPtr; } else { *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1); @@ -1006,6 +1027,7 @@ TclpObjRemoveDirectory(pathPtr, recursive, errorPtr) } Tcl_DStringFree(&ds); } + return ret; } @@ -1013,16 +1035,17 @@ static int DoRemoveJustDirectory( CONST TCHAR *nativePath, /* Pathname of directory to be removed * (native). */ - int ignoreError, /* If non-zero, don't initialize the - * errorPtr under some circumstances - * on return. */ - Tcl_DString *errorPtr) /* If non-NULL, uninitialized or free - * DString filled with UTF-8 name of file - * causing error. */ + int ignoreError, /* If non-zero, don't initialize the errorPtr + * under some circumstances on return. */ + Tcl_DString *errorPtr) /* If non-NULL, uninitialized or free DString + * filled with UTF-8 name of file causing + * error. */ { + DWORD attr; + /* - * The RemoveDirectory API acts differently under Win95/98 and NT - * WRT NULL and "". Avoid passing these values. + * The RemoveDirectory API acts differently under Win95/98 and NT WRT NULL + * and "". Avoid passing these values. */ if (nativePath == NULL || nativePath[0] == '\0') { @@ -1030,48 +1053,68 @@ DoRemoveJustDirectory( goto end; } - if ((*tclWinProcs->removeDirectoryProc)(nativePath) != FALSE) { - return TCL_OK; + attr = (*tclWinProcs->getFileAttributesProc)(nativePath); + + if (attr & FILE_ATTRIBUTE_REPARSE_POINT) { + /* + * It is a symbolic link - remove it. + */ + if (TclWinSymLinkDelete(nativePath, 0) == 0) { + return TCL_OK; + } + } else { + /* + * Ordinary directory. + */ + + if ((*tclWinProcs->removeDirectoryProc)(nativePath) != FALSE) { + return TCL_OK; + } } + TclWinConvertError(GetLastError()); if (Tcl_GetErrno() == EACCES) { - DWORD attr = (*tclWinProcs->getFileAttributesProc)(nativePath); + attr = (*tclWinProcs->getFileAttributesProc)(nativePath); if (attr != 0xffffffff) { if ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0) { - /* - * Windows 95 reports calling RemoveDirectory on a file as an + /* + * Windows 95 reports calling RemoveDirectory on a file as an * EACCES, not an ENOTDIR. */ - + Tcl_SetErrno(ENOTDIR); goto end; } if (attr & FILE_ATTRIBUTE_REPARSE_POINT) { - /* It is a symbolic link -- remove it */ + /* + * It is a symbolic link - remove it. + */ + if (TclWinSymLinkDelete(nativePath, 1) != 0) { goto end; } } - + if (attr & FILE_ATTRIBUTE_READONLY) { attr &= ~FILE_ATTRIBUTE_READONLY; - if ((*tclWinProcs->setFileAttributesProc)(nativePath, attr) == FALSE) { + if ((*tclWinProcs->setFileAttributesProc)(nativePath, + attr) == FALSE) { goto end; } if ((*tclWinProcs->removeDirectoryProc)(nativePath) != FALSE) { return TCL_OK; } TclWinConvertError(GetLastError()); - (*tclWinProcs->setFileAttributesProc)(nativePath, + (*tclWinProcs->setFileAttributesProc)(nativePath, attr | FILE_ATTRIBUTE_READONLY); } - /* - * Windows 95 and Win32s report removing a non-empty directory - * as EACCES, not EEXIST. If the directory is not empty, - * change errno so caller knows what's going on. + /* + * Windows 95 and Win32s report removing a non-empty directory as + * EACCES, not EEXIST. If the directory is not empty, change errno + * so caller knows what's going on. */ if (TclWinGetPlatformId() != VER_PLATFORM_WIN32_NT) { @@ -1112,24 +1155,25 @@ DoRemoveJustDirectory( } } } + if (Tcl_GetErrno() == ENOTEMPTY) { - /* - * The caller depends on EEXIST to signify that the directory is - * not empty, not ENOTEMPTY. + /* + * The caller depends on EEXIST to signify that the directory is not + * empty, not ENOTEMPTY. */ Tcl_SetErrno(EEXIST); } + if ((ignoreError != 0) && (Tcl_GetErrno() == EEXIST)) { - /* - * If we're being recursive, this error may actually - * be ok, so we don't want to initialise the errorPtr - * yet. + /* + * If we're being recursive, this error may actually be ok, so we + * don't want to initialise the errorPtr yet. */ return TCL_ERROR; } - end: + end: if (errorPtr != NULL) { Tcl_WinTCharToUtf(nativePath, -1, errorPtr); } @@ -1141,21 +1185,22 @@ static int DoRemoveDirectory( Tcl_DString *pathPtr, /* Pathname of directory to be removed * (native). */ - int recursive, /* If non-zero, removes directories that - * are nonempty. Otherwise, will only remove - * empty directories. */ - Tcl_DString *errorPtr) /* If non-NULL, uninitialized or free - * DString filled with UTF-8 name of file - * causing error. */ + int recursive, /* If non-zero, removes directories that are + * nonempty. Otherwise, will only remove empty + * directories. */ + Tcl_DString *errorPtr) /* If non-NULL, uninitialized or free DString + * filled with UTF-8 name of file causing + * error. */ { - int res = DoRemoveJustDirectory(Tcl_DStringValue(pathPtr), recursive, - errorPtr); - + int res = DoRemoveJustDirectory(Tcl_DStringValue(pathPtr), recursive, + errorPtr); + if ((res == TCL_ERROR) && (recursive != 0) && (Tcl_GetErrno() == EEXIST)) { /* * The directory is nonempty, but the recursive flag has been * specified, so we recursively remove all the files in the directory. */ + return TraverseWinTree(TraversalDelete, pathPtr, NULL, errorPtr); } else { return res; @@ -1167,24 +1212,24 @@ DoRemoveDirectory( * * TraverseWinTree -- * - * Traverse directory tree specified by sourcePtr, calling the function - * traverseProc for each file and directory encountered. If destPtr - * is non-null, each of name in the sourcePtr directory is appended to - * the directory specified by destPtr and passed as the second argument - * to traverseProc() . + * Traverse directory tree specified by sourcePtr, calling the function + * traverseProc for each file and directory encountered. If destPtr is + * non-null, each of name in the sourcePtr directory is appended to the + * directory specified by destPtr and passed as the second argument to + * traverseProc(). * * Results: - * Standard Tcl result. + * Standard Tcl result. * * Side effects: - * None caused by TraverseWinTree, however the user specified - * traverseProc() may change state. If an error occurs, the error will - * be returned immediately, and remaining files will not be processed. + * None caused by TraverseWinTree, however the user specified + * traverseProc() may change state. If an error occurs, the error will be + * returned immediately, and remaining files will not be processed. * *--------------------------------------------------------------------------- */ -static int +static int TraverseWinTree( TraversalProc *traverseProc,/* Function to call for every file and * directory in source hierarchy. */ @@ -1193,9 +1238,9 @@ TraverseWinTree( Tcl_DString *targetPtr, /* Pathname of directory to traverse in * parallel with source directory (native), * may be NULL. */ - Tcl_DString *errorPtr) /* If non-NULL, uninitialized or free - * DString filled with UTF-8 name of file - * causing error. */ + Tcl_DString *errorPtr) /* If non-NULL, uninitialized or free DString + * filled with UTF-8 name of file causing + * error. */ { DWORD sourceAttr; TCHAR *nativeSource, *nativeTarget, *nativeErrfile; @@ -1208,15 +1253,25 @@ TraverseWinTree( oldTargetLen = 0; /* lint. */ nativeSource = (TCHAR *) Tcl_DStringValue(sourcePtr); - nativeTarget = (TCHAR *) (targetPtr == NULL - ? NULL : Tcl_DStringValue(targetPtr)); - + nativeTarget = (TCHAR *) + (targetPtr == NULL ? NULL : Tcl_DStringValue(targetPtr)); + oldSourceLen = Tcl_DStringLength(sourcePtr); sourceAttr = (*tclWinProcs->getFileAttributesProc)(nativeSource); if (sourceAttr == 0xffffffff) { nativeErrfile = nativeSource; goto end; } + + if (sourceAttr & FILE_ATTRIBUTE_REPARSE_POINT) { + /* + * Process the symbolic link + */ + + return (*traverseProc)(nativeSource, nativeTarget, DOTREE_LINK, + errorPtr); + } + if ((sourceAttr & FILE_ATTRIBUTE_DIRECTORY) == 0) { /* * Process the regular file @@ -1231,11 +1286,12 @@ TraverseWinTree( } else { Tcl_DStringAppend(sourcePtr, "\\*.*", 4); } + nativeSource = (TCHAR *) Tcl_DStringValue(sourcePtr); handle = (*tclWinProcs->findFirstFileProc)(nativeSource, &data); - if (handle == INVALID_HANDLE_VALUE) { - /* - * Can't read directory + if (handle == INVALID_HANDLE_VALUE) { + /* + * Can't read directory. */ TclWinConvertError(GetLastError()); @@ -1245,7 +1301,8 @@ TraverseWinTree( nativeSource[oldSourceLen + 1] = '\0'; Tcl_DStringSetLength(sourcePtr, oldSourceLen); - result = (*traverseProc)(nativeSource, nativeTarget, DOTREE_PRED, errorPtr); + result = (*traverseProc)(nativeSource, nativeTarget, DOTREE_PRED, + errorPtr); if (result != TCL_OK) { FindClose(handle); return result; @@ -1276,7 +1333,7 @@ TraverseWinTree( } found = 1; - for ( ; found; found = (*tclWinProcs->findNextFileProc)(handle, &data)) { + for (; found; found = (*tclWinProcs->findNextFileProc)(handle, &data)) { TCHAR *nativeName; int len; @@ -1296,7 +1353,7 @@ TraverseWinTree( nativeName = (TCHAR *) data.w.cFileName; len = wcslen(data.w.cFileName) * sizeof(WCHAR); } else { - if ((strcmp(data.a.cFileName, ".") == 0) + if ((strcmp(data.a.cFileName, ".") == 0) || (strcmp(data.a.cFileName, "..") == 0)) { continue; } @@ -1304,8 +1361,8 @@ TraverseWinTree( len = strlen(data.a.cFileName); } - /* - * Append name after slash, and recurse on the file. + /* + * Append name after slash, and recurse on the file. */ Tcl_DStringAppend(sourcePtr, (char *) nativeName, len + 1); @@ -1314,7 +1371,7 @@ TraverseWinTree( Tcl_DStringAppend(targetPtr, (char *) nativeName, len + 1); Tcl_DStringSetLength(targetPtr, Tcl_DStringLength(targetPtr) - 1); } - result = TraverseWinTree(traverseProc, sourcePtr, targetPtr, + result = TraverseWinTree(traverseProc, sourcePtr, targetPtr, errorPtr); if (result != TCL_OK) { break; @@ -1332,7 +1389,7 @@ TraverseWinTree( FindClose(handle); /* - * Strip off the trailing slash we added + * Strip off the trailing slash we added. */ Tcl_DStringSetLength(sourcePtr, oldSourceLen + 1); @@ -1347,11 +1404,12 @@ TraverseWinTree( * files in that directory. */ - result = (*traverseProc)(Tcl_DStringValue(sourcePtr), - (targetPtr == NULL ? NULL : Tcl_DStringValue(targetPtr)), - DOTREE_POSTD, errorPtr); + result = (*traverseProc)(Tcl_DStringValue(sourcePtr), + (targetPtr == NULL ? NULL : Tcl_DStringValue(targetPtr)), + DOTREE_POSTD, errorPtr); } - end: + + end: if (nativeErrfile != NULL) { TclWinConvertError(GetLastError()); if (errorPtr != NULL) { @@ -1368,19 +1426,19 @@ TraverseWinTree( * * TraversalCopy * - * Called from TraverseUnixTree in order to execute a recursive - * copy of a directory. + * Called from TraverseUnixTree in order to execute a recursive copy of a + * directory. * * Results: - * Standard Tcl result. + * Standard Tcl result. * * Side effects: - * Depending on the value of type, src may be copied to dst. - * + * Depending on the value of type, src may be copied to dst. + * *---------------------------------------------------------------------- */ -static int +static int TraversalCopy( CONST TCHAR *nativeSrc, /* Source pathname to copy. */ CONST TCHAR *nativeDst, /* Destination pathname of copy. */ @@ -1389,30 +1447,34 @@ TraversalCopy( * with UTF-8 name of file causing error. */ { switch (type) { - case DOTREE_F: { - if (DoCopyFile(nativeSrc, nativeDst) == TCL_OK) { - return TCL_OK; - } - break; - } - case DOTREE_PRED: { - if (DoCreateDirectory(nativeDst) == TCL_OK) { - DWORD attr = (*tclWinProcs->getFileAttributesProc)(nativeSrc); - if ((*tclWinProcs->setFileAttributesProc)(nativeDst, attr) != FALSE) { - return TCL_OK; - } - TclWinConvertError(GetLastError()); - } - break; + case DOTREE_F: + if (DoCopyFile(nativeSrc, nativeDst) == TCL_OK) { + return TCL_OK; } - case DOTREE_POSTD: { + break; + case DOTREE_LINK: + if (TclWinSymLinkCopyDirectory(nativeSrc, nativeDst) == TCL_OK) { return TCL_OK; } + break; + case DOTREE_PRED: + if (DoCreateDirectory(nativeDst) == TCL_OK) { + DWORD attr = (tclWinProcs->getFileAttributesProc)(nativeSrc); + + if ((tclWinProcs->setFileAttributesProc)(nativeDst, + attr) != FALSE) { + return TCL_OK; + } + TclWinConvertError(GetLastError()); + } + break; + case DOTREE_POSTD: + return TCL_OK; } /* - * There shouldn't be a problem with src, because we already - * checked it to get here. + * There shouldn't be a problem with src, because we already checked it to + * get here. */ if (errorPtr != NULL) { @@ -1426,24 +1488,24 @@ TraversalCopy( * * TraversalDelete -- * - * Called by procedure TraverseWinTree for every file and - * directory that it encounters in a directory hierarchy. This - * procedure unlinks files, and removes directories after all the - * containing files have been processed. + * Called by function TraverseWinTree for every file and directory that + * it encounters in a directory hierarchy. This function unlinks files, + * and removes directories after all the containing files have been + * processed. * * Results: - * Standard Tcl result. + * Standard Tcl result. * * Side effects: - * Files or directory specified by src will be deleted. If an - * error occurs, the windows error is converted to a Posix error - * and errno is set accordingly. + * Files or directory specified by src will be deleted. If an error + * occurs, the windows error is converted to a Posix error and errno is + * set accordingly. * *---------------------------------------------------------------------- */ static int -TraversalDelete( +TraversalDelete( CONST TCHAR *nativeSrc, /* Source pathname to delete. */ CONST TCHAR *dstPtr, /* Not used. */ int type, /* Reason for call - see TraverseWinTree() */ @@ -1451,21 +1513,23 @@ TraversalDelete( * with UTF-8 name of file causing error. */ { switch (type) { - case DOTREE_F: { - if (TclpDeleteFile(nativeSrc) == TCL_OK) { - return TCL_OK; - } - break; + case DOTREE_F: + if (TclpDeleteFile(nativeSrc) == TCL_OK) { + return TCL_OK; } - case DOTREE_PRED: { + break; + case DOTREE_LINK: + if (DoRemoveJustDirectory(nativeSrc, 0, NULL) == TCL_OK) { return TCL_OK; } - case DOTREE_POSTD: { - if (DoRemoveJustDirectory(nativeSrc, 0, NULL) == TCL_OK) { - return TCL_OK; - } - break; + break; + case DOTREE_PRED: + return TCL_OK; + case DOTREE_POSTD: + if (DoRemoveJustDirectory(nativeSrc, 0, NULL) == TCL_OK) { + return TCL_OK; } + break; } if (errorPtr != NULL) { @@ -1482,11 +1546,11 @@ TraversalDelete( * Sets the object result with the appropriate error. * * Results: - * None. + * None. * * Side effects: - * The interp's object result is set with an error message - * based on the objIndex, fileName and errno. + * The interp's object result is set with an error message based on the + * objIndex, fileName and errno. * *---------------------------------------------------------------------- */ @@ -1494,14 +1558,12 @@ TraversalDelete( static void StatError( Tcl_Interp *interp, /* The interp that has the error */ - Tcl_Obj *fileName) /* The name of the file which caused the + Tcl_Obj *fileName) /* The name of the file which caused the * error. */ { TclWinConvertError(GetLastError()); - Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), - "could not read \"", Tcl_GetString(fileName), - "\": ", Tcl_PosixError(interp), - (char *) NULL); + Tcl_AppendResult(interp, "could not read \"", TclGetString(fileName), + "\": ", Tcl_PosixError(interp), (char *) NULL); } /* @@ -1509,16 +1571,16 @@ StatError( * * GetWinFileAttributes -- * - * Returns a Tcl_Obj containing the value of a file attribute. - * This routine gets the -hidden, -readonly or -system attribute. + * Returns a Tcl_Obj containing the value of a file attribute. This + * routine gets the -hidden, -readonly or -system attribute. * * Results: - * Standard Tcl result and a Tcl_Obj in attributePtrPtr. The object - * will have ref count 0. If the return value is not TCL_OK, - * attributePtrPtr is not touched. + * Standard Tcl result and a Tcl_Obj in attributePtrPtr. The object will + * have ref count 0. If the return value is not TCL_OK, attributePtrPtr + * is not touched. * * Side effects: - * A new object is allocated if the file is valid. + * A new object is allocated if the file is valid. * *---------------------------------------------------------------------- */ @@ -1527,13 +1589,13 @@ static int GetWinFileAttributes( Tcl_Interp *interp, /* The interp we are using for errors. */ int objIndex, /* The index of the attribute. */ - Tcl_Obj *fileName, /* The name of the file. */ + Tcl_Obj *fileName, /* The name of the file. */ Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */ { DWORD result; CONST TCHAR *nativeName; int attr; - + nativeName = Tcl_FSGetNativePath(fileName); result = (*tclWinProcs->getFileAttributesProc)(nativeName); @@ -1544,31 +1606,39 @@ GetWinFileAttributes( attr = (int)(result & attributeArray[objIndex]); if ((objIndex == WIN_HIDDEN_ATTRIBUTE) && (attr != 0)) { - /* - * It is hidden. However there is a bug on some Windows - * OSes in which root volumes (drives) formatted as NTFS - * are declared hidden when they are not (and cannot be). - * + /* + * It is hidden. However there is a bug on some Windows OSes in which + * root volumes (drives) formatted as NTFS are declared hidden when + * they are not (and cannot be). + * * We test for, and fix that case, here. */ + int len; char *str = Tcl_GetStringFromObj(fileName,&len); + if (len < 4) { if (len == 0) { - /* - * Not sure if this is possible, but we pass it on - * anyway + /* + * Not sure if this is possible, but we pass it on anyway. */ } else if (len == 1 && (str[0] == '/' || str[0] == '\\')) { - /* Path is pointing to the root volume */ + /* + * Path is pointing to the root volume. + */ + attr = 0; - } else if ((str[1] == ':') - && (len == 2 || (str[2] == '/' || str[2] == '\\'))) { - /* Path is of the form 'x:' or 'x:/' or 'x:\' */ + } else if ((str[1] == ':') + && (len == 2 || (str[2] == '/' || str[2] == '\\'))) { + /* + * Path is of the form 'x:' or 'x:/' or 'x:\' + */ + attr = 0; } } } + *attributePtrPtr = Tcl_NewBooleanObj(attr); return TCL_OK; } @@ -1578,21 +1648,20 @@ GetWinFileAttributes( * * ConvertFileNameFormat -- * - * Returns a Tcl_Obj containing either the long or short version of the + * Returns a Tcl_Obj containing either the long or short version of the * file name. * * Results: - * Standard Tcl result and a Tcl_Obj in attributePtrPtr. The object - * will have ref count 0. If the return value is not TCL_OK, - * attributePtrPtr is not touched. - * - * Warning: if you pass this function a drive name like 'c:' it - * will actually return the current working directory on that - * drive. To avoid this, make sure the drive name ends in a - * slash, like this 'c:/'. + * Standard Tcl result and a Tcl_Obj in attributePtrPtr. The object will + * have ref count 0. If the return value is not TCL_OK, attributePtrPtr + * is not touched. + * + * Warning: if you pass this function a drive name like 'c:' it will + * actually return the current working directory on that drive. To avoid + * this, make sure the drive name ends in a slash, like this 'c:/'. * * Side effects: - * A new object is allocated if the file is valid. + * A new object is allocated if the file is valid. * *---------------------------------------------------------------------- */ @@ -1601,48 +1670,55 @@ static int ConvertFileNameFormat( Tcl_Interp *interp, /* The interp we are using for errors. */ int objIndex, /* The index of the attribute. */ - Tcl_Obj *fileName, /* The name of the file. */ + Tcl_Obj *fileName, /* The name of the file. */ int longShort, /* 0 to short name, 1 to long name. */ Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */ { int pathc, i; Tcl_Obj *splitPath; - int result = TCL_OK; splitPath = Tcl_FSSplitPath(fileName, &pathc); if (splitPath == NULL || pathc == 0) { if (interp != NULL) { - Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), - "could not read \"", Tcl_GetString(fileName), - "\": no such file or directory", - (char *) NULL); + Tcl_AppendResult(interp, "could not read \"", + Tcl_GetString(fileName), "\": no such file or directory", + (char *) NULL); } - result = TCL_ERROR; goto cleanup; } - + + /* + * We will decrement this again at the end. It is safer to do this in + * case any of the calls below retain a reference to splitPath. + */ + + Tcl_IncrRefCount(splitPath); + for (i = 0; i < pathc; i++) { Tcl_Obj *elt; char *pathv; int pathLen; + Tcl_ListObjIndex(NULL, splitPath, i, &elt); - + pathv = Tcl_GetStringFromObj(elt, &pathLen); - if ((pathv[0] == '/') - || ((pathLen == 3) && (pathv[1] == ':')) - || (strcmp(pathv, ".") == 0) - || (strcmp(pathv, "..") == 0)) { + if ((pathv[0] == '/') || ((pathLen == 3) && (pathv[1] == ':')) + || (strcmp(pathv, ".") == 0) || (strcmp(pathv, "..") == 0)) { /* * Handle "/", "//machine/export", "c:/", "." or ".." by just - * copying the string literally. Uppercase the drive letter, - * just because it looks better under Windows to do so. + * copying the string literally. Uppercase the drive letter, just + * because it looks better under Windows to do so. + */ + + simple: + /* + * Here we are modifying the string representation in place. + * + * I believe this is legal, since this won't affect any file + * representation this thing may have. */ - simple: - /* Here we are modifying the string representation in place */ - /* I believe this is legal, since this won't affect any - * file representation this thing may have. */ pathv[0] = (char) Tcl_UniCharToUpper(UCHAR(pathv[0])); } else { Tcl_Obj *tempPath; @@ -1657,10 +1733,12 @@ ConvertFileNameFormat( tempPath = Tcl_FSJoinPath(splitPath, i+1); Tcl_IncrRefCount(tempPath); - /* - * We'd like to call Tcl_FSGetNativePath(tempPath) - * but that is likely to lead to infinite loops + + /* + * We'd like to call Tcl_FSGetNativePath(tempPath) but that is + * likely to lead to infinite loops. */ + Tcl_DStringInit(&ds); tempString = Tcl_GetStringFromObj(tempPath,&tempLen); nativeName = Tcl_WinUtfToTChar(tempString, tempLen, &ds); @@ -1668,14 +1746,14 @@ ConvertFileNameFormat( handle = (*tclWinProcs->findFirstFileProc)(nativeName, &data); if (handle == INVALID_HANDLE_VALUE) { /* - * FindFirstFile() doesn't like root directories. We - * would only get a root directory here if the caller - * specified "c:" or "c:." and the current directory on the - * drive was the root directory + * FindFirstFile() doesn't like root directories. We would + * only get a root directory here if the caller specified "c:" + * or "c:." and the current directory on the drive was the + * root directory */ attr = (*tclWinProcs->getFileAttributesProc)(nativeName); - if ((attr != 0xFFFFFFFF) && (attr & FILE_ATTRIBUTE_DIRECTORY)) { + if ((attr!=0xFFFFFFFF) && (attr & FILE_ATTRIBUTE_DIRECTORY)) { Tcl_DStringFree(&ds); goto simple; } @@ -1686,7 +1764,6 @@ ConvertFileNameFormat( if (interp != NULL) { StatError(interp, fileName); } - result = TCL_ERROR; goto cleanup; } if (tclWinProcs->useWide) { @@ -1694,7 +1771,7 @@ ConvertFileNameFormat( if (longShort) { if (data.w.cFileName[0] != '\0') { nativeName = (TCHAR *) data.w.cFileName; - } + } } else { if (data.w.cAlternateFileName[0] == '\0') { nativeName = (TCHAR *) data.w.cFileName; @@ -1705,7 +1782,7 @@ ConvertFileNameFormat( if (longShort) { if (data.a.cFileName[0] != '\0') { nativeName = (TCHAR *) data.a.cFileName; - } + } } else { if (data.a.cAlternateFileName[0] == '\0') { nativeName = (TCHAR *) data.a.cFileName; @@ -1714,12 +1791,12 @@ ConvertFileNameFormat( } /* - * Purify reports a extraneous UMR in Tcl_WinTCharToUtf() trying - * to dereference nativeName as a Unicode string. I have proven - * to myself that purify is wrong by running the following - * example when nativeName == data.w.cAlternateFileName and - * noting that purify doesn't complain about the first line, - * but does complain about the second. + * Purify reports a extraneous UMR in Tcl_WinTCharToUtf() trying + * to dereference nativeName as a Unicode string. I have proven to + * myself that purify is wrong by running the following example + * when nativeName == data.w.cAlternateFileName and noting that + * purify doesn't complain about the first line, but does complain + * about the second. * * fprintf(stderr, "%d\n", data.w.cAlternateFileName[0]); * fprintf(stderr, "%d\n", ((WCHAR *) nativeName)[0]); @@ -1727,14 +1804,18 @@ ConvertFileNameFormat( Tcl_DStringInit(&dsTemp); Tcl_WinTCharToUtf(nativeName, -1, &dsTemp); - /* Deal with issues of tildes being absolute */ + + /* + * Deal with issues of tildes being absolute. + */ + if (Tcl_DStringValue(&dsTemp)[0] == '~') { tempPath = Tcl_NewStringObj("./",2); - Tcl_AppendToObj(tempPath, Tcl_DStringValue(&dsTemp), - Tcl_DStringLength(&dsTemp)); + Tcl_AppendToObj(tempPath, Tcl_DStringValue(&dsTemp), + Tcl_DStringLength(&dsTemp)); } else { - tempPath = Tcl_NewStringObj(Tcl_DStringValue(&dsTemp), - Tcl_DStringLength(&dsTemp)); + tempPath = Tcl_NewStringObj(Tcl_DStringValue(&dsTemp), + Tcl_DStringLength(&dsTemp)); } Tcl_ListObjReplace(NULL, splitPath, i, 1, 1, &tempPath); Tcl_DStringFree(&ds); @@ -1745,12 +1826,27 @@ ConvertFileNameFormat( *attributePtrPtr = Tcl_FSJoinPath(splitPath, -1); -cleanup: + if (splitPath != NULL) { + /* + * Unfortunately, the object we will return may have its only refCount + * as part of the list splitPath. This means if we free splitPath, the + * object will disappear. So, we have to be very careful here. + * Unfortunately this means we must manipulate the object's refCount + * directly. + */ + + Tcl_IncrRefCount(*attributePtrPtr); + Tcl_DecrRefCount(splitPath); + --(*attributePtrPtr)->refCount; + } + return TCL_OK; + + cleanup: if (splitPath != NULL) { Tcl_DecrRefCount(splitPath); } - - return result; + + return TCL_ERROR; } /* @@ -1758,16 +1854,15 @@ cleanup: * * GetWinFileLongName -- * - * Returns a Tcl_Obj containing the long version of the file - * name. + * Returns a Tcl_Obj containing the long version of the file name. * * Results: - * Standard Tcl result and a Tcl_Obj in attributePtrPtr. The object - * will have ref count 0. If the return value is not TCL_OK, - * attributePtrPtr is not touched. + * Standard Tcl result and a Tcl_Obj in attributePtrPtr. The object will + * have ref count 0. If the return value is not TCL_OK, attributePtrPtr + * is not touched. * * Side effects: - * A new object is allocated if the file is valid. + * A new object is allocated if the file is valid. * *---------------------------------------------------------------------- */ @@ -1776,10 +1871,11 @@ static int GetWinFileLongName( Tcl_Interp *interp, /* The interp we are using for errors. */ int objIndex, /* The index of the attribute. */ - Tcl_Obj *fileName, /* The name of the file. */ + Tcl_Obj *fileName, /* The name of the file. */ Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */ { - return ConvertFileNameFormat(interp, objIndex, fileName, 1, attributePtrPtr); + return ConvertFileNameFormat(interp, objIndex, fileName, 1, + attributePtrPtr); } /* @@ -1787,16 +1883,15 @@ GetWinFileLongName( * * GetWinFileShortName -- * - * Returns a Tcl_Obj containing the short version of the file - * name. + * Returns a Tcl_Obj containing the short version of the file name. * * Results: - * Standard Tcl result and a Tcl_Obj in attributePtrPtr. The object - * will have ref count 0. If the return value is not TCL_OK, - * attributePtrPtr is not touched. + * Standard Tcl result and a Tcl_Obj in attributePtrPtr. The object will + * have ref count 0. If the return value is not TCL_OK, attributePtrPtr + * is not touched. * * Side effects: - * A new object is allocated if the file is valid. + * A new object is allocated if the file is valid. * *---------------------------------------------------------------------- */ @@ -1805,10 +1900,11 @@ static int GetWinFileShortName( Tcl_Interp *interp, /* The interp we are using for errors. */ int objIndex, /* The index of the attribute. */ - Tcl_Obj *fileName, /* The name of the file. */ + Tcl_Obj *fileName, /* The name of the file. */ Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */ { - return ConvertFileNameFormat(interp, objIndex, fileName, 0, attributePtrPtr); + return ConvertFileNameFormat(interp, objIndex, fileName, 0, + attributePtrPtr); } /* @@ -1816,14 +1912,14 @@ GetWinFileShortName( * * SetWinFileAttributes -- * - * Set the file attributes to the value given by attributePtr. - * This routine sets the -hidden, -readonly, or -system attributes. + * Set the file attributes to the value given by attributePtr. This + * routine sets the -hidden, -readonly, or -system attributes. * * Results: - * Standard TCL error. + * Standard TCL error. * * Side effects: - * The file's attribute is set. + * The file's attribute is set. * *---------------------------------------------------------------------- */ @@ -1832,7 +1928,7 @@ static int SetWinFileAttributes( Tcl_Interp *interp, /* The interp we are using for errors. */ int objIndex, /* The index of the attribute. */ - Tcl_Obj *fileName, /* The name of the file. */ + Tcl_Obj *fileName, /* The name of the file. */ Tcl_Obj *attributePtr) /* The new value of the attribute. */ { DWORD fileAttributes; @@ -1872,14 +1968,13 @@ SetWinFileAttributes( * * SetWinFileLongName -- * - * The attribute in question is a readonly attribute and cannot - * be set. + * The attribute in question is a readonly attribute and cannot be set. * * Results: - * TCL_ERROR + * TCL_ERROR * * Side effects: - * The object result is set to a pertinent error message. + * The object result is set to a pertinent error message. * *---------------------------------------------------------------------- */ @@ -1888,13 +1983,12 @@ static int CannotSetAttribute( Tcl_Interp *interp, /* The interp we are using for errors. */ int objIndex, /* The index of the attribute. */ - Tcl_Obj *fileName, /* The name of the file. */ + Tcl_Obj *fileName, /* The name of the file. */ Tcl_Obj *attributePtr) /* The new value of the attribute. */ { - Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), - "cannot set attribute \"", tclpFileAttrStrings[objIndex], - "\" for file \"", Tcl_GetString(fileName), - "\": attribute is readonly", + Tcl_AppendResult(interp, "cannot set attribute \"", + tclpFileAttrStrings[objIndex], "\" for file \"", + Tcl_GetString(fileName), "\": attribute is readonly", (char *) NULL); return TCL_ERROR; } @@ -1935,11 +2029,11 @@ TclpObjListVolumes(void) if (GetLogicalDriveStringsA(sizeof(buf), buf) == 0) { /* * GetVolumeInformation() will detects all drives, but causes - * chattering on empty floppy drives. We only do this if - * GetLogicalDriveStrings() didn't work. It has also been reported - * that on some laptops it takes a while for GetVolumeInformation() - * to return when pinging an empty floppy drive, another reason to - * try to avoid calling it. + * chattering on empty floppy drives. We only do this if + * GetLogicalDriveStrings() didn't work. It has also been reported + * that on some laptops it takes a while for GetVolumeInformation() to + * return when pinging an empty floppy drive, another reason to try to + * avoid calling it. */ buf[1] = ':'; @@ -1948,7 +2042,7 @@ TclpObjListVolumes(void) for (i = 0; i < 26; i++) { buf[0] = (char) ('a' + i); - if (GetVolumeInformationA(buf, NULL, 0, NULL, NULL, NULL, NULL, 0) + if (GetVolumeInformationA(buf, NULL, 0, NULL, NULL, NULL, NULL, 0) || (GetLastError() == ERROR_NOT_READY)) { elemPtr = Tcl_NewStringObj(buf, -1); Tcl_ListObjAppendElement(NULL, resultPtr, elemPtr); @@ -1961,7 +2055,15 @@ TclpObjListVolumes(void) Tcl_ListObjAppendElement(NULL, resultPtr, elemPtr); } } - + Tcl_IncrRefCount(resultPtr); return resultPtr; } + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ diff --git a/win/tclWinFile.c b/win/tclWinFile.c index 316a827..0291a41 100644 --- a/win/tclWinFile.c +++ b/win/tclWinFile.c @@ -1,23 +1,24 @@ -/* +/* * tclWinFile.c -- * - * This file contains temporary wrappers around UNIX file handling - * functions. These wrappers map the UNIX functions to Win32 HANDLE-style - * files, which can be manipulated through the Win32 console redirection - * interfaces. + * This file contains temporary wrappers around UNIX file handling + * functions. These wrappers map the UNIX functions to Win32 HANDLE-style + * files, which can be manipulated through the Win32 console redirection + * interfaces. * * Copyright (c) 1995-1998 Sun Microsystems, Inc. * - * See the file "license.terms" for information on usage and redistribution - * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #ifndef _WIN64 # define _USE_32BIT_TIME_T #endif -#include <sys/stat.h> #include "tclWinInt.h" +#include "tclFileSystem.h" #include <winioctl.h> +#include <sys/stat.h> #include <shlobj.h> #include <lmaccess.h> /* For TclpGetUserHome(). */ @@ -26,234 +27,280 @@ * on the proleptic Gregorian calendar) and the Posix epoch (1970-01-01). */ -#define POSIX_EPOCH_AS_FILETIME 116444736000000000 +#define POSIX_EPOCH_AS_FILETIME \ + ((Tcl_WideInt) 116444736 * (Tcl_WideInt) 1000000000) /* - * Declarations for 'link' related information. This information - * should come with VC++ 6.0, but is not in some older SDKs. - * In any case it is not well documented. + * Declarations for 'link' related information. This information should come + * with VC++ 6.0, but is not in some older SDKs. In any case it is not well + * documented. */ + #ifndef IO_REPARSE_TAG_RESERVED_ONE -# define IO_REPARSE_TAG_RESERVED_ONE 0x000000001 +# define IO_REPARSE_TAG_RESERVED_ONE 0x000000001 #endif #ifndef IO_REPARSE_TAG_RESERVED_RANGE -# define IO_REPARSE_TAG_RESERVED_RANGE 0x000000001 +# define IO_REPARSE_TAG_RESERVED_RANGE 0x000000001 #endif #ifndef IO_REPARSE_TAG_VALID_VALUES -# define IO_REPARSE_TAG_VALID_VALUES 0x0E000FFFF +# define IO_REPARSE_TAG_VALID_VALUES 0x0E000FFFF #endif #ifndef IO_REPARSE_TAG_HSM -# define IO_REPARSE_TAG_HSM 0x0C0000004 +# define IO_REPARSE_TAG_HSM 0x0C0000004 #endif #ifndef IO_REPARSE_TAG_NSS -# define IO_REPARSE_TAG_NSS 0x080000005 +# define IO_REPARSE_TAG_NSS 0x080000005 #endif #ifndef IO_REPARSE_TAG_NSSRECOVER -# define IO_REPARSE_TAG_NSSRECOVER 0x080000006 +# define IO_REPARSE_TAG_NSSRECOVER 0x080000006 #endif #ifndef IO_REPARSE_TAG_SIS -# define IO_REPARSE_TAG_SIS 0x080000007 +# define IO_REPARSE_TAG_SIS 0x080000007 #endif #ifndef IO_REPARSE_TAG_DFS -# define IO_REPARSE_TAG_DFS 0x080000008 +# define IO_REPARSE_TAG_DFS 0x080000008 #endif #ifndef IO_REPARSE_TAG_RESERVED_ZERO -# define IO_REPARSE_TAG_RESERVED_ZERO 0x00000000 +# define IO_REPARSE_TAG_RESERVED_ZERO 0x00000000 #endif #ifndef FILE_FLAG_OPEN_REPARSE_POINT -# define FILE_FLAG_OPEN_REPARSE_POINT 0x00200000 +# define FILE_FLAG_OPEN_REPARSE_POINT 0x00200000 #endif #ifndef IO_REPARSE_TAG_MOUNT_POINT -# define IO_REPARSE_TAG_MOUNT_POINT 0xA0000003 +# define IO_REPARSE_TAG_MOUNT_POINT 0xA0000003 #endif #ifndef IsReparseTagValid -# define IsReparseTagValid(x) (!((x)&~IO_REPARSE_TAG_VALID_VALUES)&&((x)>IO_REPARSE_TAG_RESERVED_RANGE)) +# define IsReparseTagValid(x) \ + (!((x)&~IO_REPARSE_TAG_VALID_VALUES)&&((x)>IO_REPARSE_TAG_RESERVED_RANGE)) #endif #ifndef IO_REPARSE_TAG_SYMBOLIC_LINK -# define IO_REPARSE_TAG_SYMBOLIC_LINK IO_REPARSE_TAG_RESERVED_ZERO +# define IO_REPARSE_TAG_SYMBOLIC_LINK IO_REPARSE_TAG_RESERVED_ZERO #endif #ifndef FILE_SPECIAL_ACCESS -# define FILE_SPECIAL_ACCESS (FILE_ANY_ACCESS) +# define FILE_SPECIAL_ACCESS (FILE_ANY_ACCESS) #endif #ifndef FSCTL_SET_REPARSE_POINT -# define FSCTL_SET_REPARSE_POINT CTL_CODE(FILE_DEVICE_FILE_SYSTEM, 41, METHOD_BUFFERED, FILE_SPECIAL_ACCESS) -# define FSCTL_GET_REPARSE_POINT CTL_CODE(FILE_DEVICE_FILE_SYSTEM, 42, METHOD_BUFFERED, FILE_ANY_ACCESS) -# define FSCTL_DELETE_REPARSE_POINT CTL_CODE(FILE_DEVICE_FILE_SYSTEM, 43, METHOD_BUFFERED, FILE_SPECIAL_ACCESS) +# define FSCTL_SET_REPARSE_POINT \ + CTL_CODE(FILE_DEVICE_FILE_SYSTEM, 41, METHOD_BUFFERED, FILE_SPECIAL_ACCESS) +# define FSCTL_GET_REPARSE_POINT \ + CTL_CODE(FILE_DEVICE_FILE_SYSTEM, 42, METHOD_BUFFERED, FILE_ANY_ACCESS) +# define FSCTL_DELETE_REPARSE_POINT \ + CTL_CODE(FILE_DEVICE_FILE_SYSTEM, 43, METHOD_BUFFERED, FILE_SPECIAL_ACCESS) #endif #ifndef INVALID_FILE_ATTRIBUTES -#define INVALID_FILE_ATTRIBUTES ((DWORD)-1) +#define INVALID_FILE_ATTRIBUTES ((DWORD)-1) #endif -/* - * Maximum reparse buffer info size. The max user defined reparse - * data is 16KB, plus there's a header. +/* + * Maximum reparse buffer info size. The max user defined reparse data is + * 16KB, plus there's a header. */ -#define MAX_REPARSE_SIZE 17000 +#define MAX_REPARSE_SIZE 17000 /* - * Undocumented REPARSE_MOUNTPOINT_HEADER_SIZE structure definition. - * This is found in winnt.h. - * - * IMPORTANT: caution when using this structure, since the actual - * structures used will want to store a full path in the 'PathBuffer' - * field, but there isn't room (there's only a single WCHAR!). Therefore - * one must artificially create a larger space of memory and then cast it - * to this type. We use the 'DUMMY_REPARSE_BUFFER' struct just below to - * deal with this problem. + * Undocumented REPARSE_MOUNTPOINT_HEADER_SIZE structure definition. This is + * found in winnt.h. + * + * IMPORTANT: caution when using this structure, since the actual structures + * used will want to store a full path in the 'PathBuffer' field, but there + * isn't room (there's only a single WCHAR!). Therefore one must artificially + * create a larger space of memory and then cast it to this type. We use the + * 'DUMMY_REPARSE_BUFFER' struct just below to deal with this problem. */ -#define REPARSE_MOUNTPOINT_HEADER_SIZE 8 +#define REPARSE_MOUNTPOINT_HEADER_SIZE 8 #ifndef REPARSE_DATA_BUFFER_HEADER_SIZE typedef struct _REPARSE_DATA_BUFFER { - DWORD ReparseTag; - WORD ReparseDataLength; - WORD Reserved; + DWORD ReparseTag; + WORD ReparseDataLength; + WORD Reserved; union { - struct { - WORD SubstituteNameOffset; - WORD SubstituteNameLength; - WORD PrintNameOffset; - WORD PrintNameLength; - WCHAR PathBuffer[1]; - } SymbolicLinkReparseBuffer; - struct { - WORD SubstituteNameOffset; - WORD SubstituteNameLength; - WORD PrintNameOffset; - WORD PrintNameLength; - WCHAR PathBuffer[1]; - } MountPointReparseBuffer; - struct { - BYTE DataBuffer[1]; - } GenericReparseBuffer; + struct { + WORD SubstituteNameOffset; + WORD SubstituteNameLength; + WORD PrintNameOffset; + WORD PrintNameLength; + ULONG Flags; + WCHAR PathBuffer[1]; + } SymbolicLinkReparseBuffer; + struct { + WORD SubstituteNameOffset; + WORD SubstituteNameLength; + WORD PrintNameOffset; + WORD PrintNameLength; + WCHAR PathBuffer[1]; + } MountPointReparseBuffer; + struct { + BYTE DataBuffer[1]; + } GenericReparseBuffer; }; } REPARSE_DATA_BUFFER; #endif typedef struct { REPARSE_DATA_BUFFER dummy; - WCHAR dummyBuf[MAX_PATH*3]; + WCHAR dummyBuf[MAX_PATH * 3]; } DUMMY_REPARSE_BUFFER; -#if defined(_MSC_VER) && ( _MSC_VER <= 1100 ) +#if defined(_MSC_VER) && (_MSC_VER <= 1100) +#undef HAVE_NO_FINDEX_ENUMS #define HAVE_NO_FINDEX_ENUMS #elif !defined(_WIN32_WINNT) || (_WIN32_WINNT < 0x0400) +#undef HAVE_NO_FINDEX_ENUMS #define HAVE_NO_FINDEX_ENUMS #endif #ifdef HAVE_NO_FINDEX_ENUMS /* These two aren't in VC++ 5.2 headers */ typedef enum _FINDEX_INFO_LEVELS { - FindExInfoStandard, - FindExInfoMaxInfoLevel + FindExInfoStandard, + FindExInfoMaxInfoLevel } FINDEX_INFO_LEVELS; typedef enum _FINDEX_SEARCH_OPS { - FindExSearchNameMatch, - FindExSearchLimitToDirectories, - FindExSearchLimitToDevices, - FindExSearchMaxSearchOp + FindExSearchNameMatch, + FindExSearchLimitToDirectories, + FindExSearchLimitToDevices, + FindExSearchMaxSearchOp } FINDEX_SEARCH_OPS; #endif /* HAVE_NO_FINDEX_ENUMS */ -/* Other typedefs required by this code */ +/* + * Other typedefs required by this code. + */ static time_t ToCTime(FILETIME fileTime); static void FromCTime(time_t posixTime, FILETIME *fileTime); -typedef NET_API_STATUS NET_API_FUNCTION NETUSERGETINFOPROC - (LPWSTR servername, LPWSTR username, DWORD level, LPBYTE *bufptr); +typedef NET_API_STATUS NET_API_FUNCTION NETUSERGETINFOPROC( + LPWSTR servername, LPWSTR username, DWORD level, LPBYTE *bufptr); -typedef NET_API_STATUS NET_API_FUNCTION NETAPIBUFFERFREEPROC - (LPVOID Buffer); +typedef NET_API_STATUS NET_API_FUNCTION NETAPIBUFFERFREEPROC(LPVOID Buffer); -typedef NET_API_STATUS NET_API_FUNCTION NETGETDCNAMEPROC - (LPWSTR servername, LPWSTR domainname, LPBYTE *bufptr); +typedef NET_API_STATUS NET_API_FUNCTION NETGETDCNAMEPROC( + LPWSTR servername, LPWSTR domainname, LPBYTE *bufptr); /* - * Declarations for local procedures defined in this file: + * Declarations for local functions defined in this file: */ -static int NativeAccess(CONST TCHAR *path, int mode); -static int NativeStat(CONST TCHAR *path, Tcl_StatBuf *statPtr, int checkLinks); -static unsigned short NativeStatMode(DWORD attr, int checkLinks, int isExec); -static int NativeIsExec(CONST TCHAR *path); -static int NativeReadReparse(CONST TCHAR* LinkDirectory, - REPARSE_DATA_BUFFER* buffer); -static int NativeWriteReparse(CONST TCHAR* LinkDirectory, - REPARSE_DATA_BUFFER* buffer); -static int NativeMatchType(int isDrive, DWORD attr, CONST TCHAR* nativeName, - Tcl_GlobTypeData *types); -static int WinIsDrive(CONST char *name, int nameLen); -static int WinIsReserved(CONST char *path); -static Tcl_Obj* WinReadLink(CONST TCHAR* LinkSource); -static Tcl_Obj* WinReadLinkDirectory(CONST TCHAR* LinkDirectory); -static int WinLink(CONST TCHAR* LinkSource, CONST TCHAR* LinkTarget, - int linkAction); -static int WinSymLinkDirectory(CONST TCHAR* LinkDirectory, - CONST TCHAR* LinkTarget); +static int NativeAccess(const TCHAR *path, int mode); +static int NativeDev(const TCHAR *path); +static int NativeStat(const TCHAR *path, Tcl_StatBuf *statPtr, + int checkLinks); +static unsigned short NativeStatMode(DWORD attr, int checkLinks, + int isExec); +static int NativeIsExec(const TCHAR *path); +static int NativeReadReparse(const TCHAR *LinkDirectory, + REPARSE_DATA_BUFFER *buffer); +static int NativeWriteReparse(const TCHAR *LinkDirectory, + REPARSE_DATA_BUFFER *buffer); +static int NativeMatchType(int isDrive, DWORD attr, + const TCHAR *nativeName, Tcl_GlobTypeData *types); +static int WinIsDrive(const char *name, int nameLen); +static int WinIsReserved(const char *path); +static Tcl_Obj * WinReadLink(const TCHAR *LinkSource); +static Tcl_Obj * WinReadLinkDirectory(const TCHAR *LinkDirectory); +static int WinLink(const TCHAR *LinkSource, + const TCHAR *LinkTarget, int linkAction); +static int WinSymLinkDirectory(const TCHAR *LinkDirectory, + const TCHAR *LinkTarget); /* *-------------------------------------------------------------------- * - * WinLink + * WinLink -- + * + * Make a link from source to target. * - * Make a link from source to target. *-------------------------------------------------------------------- */ -static int -WinLink(LinkSource, LinkTarget, linkAction) - CONST TCHAR* LinkSource; - CONST TCHAR* LinkTarget; - int linkAction; + +static int +WinLink( + const TCHAR *linkSourcePath, + const TCHAR *linkTargetPath, + int linkAction) { - WCHAR tempFileName[MAX_PATH]; - TCHAR* tempFilePart; - int attr; - - /* Get the full path referenced by the target */ - if (!(*tclWinProcs->getFullPathNameProc)(LinkTarget, - MAX_PATH, tempFileName, &tempFilePart)) { - /* Invalid file */ + WCHAR tempFileName[MAX_PATH]; + TCHAR *tempFilePart; + DWORD attr; + + /* + * Get the full path referenced by the target. + */ + + if (!(*tclWinProcs->getFullPathNameProc)(linkTargetPath, MAX_PATH, + tempFileName, &tempFilePart)) { + /* + * Invalid file. + */ + TclWinConvertError(GetLastError()); return -1; } - /* Make sure source file doesn't exist */ - attr = (*tclWinProcs->getFileAttributesProc)(LinkSource); - if (attr != 0xffffffff) { + /* + * Make sure source file doesn't exist. + */ + + attr = (*tclWinProcs->getFileAttributesProc)(linkSourcePath); + if (attr != INVALID_FILE_ATTRIBUTES) { Tcl_SetErrno(EEXIST); return -1; } - /* Get the full path referenced by the directory */ - if (!(*tclWinProcs->getFullPathNameProc)(LinkSource, - MAX_PATH, tempFileName, &tempFilePart)) { - /* Invalid file */ + /* + * Get the full path referenced by the source file/directory. + */ + + if (!(*tclWinProcs->getFullPathNameProc)(linkSourcePath, MAX_PATH, + tempFileName, &tempFilePart)) { + /* + * Invalid file. + */ + TclWinConvertError(GetLastError()); return -1; } - /* Check the target */ - attr = (*tclWinProcs->getFileAttributesProc)(LinkTarget); - if (attr == 0xffffffff) { - /* The target doesn't exist */ + + /* + * Check the target. + */ + + attr = (*tclWinProcs->getFileAttributesProc)(linkTargetPath); + if (attr == INVALID_FILE_ATTRIBUTES) { + /* + * The target doesn't exist. + */ + TclWinConvertError(GetLastError()); return -1; + } else if ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0) { - /* It is a file */ + /* + * It is a file. + */ + if (tclWinProcs->createHardLinkProc == NULL) { Tcl_SetErrno(ENOTDIR); return -1; } + if (linkAction & TCL_CREATE_HARD_LINK) { - if (!(*tclWinProcs->createHardLinkProc)(LinkSource, LinkTarget, NULL)) { + if (!(*tclWinProcs->createHardLinkProc)(linkSourcePath, + linkTargetPath, NULL)) { TclWinConvertError(GetLastError()); return -1; } return 0; + } else if (linkAction & TCL_CREATE_SYMBOLIC_LINK) { - /* Can't symlink files */ + /* + * Can't symlink files. + */ + Tcl_SetErrno(ENOTDIR); return -1; } else { @@ -261,10 +308,19 @@ WinLink(LinkSource, LinkTarget, linkAction) return -1; } } else { + /* + * We've got a directory. Now check whether what we're trying to do is + * reasonable. + */ + if (linkAction & TCL_CREATE_SYMBOLIC_LINK) { - return WinSymLinkDirectory(LinkSource, LinkTarget); + return WinSymLinkDirectory(linkSourcePath, linkTargetPath); + } else if (linkAction & TCL_CREATE_HARD_LINK) { - /* Can't hard link directories */ + /* + * Can't hard link directories. + */ + Tcl_SetErrno(EISDIR); return -1; } else { @@ -277,169 +333,213 @@ WinLink(LinkSource, LinkTarget, linkAction) /* *-------------------------------------------------------------------- * - * WinReadLink + * WinReadLink -- + * + * What does 'LinkSource' point to? * - * What does 'LinkSource' point to? *-------------------------------------------------------------------- */ -static Tcl_Obj* -WinReadLink(LinkSource) - CONST TCHAR* LinkSource; + +static Tcl_Obj * +WinReadLink( + const TCHAR *linkSourcePath) { - WCHAR tempFileName[MAX_PATH]; - TCHAR* tempFilePart; - int attr; - - /* Get the full path referenced by the target */ - if (!(*tclWinProcs->getFullPathNameProc)(LinkSource, - MAX_PATH, tempFileName, &tempFilePart)) { - /* Invalid file */ + WCHAR tempFileName[MAX_PATH]; + TCHAR *tempFilePart; + DWORD attr; + + /* + * Get the full path referenced by the target. + */ + + if (!(*tclWinProcs->getFullPathNameProc)(linkSourcePath, MAX_PATH, + tempFileName, &tempFilePart)) { + /* + * Invalid file. + */ + TclWinConvertError(GetLastError()); return NULL; } - /* Make sure source file does exist */ - attr = (*tclWinProcs->getFileAttributesProc)(LinkSource); - if (attr == 0xffffffff) { - /* The source doesn't exist */ + /* + * Make sure source file does exist. + */ + + attr = (*tclWinProcs->getFileAttributesProc)(linkSourcePath); + if (attr == INVALID_FILE_ATTRIBUTES) { + /* + * The source doesn't exist. + */ + TclWinConvertError(GetLastError()); return NULL; + } else if ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0) { - /* It is a file - this is not yet supported */ + /* + * It is a file - this is not yet supported. + */ + Tcl_SetErrno(ENOTDIR); return NULL; } else { - return WinReadLinkDirectory(LinkSource); + return WinReadLinkDirectory(linkSourcePath); } } /* *-------------------------------------------------------------------- * - * WinSymLinkDirectory + * WinSymLinkDirectory -- + * + * This routine creates a NTFS junction, using the undocumented + * FSCTL_SET_REPARSE_POINT structure Win2K uses for mount points and + * junctions. + * + * Assumption that linkTargetPath is a valid, existing directory. * - * This routine creates a NTFS junction, using the undocumented - * FSCTL_SET_REPARSE_POINT structure Win2K uses for mount points - * and junctions. + * Returns: + * Zero on success. * - * Assumption that LinkTarget is a valid, existing directory. - * - * Returns zero on success. *-------------------------------------------------------------------- */ -static int -WinSymLinkDirectory(LinkDirectory, LinkTarget) - CONST TCHAR* LinkDirectory; - CONST TCHAR* LinkTarget; + +static int +WinSymLinkDirectory( + const TCHAR *linkDirPath, + const TCHAR *linkTargetPath) { DUMMY_REPARSE_BUFFER dummy; - REPARSE_DATA_BUFFER *reparseBuffer = (REPARSE_DATA_BUFFER*)&dummy; - int len; - WCHAR nativeTarget[MAX_PATH]; - WCHAR *loop; - - /* Make the native target name */ - memcpy((VOID*)nativeTarget, (VOID*)L"\\??\\", 4*sizeof(WCHAR)); - memcpy((VOID*)(nativeTarget + 4), (VOID*)LinkTarget, - sizeof(WCHAR)*(1+wcslen((WCHAR*)LinkTarget))); + REPARSE_DATA_BUFFER *reparseBuffer = (REPARSE_DATA_BUFFER *) &dummy; + int len; + WCHAR nativeTarget[MAX_PATH]; + WCHAR *loop; + + /* + * Make the native target name. + */ + + memcpy(nativeTarget, L"\\??\\", 4 * sizeof(WCHAR)); + memcpy(nativeTarget + 4, linkTargetPath, + sizeof(WCHAR) * (1+wcslen((WCHAR *) linkTargetPath))); len = wcslen(nativeTarget); - /* - * We must have backslashes only. This is VERY IMPORTANT. - * If we have any forward slashes everything appears to work, - * but the resulting symlink is useless! + + /* + * We must have backslashes only. This is VERY IMPORTANT. If we have any + * forward slashes everything appears to work, but the resulting symlink + * is useless! */ + for (loop = nativeTarget; *loop != 0; loop++) { - if (*loop == L'/') *loop = L'\\'; + if (*loop == L'/') { + *loop = L'\\'; + } } if ((nativeTarget[len-1] == L'\\') && (nativeTarget[len-2] != L':')) { nativeTarget[len-1] = 0; } - - /* Build the reparse info */ + + /* + * Build the reparse info. + */ + memset(reparseBuffer, 0, sizeof(DUMMY_REPARSE_BUFFER)); reparseBuffer->ReparseTag = IO_REPARSE_TAG_MOUNT_POINT; - reparseBuffer->SymbolicLinkReparseBuffer.SubstituteNameLength = - wcslen(nativeTarget) * sizeof(WCHAR); + reparseBuffer->MountPointReparseBuffer.SubstituteNameLength = + wcslen(nativeTarget) * sizeof(WCHAR); reparseBuffer->Reserved = 0; - reparseBuffer->SymbolicLinkReparseBuffer.PrintNameLength = 0; - reparseBuffer->SymbolicLinkReparseBuffer.PrintNameOffset = - reparseBuffer->SymbolicLinkReparseBuffer.SubstituteNameLength - + sizeof(WCHAR); - memcpy(reparseBuffer->SymbolicLinkReparseBuffer.PathBuffer, nativeTarget, - sizeof(WCHAR) - + reparseBuffer->SymbolicLinkReparseBuffer.SubstituteNameLength); - reparseBuffer->ReparseDataLength = - reparseBuffer->SymbolicLinkReparseBuffer.SubstituteNameLength + 12; - - return NativeWriteReparse(LinkDirectory, reparseBuffer); + reparseBuffer->MountPointReparseBuffer.PrintNameLength = 0; + reparseBuffer->MountPointReparseBuffer.PrintNameOffset = + reparseBuffer->MountPointReparseBuffer.SubstituteNameLength + + sizeof(WCHAR); + memcpy(reparseBuffer->MountPointReparseBuffer.PathBuffer, nativeTarget, + sizeof(WCHAR) + + reparseBuffer->MountPointReparseBuffer.SubstituteNameLength); + reparseBuffer->ReparseDataLength = + reparseBuffer->MountPointReparseBuffer.SubstituteNameLength+12; + + return NativeWriteReparse(linkDirPath, reparseBuffer); } /* *-------------------------------------------------------------------- * - * TclWinSymLinkCopyDirectory + * TclWinSymLinkCopyDirectory -- + * + * Copy a Windows NTFS junction. This function assumes that LinkOriginal + * exists and is a valid junction point, and that LinkCopy does not + * exist. + * + * Returns: + * Zero on success. * - * Copy a Windows NTFS junction. This function assumes that - * LinkOriginal exists and is a valid junction point, and that - * LinkCopy does not exist. - * - * Returns zero on success. *-------------------------------------------------------------------- */ -int -TclWinSymLinkCopyDirectory(LinkOriginal, LinkCopy) - CONST TCHAR* LinkOriginal; /* Existing junction - reparse point */ - CONST TCHAR* LinkCopy; /* Will become a duplicate junction */ + +int +TclWinSymLinkCopyDirectory( + const TCHAR *linkOrigPath, /* Existing junction - reparse point */ + const TCHAR *linkCopyPath) /* Will become a duplicate junction */ { DUMMY_REPARSE_BUFFER dummy; - REPARSE_DATA_BUFFER *reparseBuffer = (REPARSE_DATA_BUFFER*)&dummy; - - if (NativeReadReparse(LinkOriginal, reparseBuffer)) { + REPARSE_DATA_BUFFER *reparseBuffer = (REPARSE_DATA_BUFFER *) &dummy; + + if (NativeReadReparse(linkOrigPath, reparseBuffer)) { return -1; } - return NativeWriteReparse(LinkCopy, reparseBuffer); + return NativeWriteReparse(linkCopyPath, reparseBuffer); } /* *-------------------------------------------------------------------- * - * TclWinSymLinkDelete + * TclWinSymLinkDelete -- + * + * Delete a Windows NTFS junction. Once the junction information is + * deleted, the filesystem object becomes an ordinary directory. Unless + * 'linkOnly' is given, that directory is also removed. + * + * Assumption that LinkOriginal is a valid, existing junction. + * + * Returns: + * Zero on success. * - * Delete a Windows NTFS junction. Once the junction information - * is deleted, the filesystem object becomes an ordinary directory. - * Unless 'linkOnly' is given, that directory is also removed. - * - * Assumption that LinkOriginal is a valid, existing junction. - * - * Returns zero on success. *-------------------------------------------------------------------- */ -int -TclWinSymLinkDelete(LinkOriginal, linkOnly) - CONST TCHAR* LinkOriginal; - int linkOnly; + +int +TclWinSymLinkDelete( + const TCHAR *linkOrigPath, + int linkOnly) { - /* It is a symbolic link -- remove it */ + /* + * It is a symbolic link - remove it. + */ + DUMMY_REPARSE_BUFFER dummy; - REPARSE_DATA_BUFFER *reparseBuffer = (REPARSE_DATA_BUFFER*)&dummy; + REPARSE_DATA_BUFFER *reparseBuffer = (REPARSE_DATA_BUFFER *) &dummy; HANDLE hFile; DWORD returnedLength; + memset(reparseBuffer, 0, sizeof(DUMMY_REPARSE_BUFFER)); reparseBuffer->ReparseTag = IO_REPARSE_TAG_MOUNT_POINT; - hFile = (*tclWinProcs->createFileProc)(LinkOriginal, GENERIC_WRITE, 0, - NULL, OPEN_EXISTING, - FILE_FLAG_OPEN_REPARSE_POINT|FILE_FLAG_BACKUP_SEMANTICS, NULL); + hFile = (*tclWinProcs->createFileProc)(linkOrigPath, GENERIC_WRITE, 0, + NULL, OPEN_EXISTING, + FILE_FLAG_OPEN_REPARSE_POINT|FILE_FLAG_BACKUP_SEMANTICS, NULL); + if (hFile != INVALID_HANDLE_VALUE) { - if (!DeviceIoControl(hFile, FSCTL_DELETE_REPARSE_POINT, reparseBuffer, - REPARSE_MOUNTPOINT_HEADER_SIZE, - NULL, 0, &returnedLength, NULL)) { - /* Error setting junction */ + if (!DeviceIoControl(hFile, FSCTL_DELETE_REPARSE_POINT, reparseBuffer, + REPARSE_MOUNTPOINT_HEADER_SIZE,NULL,0,&returnedLength,NULL)) { + /* + * Error setting junction. + */ + TclWinConvertError(GetLastError()); CloseHandle(hFile); } else { CloseHandle(hFile); if (!linkOnly) { - (*tclWinProcs->removeDirectoryProc)(LinkOriginal); + (*tclWinProcs->removeDirectoryProc)(linkOrigPath); } return 0; } @@ -450,123 +550,136 @@ TclWinSymLinkDelete(LinkOriginal, linkOnly) /* *-------------------------------------------------------------------- * - * WinReadLinkDirectory + * WinReadLinkDirectory -- * - * This routine reads a NTFS junction, using the undocumented - * FSCTL_GET_REPARSE_POINT structure Win2K uses for mount points - * and junctions. + * This routine reads a NTFS junction, using the undocumented + * FSCTL_GET_REPARSE_POINT structure Win2K uses for mount points and + * junctions. + * + * Assumption that LinkDirectory is a valid, existing directory. + * + * Returns: + * A Tcl_Obj with refCount of 1 (i.e. owned by the caller), or NULL if + * anything went wrong. + * + * In the future we should enhance this to return a path object rather + * than a string. * - * Assumption that LinkDirectory is a valid, existing directory. - * - * Returns a Tcl_Obj with refCount of 1 (i.e. owned by the caller), - * or NULL if anything went wrong. - * - * In the future we should enhance this to return a path object - * rather than a string. *-------------------------------------------------------------------- */ -static Tcl_Obj* -WinReadLinkDirectory(LinkDirectory) - CONST TCHAR* LinkDirectory; + +static Tcl_Obj * +WinReadLinkDirectory( + const TCHAR *linkDirPath) { - int attr; + int attr, len, offset; DUMMY_REPARSE_BUFFER dummy; - REPARSE_DATA_BUFFER *reparseBuffer = (REPARSE_DATA_BUFFER*)&dummy; - - attr = (*tclWinProcs->getFileAttributesProc)(LinkDirectory); + REPARSE_DATA_BUFFER *reparseBuffer = (REPARSE_DATA_BUFFER *) &dummy; + Tcl_Obj *retVal; + Tcl_DString ds; + const char *copy; + + attr = (*tclWinProcs->getFileAttributesProc)(linkDirPath); if (!(attr & FILE_ATTRIBUTE_REPARSE_POINT)) { - Tcl_SetErrno(EINVAL); - return NULL; + goto invalidError; } - if (NativeReadReparse(LinkDirectory, reparseBuffer)) { - return NULL; + if (NativeReadReparse(linkDirPath, reparseBuffer)) { + return NULL; } - + switch (reparseBuffer->ReparseTag) { - case 0x80000000|IO_REPARSE_TAG_SYMBOLIC_LINK: - case IO_REPARSE_TAG_SYMBOLIC_LINK: - case IO_REPARSE_TAG_MOUNT_POINT: { - Tcl_Obj *retVal; - Tcl_DString ds; - CONST char *copy; - int len; - int offset = 0; - - /* - * Certain native path representations on Windows have a - * special prefix to indicate that they are to be treated - * specially. For example extremely long paths, or symlinks, - * or volumes mounted inside directories. - * - * There is an assumption in this code that 'wide' interfaces - * are being used (see tclWin32Dll.c), which is true for the - * only systems which support reparse tags at present. If - * that changes in the future, this code will have to be - * generalised. + case 0x80000000|IO_REPARSE_TAG_SYMBOLIC_LINK: + case IO_REPARSE_TAG_SYMBOLIC_LINK: + case IO_REPARSE_TAG_MOUNT_POINT: + /* + * Certain native path representations on Windows have a special + * prefix to indicate that they are to be treated specially. For + * example extremely long paths, or symlinks, or volumes mounted + * inside directories. + * + * There is an assumption in this code that 'wide' interfaces are + * being used (see tclWin32Dll.c), which is true for the only systems + * which support reparse tags at present. If that changes in the + * future, this code will have to be generalised. + */ + + offset = 0; + if (reparseBuffer->MountPointReparseBuffer.PathBuffer[0] == L'\\') { + /* + * Check whether this is a mounted volume. */ - if (reparseBuffer->SymbolicLinkReparseBuffer.PathBuffer[0] - == L'\\') { - /* Check whether this is a mounted volume */ - if (wcsncmp(reparseBuffer->SymbolicLinkReparseBuffer.PathBuffer, - L"\\??\\Volume{",11) == 0) { - char drive; - /* - * There is some confusion between \??\ and \\?\ which - * we have to fix here. It doesn't seem very well - * documented. - */ - reparseBuffer->SymbolicLinkReparseBuffer - .PathBuffer[1] = L'\\'; - /* - * Check if a corresponding drive letter exists, and - * use that if it is found - */ - drive = TclWinDriveLetterForVolMountPoint(reparseBuffer - ->SymbolicLinkReparseBuffer.PathBuffer); - if (drive != -1) { - char driveSpec[3] = { - drive, ':', '\0' - }; - retVal = Tcl_NewStringObj(driveSpec,2); - Tcl_IncrRefCount(retVal); - return retVal; - } - /* - * This is actually a mounted drive, which doesn't - * exists as a DOS drive letter. This means the path - * isn't actually a link, although we partially treat - * it like one ('file type' will return 'link'), but - * then the link will actually just be treated like - * an ordinary directory. I don't believe any - * serious inconsistency will arise from this, but it - * is something to be aware of. - */ - Tcl_SetErrno(EINVAL); - return NULL; - } else if (wcsncmp(reparseBuffer->SymbolicLinkReparseBuffer - .PathBuffer, L"\\\\?\\",4) == 0) { - /* Strip off the prefix */ - offset = 4; - } else if (wcsncmp(reparseBuffer->SymbolicLinkReparseBuffer - .PathBuffer, L"\\??\\",4) == 0) { - /* Strip off the prefix */ - offset = 4; + + if (wcsncmp(reparseBuffer->MountPointReparseBuffer.PathBuffer, + L"\\??\\Volume{",11) == 0) { + char drive; + + /* + * There is some confusion between \??\ and \\?\ which we have + * to fix here. It doesn't seem very well documented. + */ + + reparseBuffer->MountPointReparseBuffer.PathBuffer[1]=L'\\'; + + /* + * Check if a corresponding drive letter exists, and use that + * if it is found + */ + + drive = TclWinDriveLetterForVolMountPoint( + reparseBuffer->MountPointReparseBuffer.PathBuffer); + if (drive != -1) { + char driveSpec[3] = { + '\0', ':', '\0' + }; + + driveSpec[0] = drive; + retVal = Tcl_NewStringObj(driveSpec,2); + Tcl_IncrRefCount(retVal); + return retVal; } + + /* + * This is actually a mounted drive, which doesn't exists as a + * DOS drive letter. This means the path isn't actually a + * link, although we partially treat it like one ('file type' + * will return 'link'), but then the link will actually just + * be treated like an ordinary directory. I don't believe any + * serious inconsistency will arise from this, but it is + * something to be aware of. + */ + + goto invalidError; + } else if (wcsncmp(reparseBuffer->MountPointReparseBuffer + .PathBuffer, L"\\\\?\\",4) == 0) { + /* + * Strip off the prefix. + */ + + offset = 4; + } else if (wcsncmp(reparseBuffer->MountPointReparseBuffer + .PathBuffer, L"\\??\\",4) == 0) { + /* + * Strip off the prefix. + */ + + offset = 4; } - - Tcl_WinTCharToUtf( - (CONST char*)reparseBuffer->SymbolicLinkReparseBuffer.PathBuffer, - (int)reparseBuffer->SymbolicLinkReparseBuffer - .SubstituteNameLength, &ds); - - copy = Tcl_DStringValue(&ds)+offset; - len = Tcl_DStringLength(&ds)-offset; - retVal = Tcl_NewStringObj(copy,len); - Tcl_IncrRefCount(retVal); - Tcl_DStringFree(&ds); - return retVal; } + + Tcl_WinTCharToUtf((const char *) + reparseBuffer->MountPointReparseBuffer.PathBuffer, + (int) reparseBuffer->MountPointReparseBuffer + .SubstituteNameLength, &ds); + + copy = Tcl_DStringValue(&ds)+offset; + len = Tcl_DStringLength(&ds)-offset; + retVal = Tcl_NewStringObj(copy,len); + Tcl_IncrRefCount(retVal); + Tcl_DStringFree(&ds); + return retVal; } + + invalidError: Tcl_SetErrno(EINVAL); return NULL; } @@ -574,42 +687,55 @@ WinReadLinkDirectory(LinkDirectory) /* *-------------------------------------------------------------------- * - * NativeReadReparse + * NativeReadReparse -- + * + * Read the junction/reparse information from a given NTFS directory. * - * Read the junction/reparse information from a given NTFS directory. + * Assumption that linkDirPath is a valid, existing directory. + * + * Returns: + * Zero on success. * - * Assumption that LinkDirectory is a valid, existing directory. - * - * Returns zero on success. *-------------------------------------------------------------------- */ -static int -NativeReadReparse(LinkDirectory, buffer) - CONST TCHAR* LinkDirectory; /* The junction to read */ - REPARSE_DATA_BUFFER* buffer; /* Pointer to buffer. Cannot be NULL */ + +static int +NativeReadReparse( + const TCHAR *linkDirPath, /* The junction to read */ + REPARSE_DATA_BUFFER *buffer)/* Pointer to buffer. Cannot be NULL */ { HANDLE hFile; DWORD returnedLength; - - hFile = (*tclWinProcs->createFileProc)(LinkDirectory, GENERIC_READ, 0, - NULL, OPEN_EXISTING, - FILE_FLAG_OPEN_REPARSE_POINT|FILE_FLAG_BACKUP_SEMANTICS, NULL); + + hFile = (*tclWinProcs->createFileProc)(linkDirPath, GENERIC_READ, 0, + NULL, OPEN_EXISTING, + FILE_FLAG_OPEN_REPARSE_POINT|FILE_FLAG_BACKUP_SEMANTICS, NULL); + if (hFile == INVALID_HANDLE_VALUE) { - /* Error creating directory */ + /* + * Error creating directory. + */ + TclWinConvertError(GetLastError()); return -1; } - /* Get the link */ - if (!DeviceIoControl(hFile, FSCTL_GET_REPARSE_POINT, NULL, - 0, buffer, sizeof(DUMMY_REPARSE_BUFFER), - &returnedLength, NULL)) { - /* Error setting junction */ + + /* + * Get the link. + */ + + if (!DeviceIoControl(hFile, FSCTL_GET_REPARSE_POINT, NULL, 0, buffer, + sizeof(DUMMY_REPARSE_BUFFER), &returnedLength, NULL)) { + /* + * Error setting junction. + */ + TclWinConvertError(GetLastError()); CloseHandle(hFile); return -1; } CloseHandle(hFile); - + if (!IsReparseTagValid(buffer->ReparseTag)) { Tcl_SetErrno(EINVAL); return -1; @@ -620,48 +746,69 @@ NativeReadReparse(LinkDirectory, buffer) /* *-------------------------------------------------------------------- * - * NativeWriteReparse + * NativeWriteReparse -- + * + * Write the reparse information for a given directory. + * + * Assumption that LinkDirectory does not exist. * - * Write the reparse information for a given directory. - * - * Assumption that LinkDirectory does not exist. *-------------------------------------------------------------------- */ -static int -NativeWriteReparse(LinkDirectory, buffer) - CONST TCHAR* LinkDirectory; - REPARSE_DATA_BUFFER* buffer; + +static int +NativeWriteReparse( + const TCHAR *linkDirPath, + REPARSE_DATA_BUFFER *buffer) { HANDLE hFile; DWORD returnedLength; - - /* Create the directory - it must not already exist */ - if ((*tclWinProcs->createDirectoryProc)(LinkDirectory, NULL) == 0) { - /* Error creating directory */ + + /* + * Create the directory - it must not already exist. + */ + + if ((*tclWinProcs->createDirectoryProc)(linkDirPath, NULL) == 0) { + /* + * Error creating directory. + */ + TclWinConvertError(GetLastError()); return -1; } - hFile = (*tclWinProcs->createFileProc)(LinkDirectory, GENERIC_WRITE, 0, - NULL, OPEN_EXISTING, - FILE_FLAG_OPEN_REPARSE_POINT|FILE_FLAG_BACKUP_SEMANTICS, NULL); + hFile = (*tclWinProcs->createFileProc)(linkDirPath, GENERIC_WRITE, 0, + NULL, OPEN_EXISTING, + FILE_FLAG_OPEN_REPARSE_POINT|FILE_FLAG_BACKUP_SEMANTICS, NULL); if (hFile == INVALID_HANDLE_VALUE) { - /* Error creating directory */ + /* + * Error creating directory. + */ + TclWinConvertError(GetLastError()); return -1; } - /* Set the link */ - if (!DeviceIoControl(hFile, FSCTL_SET_REPARSE_POINT, buffer, - (DWORD) buffer->ReparseDataLength - + REPARSE_MOUNTPOINT_HEADER_SIZE, - NULL, 0, &returnedLength, NULL)) { - /* Error setting junction */ + + /* + * Set the link. + */ + + if (!DeviceIoControl(hFile, FSCTL_SET_REPARSE_POINT, buffer, + (DWORD) buffer->ReparseDataLength + REPARSE_MOUNTPOINT_HEADER_SIZE, + NULL, 0, &returnedLength, NULL)) { + /* + * Error setting junction. + */ + TclWinConvertError(GetLastError()); CloseHandle(hFile); - (*tclWinProcs->removeDirectoryProc)(LinkDirectory); + (*tclWinProcs->removeDirectoryProc)(linkDirPath); return -1; } CloseHandle(hFile); - /* We succeeded */ + + /* + * We succeeded. + */ + return 0; } @@ -670,39 +817,26 @@ NativeWriteReparse(LinkDirectory, buffer) * * TclpFindExecutable -- * - * This procedure computes the absolute path name of the current - * application, given its argv[0] value. + * This function computes the absolute path name of the current + * application. * * Results: - * A clean UTF string that is the path to the executable. At this - * point we may not know the system encoding, but we convert the - * string value to UTF-8 using core Windows functions. The path name - * contains ASCII string and '/' chars do not conflict with other UTF - * chars. + * None. * * Side effects: - * The variable tclNativeExecutableName gets filled in with the file - * name for the application, if we figured it out. If we couldn't - * figure it out, tclNativeExecutableName is set to NULL. + * The computed path is stored. * *--------------------------------------------------------------------------- */ -char * -TclpFindExecutable(argv0) - CONST char *argv0; /* The value of the application's argv[0] +void +TclpFindExecutable( + const char *argv0) /* The value of the application's argv[0] * (native). */ { WCHAR wName[MAX_PATH]; char name[MAX_PATH * TCL_UTF_MAX]; - if (argv0 == NULL) { - return NULL; - } - if (tclNativeExecutableName != NULL) { - return tclNativeExecutableName; - } - /* * Under Windows we ignore argv0, and return the path for the file used to * create this process. @@ -710,16 +844,17 @@ TclpFindExecutable(argv0) if (GetModuleFileNameW(NULL, wName, MAX_PATH) == 0) { GetModuleFileNameA(NULL, name, sizeof(name)); - } else { - WideCharToMultiByte(CP_UTF8, 0, wName, -1, - name, sizeof(name), NULL, NULL); - } - tclNativeExecutableName = ckalloc((unsigned) (strlen(name) + 1)); - strcpy(tclNativeExecutableName, name); + /* + * Convert to WCHAR to get out of ANSI codepage + */ - TclWinNoBackslash(tclNativeExecutableName); - return tclNativeExecutableName; + MultiByteToWideChar(CP_ACP, 0, name, -1, wName, MAX_PATH); + } + + WideCharToMultiByte(CP_UTF8, 0, wName, -1, name, sizeof(name), NULL,NULL); + TclWinNoBackslash(name); + TclSetObjNameOfExecutable(Tcl_NewStringObj(name, -1), NULL); } /* @@ -727,42 +862,53 @@ TclpFindExecutable(argv0) * * TclpMatchInDirectory -- * - * This routine is used by the globbing code to search a - * directory for all files which match a given pattern. + * This routine is used by the globbing code to search a directory for + * all files which match a given pattern. * - * Results: - * - * The return value is a standard Tcl result indicating whether an - * error occurred in globbing. Errors are left in interp, good - * results are lappended to resultPtr (which must be a valid object) + * Results: + * The return value is a standard Tcl result indicating whether an error + * occurred in globbing. Errors are left in interp, good results are + * lappended to resultPtr (which must be a valid object). * * Side effects: * None. * - *---------------------------------------------------------------------- */ + *---------------------------------------------------------------------- + */ int -TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types) - Tcl_Interp *interp; /* Interpreter to receive errors. */ - Tcl_Obj *resultPtr; /* List object to lappend results. */ - Tcl_Obj *pathPtr; /* Contains path to directory to search. */ - CONST char *pattern; /* Pattern to match against. */ - Tcl_GlobTypeData *types; /* Object containing list of acceptable types. +TclpMatchInDirectory( + Tcl_Interp *interp, /* Interpreter to receive errors. */ + Tcl_Obj *resultPtr, /* List object to lappend results. */ + Tcl_Obj *pathPtr, /* Contains path to directory to search. */ + const char *pattern, /* Pattern to match against. */ + Tcl_GlobTypeData *types) /* Object containing list of acceptable types. * May be NULL. In particular the directory * flag is very important. */ { - CONST TCHAR *native; + const TCHAR *native; + + if (types != NULL && types->type == TCL_GLOB_TYPE_MOUNT) { + /* + * The native filesystem never adds mounts. + */ + + return TCL_OK; + } if (pattern == NULL || (*pattern == '\0')) { Tcl_Obj *norm = Tcl_FSGetNormalizedPath(NULL, pathPtr); if (norm != NULL) { - /* Match a single file directly */ + /* + * Match a single file directly. + */ + int len; DWORD attr; - CONST char *str = Tcl_GetStringFromObj(norm,&len); + const char *str = Tcl_GetStringFromObj(norm,&len); + + native = (const TCHAR *) Tcl_FSGetNativePath(pathPtr); - native = (CONST TCHAR*) Tcl_FSGetNativePath(pathPtr); - if (tclWinProcs->getFileAttributesExProc == NULL) { attr = (*tclWinProcs->getFileAttributesProc)(native); if (attr == 0xffffffff) { @@ -776,8 +922,8 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types) } attr = data.dwFileAttributes; } - if (NativeMatchType(WinIsDrive(str,len), attr, - native, types)) { + + if (NativeMatchType(WinIsDrive(str,len), attr, native, types)) { Tcl_ListObjAppendElement(interp, resultPtr, pathPtr); } } @@ -786,94 +932,127 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types) DWORD attr; HANDLE handle; WIN32_FIND_DATAT data; - CONST char *dirName; + const char *dirName; /* UTF-8 dir name, later with pattern + * appended. */ int dirLength; int matchSpecialDots; - Tcl_DString ds; /* native encoding of dir */ - Tcl_DString dsOrig; /* utf-8 encoding of dir */ - Tcl_DString dirString; /* utf-8 encoding of dir with \'s */ + Tcl_DString ds; /* Native encoding of dir, also used + * temporarily for other things. */ + Tcl_DString dsOrig; /* UTF-8 encoding of dir. */ Tcl_Obj *fileNamePtr; + char lastChar; /* - * Convert the path to normalized form since some interfaces only - * accept backslashes. Also, ensure that the directory ends with a - * separator character. + * Get the normalized path representation (the main thing is we dont + * want any '~' sequences). */ - fileNamePtr = Tcl_FSGetTranslatedPath(interp, pathPtr); + fileNamePtr = Tcl_FSGetNormalizedPath(interp, pathPtr); if (fileNamePtr == NULL) { return TCL_ERROR; } - Tcl_DStringInit(&dsOrig); - dirName = Tcl_GetStringFromObj(fileNamePtr, &dirLength); - Tcl_DStringAppend(&dsOrig, dirName, dirLength); - - Tcl_DStringInit(&dirString); - if (dirLength == 0) { - Tcl_DStringAppend(&dirString, ".\\", 2); - } else { - char *p; - Tcl_DStringAppend(&dirString, dirName, dirLength); - for (p = Tcl_DStringValue(&dirString); *p != '\0'; p++) { - if (*p == '/') { - *p = '\\'; - } - } - p--; - /* Make sure we have a trailing directory delimiter */ - if ((*p != '\\') && (*p != ':')) { - Tcl_DStringAppend(&dirString, "\\", 1); - Tcl_DStringAppend(&dsOrig, "/", 1); - dirLength++; - } - } - dirName = Tcl_DStringValue(&dirString); - Tcl_DecrRefCount(fileNamePtr); - /* - * First verify that the specified path is actually a directory. + * Verify that the specified path exists and is actually a directory. */ - native = Tcl_WinUtfToTChar(dirName, Tcl_DStringLength(&dirString), - &ds); + native = Tcl_FSGetNativePath(pathPtr); + if (native == NULL) { + return TCL_OK; + } attr = (*tclWinProcs->getFileAttributesProc)(native); - Tcl_DStringFree(&ds); if ((attr == 0xffffffff) || ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0)) { - Tcl_DStringFree(&dirString); return TCL_OK; } /* - * We need to check all files in the directory, so append a *.* - * to the path. + * Build up the directory name for searching, including a trailing + * directory separator. */ - dirName = Tcl_DStringAppend(&dirString, "*.*", 3); + Tcl_DStringInit(&dsOrig); + dirName = Tcl_GetStringFromObj(fileNamePtr, &dirLength); + Tcl_DStringAppend(&dsOrig, dirName, dirLength); + + lastChar = dirName[dirLength -1]; + if ((lastChar != '\\') && (lastChar != '/') && (lastChar != ':')) { + Tcl_DStringAppend(&dsOrig, "/", 1); + dirLength++; + } + dirName = Tcl_DStringValue(&dsOrig); + + /* + * We need to check all files in the directory, so we append '*.*' to + * the path, unless the pattern we've been given is rather simple, + * when we can use that instead. + */ + + if (strpbrk(pattern, "[]\\") == NULL) { + /* + * The pattern is a simple one containing just '*' and/or '?'. + * This means we can get the OS to help us, by passing it the + * pattern. + */ + + dirName = Tcl_DStringAppend(&dsOrig, pattern, -1); + } else { + dirName = Tcl_DStringAppend(&dsOrig, "*.*", 3); + } + native = Tcl_WinUtfToTChar(dirName, -1, &ds); - handle = (*tclWinProcs->findFirstFileProc)(native, &data); + if (tclWinProcs->findFirstFileExProc == NULL || (types == NULL) + || (types->type != TCL_GLOB_TYPE_DIR)) { + handle = (*tclWinProcs->findFirstFileProc)(native, &data); + } else { + /* + * We can be more efficient, for pure directory requests. + */ + + handle = (*tclWinProcs->findFirstFileExProc)(native, + FindExInfoStandard, &data, + FindExSearchLimitToDirectories, NULL, 0); + } if (handle == INVALID_HANDLE_VALUE) { - TclWinConvertError(GetLastError()); + DWORD err = GetLastError(); Tcl_DStringFree(&ds); - Tcl_DStringFree(&dirString); - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "couldn't read directory \"", - Tcl_DStringValue(&dsOrig), "\": ", - Tcl_PosixError(interp), (char *) NULL); + if (err == ERROR_FILE_NOT_FOUND) { + /* + * We used our 'pattern' above, and matched nothing. This + * means we just return TCL_OK, indicating no results found. + */ + + Tcl_DStringFree(&dsOrig); + return TCL_OK; + } + + TclWinConvertError(err); + if (interp != NULL) { + Tcl_ResetResult(interp); + Tcl_AppendResult(interp, "couldn't read directory \"", + Tcl_DStringValue(&dsOrig), "\": ", + Tcl_PosixError(interp), NULL); + } Tcl_DStringFree(&dsOrig); return TCL_ERROR; } Tcl_DStringFree(&ds); /* - * Check to see if the pattern should match the special - * . and .. names, referring to the current directory, - * or the directory above. We need a special check for - * this because paths beginning with a dot are not considered - * hidden on Windows, and so otherwise a relative glob like - * 'glob -join * *' will actually return './. ../..' etc. + * We may use this later, so we must restore it to its length + * including the directory delimiter. + */ + + Tcl_DStringSetLength(&dsOrig, dirLength); + + /* + * Check to see if the pattern should match the special . and + * .. names, referring to the current directory, or the directory + * above. We need a special check for this because paths beginning + * with a dot are not considered hidden on Windows, and so otherwise a + * relative glob like 'glob -join * *' will actually return + * './. ../..' etc. */ if ((pattern[0] == '.') @@ -884,51 +1063,53 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types) } /* - * Now iterate over all of the files in the directory, starting - * with the first one we found. + * Now iterate over all of the files in the directory, starting with + * the first one we found. */ do { - CONST char *utfname; - int checkDrive = 0; - int isDrive; + const char *utfname; + int checkDrive = 0, isDrive; DWORD attr; - + if (tclWinProcs->useWide) { - native = (CONST TCHAR *) data.w.cFileName; + native = (const TCHAR *) data.w.cFileName; attr = data.w.dwFileAttributes; } else { - native = (CONST TCHAR *) data.a.cFileName; + native = (const TCHAR *) data.a.cFileName; attr = data.a.dwFileAttributes; } - + utfname = Tcl_WinTCharToUtf(native, -1, &ds); if (!matchSpecialDots) { - /* If it is exactly '.' or '..' then we ignore it */ - if ((utfname[0] == '.') && (utfname[1] == '\0' + /* + * If it is exactly '.' or '..' then we ignore it. + */ + + if ((utfname[0] == '.') && (utfname[1] == '\0' || (utfname[1] == '.' && utfname[2] == '\0'))) { Tcl_DStringFree(&ds); continue; } } else if (utfname[0] == '.' && utfname[1] == '.' && utfname[2] == '\0') { - /* - * Have to check if this is a drive below, so we can - * correctly match 'hidden' and not hidden files. + /* + * Have to check if this is a drive below, so we can correctly + * match 'hidden' and not hidden files. */ + checkDrive = 1; } - + /* - * Check to see if the file matches the pattern. Note that - * we are ignoring the case sensitivity flag because Windows - * doesn't honor case even if the volume is case sensitive. - * If the volume also doesn't preserve case, then we - * previously returned the lower case form of the name. This - * didn't seem quite right since there are - * non-case-preserving volumes that actually return mixed - * case. So now we are returning exactly what we get from + * Check to see if the file matches the pattern. Note that we are + * ignoring the case sensitivity flag because Windows doesn't + * honor case even if the volume is case sensitive. If the volume + * also doesn't preserve case, then we previously returned the + * lower case form of the name. This didn't seem quite right since + * there are non-case-preserving volumes that actually return + * mixed case. So now we are returning exactly what we get from * the system. */ @@ -939,7 +1120,7 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types) */ if (checkDrive) { - CONST char *fullname = Tcl_DStringAppend(&dsOrig, utfname, + const char *fullname = Tcl_DStringAppend(&dsOrig, utfname, Tcl_DStringLength(&ds)); isDrive = WinIsDrive(fullname, Tcl_DStringLength(&dsOrig)); Tcl_DStringSetLength(&dsOrig, dirLength); @@ -947,7 +1128,7 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types) isDrive = 0; } if (NativeMatchType(isDrive, attr, native, types)) { - Tcl_ListObjAppendElement(interp, resultPtr, + Tcl_ListObjAppendElement(interp, resultPtr, TclNewFSPathObj(pathPtr, utfname, Tcl_DStringLength(&ds))); } @@ -956,33 +1137,38 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types) /* * Free ds here to ensure that native is valid above. */ + Tcl_DStringFree(&ds); } while ((*tclWinProcs->findNextFileProc)(handle, &data) == TRUE); FindClose(handle); - Tcl_DStringFree(&dirString); Tcl_DStringFree(&dsOrig); return TCL_OK; } } -/* - * Does the given path represent a root volume? We need this special - * case because for NTFS root volumes, the getFileAttributesProc returns - * a 'hidden' attribute when it should not. +/* + * Does the given path represent a root volume? We need this special case + * because for NTFS root volumes, the getFileAttributesProc returns a 'hidden' + * attribute when it should not. */ + static int WinIsDrive( - CONST char *name, /* Name (UTF-8) */ - int len) /* Length of name */ + const char *name, /* Name (UTF-8) */ + int len) /* Length of name */ { int remove = 0; + while (len > 4) { - if ((name[len-1] != '.' || name[len-2] != '.') - || (name[len-3] != '/' && name[len-3] != '\\')) { - /* We don't have '/..' at the end */ + if ((name[len-1] != '.' || name[len-2] != '.') + || (name[len-3] != '/' && name[len-3] != '\\')) { + /* + * We don't have '/..' at the end. + */ + if (remove == 0) { - break; + break; } remove--; while (len > 0) { @@ -992,74 +1178,95 @@ WinIsDrive( } } if (len < 4) { - len++; + len++; break; } - } else { - /* We do have '/..' */ + } else { + /* + * We do have '/..' + */ + len -= 3; remove++; - } + } } + if (len < 4) { if (len == 0) { - /* - * Not sure if this is possible, but we pass it on - * anyway + /* + * Not sure if this is possible, but we pass it on anyway. */ } else if (len == 1 && (name[0] == '/' || name[0] == '\\')) { - /* Path is pointing to the root volume */ + /* + * Path is pointing to the root volume. + */ + return 1; - } else if ((name[1] == ':') + } else if ((name[1] == ':') && (len == 2 || (name[2] == '/' || name[2] == '\\'))) { - /* Path is of the form 'x:' or 'x:/' or 'x:\' */ + /* + * Path is of the form 'x:' or 'x:/' or 'x:\' + */ + return 1; } } + return 0; } -/* - * Does the given path represent a reserved window path name? If not - * return 0, if true, return the number of characters of the path that - * we actually want (not any trailing :). +/* + * Does the given path represent a reserved window path name? If not return 0, + * if true, return the number of characters of the path that we actually want + * (not any trailing :). */ -static int WinIsReserved( - CONST char *path) /* Path in UTF-8 */ + +static int +WinIsReserved( + const char *path) /* Path in UTF-8 */ { - if ((path[0] == 'c' || path[0] == 'C') - && (path[1] == 'o' || path[1] == 'O')) { + if ((path[0] == 'c' || path[0] == 'C') + && (path[1] == 'o' || path[1] == 'O')) { if ((path[2] == 'm' || path[2] == 'M') - && path[3] >= '1' && path[3] <= '4') { - /* May have match for 'com[1-4]:?', which is a serial port */ + && path[3] >= '1' && path[3] <= '4') { + /* + * May have match for 'com[1-4]:?', which is a serial port. + */ + if (path[4] == '\0') { return 4; } else if (path [4] == ':' && path[5] == '\0') { return 4; } } else if ((path[2] == 'n' || path[2] == 'N') && path[3] == '\0') { - /* Have match for 'con' */ + /* + * Have match for 'con' + */ + return 3; } + } else if ((path[0] == 'l' || path[0] == 'L') - && (path[1] == 'p' || path[1] == 'P') - && (path[2] == 't' || path[2] == 'T')) { + && (path[1] == 'p' || path[1] == 'P') + && (path[2] == 't' || path[2] == 'T')) { if (path[3] >= '1' && path[3] <= '3') { - /* May have match for 'lpt[1-3]:?' */ + /* + * May have match for 'lpt[1-3]:?' + */ + if (path[4] == '\0') { return 4; } else if (path [4] == ':' && path[5] == '\0') { return 4; } } - } else if (stricmp(path, "prn") == 0) { - /* Have match for 'prn' */ - return 3; - } else if (stricmp(path, "nul") == 0) { - /* Have match for 'nul' */ - return 3; - } else if (stricmp(path, "aux") == 0) { - /* Have match for 'aux' */ + + } else if (!strcasecmp(path, "prn") || !strcasecmp(path, "nul") + || !strcasecmp(path, "aux")) { + /* + * Have match for 'prn', 'nul' or 'aux'. + */ + return 3; } return 0; @@ -1067,102 +1274,108 @@ static int WinIsReserved( /* *---------------------------------------------------------------------- - * + * * NativeMatchType -- - * - * This function needs a special case for a path which is a root - * volume, because for NTFS root volumes, the getFileAttributesProc - * returns a 'hidden' attribute when it should not. - * - * We never make any calss to a 'get attributes' routine here, - * since we have arranged things so that our caller already knows - * such information. - * + * + * This function needs a special case for a path which is a root volume, + * because for NTFS root volumes, the getFileAttributesProc returns a + * 'hidden' attribute when it should not. + * + * We never make any calss to a 'get attributes' routine here, since we + * have arranged things so that our caller already knows such + * information. + * * Results: - * 0 = file doesn't match - * 1 = file matches - * + * 0 = file doesn't match + * 1 = file matches + * *---------------------------------------------------------------------- */ -static int + +static int NativeMatchType( - int isDrive, /* Is this a drive */ - DWORD attr, /* We already know the attributes - * for the file */ - CONST TCHAR* nativeName, /* Native path to check */ - Tcl_GlobTypeData *types) /* Type description to match against */ + int isDrive, /* Is this a drive. */ + DWORD attr, /* We already know the attributes for the + * file. */ + const TCHAR *nativeName, /* Native path to check. */ + Tcl_GlobTypeData *types) /* Type description to match against. */ { /* - * 'attr' represents the attributes of the file, but we only - * want to retrieve this info if it is absolutely necessary - * because it is an expensive call. Unfortunately, to deal - * with hidden files properly, we must always retrieve it. + * 'attr' represents the attributes of the file, but we only want to + * retrieve this info if it is absolutely necessary because it is an + * expensive call. Unfortunately, to deal with hidden files properly, we + * must always retrieve it. */ if (types == NULL) { - /* If invisible, don't return the file */ + /* + * If invisible, don't return the file. + */ + if (attr & FILE_ATTRIBUTE_HIDDEN && !isDrive) { return 0; } } else { if (attr & FILE_ATTRIBUTE_HIDDEN && !isDrive) { - /* If invisible */ - if ((types->perm == 0) || - !(types->perm & TCL_GLOB_PERM_HIDDEN)) { + /* + * If invisible. + */ + + if ((types->perm == 0) || !(types->perm & TCL_GLOB_PERM_HIDDEN)) { return 0; } } else { - /* Visible */ + /* + * Visible. + */ + if (types->perm & TCL_GLOB_PERM_HIDDEN) { return 0; } } - + if (types->perm != 0) { - if ( - ((types->perm & TCL_GLOB_PERM_RONLY) && + if (((types->perm & TCL_GLOB_PERM_RONLY) && !(attr & FILE_ATTRIBUTE_READONLY)) || - ((types->perm & TCL_GLOB_PERM_R) && + ((types->perm & TCL_GLOB_PERM_R) && (0 /* File exists => R_OK on Windows */)) || - ((types->perm & TCL_GLOB_PERM_W) && + ((types->perm & TCL_GLOB_PERM_W) && (attr & FILE_ATTRIBUTE_READONLY)) || - ((types->perm & TCL_GLOB_PERM_X) && + ((types->perm & TCL_GLOB_PERM_X) && (!(attr & FILE_ATTRIBUTE_DIRECTORY) - && !NativeIsExec(nativeName))) - ) { + && !NativeIsExec(nativeName)))) { return 0; } } - if ((types->type & TCL_GLOB_TYPE_DIR) - && (attr & FILE_ATTRIBUTE_DIRECTORY)) { - /* Quicker test for directory, which is a common case */ + if ((types->type & TCL_GLOB_TYPE_DIR) + && (attr & FILE_ATTRIBUTE_DIRECTORY)) { + /* + * Quicker test for directory, which is a common case. + */ + return 1; + } else if (types->type != 0) { unsigned short st_mode; int isExec = NativeIsExec(nativeName); - + st_mode = NativeStatMode(attr, 0, isExec); /* * In order bcdpfls as in 'find -t' */ - if ( - ((types->type & TCL_GLOB_TYPE_BLOCK) && - S_ISBLK(st_mode)) || - ((types->type & TCL_GLOB_TYPE_CHAR) && - S_ISCHR(st_mode)) || - ((types->type & TCL_GLOB_TYPE_DIR) && - S_ISDIR(st_mode)) || - ((types->type & TCL_GLOB_TYPE_PIPE) && - S_ISFIFO(st_mode)) || - ((types->type & TCL_GLOB_TYPE_FILE) && - S_ISREG(st_mode)) + + if (((types->type&TCL_GLOB_TYPE_BLOCK) && S_ISBLK(st_mode)) || + ((types->type&TCL_GLOB_TYPE_CHAR) && S_ISCHR(st_mode)) || + ((types->type&TCL_GLOB_TYPE_DIR) && S_ISDIR(st_mode)) || + ((types->type&TCL_GLOB_TYPE_PIPE) && S_ISFIFO(st_mode)) || #ifdef S_ISSOCK - || ((types->type & TCL_GLOB_TYPE_SOCK) && - S_ISSOCK(st_mode)) + ((types->type&TCL_GLOB_TYPE_SOCK) && S_ISSOCK(st_mode)) || #endif - ) { - /* Do nothing -- this file is ok */ + ((types->type&TCL_GLOB_TYPE_FILE) && S_ISREG(st_mode))) { + /* + * Do nothing - this file is ok. + */ } else { #ifdef S_ISLNK if (types->type & TCL_GLOB_TYPE_LINK) { @@ -1174,8 +1387,8 @@ NativeMatchType( #endif return 0; } - } - } + } + } return 1; } @@ -1190,9 +1403,9 @@ NativeMatchType( * Results: * The result is a pointer to a string specifying the user's home * directory, or NULL if the user's home directory could not be - * determined. Storage for the result string is allocated in - * bufferPtr; the caller must call Tcl_DStringFree() when the result - * is no longer needed. + * determined. Storage for the result string is allocated in bufferPtr; + * the caller must call Tcl_DStringFree() when the result is no longer + * needed. * * Side effects: * None. @@ -1201,16 +1414,15 @@ NativeMatchType( */ char * -TclpGetUserHome(name, bufferPtr) - CONST char *name; /* User name for desired home directory. */ - Tcl_DString *bufferPtr; /* Uninitialized or free DString filled - * with name of user's home directory. */ +TclpGetUserHome( + const char *name, /* User name for desired home directory. */ + Tcl_DString *bufferPtr) /* Uninitialized or free DString filled with + * name of user's home directory. */ { char *result; HINSTANCE netapiInst; result = NULL; - Tcl_DStringInit(bufferPtr); netapiInst = LoadLibraryA("netapi32.dll"); @@ -1221,17 +1433,17 @@ TclpGetUserHome(name, bufferPtr) netApiBufferFreeProc = (NETAPIBUFFERFREEPROC *) GetProcAddress(netapiInst, "NetApiBufferFree"); - netGetDCNameProc = (NETGETDCNAMEPROC *) + netGetDCNameProc = (NETGETDCNAMEPROC *) GetProcAddress(netapiInst, "NetGetDCName"); - netUserGetInfoProc = (NETUSERGETINFOPROC *) + netUserGetInfoProc = (NETUSERGETINFOPROC *) GetProcAddress(netapiInst, "NetUserGetInfo"); if ((netUserGetInfoProc != NULL) && (netGetDCNameProc != NULL) && (netApiBufferFreeProc != NULL)) { - USER_INFO_1 *uiPtr; + USER_INFO_1 *uiPtr, **uiPtrPtr = &uiPtr; Tcl_DString ds; int nameLen, badDomain; char *domain; - WCHAR *wName, *wHomeDir, *wDomain; + WCHAR *wName, *wHomeDir, *wDomain, **wDomainPtr = &wDomain; WCHAR buf[MAX_PATH]; badDomain = 0; @@ -1241,23 +1453,23 @@ TclpGetUserHome(name, bufferPtr) if (domain != NULL) { Tcl_DStringInit(&ds); wName = Tcl_UtfToUniCharDString(domain + 1, -1, &ds); - badDomain = (*netGetDCNameProc)(NULL, wName, - (LPBYTE *) &wDomain); + badDomain = (netGetDCNameProc)(NULL, wName, + (LPBYTE *) wDomainPtr); Tcl_DStringFree(&ds); nameLen = domain - name; } if (badDomain == 0) { Tcl_DStringInit(&ds); wName = Tcl_UtfToUniCharDString(name, nameLen, &ds); - if ((*netUserGetInfoProc)(wDomain, wName, 1, - (LPBYTE *) &uiPtr) == 0) { + if ((netUserGetInfoProc)(wDomain, wName, 1, + (LPBYTE *) uiPtrPtr) == 0) { wHomeDir = uiPtr->usri1_home_dir; if ((wHomeDir != NULL) && (wHomeDir[0] != L'\0')) { Tcl_UniCharToUtfDString(wHomeDir, lstrlenW(wHomeDir), bufferPtr); } else { - /* - * User exists but has no home dir. Return + /* + * User exists but has no home dir. Return * "{Windows Drive}:/users/default". */ @@ -1278,20 +1490,20 @@ TclpGetUserHome(name, bufferPtr) } if (result == NULL) { /* - * Look in the "Password Lists" section of system.ini for the - * local user. There are also entries in that section that begin - * with a "*" character that are used by Windows for other - * purposes; ignore user names beginning with a "*". + * Look in the "Password Lists" section of system.ini for the local + * user. There are also entries in that section that begin with a "*" + * character that are used by Windows for other purposes; ignore user + * names beginning with a "*". */ char buf[MAX_PATH]; if (name[0] != '*') { - if (GetPrivateProfileStringA("Password Lists", name, "", buf, + if (GetPrivateProfileStringA("Password Lists", name, "", buf, MAX_PATH, "system.ini") > 0) { - /* - * User exists, but there is no such thing as a home - * directory in system.ini. Return "{Windows drive}:/". + /* + * User exists, but there is no such thing as a home directory + * in system.ini. Return "{Windows drive}:/". */ GetWindowsDirectoryA(buf, MAX_PATH); @@ -1311,7 +1523,7 @@ TclpGetUserHome(name, bufferPtr) * * This function replaces the library version of access(), fixing the * following bugs: - * + * * 1. access() returns that all files have execute permission. * * Results: @@ -1325,7 +1537,7 @@ TclpGetUserHome(name, bufferPtr) static int NativeAccess( - CONST TCHAR *nativePath, /* Path of file to access (UTF-8). */ + const TCHAR *nativePath, /* Path of file to access, native encoding. */ int mode) /* Permission setting. */ { DWORD attr; @@ -1341,14 +1553,14 @@ NativeAccess( return -1; } - if ((mode & W_OK) - && (tclWinProcs->getFileSecurityProc == NULL) - && (attr & FILE_ATTRIBUTE_READONLY)) { + if ((mode & W_OK) + && (tclWinProcs->getFileSecurityProc == NULL) + && (attr & FILE_ATTRIBUTE_READONLY)) { /* - * We don't have the advanced 'getFileSecurityProc', and - * our attributes say the file is not writable. If we - * do have 'getFileSecurityProc', we'll do a more - * robust XP-related check below. + * We don't have the advanced 'getFileSecurityProc', and our + * attributes say the file is not writable. If we do have + * 'getFileSecurityProc', we'll do a more robust XP-related check + * below. */ Tcl_SetErrno(EACCES); @@ -1383,8 +1595,7 @@ NativeAccess( unsigned long size; GENERIC_MAPPING genMap; HANDLE hToken = NULL; - DWORD desiredAccess = 0; - DWORD grantedAccess = 0; + DWORD desiredAccess = 0, grantedAccess = 0; BOOL accessYesNo = FALSE; PRIVILEGE_SET privSet; DWORD privSetSize = sizeof(PRIVILEGE_SET); @@ -1410,12 +1621,12 @@ NativeAccess( * to EACCES - just what we want! */ - TclWinConvertError((DWORD)error); + TclWinConvertError((DWORD) error); return -1; } /* - * Now size contains the size of buffer needed + * Now size contains the size of buffer needed. */ sdPtr = (SECURITY_DESCRIPTOR *) HeapAlloc(GetProcessHeap(), 0, size); @@ -1425,7 +1636,7 @@ NativeAccess( } /* - * Call GetFileSecurity() for real + * Call GetFileSecurity() for real. */ if (!(*tclWinProcs->getFileSecurityProc)(nativePath, @@ -1439,28 +1650,28 @@ NativeAccess( } /* - * Perform security impersonation of the user and open the - * resulting thread token. + * Perform security impersonation of the user and open the resulting + * thread token. */ if (!(*tclWinProcs->impersonateSelfProc)(SecurityImpersonation)) { /* * Unable to perform security impersonation. */ - + goto accessError; } - if (!(*tclWinProcs->openThreadTokenProc)(GetCurrentThread (), + if (!(*tclWinProcs->openThreadTokenProc)(GetCurrentThread(), TOKEN_DUPLICATE | TOKEN_QUERY, FALSE, &hToken)) { /* * Unable to get current thread's token. */ - + goto accessError; } - + (*tclWinProcs->revertToSelfProc)(); - + /* * Setup desiredAccess according to the access priveleges we are * checking. @@ -1476,12 +1687,12 @@ NativeAccess( desiredAccess |= FILE_GENERIC_EXECUTE; } - memset (&genMap, 0x0, sizeof (GENERIC_MAPPING)); + memset(&genMap, 0x0, sizeof(GENERIC_MAPPING)); genMap.GenericRead = FILE_GENERIC_READ; genMap.GenericWrite = FILE_GENERIC_WRITE; genMap.GenericExecute = FILE_GENERIC_EXECUTE; genMap.GenericAll = FILE_ALL_ACCESS; - + /* * Perform access check using the token. */ @@ -1508,19 +1719,21 @@ NativeAccess( * Clean up. */ - HeapFree(GetProcessHeap (), 0, sdPtr); + HeapFree(GetProcessHeap(), 0, sdPtr); CloseHandle(hToken); if (!accessYesNo) { Tcl_SetErrno(EACCES); return -1; } + /* - * For directories the above checks are ok. For files, though, - * we must still check the 'attr' value. + * For directories the above checks are ok. For files, though, we must + * still check the 'attr' value. */ + if ((mode & W_OK) - && !(attr & FILE_ATTRIBUTE_DIRECTORY) - && (attr & FILE_ATTRIBUTE_READONLY)) { + && !(attr & FILE_ATTRIBUTE_DIRECTORY) + && (attr & FILE_ATTRIBUTE_READONLY)) { Tcl_SetErrno(EACCES); return -1; } @@ -1533,25 +1746,22 @@ NativeAccess( * * NativeIsExec -- * - * Determines if a path is executable. On windows this is - * simply defined by whether the path ends in any of ".exe", - * ".com", or ".bat" + * Determines if a path is executable. On windows this is simply defined + * by whether the path ends in any of ".exe", ".com", or ".bat" * * Results: * 1 = executable, 0 = not. * *---------------------------------------------------------------------- */ + static int -NativeIsExec(nativePath) - CONST TCHAR *nativePath; +NativeIsExec( + const TCHAR *nativePath) { if (tclWinProcs->useWide) { - CONST WCHAR *path; - int len; - - path = (CONST WCHAR*)nativePath; - len = wcslen(path); + const WCHAR *path = (const WCHAR *) nativePath; + int len = wcslen(path); if (len < 5) { return 0; @@ -1564,26 +1774,31 @@ NativeIsExec(nativePath) /* * Use wide-char case-insensitive comparison */ - if ((_wcsicmp(path+len-3,L"exe") == 0) - || (_wcsicmp(path+len-3,L"com") == 0) - || (_wcsicmp(path+len-3,L"bat") == 0)) { + + if ((_wcsicmp(path+len-3, L"exe") == 0) + || (_wcsicmp(path+len-3, L"com") == 0) + || (_wcsicmp(path+len-3, L"bat") == 0)) { return 1; } } else { - CONST char *p; + const char *p; - /* We are only looking for pure ascii */ + /* + * We are only looking for pure ascii. + */ - p = strrchr((CONST char*)nativePath, '.'); + p = strrchr((const char *) nativePath, '.'); if (p != NULL) { p++; - /* + + /* * Note: in the old code, stat considered '.pif' files as * executable, whereas access did not. */ - if ((stricmp(p, "exe") == 0) - || (stricmp(p, "com") == 0) - || (stricmp(p, "bat") == 0)) { + + if ((strcasecmp(p, "exe") == 0) + || (strcasecmp(p, "com") == 0) + || (strcasecmp(p, "bat") == 0)) { /* * File that ends with .exe, .com, or .bat is executable. */ @@ -1606,28 +1821,31 @@ NativeIsExec(nativePath) * See chdir() documentation. * * Side effects: - * See chdir() documentation. + * See chdir() documentation. * *---------------------------------------------------------------------- */ -int -TclpObjChdir(pathPtr) - Tcl_Obj *pathPtr; /* Path to new working directory. */ +int +TclpObjChdir( + Tcl_Obj *pathPtr) /* Path to new working directory. */ { int result; - CONST TCHAR *nativePath; + const TCHAR *nativePath; #ifdef __CYGWIN__ - extern int cygwin_conv_to_posix_path - _ANSI_ARGS_((CONST char *, char *)); + extern int cygwin_conv_to_posix_path(const char *, char *); char posixPath[MAX_PATH+1]; - CONST char *path; + const char *path; Tcl_DString ds; #endif /* __CYGWIN__ */ - nativePath = (CONST TCHAR *) Tcl_FSGetNativePath(pathPtr); + nativePath = (const TCHAR *) Tcl_FSGetNativePath(pathPtr); + #ifdef __CYGWIN__ - /* Cygwin chdir only groks POSIX path. */ + /* + * Cygwin chdir only groks POSIX path. + */ + path = Tcl_WinTCharToUtf(nativePath, -1, &ds); cygwin_conv_to_posix_path(path, posixPath); result = (chdir(posixPath) == 0 ? 1 : 0); @@ -1649,26 +1867,26 @@ TclpObjChdir(pathPtr) * * TclpReadlink -- * - * This function replaces the library version of readlink(). + * This function replaces the library version of readlink(). * * Results: - * The result is a pointer to a string specifying the contents - * of the symbolic link given by 'path', or NULL if the symbolic - * link could not be read. Storage for the result string is - * allocated in bufferPtr; the caller must call Tcl_DStringFree() - * when the result is no longer needed. + * The result is a pointer to a string specifying the contents of the + * symbolic link given by 'path', or NULL if the symbolic link could not + * be read. Storage for the result string is allocated in bufferPtr; the + * caller must call Tcl_DStringFree() when the result is no longer + * needed. * * Side effects: - * See readlink() documentation. + * See readlink() documentation. * *--------------------------------------------------------------------------- */ char * -TclpReadlink(path, linkPtr) - CONST char *path; /* Path of file to readlink (UTF-8). */ - Tcl_DString *linkPtr; /* Uninitialized or free DString filled - * with contents of link (UTF-8). */ +TclpReadlink( + const char *path, /* Path of file to readlink (UTF-8). */ + Tcl_DString *linkPtr) /* Uninitialized or free DString filled with + * contents of link (UTF-8). */ { char link[MAXPATHLEN]; int length; @@ -1676,9 +1894,9 @@ TclpReadlink(path, linkPtr) Tcl_DString ds; native = Tcl_UtfToExternalDString(NULL, path, -1, &ds); - length = readlink(native, link, sizeof(link)); /* INTL: Native. */ + length = readlink(native, link, sizeof(link)); /* INTL: Native. */ Tcl_DStringFree(&ds); - + if (length < 0) { return NULL; } @@ -1693,15 +1911,16 @@ TclpReadlink(path, linkPtr) * * TclpGetCwd -- * - * This function replaces the library version of getcwd(). + * This function replaces the library version of getcwd(). (Obsolete + * function, only retained for old extensions which may call it + * directly). * * Results: - * The result is a pointer to a string specifying the current - * directory, or NULL if the current directory could not be - * determined. If NULL is returned, an error message is left in the - * interp's result. Storage for the result string is allocated in - * bufferPtr; the caller must call Tcl_DStringFree() when the result - * is no longer needed. + * The result is a pointer to a string specifying the current directory, + * or NULL if the current directory could not be determined. If NULL is + * returned, an error message is left in the interp's result. Storage for + * the result string is allocated in bufferPtr; the caller must call + * Tcl_DStringFree() when the result is no longer needed. * * Side effects: * None. @@ -1709,11 +1928,11 @@ TclpReadlink(path, linkPtr) *---------------------------------------------------------------------- */ -CONST char * -TclpGetCwd(interp, bufferPtr) - Tcl_Interp *interp; /* If non-NULL, used for error reporting. */ - Tcl_DString *bufferPtr; /* Uninitialized or free DString filled - * with name of current directory. */ +const char * +TclpGetCwd( + Tcl_Interp *interp, /* If non-NULL, used for error reporting. */ + Tcl_DString *bufferPtr) /* Uninitialized or free DString filled with + * name of current directory. */ { WCHAR buffer[MAX_PATH]; char *p; @@ -1721,9 +1940,8 @@ TclpGetCwd(interp, bufferPtr) if ((*tclWinProcs->getCurrentDirectoryProc)(MAX_PATH, buffer) == 0) { TclWinConvertError(GetLastError()); if (interp != NULL) { - Tcl_AppendResult(interp, - "error getting working directory name: ", - Tcl_PosixError(interp), (char *) NULL); + Tcl_AppendResult(interp, "error getting working directory name: ", + Tcl_PosixError(interp), NULL); } return NULL; } @@ -1736,7 +1954,7 @@ TclpGetCwd(interp, bufferPtr) WCHAR *native; native = (WCHAR *) buffer; - if ((native[0] != '\0') && (native[1] == ':') + if ((native[0] != '\0') && (native[1] == ':') && (native[2] == '\\') && (native[3] == '\\')) { native += 2; } @@ -1745,7 +1963,7 @@ TclpGetCwd(interp, bufferPtr) char *native; native = (char *) buffer; - if ((native[0] != '\0') && (native[1] == ':') + if ((native[0] != '\0') && (native[1] == ':') && (native[2] == '\\') && (native[3] == '\\')) { native += 2; } @@ -1755,7 +1973,7 @@ TclpGetCwd(interp, bufferPtr) /* * Convert to forward slashes for easier use in scripts. */ - + for (p = Tcl_DStringValue(bufferPtr); *p != '\0'; p++) { if (*p == '\\') { *p = '/'; @@ -1764,38 +1982,21 @@ TclpGetCwd(interp, bufferPtr) return Tcl_DStringValue(bufferPtr); } -int -TclpObjStat(pathPtr, statPtr) - Tcl_Obj *pathPtr; /* Path of file to stat */ - Tcl_StatBuf *statPtr; /* Filled with results of stat call. */ +int +TclpObjStat( + Tcl_Obj *pathPtr, /* Path of file to stat. */ + Tcl_StatBuf *statPtr) /* Filled with results of stat call. */ { -#ifdef OLD_API - Tcl_Obj *transPtr; /* - * Eliminate file names containing wildcard characters, or subsequent - * call to FindFirstFile() will expand them, matching some other file. + * Ensure correct file sizes by forcing the OS to write any pending data + * to disk. This is done only for channels which are dirty, i.e. have been + * written to since the last flush here. */ - transPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr); - if (transPtr == NULL || (strpbrk(Tcl_GetString(transPtr), "?*") != NULL)) { - if (transPtr != NULL) { - Tcl_DecrRefCount(transPtr); - } - Tcl_SetErrno(ENOENT); - return -1; - } - Tcl_DecrRefCount(transPtr); -#endif - - /* - * Ensure correct file sizes by forcing the OS to write any - * pending data to disk. This is done only for channels which are - * dirty, i.e. have been written to since the last flush here. - */ + TclWinFlushDirtyChannels(); - TclWinFlushDirtyChannels (); - - return NativeStat((CONST TCHAR*) Tcl_FSGetNativePath(pathPtr), statPtr, 0); + return NativeStat((const TCHAR *) Tcl_FSGetNativePath(pathPtr), + statPtr, 0); } /* @@ -1803,8 +2004,8 @@ TclpObjStat(pathPtr, statPtr) * * NativeStat -- * - * This function replaces the library version of stat(), fixing - * the following bugs: + * This function replaces the library version of stat(), fixing the + * following bugs: * * 1. stat("c:") returns an error. * 2. Borland stat() return time in GMT instead of localtime. @@ -1821,31 +2022,97 @@ TclpObjStat(pathPtr, statPtr) *---------------------------------------------------------------------- */ -static int -NativeStat(nativePath, statPtr, checkLinks) - CONST TCHAR *nativePath; /* Path of file to stat */ - Tcl_StatBuf *statPtr; /* Filled with results of stat call. */ - int checkLinks; /* If non-zero, behave like 'lstat' */ +static int +NativeStat( + const TCHAR *nativePath, /* Path of file to stat */ + Tcl_StatBuf *statPtr, /* Filled with results of stat call. */ + int checkLinks) /* If non-zero, behave like 'lstat' */ { - Tcl_DString ds; DWORD attr; - WCHAR nativeFullPath[MAX_PATH]; - TCHAR *nativePart; - CONST char *fullPath; - int dev; + int dev, nlink = 1; unsigned short mode; - - if (tclWinProcs->getFileAttributesExProc == NULL) { - /* - * We don't have the faster attributes proc, so we're - * probably running on Win95 - */ + unsigned int inode = 0; + HANDLE fileHandle; + + /* + * If we can use 'createFile' on this, then we can use the resulting + * fileHandle to read more information (nlink, ino) than we can get from + * other attributes reading APIs. If not, then we try to fall back on the + * 'getFileAttributesExProc', and if that isn't available, then on even + * simpler routines. + */ + + fileHandle = (tclWinProcs->createFileProc)(nativePath, GENERIC_READ, + FILE_SHARE_READ | FILE_SHARE_WRITE, NULL, OPEN_EXISTING, + FILE_FLAG_BACKUP_SEMANTICS | FILE_FLAG_OPEN_REPARSE_POINT, NULL); + + if (fileHandle != INVALID_HANDLE_VALUE) { + BY_HANDLE_FILE_INFORMATION data; + + if (GetFileInformationByHandle(fileHandle,&data) != TRUE) { + CloseHandle(fileHandle); + Tcl_SetErrno(ENOENT); + return -1; + } + CloseHandle(fileHandle); + + attr = data.dwFileAttributes; + + statPtr->st_size = ((Tcl_WideInt) data.nFileSizeLow) | + (((Tcl_WideInt) data.nFileSizeHigh) << 32); + statPtr->st_atime = ToCTime(data.ftLastAccessTime); + statPtr->st_mtime = ToCTime(data.ftLastWriteTime); + statPtr->st_ctime = ToCTime(data.ftCreationTime); + + /* + * On Unix, for directories, nlink apparently depends on the number of + * files in the directory. We could calculate that, but it would be a + * bit of a performance penalty, I think. Hence we just use what + * Windows gives us, which is the same as Unix for files, at least. + */ + + nlink = data.nNumberOfLinks; + + /* + * Unfortunately our stat definition's inode field (unsigned short) + * will throw away most of the precision we have here, which means we + * can't rely on inode as a unique identifier of a file. We'd really + * like to do something like how we handle 'st_size'. + */ + + inode = data.nFileIndexHigh | data.nFileIndexLow; + } else if (tclWinProcs->getFileAttributesExProc != NULL) { + /* + * Fall back on the less capable routines. This means no nlink or ino. + */ + + WIN32_FILE_ATTRIBUTE_DATA data; + + if ((*tclWinProcs->getFileAttributesExProc)(nativePath, + GetFileExInfoStandard, &data) != TRUE) { + Tcl_SetErrno(ENOENT); + return -1; + } + + attr = data.dwFileAttributes; + + statPtr->st_size = ((Tcl_WideInt) data.nFileSizeLow) | + (((Tcl_WideInt) data.nFileSizeHigh) << 32); + statPtr->st_atime = ToCTime(data.ftLastAccessTime); + statPtr->st_mtime = ToCTime(data.ftLastWriteTime); + statPtr->st_ctime = ToCTime(data.ftCreationTime); + } else { + /* + * We don't have the faster attributes proc, so we're probably running + * on Win95. + */ + WIN32_FIND_DATAT data; HANDLE handle; handle = (*tclWinProcs->findFirstFileProc)(nativePath, &data); if (handle == INVALID_HANDLE_VALUE) { - /* + /* * FindFirstFile() doesn't work on root directories, so call * GetFileAttributes() to see if the specified file exists. */ @@ -1856,9 +2123,9 @@ NativeStat(nativePath, statPtr, checkLinks) return -1; } - /* - * Make up some fake information for this file. It has the - * correct file attributes and a time of 0. + /* + * Make up some fake information for this file. It has the correct + * file attributes and a time of 0. */ memset(&data, 0, sizeof(data)); @@ -1867,131 +2134,95 @@ NativeStat(nativePath, statPtr, checkLinks) FindClose(handle); } - - (*tclWinProcs->getFullPathNameProc)(nativePath, MAX_PATH, nativeFullPath, - &nativePart); - - fullPath = Tcl_WinTCharToUtf((TCHAR *) nativeFullPath, -1, &ds); - - dev = -1; - if ((fullPath[0] == '\\') && (fullPath[1] == '\\')) { - CONST char *p; - DWORD dw; - CONST TCHAR *nativeVol; - Tcl_DString volString; - - p = strchr(fullPath + 2, '\\'); - p = strchr(p + 1, '\\'); - if (p == NULL) { - /* - * Add terminating backslash to fullpath or - * GetVolumeInformation() won't work. - */ - - fullPath = Tcl_DStringAppend(&ds, "\\", 1); - p = fullPath + Tcl_DStringLength(&ds); - } else { - p++; - } - nativeVol = Tcl_WinUtfToTChar(fullPath, p - fullPath, &volString); - dw = (DWORD) -1; - (*tclWinProcs->getVolumeInformationProc)(nativeVol, NULL, 0, &dw, - NULL, NULL, NULL, 0); - /* - * GetFullPathName() turns special devices like "NUL" into - * "\\.\NUL", but GetVolumeInformation() returns failure for - * "\\.\NUL". This will cause "NUL" to get a drive number of - * -1, which makes about as much sense as anything since the - * special devices don't live on any drive. - */ - - dev = dw; - Tcl_DStringFree(&volString); - } else if ((fullPath[0] != '\0') && (fullPath[1] == ':')) { - dev = Tcl_UniCharToLower(fullPath[0]) - 'a'; - } - Tcl_DStringFree(&ds); - attr = data.a.dwFileAttributes; - statPtr->st_size = ((Tcl_WideInt)data.a.nFileSizeLow) | - (((Tcl_WideInt)data.a.nFileSizeHigh) << 32); + statPtr->st_size = ((Tcl_WideInt) data.a.nFileSizeLow) | + (((Tcl_WideInt) data.a.nFileSizeHigh) << 32); statPtr->st_atime = ToCTime(data.a.ftLastAccessTime); statPtr->st_mtime = ToCTime(data.a.ftLastWriteTime); statPtr->st_ctime = ToCTime(data.a.ftCreationTime); - } else { - WIN32_FILE_ATTRIBUTE_DATA data; - if((*tclWinProcs->getFileAttributesExProc)(nativePath, - GetFileExInfoStandard, - &data) != TRUE) { - Tcl_SetErrno(ENOENT); - return -1; - } + } - - (*tclWinProcs->getFullPathNameProc)(nativePath, MAX_PATH, - nativeFullPath, &nativePart); + dev = NativeDev(nativePath); + mode = NativeStatMode(attr, checkLinks, NativeIsExec(nativePath)); - fullPath = Tcl_WinTCharToUtf((TCHAR *) nativeFullPath, -1, &ds); + statPtr->st_dev = (dev_t) dev; + statPtr->st_ino = inode; + statPtr->st_mode = mode; + statPtr->st_nlink = nlink; + statPtr->st_uid = 0; + statPtr->st_gid = 0; + statPtr->st_rdev = (dev_t) dev; + return 0; +} + +/* + *---------------------------------------------------------------------- + * + * NativeDev -- + * + * Calculate just the 'st_dev' field of a 'stat' structure. + * + *---------------------------------------------------------------------- + */ - dev = -1; - if ((fullPath[0] == '\\') && (fullPath[1] == '\\')) { - CONST char *p; - DWORD dw; - CONST TCHAR *nativeVol; - Tcl_DString volString; - - p = strchr(fullPath + 2, '\\'); - p = strchr(p + 1, '\\'); - if (p == NULL) { - /* - * Add terminating backslash to fullpath or - * GetVolumeInformation() won't work. - */ +static int +NativeDev( + const TCHAR *nativePath) /* Full path of file to stat */ +{ + int dev; + Tcl_DString ds; + WCHAR nativeFullPath[MAX_PATH]; + TCHAR *nativePart; + const char *fullPath; - fullPath = Tcl_DStringAppend(&ds, "\\", 1); - p = fullPath + Tcl_DStringLength(&ds); - } else { - p++; - } - nativeVol = Tcl_WinUtfToTChar(fullPath, p - fullPath, &volString); - dw = (DWORD) -1; - (*tclWinProcs->getVolumeInformationProc)(nativeVol, NULL, 0, &dw, - NULL, NULL, NULL, 0); + (*tclWinProcs->getFullPathNameProc)(nativePath, MAX_PATH, + nativeFullPath, &nativePart); + + fullPath = Tcl_WinTCharToUtf((TCHAR *) nativeFullPath, -1, &ds); + + if ((fullPath[0] == '\\') && (fullPath[1] == '\\')) { + const char *p; + DWORD dw; + const TCHAR *nativeVol; + Tcl_DString volString; + + p = strchr(fullPath + 2, '\\'); + p = strchr(p + 1, '\\'); + if (p == NULL) { /* - * GetFullPathName() turns special devices like "NUL" into - * "\\.\NUL", but GetVolumeInformation() returns failure for - * "\\.\NUL". This will cause "NUL" to get a drive number of - * -1, which makes about as much sense as anything since the - * special devices don't live on any drive. + * Add terminating backslash to fullpath or GetVolumeInformation() + * won't work. */ - dev = dw; - Tcl_DStringFree(&volString); - } else if ((fullPath[0] != '\0') && (fullPath[1] == ':')) { - dev = Tcl_UniCharToLower(fullPath[0]) - 'a'; + fullPath = Tcl_DStringAppend(&ds, "\\", 1); + p = fullPath + Tcl_DStringLength(&ds); + } else { + p++; } - Tcl_DStringFree(&ds); - - attr = data.dwFileAttributes; - - statPtr->st_size = ((Tcl_WideInt)data.nFileSizeLow) | - (((Tcl_WideInt)data.nFileSizeHigh) << 32); - statPtr->st_atime = ToCTime(data.ftLastAccessTime); - statPtr->st_mtime = ToCTime(data.ftLastWriteTime); - statPtr->st_ctime = ToCTime(data.ftCreationTime); + nativeVol = Tcl_WinUtfToTChar(fullPath, p - fullPath, &volString); + dw = (DWORD) -1; + (*tclWinProcs->getVolumeInformationProc)(nativeVol, NULL, 0, &dw, + NULL, NULL, NULL, 0); + + /* + * GetFullPathName() turns special devices like "NUL" into "\\.\NUL", + * but GetVolumeInformation() returns failure for "\\.\NUL". This will + * cause "NUL" to get a drive number of -1, which makes about as much + * sense as anything since the special devices don't live on any + * drive. + */ + + dev = dw; + Tcl_DStringFree(&volString); + } else if ((fullPath[0] != '\0') && (fullPath[1] == ':')) { + dev = Tcl_UniCharToLower(fullPath[0]) - 'a'; + } else { + dev = -1; } + Tcl_DStringFree(&ds); - mode = NativeStatMode(attr, checkLinks, NativeIsExec(nativePath)); - - statPtr->st_dev = (dev_t) dev; - statPtr->st_ino = 0; - statPtr->st_mode = mode; - statPtr->st_nlink = 1; - statPtr->st_uid = 0; - statPtr->st_gid = 0; - statPtr->st_rdev = (dev_t) dev; - return 0; + return dev; } /* @@ -2001,31 +2232,42 @@ NativeStat(nativePath, statPtr, checkLinks) * * Calculate just the 'st_mode' field of a 'stat' structure. * + * In many places we don't need the full stat structure, and it's much + * faster just to calculate these pieces, if that's all we need. + * *---------------------------------------------------------------------- */ + static unsigned short -NativeStatMode(DWORD attr, int checkLinks, int isExec) +NativeStatMode( + DWORD attr, + int checkLinks, + int isExec) { int mode; + if (checkLinks && (attr & FILE_ATTRIBUTE_REPARSE_POINT)) { - /* It is a link */ + /* + * It is a link. + */ + mode = S_IFLNK; } else { - mode = (attr & FILE_ATTRIBUTE_DIRECTORY) ? S_IFDIR | S_IEXEC : S_IFREG; + mode = (attr & FILE_ATTRIBUTE_DIRECTORY) ? S_IFDIR|S_IEXEC : S_IFREG; } - mode |= (attr & FILE_ATTRIBUTE_READONLY) ? S_IREAD : S_IREAD | S_IWRITE; + mode |= (attr & FILE_ATTRIBUTE_READONLY) ? S_IREAD : S_IREAD|S_IWRITE; if (isExec) { mode |= S_IEXEC; } - + /* - * Propagate the S_IREAD, S_IWRITE, S_IEXEC bits to the group and - * other positions. + * Propagate the S_IREAD, S_IWRITE, S_IEXEC bits to the group and other + * positions. */ mode |= (mode & 0x0700) >> 3; mode |= (mode & 0x0700) >> 6; - return (unsigned short)mode; + return (unsigned short) mode; } /* @@ -2050,8 +2292,8 @@ ToCTime( convertedTime.LowPart = fileTime.dwLowDateTime; convertedTime.HighPart = (LONG) fileTime.dwHighDateTime; - return (time_t) ((convertedTime.QuadPart - - (Tcl_WideInt) POSIX_EPOCH_AS_FILETIME) / (Tcl_WideInt) 10000000); + return (time_t) ((convertedTime.QuadPart - + (Tcl_WideInt) POSIX_EPOCH_AS_FILETIME) / (Tcl_WideInt) 10000000); } /* @@ -2070,7 +2312,7 @@ ToCTime( static void FromCTime( time_t posixTime, - FILETIME* fileTime) /* UTC Time */ + FILETIME *fileTime) /* UTC Time */ { LARGE_INTEGER convertedTime; convertedTime.QuadPart = ((LONGLONG) posixTime) * 10000000 @@ -2079,136 +2321,105 @@ FromCTime( fileTime->dwHighDateTime = convertedTime.HighPart; } -#if 0 /* - *------------------------------------------------------------------------- + *--------------------------------------------------------------------------- * - * TclWinResolveShortcut -- + * TclpGetNativeCwd -- * - * Resolve a potential Windows shortcut to get the actual file or - * directory in question. + * This function replaces the library version of getcwd(). * * Results: - * Returns 1 if the shortcut could be resolved, or 0 if there was - * an error or if the filename was not a shortcut. - * If bufferPtr did hold the name of a shortcut, it is modified to - * hold the resolved target of the shortcut instead. + * The input and output are filesystem paths in native form. The result + * is either the given clientData, if the working directory hasn't + * changed, or a new clientData (owned by our caller), giving the new + * native path, or NULL if the current directory could not be determined. + * If NULL is returned, the caller can examine the standard posix error + * codes to determine the cause of the problem. * * Side effects: - * Loads and unloads OLE package to determine if filename refers to - * a shortcut. + * None. * - *------------------------------------------------------------------------- + *---------------------------------------------------------------------- */ -int -TclWinResolveShortcut(bufferPtr) - Tcl_DString *bufferPtr; /* Holds name of file to resolve. On - * return, holds resolved file name. */ +ClientData +TclpGetNativeCwd( + ClientData clientData) { - HRESULT hres; - IShellLink *psl; - IPersistFile *ppf; - WIN32_FIND_DATA wfd; - WCHAR wpath[MAX_PATH]; - char *path, *ext; - char realFileName[MAX_PATH]; + WCHAR buffer[MAX_PATH]; - /* - * Windows system calls do not automatically resolve - * shortcuts like UNIX automatically will with symbolic links. - */ + if ((*tclWinProcs->getCurrentDirectoryProc)(MAX_PATH, buffer) == 0) { + TclWinConvertError(GetLastError()); + return NULL; + } + + if (clientData != NULL) { + if (tclWinProcs->useWide) { + /* + * Unicode representation when running on NT/2K/XP. + */ + + if (wcscmp((const WCHAR*)clientData, (const WCHAR*)buffer) == 0) { + return clientData; + } + } else { + /* + * ANSI representation when running on 95/98/ME. + */ - path = Tcl_DStringValue(bufferPtr); - ext = strrchr(path, '.'); - if ((ext == NULL) || (stricmp(ext, ".lnk") != 0)) { - return 0; - } - - CoInitialize(NULL); - path = Tcl_DStringValue(bufferPtr); - realFileName[0] = '\0'; - hres = CoCreateInstance(&CLSID_ShellLink, NULL, CLSCTX_INPROC_SERVER, - &IID_IShellLink, &psl); - if (SUCCEEDED(hres)) { - hres = psl->lpVtbl->QueryInterface(psl, &IID_IPersistFile, &ppf); - if (SUCCEEDED(hres)) { - MultiByteToWideChar(CP_ACP, 0, path, -1, wpath, sizeof(wpath)); - hres = ppf->lpVtbl->Load(ppf, wpath, STGM_READ); - if (SUCCEEDED(hres)) { - hres = psl->lpVtbl->Resolve(psl, NULL, - SLR_ANY_MATCH | SLR_NO_UI); - if (SUCCEEDED(hres)) { - hres = psl->lpVtbl->GetPath(psl, realFileName, MAX_PATH, - &wfd, 0); - } - } - ppf->lpVtbl->Release(ppf); - } - psl->lpVtbl->Release(psl); - } - CoUninitialize(); - - if (realFileName[0] != '\0') { - Tcl_DStringSetLength(bufferPtr, 0); - Tcl_DStringAppend(bufferPtr, realFileName, -1); - return 1; + if (strcmp((const char*) clientData, (const char*) buffer) == 0) { + return clientData; + } + } } - return 0; + + return TclNativeDupInternalRep((ClientData) buffer); } -#endif -Tcl_Obj* -TclpObjGetCwd(interp) - Tcl_Interp *interp; -{ - Tcl_DString ds; - if (TclpGetCwd(interp, &ds) != NULL) { - Tcl_Obj *cwdPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1); - Tcl_IncrRefCount(cwdPtr); - Tcl_DStringFree(&ds); - return cwdPtr; - } else { - return NULL; - } -} - -int -TclpObjAccess(pathPtr, mode) - Tcl_Obj *pathPtr; - int mode; +int +TclpObjAccess( + Tcl_Obj *pathPtr, + int mode) { - return NativeAccess((CONST TCHAR*) Tcl_FSGetNativePath(pathPtr), mode); + return NativeAccess((const TCHAR *) Tcl_FSGetNativePath(pathPtr), mode); } - -int -TclpObjLstat(pathPtr, statPtr) - Tcl_Obj *pathPtr; - Tcl_StatBuf *statPtr; + +int +TclpObjLstat( + Tcl_Obj *pathPtr, + Tcl_StatBuf *statPtr) { /* - * Ensure correct file sizes by forcing the OS to write any - * pending data to disk. This is done only for channels which are - * dirty, i.e. have been written to since the last flush here. + * Ensure correct file sizes by forcing the OS to write any pending data + * to disk. This is done only for channels which are dirty, i.e. have been + * written to since the last flush here. */ - TclWinFlushDirtyChannels (); + TclWinFlushDirtyChannels(); - return NativeStat((CONST TCHAR*) Tcl_FSGetNativePath(pathPtr), statPtr, 1); + return NativeStat((const TCHAR *) Tcl_FSGetNativePath(pathPtr), + statPtr, 1); } - + #ifdef S_IFLNK - -Tcl_Obj* -TclpObjLink(pathPtr, toPtr, linkAction) - Tcl_Obj *pathPtr; - Tcl_Obj *toPtr; - int linkAction; +Tcl_Obj * +TclpObjLink( + Tcl_Obj *pathPtr, + Tcl_Obj *toPtr, + int linkAction) { if (toPtr != NULL) { int res; - TCHAR* LinkTarget = (TCHAR*)Tcl_FSGetNativePath(toPtr); - TCHAR* LinkSource = (TCHAR*)Tcl_FSGetNativePath(pathPtr); + TCHAR *LinkTarget; + TCHAR *LinkSource = (TCHAR *) Tcl_FSGetNativePath(pathPtr); + Tcl_Obj *normalizedToPtr = Tcl_FSGetNormalizedPath(NULL, toPtr); + + if (normalizedToPtr == NULL) { + return NULL; + } + + LinkTarget = (TCHAR *) Tcl_FSGetNativePath(normalizedToPtr); + if (LinkSource == NULL || LinkTarget == NULL) { return NULL; } @@ -2219,60 +2430,65 @@ TclpObjLink(pathPtr, toPtr, linkAction) return NULL; } } else { - TCHAR* LinkSource = (TCHAR*)Tcl_FSGetNativePath(pathPtr); + TCHAR *LinkSource = (TCHAR *) Tcl_FSGetNativePath(pathPtr); + if (LinkSource == NULL) { return NULL; } return WinReadLink(LinkSource); } } - #endif - /* *--------------------------------------------------------------------------- * * TclpFilesystemPathType -- * - * This function is part of the native filesystem support, and - * returns the path type of the given path. Returns NTFS or FAT - * or whatever is returned by the 'volume information' proc. + * This function is part of the native filesystem support, and returns + * the path type of the given path. Returns NTFS or FAT or whatever is + * returned by the 'volume information' proc. * * Results: - * NULL at present. + * NULL at present. * * Side effects: * None. * *--------------------------------------------------------------------------- */ -Tcl_Obj* -TclpFilesystemPathType(pathObjPtr) - Tcl_Obj* pathObjPtr; + +Tcl_Obj * +TclpFilesystemPathType( + Tcl_Obj *pathPtr) { #define VOL_BUF_SIZE 32 int found; WCHAR volType[VOL_BUF_SIZE]; - char* firstSeparator; - CONST char *path; - - Tcl_Obj *normPath = Tcl_FSGetNormalizedPath(NULL, pathObjPtr); - if (normPath == NULL) return NULL; + char *firstSeparator; + const char *path; + Tcl_Obj *normPath = Tcl_FSGetNormalizedPath(NULL, pathPtr); + + if (normPath == NULL) { + return NULL; + } path = Tcl_GetString(normPath); - if (path == NULL) return NULL; - + if (path == NULL) { + return NULL; + } + firstSeparator = strchr(path, '/'); if (firstSeparator == NULL) { found = tclWinProcs->getVolumeInformationProc( - Tcl_FSGetNativePath(pathObjPtr), NULL, 0, NULL, NULL, - NULL, (WCHAR *)volType, VOL_BUF_SIZE); + Tcl_FSGetNativePath(pathPtr), NULL, 0, NULL, NULL, NULL, + (WCHAR *) volType, VOL_BUF_SIZE); } else { Tcl_Obj *driveName = Tcl_NewStringObj(path, firstSeparator - path+1); + Tcl_IncrRefCount(driveName); found = tclWinProcs->getVolumeInformationProc( - Tcl_FSGetNativePath(driveName), NULL, 0, NULL, NULL, - NULL, (WCHAR *)volType, VOL_BUF_SIZE); + Tcl_FSGetNativePath(driveName), NULL, 0, NULL, NULL, NULL, + (WCHAR *) volType, VOL_BUF_SIZE); Tcl_DecrRefCount(driveName); } @@ -2281,91 +2497,118 @@ TclpFilesystemPathType(pathObjPtr) } else { Tcl_DString ds; Tcl_Obj *objPtr; - - Tcl_WinTCharToUtf((CONST char *)volType, -1, &ds); - objPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds),Tcl_DStringLength(&ds)); + + Tcl_WinTCharToUtf((const char *) volType, -1, &ds); + objPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), + Tcl_DStringLength(&ds)); Tcl_DStringFree(&ds); return objPtr; } #undef VOL_BUF_SIZE } + +/* + * This define can be turned on to experiment with a different way of + * normalizing paths (using a different Windows API). Unfortunately the new + * path seems to take almost exactly the same amount of time as the old path! + * The primary time taken by normalization is in + * GetFileAttributesEx/FindFirstFile or GetFileAttributesEx/GetLongPathName. + * Conversion to/from native is not a significant factor at all. + * + * Also, since we have to check for symbolic links (reparse points) then we + * have to call GetFileAttributes on each path segment anyway, so there's no + * benefit to doing anything clever there. + */ +/* #define TclNORM_LONG_PATH */ /* *--------------------------------------------------------------------------- * * TclpObjNormalizePath -- * - * This function scans through a path specification and replaces it, - * in place, with a normalized version. This means using the - * 'longname', and expanding any symbolic links contained within the - * path. + * This function scans through a path specification and replaces it, in + * place, with a normalized version. This means using the 'longname', and + * expanding any symbolic links contained within the path. * * Results: - * The new 'nextCheckpoint' value, giving as far as we could - * understand in the path. + * The new 'nextCheckpoint' value, giving as far as we could understand + * in the path. * * Side effects: - * The pathPtr string, which must contain a valid path, is - * possibly modified in place. + * The pathPtr string, which must contain a valid path, is possibly + * modified in place. * *--------------------------------------------------------------------------- */ int -TclpObjNormalizePath(interp, pathPtr, nextCheckpoint) - Tcl_Interp *interp; - Tcl_Obj *pathPtr; - int nextCheckpoint; +TclpObjNormalizePath( + Tcl_Interp *interp, + Tcl_Obj *pathPtr, + int nextCheckpoint) { char *lastValidPathEnd = NULL; - /* This will hold the normalized string */ - Tcl_DString dsNorm; - char *path; - char *currentPathEndPosition; + Tcl_DString dsNorm; /* This will hold the normalized string. */ + char *path, *currentPathEndPosition; Tcl_Obj *temp = NULL; Tcl_DStringInit(&dsNorm); path = Tcl_GetString(pathPtr); if (TclWinGetPlatformId() == VER_PLATFORM_WIN32_WINDOWS) { - /* - * We're on Win95, 98 or ME. There are two assumptions - * in this block of code. First that the native (NULL) - * encoding is basically ascii, and second that symbolic - * links are not possible. Both of these assumptions - * appear to be true of these operating systems. + /* + * We're on Win95, 98 or ME. There are two assumptions in this block + * of code. First that the native (NULL) encoding is basically ascii, + * and second that symbolic links are not possible. Both of these + * assumptions appear to be true of these operating systems. */ + int isDrive = 1; Tcl_DString ds; currentPathEndPosition = path + nextCheckpoint; - if (*currentPathEndPosition == '/') { + if (*currentPathEndPosition == '/') { currentPathEndPosition++; - } + } + while (1) { char cur = *currentPathEndPosition; - if ((cur == '/' || cur == 0) && (path != currentPathEndPosition)) { - /* Reached directory separator, or end of string */ - CONST char *nativePath = Tcl_UtfToExternalDString(NULL, path, - currentPathEndPosition - path, &ds); + if ((cur=='/' || cur==0) && (path != currentPathEndPosition)) { /* - * Now we convert the tail of the current path to its - * 'long form', and append it to 'dsNorm' which holds - * the current normalized path, if the file exists. + * Reached directory separator, or end of string. */ + + const char *nativePath = Tcl_UtfToExternalDString(NULL, path, + currentPathEndPosition - path, &ds); + + /* + * Now we convert the tail of the current path to its 'long + * form', and append it to 'dsNorm' which holds the current + * normalized path, if the file exists. + */ + if (isDrive) { - if (GetFileAttributesA(nativePath) == INVALID_FILE_ATTRIBUTES) { - /* File doesn't exist */ + if (GetFileAttributesA(nativePath) + == INVALID_FILE_ATTRIBUTES) { + /* + * File doesn't exist. + */ + if (isDrive) { int len = WinIsReserved(path); + if (len > 0) { - /* Actually it does exist - COM1, etc */ + /* + * Actually it does exist - COM1, etc. + */ + int i; - for (i=0;i<len;i++) { + + for (i=0 ; i<len ; i++) { if (nativePath[i] >= 'a') { - ((char*)nativePath)[i] -= ('a' - 'A'); + ((char *) nativePath)[i] -= ('a'-'A'); } } Tcl_DStringAppend(&dsNorm, nativePath, len); @@ -2376,33 +2619,74 @@ TclpObjNormalizePath(interp, pathPtr, nextCheckpoint) break; } if (nativePath[0] >= 'a') { - ((char*)nativePath)[0] -= ('a' - 'A'); + ((char *) nativePath)[0] -= ('a' - 'A'); } - Tcl_DStringAppend(&dsNorm,nativePath,Tcl_DStringLength(&ds)); + Tcl_DStringAppend(&dsNorm, nativePath, + Tcl_DStringLength(&ds)); } else { - WIN32_FIND_DATA fData; - HANDLE handle; - - handle = FindFirstFileA(nativePath, &fData); - if (handle == INVALID_HANDLE_VALUE) { - if (GetFileAttributesA(nativePath) - == INVALID_FILE_ATTRIBUTES) { - /* File doesn't exist */ - Tcl_DStringFree(&ds); - break; + char *checkDots = NULL; + + if (lastValidPathEnd[1] == '.') { + checkDots = lastValidPathEnd + 1; + while (checkDots < currentPathEndPosition) { + if (*checkDots != '.') { + checkDots = NULL; + break; + } + checkDots++; } - /* This is usually the '/' in 'c:/' at end of string */ - Tcl_DStringAppend(&dsNorm,"/", 1); + } + if (checkDots != NULL) { + int dotLen = currentPathEndPosition-lastValidPathEnd; + + /* + * Path is just dots. We shouldn't really ever see a + * path like that. However, to be nice we at least + * don't mangle the path - we just add the dots as a + * path segment and continue + */ + + Tcl_DStringAppend(&dsNorm, (TCHAR *) + (nativePath + Tcl_DStringLength(&ds)-dotLen), + dotLen); } else { - char *nativeName; - if (fData.cFileName[0] != '\0') { - nativeName = fData.cFileName; + /* + * Normal path. + */ + + WIN32_FIND_DATA fData; + HANDLE handle; + + handle = FindFirstFileA(nativePath, &fData); + if (handle == INVALID_HANDLE_VALUE) { + if (GetFileAttributesA(nativePath) + == INVALID_FILE_ATTRIBUTES) { + /* + * File doesn't exist. + */ + + Tcl_DStringFree(&ds); + break; + } + + /* + * This is usually the '/' in 'c:/' at end of + * string. + */ + + Tcl_DStringAppend(&dsNorm,"/", 1); } else { - nativeName = fData.cAlternateFileName; + char *nativeName; + + if (fData.cFileName[0] != '\0') { + nativeName = fData.cFileName; + } else { + nativeName = fData.cAlternateFileName; + } + FindClose(handle); + Tcl_DStringAppend(&dsNorm,"/", 1); + Tcl_DStringAppend(&dsNorm,nativeName,-1); } - FindClose(handle); - Tcl_DStringAppend(&dsNorm,"/", 1); - Tcl_DStringAppend(&dsNorm,nativeName,-1); } } Tcl_DStringFree(&ds); @@ -2410,16 +2694,21 @@ TclpObjNormalizePath(interp, pathPtr, nextCheckpoint) if (cur == 0) { break; } - /* - * If we get here, we've got past one directory - * delimiter, so we know it is no longer a drive + + /* + * If we get here, we've got past one directory delimiter, so + * we know it is no longer a drive. */ + isDrive = 0; } currentPathEndPosition++; } } else { - /* We're on WinNT or 2000 or XP */ + /* + * We're on WinNT (or 2000 or XP; something with an NT core). + */ + int isDrive = 1; Tcl_DString ds; @@ -2429,28 +2718,42 @@ TclpObjNormalizePath(interp, pathPtr, nextCheckpoint) } while (1) { char cur = *currentPathEndPosition; - if ((cur == '/' || cur == 0) && (path != currentPathEndPosition)) { - /* Reached directory separator, or end of string */ + + if ((cur=='/' || cur==0) && (path != currentPathEndPosition)) { + /* + * Reached directory separator, or end of string. + */ + WIN32_FILE_ATTRIBUTE_DATA data; - CONST char *nativePath = Tcl_WinUtfToTChar(path, - currentPathEndPosition - path, &ds); + const char *nativePath = Tcl_WinUtfToTChar(path, + currentPathEndPosition - path, &ds); + if ((*tclWinProcs->getFileAttributesExProc)(nativePath, - GetFileExInfoStandard, &data) != TRUE) { - /* File doesn't exist */ + GetFileExInfoStandard, &data) != TRUE) { + /* + * File doesn't exist. + */ + if (isDrive) { int len = WinIsReserved(path); + if (len > 0) { - /* Actually it does exist - COM1, etc */ + /* + * Actually it does exist - COM1, etc. + */ + int i; - for (i=0;i<len;i++) { - WCHAR wc = ((WCHAR*)nativePath)[i]; + + for (i=0 ; i<len ; i++) { + WCHAR wc = ((WCHAR *) nativePath)[i]; + if (wc >= L'a') { wc -= (L'a' - L'A'); - ((WCHAR*)nativePath)[i] = wc; + ((WCHAR *) nativePath)[i] = wc; } } Tcl_DStringAppend(&dsNorm, nativePath, - sizeof(WCHAR)*len); + (int)(sizeof(WCHAR) * len)); lastValidPathEnd = currentPathEndPosition; } } @@ -2458,31 +2761,46 @@ TclpObjNormalizePath(interp, pathPtr, nextCheckpoint) break; } - /* - * File 'nativePath' does exist if we get here. We - * now want to check if it is a symlink and otherwise - * continue with the rest of the path. + /* + * File 'nativePath' does exist if we get here. We now want to + * check if it is a symlink and otherwise continue with the + * rest of the path. */ - - /* - * Check for symlinks, except at last component - * of path (we don't follow final symlinks). Also - * a drive (C:/) for example, may sometimes have - * the reparse flag set for some reason I don't - * understand. We therefore don't perform this + + /* + * Check for symlinks, except at last component of path (we + * don't follow final symlinks). Also a drive (C:/) for + * example, may sometimes have the reparse flag set for some + * reason I don't understand. We therefore don't perform this * check for drives. */ - if (cur != 0 && !isDrive && (data.dwFileAttributes - & FILE_ATTRIBUTE_REPARSE_POINT)) { + + if (cur != 0 && !isDrive && + data.dwFileAttributes & FILE_ATTRIBUTE_REPARSE_POINT){ Tcl_Obj *to = WinReadLinkDirectory(nativePath); + if (to != NULL) { - /* Read the reparse point ok */ - /* Tcl_GetStringFromObj(to, &pathLen); */ - nextCheckpoint = 0; /* pathLen */ + /* + * Read the reparse point ok. Now, reparse points need + * not be normalized, otherwise we could use: + * + * Tcl_GetStringFromObj(to, &pathLen); + * nextCheckpoint = pathLen + * + * So, instead we have to start from the beginning. + */ + + nextCheckpoint = 0; Tcl_AppendToObj(to, currentPathEndPosition, -1); - /* Convert link to forward slashes */ + + /* + * Convert link to forward slashes. + */ + for (path = Tcl_GetString(to); *path != 0; path++) { - if (*path == '\\') *path = '/'; + if (*path == '\\') { + *path = '/'; + } } path = Tcl_GetString(to); currentPathEndPosition = path + nextCheckpoint; @@ -2490,7 +2808,11 @@ TclpObjNormalizePath(interp, pathPtr, nextCheckpoint) Tcl_DecrRefCount(temp); } temp = to; - /* Reset variables so we can restart normalization */ + + /* + * Reset variables so we can restart normalization. + */ + isDrive = 1; Tcl_DStringFree(&dsNorm); Tcl_DStringInit(&dsNorm); @@ -2498,21 +2820,25 @@ TclpObjNormalizePath(interp, pathPtr, nextCheckpoint) continue; } } + +#ifndef TclNORM_LONG_PATH /* - * Now we convert the tail of the current path to its - * 'long form', and append it to 'dsNorm' which holds - * the current normalized path + * Now we convert the tail of the current path to its 'long + * form', and append it to 'dsNorm' which holds the current + * normalized path */ + if (isDrive) { - WCHAR drive = ((WCHAR*)nativePath)[0]; + WCHAR drive = ((WCHAR *) nativePath)[0]; if (drive >= L'a') { - drive -= (L'a' - L'A'); - ((WCHAR*)nativePath)[0] = drive; + drive -= (L'a' - L'A'); + ((WCHAR *) nativePath)[0] = drive; } - Tcl_DStringAppend(&dsNorm,nativePath,Tcl_DStringLength(&ds)); + Tcl_DStringAppend(&dsNorm, nativePath, + Tcl_DStringLength(&ds)); } else { char *checkDots = NULL; - + if (lastValidPathEnd[1] == '.') { checkDots = lastValidPathEnd + 1; while (checkDots < currentPathEndPosition) { @@ -2524,86 +2850,132 @@ TclpObjNormalizePath(interp, pathPtr, nextCheckpoint) } } if (checkDots != NULL) { - int dotLen = currentPathEndPosition - lastValidPathEnd; - /* - * Path is just dots. We shouldn't really - * ever see a path like that. However, to be - * nice we at least don't mangle the path -- - * we just add the dots as a path segment and - * continue + int dotLen = currentPathEndPosition-lastValidPathEnd; + + /* + * Path is just dots. We shouldn't really ever see a + * path like that. However, to be nice we at least + * don't mangle the path - we just add the dots as a + * path segment and continue. */ - Tcl_DStringAppend(&dsNorm, - (TCHAR*)((WCHAR*)(nativePath - + Tcl_DStringLength(&ds)) - - dotLen), - (int)(dotLen * sizeof(WCHAR))); + + Tcl_DStringAppend(&dsNorm, (TCHAR *) + ((WCHAR*)(nativePath + Tcl_DStringLength(&ds)) + - dotLen), (int)(dotLen * sizeof(WCHAR))); } else { - /* Normal path */ + /* + * Normal path. + */ + WIN32_FIND_DATAW fData; HANDLE handle; - - handle = FindFirstFileW((WCHAR*)nativePath, &fData); + + handle = FindFirstFileW((WCHAR *) nativePath, &fData); if (handle == INVALID_HANDLE_VALUE) { - /* This is usually the '/' in 'c:/' at end of string */ - Tcl_DStringAppend(&dsNorm,(CONST char*)L"/", - sizeof(WCHAR)); + /* + * This is usually the '/' in 'c:/' at end of + * string. + */ + + Tcl_DStringAppend(&dsNorm, (const char *) L"/", + sizeof(WCHAR)); } else { WCHAR *nativeName; + if (fData.cFileName[0] != '\0') { nativeName = fData.cFileName; } else { nativeName = fData.cAlternateFileName; } FindClose(handle); - Tcl_DStringAppend(&dsNorm,(CONST char*)L"/", - sizeof(WCHAR)); - Tcl_DStringAppend(&dsNorm,(TCHAR*)nativeName, - (int) (wcslen(nativeName)*sizeof(WCHAR))); + Tcl_DStringAppend(&dsNorm, (const char *) L"/", + sizeof(WCHAR)); + Tcl_DStringAppend(&dsNorm, (TCHAR *) nativeName, + (int) (wcslen(nativeName)*sizeof(WCHAR))); } } } +#endif Tcl_DStringFree(&ds); lastValidPathEnd = currentPathEndPosition; if (cur == 0) { break; } - /* - * If we get here, we've got past one directory - * delimiter, so we know it is no longer a drive + + /* + * If we get here, we've got past one directory delimiter, so + * we know it is no longer a drive. */ + isDrive = 0; } currentPathEndPosition++; } + +#ifdef TclNORM_LONG_PATH + /* + * Convert the entire known path to long form. + */ + + if (1) { + WCHAR wpath[MAX_PATH]; + const char *nativePath = + Tcl_WinUtfToTChar(path, lastValidPathEnd - path, &ds); + DWORD wpathlen = (*tclWinProcs->getLongPathNameProc)( + nativePath, (TCHAR *) wpath, MAX_PATH); + + /* + * We have to make the drive letter uppercase. + */ + + if (wpath[0] >= L'a') { + wpath[0] -= (L'a' - L'A'); + } + Tcl_DStringAppend(&dsNorm, (TCHAR*)wpath, wpathlen*sizeof(WCHAR)); + Tcl_DStringFree(&ds); + } +#endif } - /* Common code path for all Windows platforms */ + + /* + * Common code path for all Windows platforms. + */ + nextCheckpoint = currentPathEndPosition - path; if (lastValidPathEnd != NULL) { - /* - * Concatenate the normalized string in dsNorm with the - * tail of the path which we didn't recognise. The - * string in dsNorm is in the native encoding, so we - * have to convert it to Utf. + /* + * Concatenate the normalized string in dsNorm with the tail of the + * path which we didn't recognise. The string in dsNorm is in the + * native encoding, so we have to convert it to Utf. */ + Tcl_DString dsTemp; - Tcl_WinTCharToUtf(Tcl_DStringValue(&dsNorm), - Tcl_DStringLength(&dsNorm), &dsTemp); + + Tcl_WinTCharToUtf(Tcl_DStringValue(&dsNorm), + Tcl_DStringLength(&dsNorm), &dsTemp); nextCheckpoint = Tcl_DStringLength(&dsTemp); if (*lastValidPathEnd != 0) { - /* Not the end of the string */ + /* + * Not the end of the string. + */ + int len; char *path; Tcl_Obj *tmpPathPtr; - tmpPathPtr = Tcl_NewStringObj(Tcl_DStringValue(&dsTemp), - nextCheckpoint); + + tmpPathPtr = Tcl_NewStringObj(Tcl_DStringValue(&dsTemp), + nextCheckpoint); Tcl_AppendToObj(tmpPathPtr, lastValidPathEnd, -1); path = Tcl_GetStringFromObj(tmpPathPtr, &len); Tcl_SetStringObj(pathPtr, path, len); Tcl_DecrRefCount(tmpPathPtr); } else { - /* End of string was reached above */ + /* + * End of string was reached above. + */ + Tcl_SetStringObj(pathPtr, Tcl_DStringValue(&dsTemp), - nextCheckpoint); + nextCheckpoint); } Tcl_DStringFree(&dsTemp); } @@ -2617,13 +2989,303 @@ TclpObjNormalizePath(interp, pathPtr, nextCheckpoint) if (temp != NULL) { Tcl_DecrRefCount(temp); } - return nextCheckpoint; } /* *--------------------------------------------------------------------------- * + * TclWinVolumeRelativeNormalize -- + * + * Only Windows has volume-relative paths. These paths are rather rare, + * but it is nice if Tcl can handle them. It is much better if we can + * handle them here, rather than in the native fs code, because we really + * need to have a real absolute path just below. + * + * We do not let this block compile on non-Windows platforms because the + * test suite's manual forcing of tclPlatform can otherwise cause this + * code path to be executed, causing various errors because + * volume-relative paths really do not exist. + * + * Results: + * A valid normalized path. + * + * Side effects: + * None. + * + *--------------------------------------------------------------------------- + */ + +Tcl_Obj * +TclWinVolumeRelativeNormalize( + Tcl_Interp *interp, + const char *path, + Tcl_Obj **useThisCwdPtr) +{ + Tcl_Obj *absolutePath, *useThisCwd; + + useThisCwd = Tcl_FSGetCwd(interp); + if (useThisCwd == NULL) { + return NULL; + } + + if (path[0] == '/') { + /* + * Path of form /foo/bar which is a path in the root directory of the + * current volume. + */ + + const char *drive = Tcl_GetString(useThisCwd); + + absolutePath = Tcl_NewStringObj(drive,2); + Tcl_AppendToObj(absolutePath, path, -1); + Tcl_IncrRefCount(absolutePath); + + /* + * We have a refCount on the cwd. + */ + } else { + /* + * Path of form C:foo/bar, but this only makes sense if the cwd is + * also on drive C. + */ + + int cwdLen; + const char *drive = + Tcl_GetStringFromObj(useThisCwd, &cwdLen); + char drive_cur = path[0]; + + if (drive_cur >= 'a') { + drive_cur -= ('a' - 'A'); + } + if (drive[0] == drive_cur) { + absolutePath = Tcl_DuplicateObj(useThisCwd); + + /* + * We have a refCount on the cwd, which we will release later. + */ + + if (drive[cwdLen-1] != '/' && (path[2] != '\0')) { + /* + * Only add a trailing '/' if needed, which is if there isn't + * one already, and if we are going to be adding some more + * characters. + */ + + Tcl_AppendToObj(absolutePath, "/", 1); + } + } else { + Tcl_DecrRefCount(useThisCwd); + useThisCwd = NULL; + + /* + * The path is not in the current drive, but is volume-relative. + * The way Tcl 8.3 handles this is that it treats such a path as + * relative to the root of the drive. We therefore behave the same + * here. This behaviour is, however, different to that of the + * windows command-line. If we want to fix this at some point in + * the future (at the expense of a behaviour change to Tcl), we + * could use the '_dgetdcwd' Win32 API to get the drive's cwd. + */ + + absolutePath = Tcl_NewStringObj(path, 2); + Tcl_AppendToObj(absolutePath, "/", 1); + } + Tcl_IncrRefCount(absolutePath); + Tcl_AppendToObj(absolutePath, path+2, -1); + } + *useThisCwdPtr = useThisCwd; + return absolutePath; +} + +/* + *--------------------------------------------------------------------------- + * + * TclpNativeToNormalized -- + * + * Convert native format to a normalized path object, with refCount of + * zero. + * + * Currently assumes all native paths are actually normalized already, so + * if the path given is not normalized this will actually just convert to + * a valid string path, but not necessarily a normalized one. + * + * Results: + * A valid normalized path. + * + * Side effects: + * None. + * + *--------------------------------------------------------------------------- + */ + +Tcl_Obj * +TclpNativeToNormalized( + ClientData clientData) +{ + Tcl_DString ds; + Tcl_Obj *objPtr; + int len; + char *copy, *p; + + Tcl_WinTCharToUtf((const char *) clientData, -1, &ds); + copy = Tcl_DStringValue(&ds); + len = Tcl_DStringLength(&ds); + + /* + * Certain native path representations on Windows have this special prefix + * to indicate that they are to be treated specially. For example + * extremely long paths, or symlinks. + */ + + if (*copy == '\\') { + if (0 == strncmp(copy,"\\??\\",4)) { + copy += 4; + len -= 4; + } else if (0 == strncmp(copy,"\\\\?\\",4)) { + copy += 4; + len -= 4; + } + } + + /* + * Ensure we are using forward slashes only. + */ + + for (p = copy; *p != '\0'; p++) { + if (*p == '\\') { + *p = '/'; + } + } + + objPtr = Tcl_NewStringObj(copy,len); + Tcl_DStringFree(&ds); + + return objPtr; +} + +/* + *--------------------------------------------------------------------------- + * + * TclNativeCreateNativeRep -- + * + * Create a native representation for the given path. + * + * Results: + * The nativePath representation. + * + * Side effects: + * Memory will be allocated. The path may need to be normalized. + * + *--------------------------------------------------------------------------- + */ + +ClientData +TclNativeCreateNativeRep( + Tcl_Obj *pathPtr) +{ + char *nativePathPtr, *str; + Tcl_DString ds; + Tcl_Obj *validPathPtr; + int len; + + if (TclFSCwdIsNative()) { + /* + * The cwd is native, which means we can use the translated path + * without worrying about normalization (this will also usually be + * shorter so the utf-to-external conversion will be somewhat faster). + */ + + validPathPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr); + if (validPathPtr == NULL) { + return NULL; + } + } else { + /* + * Make sure the normalized path is set. + */ + + validPathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr); + if (validPathPtr == NULL) { + return NULL; + } + Tcl_IncrRefCount(validPathPtr); + } + + str = Tcl_GetStringFromObj(validPathPtr, &len); + if (str[0] == '/' && str[1] == '/' && str[2] == '?' && str[3] == '/') { + char *p; + + for (p = str; p && *p; ++p) { + if (*p == '/') { + *p = '\\'; + } + } + } + Tcl_WinUtfToTChar(str, len, &ds); + if (tclWinProcs->useWide) { + len = Tcl_DStringLength(&ds) + sizeof(WCHAR); + } else { + len = Tcl_DStringLength(&ds) + sizeof(char); + } + Tcl_DecrRefCount(validPathPtr); + nativePathPtr = ckalloc((unsigned) len); + memcpy(nativePathPtr, Tcl_DStringValue(&ds), (size_t) len); + + Tcl_DStringFree(&ds); + return (ClientData) nativePathPtr; +} + +/* + *--------------------------------------------------------------------------- + * + * TclNativeDupInternalRep -- + * + * Duplicate the native representation. + * + * Results: + * The copied native representation, or NULL if it is not possible to + * copy the representation. + * + * Side effects: + * Memory allocation for the copy. + * + *--------------------------------------------------------------------------- + */ + +ClientData +TclNativeDupInternalRep( + ClientData clientData) +{ + char *copy; + size_t len; + + if (clientData == NULL) { + return NULL; + } + + if (tclWinProcs->useWide) { + /* + * Unicode representation when running on NT/2K/XP. + */ + + len = sizeof(WCHAR) * (wcslen((const WCHAR *) clientData) + 1); + } else { + /* + * ANSI representation when running on 95/98/ME. + */ + + len = sizeof(char) * (strlen((const char *) clientData) + 1); + } + + copy = (char *) ckalloc(len); + memcpy(copy, clientData, len); + return (ClientData) copy; +} + +/* + *--------------------------------------------------------------------------- + * * TclpUtime -- * * Set the modification date for a file. @@ -2645,7 +3307,7 @@ TclpUtime( { int res = 0; HANDLE fileHandle; - CONST TCHAR *native; + const TCHAR *native; DWORD attr = 0; DWORD flags = FILE_ATTRIBUTE_NORMAL; FILETIME lastAccessTime, lastModTime; @@ -2653,7 +3315,7 @@ TclpUtime( FromCTime(tval->actime, &lastAccessTime); FromCTime(tval->modtime, &lastModTime); - native = (CONST TCHAR *)Tcl_FSGetNativePath(pathPtr); + native = (const TCHAR *) Tcl_FSGetNativePath(pathPtr); attr = (*tclWinProcs->getFileAttributesProc)(native); @@ -2666,9 +3328,8 @@ TclpUtime( * savings complications that utime gets wrong. */ - fileHandle = (tclWinProcs->createFileProc) ( - native, FILE_WRITE_ATTRIBUTES, 0, NULL, - OPEN_EXISTING, flags, NULL); + fileHandle = (tclWinProcs->createFileProc)(native, FILE_WRITE_ATTRIBUTES, + 0, NULL, OPEN_EXISTING, flags, NULL); if (fileHandle == INVALID_HANDLE_VALUE || !SetFileTime(fileHandle, NULL, &lastAccessTime, &lastModTime)) { @@ -2680,3 +3341,11 @@ TclpUtime( } return res; } + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ diff --git a/win/tclWinInit.c b/win/tclWinInit.c index acaf705..a1087c9 100644 --- a/win/tclWinInit.c +++ b/win/tclWinInit.c @@ -1,4 +1,4 @@ -/* +/* * tclWinInit.c -- * * Contains the Windows-specific interpreter initialization functions. @@ -6,6 +6,9 @@ * Copyright (c) 1994-1997 Sun Microsystems, Inc. * Copyright (c) 1998-1999 by Scriptics Corporation. * All rights reserved. + * + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclWinInt.h" @@ -14,10 +17,17 @@ #include <lmcons.h> /* + * GetUserName() is found in advapi32.dll + */ +#ifdef _MSC_VER +# pragma comment(lib, "advapi32.lib") +#endif + +/* * The following declaration is a workaround for some Microsoft brain damage. * The SYSTEM_INFO structure is different in various releases, even though the - * layout is the same. So we overlay our own structure on top of it so we - * can access the interesting slots in a uniform way. + * layout is the same. So we overlay our own structure on top of it so we can + * access the interesting slots in a uniform way. */ typedef struct { @@ -30,40 +40,40 @@ typedef struct { */ #ifndef PROCESSOR_ARCHITECTURE_INTEL -#define PROCESSOR_ARCHITECTURE_INTEL 0 +#define PROCESSOR_ARCHITECTURE_INTEL 0 #endif #ifndef PROCESSOR_ARCHITECTURE_MIPS -#define PROCESSOR_ARCHITECTURE_MIPS 1 +#define PROCESSOR_ARCHITECTURE_MIPS 1 #endif #ifndef PROCESSOR_ARCHITECTURE_ALPHA -#define PROCESSOR_ARCHITECTURE_ALPHA 2 +#define PROCESSOR_ARCHITECTURE_ALPHA 2 #endif #ifndef PROCESSOR_ARCHITECTURE_PPC -#define PROCESSOR_ARCHITECTURE_PPC 3 +#define PROCESSOR_ARCHITECTURE_PPC 3 #endif -#ifndef PROCESSOR_ARCHITECTURE_SHX -#define PROCESSOR_ARCHITECTURE_SHX 4 +#ifndef PROCESSOR_ARCHITECTURE_SHX +#define PROCESSOR_ARCHITECTURE_SHX 4 #endif #ifndef PROCESSOR_ARCHITECTURE_ARM -#define PROCESSOR_ARCHITECTURE_ARM 5 +#define PROCESSOR_ARCHITECTURE_ARM 5 #endif #ifndef PROCESSOR_ARCHITECTURE_IA64 -#define PROCESSOR_ARCHITECTURE_IA64 6 +#define PROCESSOR_ARCHITECTURE_IA64 6 #endif #ifndef PROCESSOR_ARCHITECTURE_ALPHA64 -#define PROCESSOR_ARCHITECTURE_ALPHA64 7 +#define PROCESSOR_ARCHITECTURE_ALPHA64 7 #endif #ifndef PROCESSOR_ARCHITECTURE_MSIL -#define PROCESSOR_ARCHITECTURE_MSIL 8 +#define PROCESSOR_ARCHITECTURE_MSIL 8 #endif #ifndef PROCESSOR_ARCHITECTURE_AMD64 -#define PROCESSOR_ARCHITECTURE_AMD64 9 +#define PROCESSOR_ARCHITECTURE_AMD64 9 #endif #ifndef PROCESSOR_ARCHITECTURE_IA32_ON_WIN64 -#define PROCESSOR_ARCHITECTURE_IA32_ON_WIN64 10 +#define PROCESSOR_ARCHITECTURE_IA32_ON_WIN64 10 #endif #ifndef PROCESSOR_ARCHITECTURE_UNKNOWN -#define PROCESSOR_ARCHITECTURE_UNKNOWN 0xFFFF +#define PROCESSOR_ARCHITECTURE_UNKNOWN 0xFFFF #endif /* @@ -83,21 +93,15 @@ static char* processors[NUMPROCESSORS] = { "amd64", "ia32_on_win64" }; -/* Used to store the encoding used for binary files */ -static Tcl_Encoding binaryEncoding = NULL; -/* Has the basic library path encoding issue been fixed */ -static int libraryPathEncodingFixed = 0; - /* - * The Init script (common to Windows and Unix platforms) is - * defined in tkInitScript.h + * The default directory in which the init.tcl file is expected to be found. */ -#include "tclInitScript.h" +static TclInitProcessGlobalValueProc InitializeDefaultLibraryDir; +static ProcessGlobalValue defaultLibraryDir = + {0, 0, NULL, NULL, InitializeDefaultLibraryDir, NULL, NULL}; static void AppendEnvironment(Tcl_Obj *listPtr, CONST char *lib); -static void AppendDllPath(Tcl_Obj *listPtr, HMODULE hModule, - CONST char *lib); static int ToUtf(CONST WCHAR *wSrc, char *dst); /* @@ -120,19 +124,18 @@ static int ToUtf(CONST WCHAR *wSrc, char *dst); */ void -TclpInitPlatform() +TclpInitPlatform(void) { tclPlatform = TCL_PLATFORM_WINDOWS; /* - * The following code stops Windows 3.X and Windows NT 3.51 from - * automatically putting up Sharing Violation dialogs, e.g, when - * someone tries to access a file that is locked or a drive with no - * disk in it. Tcl already returns the appropriate error to the - * caller, and they can decide to put up their own dialog in response - * to that failure. + * The following code stops Windows 3.X and Windows NT 3.51 from + * automatically putting up Sharing Violation dialogs, e.g, when someone + * tries to access a file that is locked or a drive with no disk in it. + * Tcl already returns the appropriate error to the caller, and they can + * decide to put up their own dialog in response to that failure. * - * Under 95 and NT 4.0, this is a NOOP because the system doesn't + * Under 95 and NT 4.0, this is a NOOP because the system doesn't * automatically put up dialogs when the above operations fail. */ @@ -140,9 +143,9 @@ TclpInitPlatform() #ifdef STATIC_BUILD /* - * If we are in a statically linked executable, then we need to - * explicitly initialize the Windows function tables here since - * DllMain() will not be invoked. + * If we are in a statically linked executable, then we need to explicitly + * initialize the Windows function tables here since DllMain() will not be + * invoked. */ TclWinInit(GetModuleHandle(NULL)); @@ -150,186 +153,64 @@ TclpInitPlatform() } /* - *--------------------------------------------------------------------------- + *------------------------------------------------------------------------- * * TclpInitLibraryPath -- * - * Initialize the library path at startup. - * - * This call sets the library path to strings in UTF-8. Any - * pre-existing library path information is assumed to have been - * in the native multibyte encoding. - * - * Called at process initialization time. + * This is the fallback routine that sets the library path if the + * application has not set one by the first time it is needed. * * Results: - * Return 0, indicating that the UTF is clean. + * None. * * Side effects: - * None. + * Sets the library path to an initial value. * - *--------------------------------------------------------------------------- + *------------------------------------------------------------------------- */ -int -TclpInitLibraryPath(path) - CONST char *path; /* Potentially dirty UTF string that is */ - /* the path to the executable name. */ +void +TclpInitLibraryPath( + char **valuePtr, + int *lengthPtr, + Tcl_Encoding *encodingPtr) { #define LIBRARY_SIZE 32 - Tcl_Obj *pathPtr, *objPtr; - CONST char *str; - Tcl_DString ds; - int pathc; - CONST char **pathv; - char installLib[LIBRARY_SIZE], developLib[LIBRARY_SIZE]; + Tcl_Obj *pathPtr; + char installLib[LIBRARY_SIZE]; + char *bytes; - Tcl_DStringInit(&ds); pathPtr = Tcl_NewObj(); /* - * Initialize the substrings used when locating an executable. The - * installLib variable computes the path as though the executable - * is installed. The developLib computes the path as though the - * executable is run from a develpment directory. + * Initialize the substring used when locating the script library. The + * installLib variable computes the script library path relative to the + * installed DLL. */ sprintf(installLib, "lib/tcl%s", TCL_VERSION); - sprintf(developLib, "tcl%s/library", TCL_PATCH_LEVEL); - - /* - * Look for the library relative to default encoding dir. - */ - - str = Tcl_GetDefaultEncodingDir(); - if ((str != NULL) && (str[0] != '\0')) { - objPtr = Tcl_NewStringObj(str, -1); - Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); - } /* - * Look for the library relative to the TCL_LIBRARY env variable. - * If the last dirname in the TCL_LIBRARY path does not match the - * last dirname in the installLib variable, use the last dir name - * of installLib in addition to the orginal TCL_LIBRARY path. + * Look for the library relative to the TCL_LIBRARY env variable. If the + * last dirname in the TCL_LIBRARY path does not match the last dirname in + * the installLib variable, use the last dir name of installLib in + * addition to the orginal TCL_LIBRARY path. */ AppendEnvironment(pathPtr, installLib); /* - * Look for the library relative to the DLL. Only use the installLib - * because in practice, the DLL is always installed. + * Look for the library in its default location. */ - AppendDllPath(pathPtr, TclWinGetTclInstance(), installLib); - + Tcl_ListObjAppendElement(NULL, pathPtr, + TclGetProcessGlobalValue(&defaultLibraryDir)); - /* - * Look for the library relative to the executable. This algorithm - * should be the same as the one in the tcl_findLibrary procedure. - * - * This code looks in the following directories: - * - * <bindir>/../<installLib> - * (e.g. /usr/local/bin/../lib/tcl8.4) - * <bindir>/../../<installLib> - * (e.g. /usr/local/TclPro/solaris-sparc/bin/../../lib/tcl8.4) - * <bindir>/../library - * (e.g. /usr/src/tcl8.4.0/unix/../library) - * <bindir>/../../library - * (e.g. /usr/src/tcl8.4.0/unix/solaris-sparc/../../library) - * <bindir>/../../<developLib> - * (e.g. /usr/src/tcl8.4.0/unix/../../tcl8.4.0/library) - * <bindir>/../../../<developLib> - * (e.g. /usr/src/tcl8.4.0/unix/solaris-sparc/../../../tcl8.4.0/library) - */ - - /* - * The variable path holds an absolute path. Take care not to - * overwrite pathv[0] since that might produce a relative path. - */ - - if (path != NULL) { - int i, origc; - CONST char **origv; - - Tcl_SplitPath(path, &origc, &origv); - pathc = 0; - pathv = (CONST char **) ckalloc((unsigned int)(origc * sizeof(char *))); - for (i=0; i< origc; i++) { - if (origv[i][0] == '.') { - if (strcmp(origv[i], ".") == 0) { - /* do nothing */ - } else if (strcmp(origv[i], "..") == 0) { - pathc--; - } else { - pathv[pathc++] = origv[i]; - } - } else { - pathv[pathc++] = origv[i]; - } - } - if (pathc > 2) { - str = pathv[pathc - 2]; - pathv[pathc - 2] = installLib; - path = Tcl_JoinPath(pathc - 1, pathv, &ds); - pathv[pathc - 2] = str; - objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds)); - Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); - Tcl_DStringFree(&ds); - } - if (pathc > 3) { - str = pathv[pathc - 3]; - pathv[pathc - 3] = installLib; - path = Tcl_JoinPath(pathc - 2, pathv, &ds); - pathv[pathc - 3] = str; - objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds)); - Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); - Tcl_DStringFree(&ds); - } - if (pathc > 2) { - str = pathv[pathc - 2]; - pathv[pathc - 2] = "library"; - path = Tcl_JoinPath(pathc - 1, pathv, &ds); - pathv[pathc - 2] = str; - objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds)); - Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); - Tcl_DStringFree(&ds); - } - if (pathc > 3) { - str = pathv[pathc - 3]; - pathv[pathc - 3] = "library"; - path = Tcl_JoinPath(pathc - 2, pathv, &ds); - pathv[pathc - 3] = str; - objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds)); - Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); - Tcl_DStringFree(&ds); - } - if (pathc > 3) { - str = pathv[pathc - 3]; - pathv[pathc - 3] = developLib; - path = Tcl_JoinPath(pathc - 2, pathv, &ds); - pathv[pathc - 3] = str; - objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds)); - Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); - Tcl_DStringFree(&ds); - } - if (pathc > 4) { - str = pathv[pathc - 4]; - pathv[pathc - 4] = developLib; - path = Tcl_JoinPath(pathc - 3, pathv, &ds); - pathv[pathc - 4] = str; - objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds)); - Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); - Tcl_DStringFree(&ds); - } - ckfree((char *) origv); - ckfree((char *) pathv); - } - - TclSetLibraryPath(pathPtr); - - return 0; /* 0 indicates that pathPtr is clean (true) utf */ + *encodingPtr = NULL; + bytes = Tcl_GetStringFromObj(pathPtr, lengthPtr); + *valuePtr = ckalloc((unsigned int)(*lengthPtr)+1); + memcpy(*valuePtr, bytes, (size_t)(*lengthPtr)+1); + Tcl_DecrRefCount(pathPtr); } /* @@ -337,9 +218,9 @@ TclpInitLibraryPath(path) * * AppendEnvironment -- * - * Append the value of the TCL_LIBRARY environment variable onto the - * path pointer. If the env variable points to another version of - * tcl (e.g. "tcl7.6") also append the path to this version (e.g., + * Append the value of the TCL_LIBRARY environment variable onto the path + * pointer. If the env variable points to another version of tcl (e.g. + * "tcl7.6") also append the path to this version (e.g., * "tcl7.6/../tcl8.2") * * Results: @@ -365,30 +246,30 @@ AppendEnvironment( char *shortlib; /* - * The shortlib value needs to be the tail component of the - * lib path. For example, "lib/tcl8.4" -> "tcl8.4" while - * "usr/share/tcl8.5" -> "tcl8.5". + * The shortlib value needs to be the tail component of the lib path. For + * example, "lib/tcl8.4" -> "tcl8.4" while "usr/share/tcl8.5" -> "tcl8.5". */ - for (shortlib = (char *) (lib + strlen(lib) - 1); shortlib > lib ; shortlib--) { - if (*shortlib == '/') { - if (shortlib == (lib + strlen(lib) - 1)) { - Tcl_Panic("last character in lib cannot be '/'"); - } - shortlib++; - break; - } + + for (shortlib = (char *) &lib[strlen(lib)-1]; shortlib>lib ; shortlib--) { + if (*shortlib == '/') { + if ((unsigned)(shortlib - lib) == strlen(lib) - 1) { + Tcl_Panic("last character in lib cannot be '/'"); + } + shortlib++; + break; + } } if (shortlib == lib) { - Tcl_Panic("no '/' character found in lib"); + Tcl_Panic("no '/' character found in lib"); } /* - * The "L" preceeding the TCL_LIBRARY string is used to tell VC++ - * that this is a unicode string. + * The "L" preceeding the TCL_LIBRARY string is used to tell VC++ that + * this is a unicode string. */ - + if (GetEnvironmentVariableW(L"TCL_LIBRARY", wBuf, MAX_PATH) == 0) { - buf[0] = '\0'; + buf[0] = '\0'; GetEnvironmentVariableA("TCL_LIBRARY", buf, MAX_PATH); } else { ToUtf(wBuf, buf); @@ -401,21 +282,21 @@ AppendEnvironment( TclWinNoBackslash(buf); Tcl_SplitPath(buf, &pathc, &pathv); - /* - * The lstrcmpi() will work even if pathv[pathc - 1] is random - * UTF-8 chars because I know shortlib is ascii. + /* + * The lstrcmpi() will work even if pathv[pathc-1] is random UTF-8 + * chars because I know shortlib is ascii. */ if ((pathc > 0) && (lstrcmpiA(shortlib, pathv[pathc - 1]) != 0)) { CONST char *str; + /* - * TCL_LIBRARY is set but refers to a different tcl - * installation than the current version. Try fiddling with the - * specified directory to make it refer to this installation by - * removing the old "tclX.Y" and substituting the current - * version string. + * TCL_LIBRARY is set but refers to a different tcl installation + * than the current version. Try fiddling with the specified + * directory to make it refer to this installation by removing the + * old "tclX.Y" and substituting the current version string. */ - + pathv[pathc - 1] = shortlib; Tcl_DStringInit(&ds); str = Tcl_JoinPath(pathc, pathv, &ds); @@ -432,10 +313,10 @@ AppendEnvironment( /* *--------------------------------------------------------------------------- * - * AppendDllPath -- + * InitializeDefaultLibraryDir -- * - * Append a path onto the path pointer that tries to locate the Tcl - * library relative to the location of the Tcl DLL. + * Locate the Tcl script library default location relative to the + * location of the Tcl DLL. * * Results: * None. @@ -446,34 +327,37 @@ AppendEnvironment( *--------------------------------------------------------------------------- */ -static void -AppendDllPath( - Tcl_Obj *pathPtr, - HMODULE hModule, - CONST char *lib) +static void +InitializeDefaultLibraryDir( + char **valuePtr, + int *lengthPtr, + Tcl_Encoding *encodingPtr) { + HMODULE hModule = TclWinGetTclInstance(); WCHAR wName[MAX_PATH + LIBRARY_SIZE]; char name[(MAX_PATH + LIBRARY_SIZE) * TCL_UTF_MAX]; + char *end, *p; if (GetModuleFileNameW(hModule, wName, MAX_PATH) == 0) { GetModuleFileNameA(hModule, name, MAX_PATH); } else { ToUtf(wName, name); } - if (lib != NULL) { - char *end, *p; - - end = strrchr(name, '\\'); - *end = '\0'; - p = strrchr(name, '\\'); - if (p != NULL) { - end = p; - } - *end = '\\'; - strcpy(end + 1, lib); + + end = strrchr(name, '\\'); + *end = '\0'; + p = strrchr(name, '\\'); + if (p != NULL) { + end = p; } + *end = '\\'; + TclWinNoBackslash(name); - Tcl_ListObjAppendElement(NULL, pathPtr, Tcl_NewStringObj(name, -1)); + sprintf(end + 1, "lib/tcl%s", TCL_VERSION); + *lengthPtr = strlen(name); + *valuePtr = ckalloc((unsigned int) *lengthPtr + 1); + *encodingPtr = NULL; + memcpy(*valuePtr, name, (size_t) *lengthPtr + 1); } /* @@ -481,7 +365,7 @@ AppendDllPath( * * ToUtf -- * - * Convert a char string to a UTF string. + * Convert a char string to a UTF string. * * Results: * None. @@ -513,10 +397,10 @@ ToUtf( * * TclWinEncodingsCleanup -- * - * Reset information to its original state in finalization to - * allow for reinitialization to be possible. This must not - * be called until after the filesystem has been finalised, or - * exit crashes may occur when using virtual filesystems. + * Reset information to its original state in finalization to allow for + * reinitialization to be possible. This must not be called until after + * the filesystem has been finalised, or exit crashes may occur when + * using virtual filesystems. * * Results: * None. @@ -528,14 +412,9 @@ ToUtf( */ void -TclWinEncodingsCleanup() +TclWinEncodingsCleanup(void) { TclWinResetInterfaceEncodings(); - libraryPathEncodingFixed = 0; - if (binaryEncoding != NULL) { - Tcl_FreeEncoding(binaryEncoding); - binaryEncoding = NULL; - } } /* @@ -543,79 +422,56 @@ TclWinEncodingsCleanup() * * TclpSetInitialEncodings -- * - * Based on the locale, determine the encoding of the operating - * system and the default encoding for newly opened files. + * Based on the locale, determine the encoding of the operating system + * and the default encoding for newly opened files. * - * Called at process initialization time, and part way through - * startup, we verify that the initial encodings were correctly - * setup. Depending on Tcl's environment, there may not have been - * enough information first time through (above). + * Called at process initialization time, and part way through startup, + * we verify that the initial encodings were correctly setup. Depending + * on Tcl's environment, there may not have been enough information first + * time through (above). * * Results: * None. * * Side effects: - * The Tcl library path is converted from native encoding to UTF-8, - * on the first call, and the encodings may be changed on first or - * second call. + * The Tcl library path is converted from native encoding to UTF-8, on + * the first call, and the encodings may be changed on first or second + * call. * *--------------------------------------------------------------------------- */ void -TclpSetInitialEncodings() +TclpSetInitialEncodings(void) { - CONST char *encoding; - char buf[4 + TCL_INTEGER_SPACE]; - - if (libraryPathEncodingFixed == 0) { - int platformId, useWide; - - platformId = TclWinGetPlatformId(); - useWide = ((platformId == VER_PLATFORM_WIN32_NT) - || (platformId == VER_PLATFORM_WIN32_CE)); - TclWinSetInterfaces(useWide); - - wsprintfA(buf, "cp%d", GetACP()); - Tcl_SetSystemEncoding(NULL, buf); - - if (!useWide) { - Tcl_Obj *pathPtr = TclGetLibraryPath(); - if (pathPtr != NULL) { - int i, objc; - Tcl_Obj **objv; - - objc = 0; - Tcl_ListObjGetElements(NULL, pathPtr, &objc, &objv); - for (i = 0; i < objc; i++) { - int length; - char *string; - Tcl_DString ds; - - string = Tcl_GetStringFromObj(objv[i], &length); - Tcl_ExternalToUtfDString(NULL, string, length, &ds); - Tcl_SetStringObj(objv[i], Tcl_DStringValue(&ds), - Tcl_DStringLength(&ds)); - Tcl_DStringFree(&ds); - } - } - } - - libraryPathEncodingFixed = 1; - } else { - wsprintfA(buf, "cp%d", GetACP()); - Tcl_SetSystemEncoding(NULL, buf); - } + Tcl_DString encodingName; - /* This is only ever called from the startup thread */ - if (binaryEncoding == NULL) { - /* - * Keep this encoding preloaded. The IO package uses it for - * gets on a binary channel. - */ - encoding = "iso8859-1"; - binaryEncoding = Tcl_GetEncoding(NULL, encoding); - } + TclpSetInterfaces(); + Tcl_SetSystemEncoding(NULL, + Tcl_GetEncodingNameFromEnvironment(&encodingName)); + Tcl_DStringFree(&encodingName); +} + +void +TclpSetInterfaces(void) +{ + int platformId, useWide; + + platformId = TclWinGetPlatformId(); + useWide = ((platformId == VER_PLATFORM_WIN32_NT) + || (platformId == VER_PLATFORM_WIN32_CE)); + TclWinSetInterfaces(useWide); +} + +CONST char * +Tcl_GetEncodingNameFromEnvironment( + Tcl_DString *bufPtr) +{ + Tcl_DStringInit(bufPtr); + Tcl_DStringSetLength(bufPtr, 2+TCL_INTEGER_SPACE); + wsprintfA(Tcl_DStringValue(bufPtr), "cp%d", GetACP()); + Tcl_DStringSetLength(bufPtr, strlen(Tcl_DStringValue(bufPtr))); + return Tcl_DStringValue(bufPtr); } /* @@ -623,9 +479,8 @@ TclpSetInitialEncodings() * * TclpSetVariables -- * - * Performs platform-specific interpreter initialization related to - * the tcl_platform and env variables, and other platform-specific - * things. + * Performs platform-specific interpreter initialization related to the + * tcl_platform and env variables, and other platform-specific things. * * Results: * None. @@ -637,23 +492,27 @@ TclpSetInitialEncodings() */ void -TclpSetVariables(interp) - Tcl_Interp *interp; /* Interp to initialize. */ -{ +TclpSetVariables( + Tcl_Interp *interp) /* Interp to initialize. */ +{ CONST char *ptr; char buffer[TCL_INTEGER_SPACE * 2]; - SYSTEM_INFO sysInfo; - OemId *oemId; + union { + SYSTEM_INFO info; + OemId oemId; + } sys; OSVERSIONINFOA osInfo; Tcl_DString ds; - TCHAR szUserName[ UNLEN+1 ]; - DWORD dwUserNameLen = sizeof(szUserName); + WCHAR szUserName[UNLEN+1]; + DWORD cchUserNameLen = UNLEN; + + Tcl_SetVar2Ex(interp, "tclDefaultLibrary", NULL, + TclGetProcessGlobalValue(&defaultLibraryDir), TCL_GLOBAL_ONLY); osInfo.dwOSVersionInfoSize = sizeof(OSVERSIONINFOA); GetVersionExA(&osInfo); - oemId = (OemId *) &sysInfo; - GetSystemInfo(&sysInfo); + GetSystemInfo(&sys.info); /* * Define the tcl_platform array. @@ -667,18 +526,19 @@ TclpSetVariables(interp) } wsprintfA(buffer, "%d.%d", osInfo.dwMajorVersion, osInfo.dwMinorVersion); Tcl_SetVar2(interp, "tcl_platform", "osVersion", buffer, TCL_GLOBAL_ONLY); - if (oemId->wProcessorArchitecture < NUMPROCESSORS) { + if (sys.oemId.wProcessorArchitecture < NUMPROCESSORS) { Tcl_SetVar2(interp, "tcl_platform", "machine", - processors[oemId->wProcessorArchitecture], + processors[sys.oemId.wProcessorArchitecture], TCL_GLOBAL_ONLY); } #ifdef _DEBUG /* - * The existence of the "debug" element of the tcl_platform array indicates - * that this particular Tcl shell has been compiled with debug information. - * Using "info exists tcl_platform(debug)" a Tcl script can direct the - * interpreter to load debug versions of DLLs with the load command. + * The existence of the "debug" element of the tcl_platform array + * indicates that this particular Tcl shell has been compiled with debug + * information. Using "info exists tcl_platform(debug)" a Tcl script can + * direct the interpreter to load debug versions of DLLs with the load + * command. */ Tcl_SetVar2(interp, "tcl_platform", "debug", "1", @@ -712,14 +572,16 @@ TclpSetVariables(interp) /* * Initialize the user name from the environment first, since this is much * faster than asking the system. + * Note: cchUserNameLen is number of characters including nul terminator. */ - Tcl_DStringInit( &ds ); + Tcl_DStringInit(&ds); if (TclGetEnv("USERNAME", &ds) == NULL) { - - if ( GetUserName( szUserName, &dwUserNameLen ) != 0 ) { - Tcl_WinTCharToUtf( szUserName, dwUserNameLen, &ds ); - } + if (tclWinProcs->getUserName((LPTSTR)szUserName, &cchUserNameLen) != 0) { + int cbUserNameLen = cchUserNameLen - 1; + if (tclWinProcs->useWide) cbUserNameLen *= sizeof(WCHAR); + Tcl_WinTCharToUtf((LPTSTR)szUserName, cbUserNameLen, &ds); + } } Tcl_SetVar2(interp, "tcl_platform", "user", Tcl_DStringValue(&ds), TCL_GLOBAL_ONLY); @@ -731,15 +593,14 @@ TclpSetVariables(interp) * * TclpFindVariable -- * - * Locate the entry in environ for a given name. On Unix this - * routine is case sensetive, on Windows this matches mioxed case. + * Locate the entry in environ for a given name. On Unix this routine is + * case sensitive, on Windows this matches mioxed case. * * Results: - * The return value is the index in environ of an entry with the - * name "name", or -1 if there is no such entry. The integer at - * *lengthPtr is filled in with the length of name (if a matching - * entry is found) or the length of the environ array (if no matching - * entry is found). + * The return value is the index in environ of an entry with the name + * "name", or -1 if there is no such entry. The integer at *lengthPtr is + * filled in with the length of name (if a matching entry is found) or + * the length of the environ array (if no matching entry is found). * * Side effects: * None. @@ -748,10 +609,10 @@ TclpSetVariables(interp) */ int -TclpFindVariable(name, lengthPtr) - CONST char *name; /* Name of desired environment variable +TclpFindVariable( + CONST char *name, /* Name of desired environment variable * (UTF-8). */ - int *lengthPtr; /* Used to return length of name (for + int *lengthPtr) /* Used to return length of name (for * successful searches) or number of non-NULL * entries in environ (for unsuccessful * searches). */ @@ -762,23 +623,22 @@ TclpFindVariable(name, lengthPtr) Tcl_DString envString; /* - * Convert the name to all upper case for the case insensitive - * comparison. + * Convert the name to all upper case for the case insensitive comparison. */ length = strlen(name); nameUpper = (char *) ckalloc((unsigned) length+1); - memcpy((VOID *) nameUpper, (VOID *) name, (size_t) length+1); + memcpy(nameUpper, name, (size_t) length+1); Tcl_UtfToUpper(nameUpper); - + Tcl_DStringInit(&envString); for (i = 0, env = environ[i]; env != NULL; i++, env = environ[i]) { /* - * Chop the env string off after the equal sign, then Convert - * the name to all upper case, so we do not have to convert - * all the characters after the equal sign. + * Chop the env string off after the equal sign, then Convert the name + * to all upper case, so we do not have to convert all the characters + * after the equal sign. */ - + envUpper = Tcl_ExternalToUtfDString(NULL, env, -1, &envString); p1 = strchr(envUpper, '='); if (p1 == NULL) { @@ -798,117 +658,22 @@ TclpFindVariable(name, lengthPtr) result = i; goto done; } - + Tcl_DStringFree(&envString); } - + *lengthPtr = i; - done: + done: Tcl_DStringFree(&envString); ckfree(nameUpper); return result; } /* - *---------------------------------------------------------------------- - * - * Tcl_Init -- - * - * This procedure is typically invoked by Tcl_AppInit procedures - * to perform additional initialization for a Tcl interpreter, - * such as sourcing the "init.tcl" script. - * - * Results: - * Returns a standard Tcl completion code and sets the interp's - * result if there is an error. - * - * Side effects: - * Depends on what's in the init.tcl script. - * - *---------------------------------------------------------------------- - */ - -int -Tcl_Init(interp) - Tcl_Interp *interp; /* Interpreter to initialize. */ -{ - Tcl_Obj *pathPtr; - - if (tclPreInitScript != NULL) { - if (Tcl_Eval(interp, tclPreInitScript) == TCL_ERROR) { - return (TCL_ERROR); - }; - } - - pathPtr = TclGetLibraryPath(); - if (pathPtr == NULL) { - pathPtr = Tcl_NewObj(); - } - Tcl_IncrRefCount(pathPtr); - Tcl_SetVar2Ex(interp, "tcl_libPath", NULL, pathPtr, TCL_GLOBAL_ONLY); - Tcl_DecrRefCount(pathPtr); - return Tcl_Eval(interp, initScript); -} - -/* - *---------------------------------------------------------------------- - * - * Tcl_SourceRCFile -- - * - * This procedure is typically invoked by Tcl_Main of Tk_Main - * procedure to source an application specific rc file into the - * interpreter at startup time. - * - * Results: - * None. - * - * Side effects: - * Depends on what's in the rc script. - * - *---------------------------------------------------------------------- + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: */ - -void -Tcl_SourceRCFile(interp) - Tcl_Interp *interp; /* Interpreter to source rc file into. */ -{ - Tcl_DString temp; - CONST char *fileName; - Tcl_Channel errChannel; - - fileName = Tcl_GetVar(interp, "tcl_rcFileName", TCL_GLOBAL_ONLY); - - if (fileName != NULL) { - Tcl_Channel c; - CONST char *fullName; - - Tcl_DStringInit(&temp); - fullName = Tcl_TranslateFileName(interp, fileName, &temp); - if (fullName == NULL) { - /* - * Couldn't translate the file name (e.g. it referred to a - * bogus user or there was no HOME environment variable). - * Just do nothing. - */ - } else { - - /* - * Test for the existence of the rc file before trying to read it. - */ - - c = Tcl_OpenFileChannel(NULL, fullName, "r", 0); - if (c != (Tcl_Channel) NULL) { - Tcl_Close(NULL, c); - if (Tcl_EvalFile(interp, fullName) != TCL_OK) { - errChannel = Tcl_GetStdChannel(TCL_STDERR); - if (errChannel) { - Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp)); - Tcl_WriteChars(errChannel, "\n", 1); - } - } - } - } - Tcl_DStringFree(&temp); - } -} diff --git a/win/tclWinInt.h b/win/tclWinInt.h index 2e80afa..a76865d 100644 --- a/win/tclWinInt.h +++ b/win/tclWinInt.h @@ -12,12 +12,7 @@ #ifndef _TCLWININT #define _TCLWININT -#ifndef _TCLINT #include "tclInt.h" -#endif -#ifndef _TCLPORT -#include "tclPort.h" -#endif /* * The following specifies how much stack space TclpCheckStackSpace() @@ -27,11 +22,6 @@ #define TCL_WIN_STACK_THRESHOLD 0x8000 -#ifdef BUILD_tcl -# undef TCL_STORAGE_CLASS -# define TCL_STORAGE_CLASS DLLEXPORT -#endif - /* * Some versions of Borland C have a define for the OSVERSIONINFO for * Win32s and for NT, but not for Windows 95. @@ -83,7 +73,7 @@ typedef struct TclWinProcs { DWORD (WINAPI *getTempPathProc)(DWORD, WCHAR *); BOOL (WINAPI *getVolumeInformationProc)(CONST TCHAR *, WCHAR *, DWORD, LPDWORD, LPDWORD, LPDWORD, WCHAR *, DWORD); - HINSTANCE (WINAPI *loadLibraryExProc)(const TCHAR *, HANDLE, DWORD); + HINSTANCE (WINAPI *loadLibraryExProc)(CONST TCHAR *, HANDLE, DWORD); TCHAR (WINAPI *lstrcpyProc)(WCHAR *, CONST TCHAR *); BOOL (WINAPI *moveFileProc)(CONST TCHAR *, CONST TCHAR *); BOOL (WINAPI *removeDirectoryProc)(CONST TCHAR *); @@ -103,13 +93,12 @@ typedef struct TclWinProcs { BOOL (WINAPI *createHardLinkProc)(CONST TCHAR*, CONST TCHAR*, LPSECURITY_ATTRIBUTES); - INT (__cdecl *utimeProc)(CONST TCHAR*, struct _utimbuf *); + /* deleted INT (__cdecl *utimeProc)(CONST TCHAR*, struct _utimbuf *); */ /* These two are also NULL at start; see comment above */ HANDLE (WINAPI *findFirstFileExProc)(CONST TCHAR*, UINT, LPVOID, UINT, LPVOID, DWORD); BOOL (WINAPI *getVolumeNameForVMPProc)(CONST TCHAR*, TCHAR*, DWORD); - DWORD (WINAPI *getLongPathNameProc)(CONST TCHAR*, TCHAR*, DWORD); /* * These six are for the security sdk to get correct file @@ -136,42 +125,57 @@ typedef struct TclWinProcs { LPDWORD PrivilegeSetLength, LPDWORD GrantedAccess, LPBOOL AccessStatus); - /* - * Unicode console support. WriteConsole and ReadConsole - */ - BOOL (WINAPI *readConsoleProc)(HANDLE hConsoleInput, - LPVOID lpBuffer, - DWORD nNumberOfCharsToRead, - LPDWORD lpNumberOfCharsRead, - LPVOID lpReserved); - BOOL (WINAPI *writeConsoleProc)(HANDLE hConsoleOutput, - const VOID* lpBuffer, - DWORD nNumberOfCharsToWrite, - LPDWORD lpNumberOfCharsWritten, - LPVOID lpReserved); + /* + * Unicode console support. WriteConsole and ReadConsole + */ + BOOL (WINAPI *readConsoleProc)( + HANDLE hConsoleInput, + LPVOID lpBuffer, + DWORD nNumberOfCharsToRead, + LPDWORD lpNumberOfCharsRead, + LPVOID lpReserved + ); + BOOL (WINAPI *writeConsoleProc)( + HANDLE hConsoleOutput, + const VOID* lpBuffer, + DWORD nNumberOfCharsToWrite, + LPDWORD lpNumberOfCharsWritten, + LPVOID lpReserved + ); + BOOL (WINAPI *getUserName)(LPTSTR lpBuffer, LPDWORD lpnSize); } TclWinProcs; -EXTERN TclWinProcs *tclWinProcs; +MODULE_SCOPE TclWinProcs *tclWinProcs; /* * Declarations of functions that are not accessible by way of the * stubs table. */ -EXTERN void TclWinEncodingsCleanup(); -EXTERN void TclWinResetInterfaceEncodings(); -EXTERN void TclWinInit(HINSTANCE hInst); -EXTERN int TclWinSymLinkCopyDirectory(CONST TCHAR* LinkOriginal, - CONST TCHAR* LinkCopy); -EXTERN int TclWinSymLinkDelete(CONST TCHAR* LinkOriginal, - int linkOnly); -EXTERN char TclWinDriveLetterForVolMountPoint(CONST WCHAR *mountPoint); +MODULE_SCOPE char TclWinDriveLetterForVolMountPoint( + CONST WCHAR *mountPoint); +MODULE_SCOPE void TclWinEncodingsCleanup(); +MODULE_SCOPE void TclWinInit(HINSTANCE hInst); +MODULE_SCOPE TclFile TclWinMakeFile(HANDLE handle); +MODULE_SCOPE Tcl_Channel TclWinOpenConsoleChannel(HANDLE handle, + char *channelName, int permissions); +MODULE_SCOPE Tcl_Channel TclWinOpenFileChannel(HANDLE handle, char *channelName, + int permissions, int appendMode); +MODULE_SCOPE Tcl_Channel TclWinOpenSerialChannel(HANDLE handle, + char *channelName, int permissions); +MODULE_SCOPE void TclWinResetInterfaceEncodings(); +MODULE_SCOPE HANDLE TclWinSerialReopen(HANDLE handle, CONST TCHAR *name, + DWORD access); +MODULE_SCOPE int TclWinSymLinkCopyDirectory(CONST TCHAR* LinkOriginal, + CONST TCHAR* LinkCopy); +MODULE_SCOPE int TclWinSymLinkDelete(CONST TCHAR* LinkOriginal, + int linkOnly); #if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC) -EXTERN void TclWinFreeAllocCache(void); -EXTERN void TclFreeAllocCache(void *); -EXTERN Tcl_Mutex *TclpNewAllocMutex(void); -EXTERN void *TclpGetAllocCache(void); -EXTERN void TclpSetAllocCache(void *); +MODULE_SCOPE void TclWinFreeAllocCache(void); +MODULE_SCOPE void TclFreeAllocCache(void *); +MODULE_SCOPE Tcl_Mutex *TclpNewAllocMutex(void); +MODULE_SCOPE void * TclpGetAllocCache(void); +MODULE_SCOPE void TclpSetAllocCache(void *); #endif /* TCL_THREADS */ /* Needed by tclWinFile.c and tclWinFCmd.c */ @@ -179,9 +183,4 @@ EXTERN void TclpSetAllocCache(void *); #define FILE_ATTRIBUTE_REPARSE_POINT 0x00000400 #endif -#include "tclIntPlatDecls.h" - -# undef TCL_STORAGE_CLASS -# define TCL_STORAGE_CLASS DLLIMPORT - #endif /* _TCLWININT */ diff --git a/win/tclWinLoad.c b/win/tclWinLoad.c index 09ade9b..c4d08e8 100644 --- a/win/tclWinLoad.c +++ b/win/tclWinLoad.c @@ -1,14 +1,14 @@ -/* +/* * tclWinLoad.c -- * - * This procedure provides a version of the TclLoadFile that - * works with the Windows "LoadLibrary" and "GetProcAddress" - * API for dynamic loading. + * This function provides a version of the TclLoadFile that works with + * the Windows "LoadLibrary" and "GetProcAddress" API for dynamic + * loading. * * Copyright (c) 1995-1997 Sun Microsystems, Inc. * - * See the file "license.terms" for information on usage and redistribution - * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclWinInt.h" @@ -19,12 +19,12 @@ * * TclpDlopen -- * - * Dynamically loads a binary code file into memory and returns - * a handle to the new code. + * Dynamically loads a binary code file into memory and returns a handle + * to the new code. * * Results: - * A standard Tcl completion code. If an error occurs, an error - * message is left in the interp's result. + * A standard Tcl completion code. If an error occurs, an error message + * is left in the interp's result. * * Side effects: * New code suddenly appears in memory. @@ -33,92 +33,100 @@ */ int -TclpDlopen(interp, pathPtr, loadHandle, unloadProcPtr) - Tcl_Interp *interp; /* Used for error reporting. */ - Tcl_Obj *pathPtr; /* Name of the file containing the desired +TclpDlopen( + Tcl_Interp *interp, /* Used for error reporting. */ + Tcl_Obj *pathPtr, /* Name of the file containing the desired * code (UTF-8). */ - Tcl_LoadHandle *loadHandle; /* Filled with token for dynamically loaded - * file which will be passed back to + Tcl_LoadHandle *loadHandle, /* Filled with token for dynamically loaded + * file which will be passed back to * (*unloadProcPtr)() to unload the file. */ - Tcl_FSUnloadFileProc **unloadProcPtr; + Tcl_FSUnloadFileProc **unloadProcPtr) /* Filled with address of Tcl_FSUnloadFileProc - * function which should be used for - * this file. */ + * function which should be used for this + * file. */ { HINSTANCE handle; CONST TCHAR *nativeName; - /* - * First try the full path the user gave us. This is particularly - * important if the cwd is inside a vfs, and we are trying to load - * using a relative path. + /* + * First try the full path the user gave us. This is particularly + * important if the cwd is inside a vfs, and we are trying to load using a + * relative path. */ + nativeName = Tcl_FSGetNativePath(pathPtr); handle = (*tclWinProcs->loadLibraryExProc)(nativeName, NULL, - LOAD_WITH_ALTERED_SEARCH_PATH); + LOAD_WITH_ALTERED_SEARCH_PATH); if (handle == NULL) { - /* - * Let the OS loader examine the binary search path for - * whatever string the user gave us which hopefully refers - * to a file on the binary path + /* + * Let the OS loader examine the binary search path for whatever + * string the user gave us which hopefully refers to a file on the + * binary path. */ + Tcl_DString ds; - char *fileName = Tcl_GetString(pathPtr); + char *fileName = Tcl_GetString(pathPtr); + nativeName = Tcl_WinUtfToTChar(fileName, -1, &ds); handle = (*tclWinProcs->loadLibraryExProc)(nativeName, NULL, - LOAD_WITH_ALTERED_SEARCH_PATH); + LOAD_WITH_ALTERED_SEARCH_PATH); Tcl_DStringFree(&ds); } *loadHandle = (Tcl_LoadHandle) handle; - + if (handle == NULL) { DWORD lastError = GetLastError(); + #if 0 /* - * It would be ideal if the FormatMessage stuff worked better, - * but unfortunately it doesn't seem to want to... + * It would be ideal if the FormatMessage stuff worked better, but + * unfortunately it doesn't seem to want to... */ + LPTSTR lpMsgBuf; char *buf; int size; + size = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_ALLOCATE_BUFFER, NULL, lastError, 0, (LPTSTR) &lpMsgBuf, 0, NULL); buf = (char *) ckalloc((unsigned) TCL_INTEGER_SPACE + size + 1); sprintf(buf, "%d %s", lastError, (char *)lpMsgBuf); #endif + Tcl_AppendResult(interp, "couldn't load library \"", - Tcl_GetString(pathPtr), "\": ", (char *) NULL); + Tcl_GetString(pathPtr), "\": ", NULL); + /* - * Check for possible DLL errors. This doesn't work quite right, - * because Windows seems to only return ERROR_MOD_NOT_FOUND for - * just about any problem, but it's better than nothing. It'd be - * even better if there was a way to get what DLLs + * Check for possible DLL errors. This doesn't work quite right, + * because Windows seems to only return ERROR_MOD_NOT_FOUND for just + * about any problem, but it's better than nothing. It'd be even + * better if there was a way to get what DLLs */ + switch (lastError) { - case ERROR_MOD_NOT_FOUND: - case ERROR_DLL_NOT_FOUND: - Tcl_AppendResult(interp, "this library or a dependent library", - " could not be found in library path", - (char *) NULL); - break; - case ERROR_PROC_NOT_FOUND: - Tcl_AppendResult(interp, "could not find specified procedure", - (char *) NULL); - break; - case ERROR_INVALID_DLL: - Tcl_AppendResult(interp, "this library or a dependent library", - " is damaged", (char *) NULL); - break; - case ERROR_DLL_INIT_FAILED: - Tcl_AppendResult(interp, "the library initialization", - " routine failed", (char *) NULL); - break; - default: - TclWinConvertError(lastError); - Tcl_AppendResult(interp, Tcl_PosixError(interp), - (char *) NULL); + case ERROR_MOD_NOT_FOUND: + case ERROR_DLL_NOT_FOUND: + Tcl_AppendResult(interp, "this library or a dependent library" + " could not be found in library path", NULL); + break; + case ERROR_PROC_NOT_FOUND: + Tcl_AppendResult(interp, "A function specified in the import" + " table could not be resolved by the system. Windows" + " is not telling which one, I'm sorry.", NULL); + break; + case ERROR_INVALID_DLL: + Tcl_AppendResult(interp, "this library or a dependent library" + " is damaged", NULL); + break; + case ERROR_DLL_INIT_FAILED: + Tcl_AppendResult(interp, "the library initialization" + " routine failed", NULL); + break; + default: + TclWinConvertError(lastError); + Tcl_AppendResult(interp, Tcl_PosixError(interp), NULL); } return TCL_ERROR; } else { @@ -132,21 +140,22 @@ TclpDlopen(interp, pathPtr, loadHandle, unloadProcPtr) * * TclpFindSymbol -- * - * Looks up a symbol, by name, through a handle associated with - * a previously loaded piece of code (shared library). + * Looks up a symbol, by name, through a handle associated with a + * previously loaded piece of code (shared library). * * Results: - * Returns a pointer to the function associated with 'symbol' if - * it is found. Otherwise returns NULL and may leave an error - * message in the interp's result. + * Returns a pointer to the function associated with 'symbol' if it is + * found. Otherwise returns NULL and may leave an error message in the + * interp's result. * *---------------------------------------------------------------------- */ -Tcl_PackageInitProc* -TclpFindSymbol(interp, loadHandle, symbol) - Tcl_Interp *interp; - Tcl_LoadHandle loadHandle; - CONST char *symbol; + +Tcl_PackageInitProc * +TclpFindSymbol( + Tcl_Interp *interp, + Tcl_LoadHandle loadHandle, + CONST char *symbol) { Tcl_PackageInitProc *proc = NULL; HINSTANCE handle = (HINSTANCE)loadHandle; @@ -159,6 +168,7 @@ TclpFindSymbol(interp, loadHandle, symbol) proc = (Tcl_PackageInitProc *) GetProcAddress(handle, symbol); if (proc == NULL) { Tcl_DString ds; + Tcl_DStringInit(&ds); Tcl_DStringAppend(&ds, "_", 1); symbol = Tcl_DStringAppend(&ds, symbol, -1); @@ -173,9 +183,9 @@ TclpFindSymbol(interp, loadHandle, symbol) * * TclpUnloadFile -- * - * Unloads a dynamically loaded binary code file from memory. - * Code pointers in the formerly loaded file are no longer valid - * after calling this function. + * Unloads a dynamically loaded binary code file from memory. Code + * pointers in the formerly loaded file are no longer valid after calling + * this function. * * Results: * None. @@ -187,11 +197,10 @@ TclpFindSymbol(interp, loadHandle, symbol) */ void -TclpUnloadFile(loadHandle) - Tcl_LoadHandle loadHandle; /* loadHandle returned by a previous call - * to TclpDlopen(). The loadHandle is - * a token that represents the loaded - * file. */ +TclpUnloadFile( + Tcl_LoadHandle loadHandle) /* loadHandle returned by a previous call to + * TclpDlopen(). The loadHandle is a token + * that represents the loaded file. */ { HINSTANCE handle; @@ -204,14 +213,14 @@ TclpUnloadFile(loadHandle) * * TclGuessPackageName -- * - * If the "load" command is invoked without providing a package - * name, this procedure is invoked to try to figure it out. + * If the "load" command is invoked without providing a package name, + * this function is invoked to try to figure it out. * * Results: - * Always returns 0 to indicate that we couldn't figure out a - * package name; generic code will then try to guess the package - * from the file name. A return value of 1 would have meant that - * we figured out the package name and put it in bufPtr. + * Always returns 0 to indicate that we couldn't figure out a package + * name; generic code will then try to guess the package from the file + * name. A return value of 1 would have meant that we figured out the + * package name and put it in bufPtr. * * Side effects: * None. @@ -220,11 +229,19 @@ TclpUnloadFile(loadHandle) */ int -TclGuessPackageName(fileName, bufPtr) - CONST char *fileName; /* Name of file containing package (already +TclGuessPackageName( + CONST char *fileName, /* Name of file containing package (already * translated to local form if needed). */ - Tcl_DString *bufPtr; /* Initialized empty dstring. Append - * package name to this if possible. */ + Tcl_DString *bufPtr) /* Initialized empty dstring. Append package + * name to this if possible. */ { return 0; } + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ diff --git a/win/tclWinMtherr.c b/win/tclWinMtherr.c deleted file mode 100644 index 269a363..0000000 --- a/win/tclWinMtherr.c +++ /dev/null @@ -1,55 +0,0 @@ -/* - * tclWinMtherr.c -- - * - * This function provides a default implementation of the - * _matherr function for Borland C++. - * - * Copyright (c) 1995 Sun Microsystems, Inc. - * - * See the file "license.terms" for information on usage and redistribution - * of this file, and for a DISCLAIMER OF ALL WARRANTIES. - */ - -#include "tclWinInt.h" -#include <math.h> - - -#ifndef __MINGW32__ -/* - *---------------------------------------------------------------------- - * - * _matherr -- - * - * This procedure is invoked by Borland C++ when certain - * errors occur in mathematical functions. This procedure - * replaces the default implementation which generates pop-up - * warnings. - * - * Results: - * Returns 1 to indicate that we've handled the error - * locally. - * - * Side effects: - * Sets errno based on what's in xPtr. - * - *---------------------------------------------------------------------- - */ - -int -_matherr(xPtr) - struct exception *xPtr; /* Describes error that occurred. */ -{ - if ((xPtr->type == DOMAIN) -#ifdef __BORLANDC__ - || (xPtr->type == TLOSS) -#endif - || (xPtr->type == SING)) { - errno = EDOM; - } else { - errno = ERANGE; - } - return 1; -} - -#endif /* !__MINGW__ */ - diff --git a/win/tclWinNotify.c b/win/tclWinNotify.c index 0ad9e49..1cd5823 100644 --- a/win/tclWinNotify.c +++ b/win/tclWinNotify.c @@ -1,30 +1,30 @@ -/* +/* * tclWinNotify.c -- * - * This file contains Windows-specific procedures for the notifier, - * which is the lowest-level part of the Tcl event loop. This file - * works together with ../generic/tclNotify.c. + * This file contains Windows-specific procedures for the notifier, which + * is the lowest-level part of the Tcl event loop. This file works + * together with ../generic/tclNotify.c. * * Copyright (c) 1995-1997 Sun Microsystems, Inc. * - * See the file "license.terms" for information on usage and redistribution - * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ -#include "tclWinInt.h" +#include "tclInt.h" /* * The follwing static indicates whether this module has been initialized. */ -#define INTERVAL_TIMER 1 /* Handle of interval timer. */ +#define INTERVAL_TIMER 1 /* Handle of interval timer. */ -#define WM_WAKEUP WM_USER /* Message that is send by +#define WM_WAKEUP WM_USER /* Message that is send by * Tcl_AlertNotifier. */ /* * The following static structure contains the state information for the - * Windows implementation of the Tcl notifier. One of these structures - * is created for each thread that is using the notifier. + * Windows implementation of the Tcl notifier. One of these structures is + * created for each thread that is using the notifier. */ typedef struct ThreadSpecificData { @@ -33,8 +33,8 @@ typedef struct ThreadSpecificData { * notifier. */ HANDLE event; /* Event object used to wake up the notifier * thread. */ - int pending; /* Alert message pending, this field is - * locked by the notifierMutex. */ + int pending; /* Alert message pending, this field is locked + * by the notifierMutex. */ HWND hwnd; /* Messaging window. */ int timeout; /* Current timeout value. */ int timerActive; /* 1 if interval timer is running. */ @@ -46,9 +46,8 @@ extern TclStubs tclStubs; extern Tcl_NotifierProcs tclOriginalNotifier; /* - * The following static indicates the number of threads that have - * initialized notifiers. It controls the lifetime of the TclNotifier - * window class. + * The following static indicates the number of threads that have initialized + * notifiers. It controls the lifetime of the TclNotifier window class. * * You must hold the notifierMutex lock before accessing this variable. */ @@ -60,9 +59,8 @@ TCL_DECLARE_MUTEX(notifierMutex) * Static routines defined in this file. */ -static LRESULT CALLBACK NotifierProc(HWND hwnd, UINT message, - WPARAM wParam, LPARAM lParam); - +static LRESULT CALLBACK NotifierProc(HWND hwnd, UINT message, + WPARAM wParam, LPARAM lParam); /* *---------------------------------------------------------------------- @@ -81,14 +79,14 @@ static LRESULT CALLBACK NotifierProc(HWND hwnd, UINT message, */ ClientData -Tcl_InitNotifier() +Tcl_InitNotifier(void) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); WNDCLASS class; /* - * Register Notifier window class if this is the first thread to - * use this module. + * Register Notifier window class if this is the first thread to use this + * module. */ Tcl_MutexLock(¬ifierMutex); @@ -105,7 +103,7 @@ Tcl_InitNotifier() class.hCursor = NULL; if (!RegisterClassA(&class)) { - panic("Unable to register TclNotifier window class"); + Tcl_Panic("Unable to register TclNotifier window class"); } } notifierCount++; @@ -129,8 +127,8 @@ Tcl_InitNotifier() * * Tcl_FinalizeNotifier -- * - * This function is called to cleanup the notifier state before - * a thread is terminated. + * This function is called to cleanup the notifier state before a thread + * is terminated. * * Results: * None. @@ -142,21 +140,22 @@ Tcl_InitNotifier() */ void -Tcl_FinalizeNotifier(clientData) - ClientData clientData; /* Pointer to notifier data. */ +Tcl_FinalizeNotifier( + ClientData clientData) /* Pointer to notifier data. */ { ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData; /* - * Only finalize the notifier if a notifier was installed in the - * current thread; there is a route in which this is not - * guaranteed to be true (when tclWin32Dll.c:DllMain() is called - * with the flag DLL_PROCESS_DETACH by the OS, which could be - * doing so from a thread that's never previously been involved - * with Tcl, e.g. the task manager) so this check is important. + * Only finalize the notifier if a notifier was installed in the current + * thread; there is a route in which this is not guaranteed to be true + * (when tclWin32Dll.c:DllMain() is called with the flag + * DLL_PROCESS_DETACH by the OS, which could be doing so from a thread + * that's never previously been involved with Tcl, e.g. the task manager) + * so this check is important. * * Fixes Bug #217982 reported by Hugh Vu and Gene Leache. */ + if (tsdPtr == NULL) { return; } @@ -174,8 +173,8 @@ Tcl_FinalizeNotifier(clientData) } /* - * If this is the last thread to use the notifier, unregister - * the notifier window class. + * If this is the last thread to use the notifier, unregister the notifier + * window class. */ Tcl_MutexLock(¬ifierMutex); @@ -191,34 +190,33 @@ Tcl_FinalizeNotifier(clientData) * * Tcl_AlertNotifier -- * - * Wake up the specified notifier from any thread. This routine - * is called by the platform independent notifier code whenever - * the Tcl_ThreadAlert routine is called. This routine is - * guaranteed not to be called on a given notifier after - * Tcl_FinalizeNotifier is called for that notifier. This routine - * is typically called from a thread other than the notifier's - * thread. + * Wake up the specified notifier from any thread. This routine is called + * by the platform independent notifier code whenever the Tcl_ThreadAlert + * routine is called. This routine is guaranteed not to be called on a + * given notifier after Tcl_FinalizeNotifier is called for that notifier. + * This routine is typically called from a thread other than the + * notifier's thread. * * Results: * None. * * Side effects: - * Sends a message to the messaging window for the notifier - * if there isn't already one pending. + * Sends a message to the messaging window for the notifier if there + * isn't already one pending. * *---------------------------------------------------------------------- */ void -Tcl_AlertNotifier(clientData) - ClientData clientData; /* Pointer to thread data. */ +Tcl_AlertNotifier( + ClientData clientData) /* Pointer to thread data. */ { ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData; /* - * Note that we do not need to lock around access to the hwnd - * because the race condition has no effect since any race condition - * implies that the notifier thread is already awake. + * Note that we do not need to lock around access to the hwnd because the + * race condition has no effect since any race condition implies that the + * notifier thread is already awake. */ if (tsdPtr->hwnd) { @@ -242,9 +240,9 @@ Tcl_AlertNotifier(clientData) * * Tcl_SetTimer -- * - * This procedure sets the current notifier timer value. The - * notifier will ensure that Tcl_ServiceAll() is called after - * the specified interval, even if no events have occurred. + * This procedure sets the current notifier timer value. The notifier + * will ensure that Tcl_ServiceAll() is called after the specified + * interval, even if no events have occurred. * * Results: * None. @@ -263,8 +261,8 @@ Tcl_SetTimer( UINT timeout; /* - * Allow the notifier to be hooked. This may not make sense - * on Windows, but mirrors the UNIX hook. + * Allow the notifier to be hooked. This may not make sense on Windows, + * but mirrors the UNIX hook. */ if (tclStubs.tcl_SetTimer != tclOriginalNotifier.setTimerProc) { @@ -273,10 +271,9 @@ Tcl_SetTimer( } /* - * We only need to set up an interval timer if we're being called - * from an external event loop. If we don't have a window handle - * then we just return immediately and let Tcl_WaitForEvent handle - * timeouts. + * We only need to set up an interval timer if we're being called from an + * external event loop. If we don't have a window handle then we just + * return immediately and let Tcl_WaitForEvent handle timeouts. */ if (!tsdPtr->hwnd) { @@ -299,8 +296,8 @@ Tcl_SetTimer( tsdPtr->timeout = timeout; if (timeout != 0) { tsdPtr->timerActive = 1; - SetTimer(tsdPtr->hwnd, INTERVAL_TIMER, - (unsigned long) tsdPtr->timeout, NULL); + SetTimer(tsdPtr->hwnd, INTERVAL_TIMER, (unsigned long) tsdPtr->timeout, + NULL); } else { tsdPtr->timerActive = 0; KillTimer(tsdPtr->hwnd, INTERVAL_TIMER); @@ -318,37 +315,37 @@ Tcl_SetTimer( * None. * * Side effects: - * If this is the first time the notifier is set into - * TCL_SERVICE_ALL, then the communication window is created. + * If this is the first time the notifier is set into TCL_SERVICE_ALL, + * then the communication window is created. * *---------------------------------------------------------------------- */ void -Tcl_ServiceModeHook(mode) - int mode; /* Either TCL_SERVICE_ALL, or +Tcl_ServiceModeHook( + int mode) /* Either TCL_SERVICE_ALL, or * TCL_SERVICE_NONE. */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); /* - * If this is the first time that the notifier has been used from a - * modal loop, then create a communication window. Note that after - * this point, the application needs to service events in a timely - * fashion or Windows will hang waiting for the window to respond - * to synchronous system messages. At some point, we may want to - * consider destroying the window if we leave the modal loop, but - * for now we'll leave it around. + * If this is the first time that the notifier has been used from a modal + * loop, then create a communication window. Note that after this point, + * the application needs to service events in a timely fashion or Windows + * will hang waiting for the window to respond to synchronous system + * messages. At some point, we may want to consider destroying the window + * if we leave the modal loop, but for now we'll leave it around. */ if (mode == TCL_SERVICE_ALL && !tsdPtr->hwnd) { tsdPtr->hwnd = CreateWindowA("TclNotifier", "TclNotifier", WS_TILED, 0, 0, 0, 0, NULL, NULL, TclWinGetTclInstance(), NULL); + /* * Send an initial message to the window to ensure that we wake up the - * notifier once we get into the modal loop. This will force the - * notifier to recompute the timeout value and schedule a timer - * if one is needed. + * notifier once we get into the modal loop. This will force the + * notifier to recompute the timeout value and schedule a timer if one + * is needed. */ Tcl_AlertNotifier((ClientData)tsdPtr); @@ -360,10 +357,9 @@ Tcl_ServiceModeHook(mode) * * NotifierProc -- * - * This procedure is invoked by Windows to process events on - * the notifier window. Messages will be sent to this window - * in response to external timer events or calls to - * TclpAlertTsdPtr-> + * This procedure is invoked by Windows to process events on the notifier + * window. Messages will be sent to this window in response to external + * timer events or calls to TclpAlertTsdPtr-> * * Results: * A standard windows result. @@ -376,10 +372,10 @@ Tcl_ServiceModeHook(mode) static LRESULT CALLBACK NotifierProc( - HWND hwnd, - UINT message, - WPARAM wParam, - LPARAM lParam) + HWND hwnd, /* Passed on... */ + UINT message, /* What messsage is this? */ + WPARAM wParam, /* Passed on... */ + LPARAM lParam) /* Passed on... */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -390,7 +386,7 @@ NotifierProc( } else if (message != WM_TIMER) { return DefWindowProc(hwnd, message, wParam, lParam); } - + /* * Process all of the runnable events. */ @@ -404,17 +400,16 @@ NotifierProc( * * Tcl_WaitForEvent -- * - * This function is called by Tcl_DoOneEvent to wait for new - * events on the message queue. If the block time is 0, then - * Tcl_WaitForEvent just polls the event queue without blocking. + * This function is called by Tcl_DoOneEvent to wait for new events on + * the message queue. If the block time is 0, then Tcl_WaitForEvent just + * polls the event queue without blocking. * * Results: - * Returns -1 if a WM_QUIT message is detected, returns 1 if - * a message was dispatched, otherwise returns 0. + * Returns -1 if a WM_QUIT message is detected, returns 1 if a message + * was dispatched, otherwise returns 0. * * Side effects: - * Dispatches a message to a window procedure, which could do - * anything. + * Dispatches a message to a window procedure, which could do anything. * *---------------------------------------------------------------------- */ @@ -429,8 +424,8 @@ Tcl_WaitForEvent( int status; /* - * Allow the notifier to be hooked. This may not make - * sense on windows, but mirrors the UNIX hook. + * Allow the notifier to be hooked. This may not make sense on windows, + * but mirrors the UNIX hook. */ if (tclStubs.tcl_WaitForEvent != tclOriginalNotifier.waitForEventProc) { @@ -442,7 +437,21 @@ Tcl_WaitForEvent( */ if (timePtr) { - timeout = timePtr->sec * 1000 + timePtr->usec / 1000; + /* + * TIP #233 (Virtualized Time). Convert virtual domain delay to + * real-time. + */ + + Tcl_Time myTime; + + myTime.sec = timePtr->sec; + myTime.usec = timePtr->usec; + + if (myTime.sec != 0 || myTime.usec != 0) { + (*tclScaleTimeProcPtr) (&myTime, tclTimeClientData); + } + + timeout = myTime.sec * 1000 + myTime.usec / 1000; } else { timeout = INFINITE; } @@ -456,11 +465,19 @@ Tcl_WaitForEvent( if (!PeekMessage(&msg, NULL, 0, 0, PM_NOREMOVE)) { /* * Wait for something to happen (a signal from another thread, a - * message, or timeout). + * message, or timeout) or loop servicing asynchronous procedure calls + * queued to this thread. */ - result = MsgWaitForMultipleObjects(1, &tsdPtr->event, FALSE, timeout, - QS_ALLINPUT); + again: + result = MsgWaitForMultipleObjectsEx(1, &tsdPtr->event, timeout, + QS_ALLINPUT, MWMO_ALERTABLE); + if (result == WAIT_IO_COMPLETION) { + goto again; + } else if (result == WAIT_FAILED) { + status = -1; + goto end; + } } /* @@ -481,9 +498,9 @@ Tcl_WaitForEvent( PostQuitMessage((int) msg.wParam); status = -1; - } else if (result == -1) { + } else if (result == (DWORD)-1) { /* - * We got an error from the system. I have no idea why this would + * We got an error from the system. I have no idea why this would * happen, so we'll just unwind. */ @@ -497,6 +514,7 @@ Tcl_WaitForEvent( status = 0; } + end: ResetEvent(tsdPtr->event); return status; } @@ -518,42 +536,64 @@ Tcl_WaitForEvent( */ void -Tcl_Sleep(ms) - int ms; /* Number of milliseconds to sleep. */ +Tcl_Sleep( + int ms) /* Number of milliseconds to sleep. */ { /* - * Simply calling 'Sleep' for the requisite number of milliseconds - * can make the process appear to wake up early because it isn't - * synchronized with the CPU performance counter that is used in - * tclWinTime.c. This behavior is probably benign, but messes - * up some of the corner cases in the test suite. We get around - * this problem by repeating the 'Sleep' call as many times - * as necessary to make the clock advance by the requisite amount. + * Simply calling 'Sleep' for the requisite number of milliseconds can + * make the process appear to wake up early because it isn't synchronized + * with the CPU performance counter that is used in tclWinTime.c. This + * behavior is probably benign, but messes up some of the corner cases in + * the test suite. We get around this problem by repeating the 'Sleep' + * call as many times as necessary to make the clock advance by the + * requisite amount. */ - Tcl_Time now; /* Current wall clock time */ - Tcl_Time desired; /* Desired wakeup time */ - DWORD sleepTime = ms; /* Time to sleep */ + Tcl_Time now; /* Current wall clock time. */ + Tcl_Time desired; /* Desired wakeup time. */ + Tcl_Time vdelay; /* Time to sleep, for scaling virtual -> + * real. */ + DWORD sleepTime; /* Time to sleep, real-time */ + + vdelay.sec = ms / 1000; + vdelay.usec = (ms % 1000) * 1000; - Tcl_GetTime( &now ); - desired.sec = now.sec + ( ms / 1000 ); - desired.usec = now.usec + 1000 * ( ms % 1000 ); - if ( desired.usec > 1000000 ) { + Tcl_GetTime(&now); + desired.sec = now.sec + vdelay.sec; + desired.usec = now.usec + vdelay.usec; + if (desired.usec > 1000000) { ++desired.sec; desired.usec -= 1000000; } - - for ( ; ; ) { - Sleep( sleepTime ); - Tcl_GetTime( &now ); - if ( now.sec > desired.sec ) { + + /* + * TIP #233: Scale delay from virtual to real-time. + */ + + (*tclScaleTimeProcPtr) (&vdelay, tclTimeClientData); + sleepTime = vdelay.sec * 1000 + vdelay.usec / 1000; + + for (;;) { + Sleep(sleepTime); + Tcl_GetTime(&now); + if (now.sec > desired.sec) { break; - } else if ( ( now.sec == desired.sec ) - && ( now.usec >= desired.usec ) ) { + } else if ((now.sec == desired.sec) && (now.usec >= desired.usec)) { break; } - sleepTime = ( ( 1000 * ( desired.sec - now.sec ) ) - + ( ( desired.usec - now.usec ) / 1000 ) ); - } + vdelay.sec = desired.sec - now.sec; + vdelay.usec = desired.usec - now.usec; + + (*tclScaleTimeProcPtr) (&vdelay, tclTimeClientData); + sleepTime = vdelay.sec * 1000 + vdelay.usec / 1000; + } } + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c index f15daa5..b29dde4 100644 --- a/win/tclWinPipe.c +++ b/win/tclWinPipe.c @@ -1,19 +1,17 @@ -/* +/* * tclWinPipe.c -- * - * This file implements the Windows-specific exec pipeline functions, - * the "pipe" channel driver, and the "pid" Tcl command. + * This file implements the Windows-specific exec pipeline functions, the + * "pipe" channel driver, and the "pid" Tcl command. * * Copyright (c) 1996-1997 by Sun Microsystems, Inc. * - * See the file "license.terms" for information on usage and redistribution - * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclWinInt.h" -#include <fcntl.h> -#include <io.h> #include <sys/stat.h> /* @@ -24,16 +22,16 @@ static int initialized = 0; /* - * The pipeMutex locks around access to the initialized and procList variables, - * and it is used to protect background threads from being terminated while - * they are using APIs that hold locks. + * The pipeMutex locks around access to the initialized and procList + * variables, and it is used to protect background threads from being + * terminated while they are using APIs that hold locks. */ TCL_DECLARE_MUTEX(pipeMutex) /* - * The following defines identify the various types of applications that - * run under windows. There is special case code for the various types. + * The following defines identify the various types of applications that run + * under windows. There is special case code for the various types. */ #define APPL_NONE 0 @@ -42,16 +40,16 @@ TCL_DECLARE_MUTEX(pipeMutex) #define APPL_WIN32 3 /* - * The following constants and structures are used to encapsulate the state - * of various types of files used in a pipeline. - * This used to have a 1 && 2 that supported Win32s. + * The following constants and structures are used to encapsulate the state of + * various types of files used in a pipeline. This used to have a 1 && 2 that + * supported Win32s. */ -#define WIN_FILE 3 /* Basic Win32 file. */ +#define WIN_FILE 3 /* Basic Win32 file. */ /* - * This structure encapsulates the common state associated with all file - * types used in a pipeline. + * This structure encapsulates the common state associated with all file types + * used in a pipeline. */ typedef struct WinFile { @@ -110,66 +108,64 @@ typedef struct PipeInfo { HANDLE writeThread; /* Handle to writer thread. */ HANDLE readThread; /* Handle to reader thread. */ HANDLE writable; /* Manual-reset event to signal when the - * writer thread has finished waiting for - * the current buffer to be written. */ + * writer thread has finished waiting for the + * current buffer to be written. */ HANDLE readable; /* Manual-reset event to signal when the * reader thread has finished waiting for * input. */ HANDLE startWriter; /* Auto-reset event used by the main thread to - * signal when the writer thread should attempt - * to write to the pipe. */ + * signal when the writer thread should + * attempt to write to the pipe. */ HANDLE stopWriter; /* Manual-reset event used to alert the reader * thread to fall-out and exit */ HANDLE startReader; /* Auto-reset event used by the main thread to - * signal when the reader thread should attempt - * to read from the pipe. */ + * signal when the reader thread should + * attempt to read from the pipe. */ HANDLE stopReader; /* Manual-reset event used to alert the reader * thread to fall-out and exit */ DWORD writeError; /* An error caused by the last background - * write. Set to 0 if no error has been - * detected. This word is shared with the + * write. Set to 0 if no error has been + * detected. This word is shared with the * writer thread so access must be * synchronized with the writable object. */ - char *writeBuf; /* Current background output buffer. - * Access is synchronized with the writable - * object. */ - int writeBufLen; /* Size of write buffer. Access is - * synchronized with the writable - * object. */ - int toWrite; /* Current amount to be written. Access is + char *writeBuf; /* Current background output buffer. Access is + * synchronized with the writable object. */ + int writeBufLen; /* Size of write buffer. Access is + * synchronized with the writable object. */ + int toWrite; /* Current amount to be written. Access is * synchronized with the writable object. */ int readFlags; /* Flags that are shared with the reader - * thread. Access is synchronized with the + * thread. Access is synchronized with the * readable object. */ char extraByte; /* Buffer for extra character consumed by - * reader thread. This byte is shared with - * the reader thread so access must be + * reader thread. This byte is shared with the + * reader thread so access must be * synchronized with the readable object. */ } PipeInfo; typedef struct ThreadSpecificData { /* - * The following pointer refers to the head of the list of pipes - * that are being watched for file events. + * The following pointer refers to the head of the list of pipes that are + * being watched for file events. */ - + PipeInfo *firstPipePtr; } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; /* - * The following structure is what is added to the Tcl event queue when - * pipe events are generated. + * The following structure is what is added to the Tcl event queue when pipe + * events are generated. */ typedef struct PipeEvent { - Tcl_Event header; /* Information that is standard for - * all events. */ - PipeInfo *infoPtr; /* Pointer to pipe info structure. Note - * that we still have to verify that the - * pipe exists before dereferencing this + Tcl_Event header; /* Information that is standard for all + * events. */ + PipeInfo *infoPtr; /* Pointer to pipe info structure. Note that + * we still have to verify that the pipe + * exists before dereferencing this * pointer. */ } PipeEvent; @@ -179,8 +175,8 @@ typedef struct PipeEvent { static int ApplicationType(Tcl_Interp *interp, const char *fileName, char *fullName); -static void BuildCommandLine(const char *executable, int argc, - CONST char **argv, Tcl_DString *linePtr); +static void BuildCommandLine(const char *executable, int argc, + const char **argv, Tcl_DString *linePtr); static BOOL HasConsole(void); static int PipeBlockModeProc(ClientData instanceData, int mode); static void PipeCheckProc(ClientData clientData, int flags); @@ -193,25 +189,24 @@ static void PipeInit(void); static int PipeInputProc(ClientData instanceData, char *buf, int toRead, int *errorCode); static int PipeOutputProc(ClientData instanceData, - CONST char *buf, int toWrite, int *errorCode); + const char *buf, int toWrite, int *errorCode); static DWORD WINAPI PipeReaderThread(LPVOID arg); static void PipeSetupProc(ClientData clientData, int flags); static void PipeWatchProc(ClientData instanceData, int mask); static DWORD WINAPI PipeWriterThread(LPVOID arg); static int TempFileName(WCHAR name[MAX_PATH]); static int WaitForRead(PipeInfo *infoPtr, int blocking); - -static void PipeThreadActionProc _ANSI_ARGS_ (( - ClientData instanceData, int action)); +static void PipeThreadActionProc(ClientData instanceData, + int action); /* - * This structure describes the channel type structure for command pipe - * based IO. + * This structure describes the channel type structure for command pipe based + * I/O. */ static Tcl_ChannelType pipeChannelType = { "pipe", /* Type name. */ - TCL_CHANNEL_VERSION_4, /* v4 channel */ + TCL_CHANNEL_VERSION_5, /* v5 channel */ TCL_CLOSE2PROC, /* Close proc. */ PipeInputProc, /* Input proc. */ PipeOutputProc, /* Output proc. */ @@ -224,8 +219,9 @@ static Tcl_ChannelType pipeChannelType = { PipeBlockModeProc, /* Set blocking or non-blocking mode.*/ NULL, /* flush proc. */ NULL, /* handler proc. */ - NULL, /* wide seek proc */ - PipeThreadActionProc, /* thread action proc */ + NULL, /* wide seek proc */ + PipeThreadActionProc, /* thread action proc */ + NULL, /* truncate */ }; /* @@ -245,13 +241,13 @@ static Tcl_ChannelType pipeChannelType = { */ static void -PipeInit() +PipeInit(void) { ThreadSpecificData *tsdPtr; /* - * Check the initialized flag first, then check again in the mutex. - * This is a speed enhancement. + * Check the initialized flag first, then check again in the mutex. This + * is a speed enhancement. */ if (!initialized) { @@ -276,7 +272,7 @@ PipeInit() * * TclpFinalizePipes -- * - * This function is called from Tcl_FinalizeThread to finalize the + * This function is called from Tcl_FinalizeThread to finalize the * platform specific pipe subsystem. * * Results: @@ -289,8 +285,8 @@ PipeInit() */ void -TclpFinalizePipes() -{ +TclpFinalizePipes(void) +{ ThreadSpecificData *tsdPtr; tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); @@ -304,8 +300,8 @@ TclpFinalizePipes() * * PipeSetupProc -- * - * This procedure is invoked before Tcl_DoOneEvent blocks waiting - * for an event. + * This function is invoked before Tcl_DoOneEvent blocks waiting for an + * event. * * Results: * None. @@ -329,12 +325,12 @@ PipeSetupProc( if (!(flags & TCL_FILE_EVENTS)) { return; } - + /* * Look to see if any events are already pending. If they are, poll. */ - for (infoPtr = tsdPtr->firstPipePtr; infoPtr != NULL; + for (infoPtr = tsdPtr->firstPipePtr; infoPtr != NULL; infoPtr = infoPtr->nextPtr) { if (infoPtr->watchMask & TCL_WRITABLE) { if (WaitForSingleObject(infoPtr->writable, 0) != WAIT_TIMEOUT) { @@ -357,8 +353,8 @@ PipeSetupProc( * * PipeCheckProc -- * - * This procedure is called by Tcl_DoOneEvent to check the pipe - * event source for events. + * This function is called by Tcl_DoOneEvent to check the pipe event + * source for events. * * Results: * None. @@ -382,18 +378,17 @@ PipeCheckProc( if (!(flags & TCL_FILE_EVENTS)) { return; } - + /* - * Queue events for any ready pipes that don't already have events - * queued. + * Queue events for any ready pipes that don't already have events queued. */ - for (infoPtr = tsdPtr->firstPipePtr; infoPtr != NULL; + for (infoPtr = tsdPtr->firstPipePtr; infoPtr != NULL; infoPtr = infoPtr->nextPtr) { if (infoPtr->flags & PIPE_PENDING) { continue; } - + /* * Queue an event if the pipe is signaled for reading or writing. */ @@ -403,7 +398,7 @@ PipeCheckProc( (WaitForSingleObject(infoPtr->writable, 0) != WAIT_TIMEOUT)) { needEvent = 1; } - + if ((infoPtr->watchMask & TCL_READABLE) && (WaitForRead(infoPtr, 0) >= 0)) { needEvent = 1; @@ -424,8 +419,8 @@ PipeCheckProc( * * TclWinMakeFile -- * - * This function constructs a new TclFile from a given data and - * type value. + * This function constructs a new TclFile from a given data and type + * value. * * Results: * Returns a newly allocated WinFile as a TclFile. @@ -454,15 +449,14 @@ TclWinMakeFile( * * TempFileName -- * - * Gets a temporary file name and deals with the fact that the - * temporary file path provided by Windows may not actually exist - * if the TMP or TEMP environment variables refer to a - * non-existent directory. + * Gets a temporary file name and deals with the fact that the temporary + * file path provided by Windows may not actually exist if the TMP or + * TEMP environment variables refer to a non-existent directory. * - * Results: - * 0 if error, non-zero otherwise. If non-zero is returned, the - * name buffer will be filled with a name that can be used to - * construct a temporary file. + * Results: + * 0 if error, non-zero otherwise. If non-zero is returned, the name + * buffer will be filled with a name that can be used to construct a + * temporary file. * * Side effects: * None. @@ -471,15 +465,15 @@ TclWinMakeFile( */ static int -TempFileName(name) - WCHAR name[MAX_PATH]; /* Buffer in which name for temporary - * file gets stored. */ +TempFileName( + WCHAR name[MAX_PATH]) /* Buffer in which name for temporary file + * gets stored. */ { TCHAR *prefix; prefix = (tclWinProcs->useWide) ? (TCHAR *) L"TCL" : (TCHAR *) "TCL"; if ((*tclWinProcs->getTempPathProc)(MAX_PATH, name) != 0) { - if ((*tclWinProcs->getTempFileNameProc)((TCHAR *) name, prefix, 0, + if ((*tclWinProcs->getTempFileNameProc)((TCHAR *) name, prefix, 0, name) != 0) { return 1; } @@ -491,7 +485,7 @@ TempFileName(name) ((char *) name)[0] = '.'; ((char *) name)[1] = '\0'; } - return (*tclWinProcs->getTempFileNameProc)((TCHAR *) name, prefix, 0, + return (*tclWinProcs->getTempFileNameProc)((TCHAR *) name, prefix, 0, name); } @@ -512,13 +506,13 @@ TempFileName(name) */ TclFile -TclpMakeFile(channel, direction) - Tcl_Channel channel; /* Channel to get file from. */ - int direction; /* Either TCL_READABLE or TCL_WRITABLE. */ +TclpMakeFile( + Tcl_Channel channel, /* Channel to get file from. */ + int direction) /* Either TCL_READABLE or TCL_WRITABLE. */ { HANDLE handle; - if (Tcl_GetChannelHandle(channel, direction, + if (Tcl_GetChannelHandle(channel, direction, (ClientData *) &handle) == TCL_OK) { return TclWinMakeFile(handle); } else { @@ -534,8 +528,8 @@ TclpMakeFile(channel, direction) * This function opens files for use in a pipeline. * * Results: - * Returns a newly allocated TclFile structure containing the - * file handle. + * Returns a newly allocated TclFile structure containing the file + * handle. * * Side effects: * None. @@ -544,32 +538,32 @@ TclpMakeFile(channel, direction) */ TclFile -TclpOpenFile(path, mode) - CONST char *path; /* The name of the file to open. */ - int mode; /* In what mode to open the file? */ +TclpOpenFile( + const char *path, /* The name of the file to open. */ + int mode) /* In what mode to open the file? */ { HANDLE handle; DWORD accessMode, createMode, shareMode, flags; Tcl_DString ds; - CONST TCHAR *nativePath; - + const TCHAR *nativePath; + /* * Map the access bits to the NT access mode. */ switch (mode & (O_RDONLY | O_WRONLY | O_RDWR)) { - case O_RDONLY: - accessMode = GENERIC_READ; - break; - case O_WRONLY: - accessMode = GENERIC_WRITE; - break; - case O_RDWR: - accessMode = (GENERIC_READ | GENERIC_WRITE); - break; - default: - TclWinConvertError(ERROR_INVALID_FUNCTION); - return NULL; + case O_RDONLY: + accessMode = GENERIC_READ; + break; + case O_WRONLY: + accessMode = GENERIC_WRITE; + break; + case O_RDWR: + accessMode = (GENERIC_READ | GENERIC_WRITE); + break; + default: + TclWinConvertError(ERROR_INVALID_FUNCTION); + return NULL; } /* @@ -577,23 +571,23 @@ TclpOpenFile(path, mode) */ switch (mode & (O_CREAT | O_EXCL | O_TRUNC)) { - case (O_CREAT | O_EXCL): - case (O_CREAT | O_EXCL | O_TRUNC): - createMode = CREATE_NEW; - break; - case (O_CREAT | O_TRUNC): - createMode = CREATE_ALWAYS; - break; - case O_CREAT: - createMode = OPEN_ALWAYS; - break; - case O_TRUNC: - case (O_TRUNC | O_EXCL): - createMode = TRUNCATE_EXISTING; - break; - default: - createMode = OPEN_EXISTING; - break; + case (O_CREAT | O_EXCL): + case (O_CREAT | O_EXCL | O_TRUNC): + createMode = CREATE_NEW; + break; + case (O_CREAT | O_TRUNC): + createMode = CREATE_ALWAYS; + break; + case O_CREAT: + createMode = OPEN_ALWAYS; + break; + case O_TRUNC: + case (O_TRUNC | O_EXCL): + createMode = TRUNCATE_EXISTING; + break; + default: + createMode = OPEN_EXISTING; + break; } nativePath = Tcl_WinUtfToTChar(path, -1, &ds); @@ -620,19 +614,19 @@ TclpOpenFile(path, mode) * Now we get to create the file. */ - handle = (*tclWinProcs->createFileProc)(nativePath, accessMode, + handle = (*tclWinProcs->createFileProc)(nativePath, accessMode, shareMode, NULL, createMode, flags, NULL); Tcl_DStringFree(&ds); if (handle == INVALID_HANDLE_VALUE) { DWORD err; - + err = GetLastError(); if ((err & 0xffffL) == ERROR_OPEN_FAILED) { err = (mode & O_CREAT) ? ERROR_FILE_EXISTS : ERROR_FILE_NOT_FOUND; } - TclWinConvertError(err); - return NULL; + TclWinConvertError(err); + return NULL; } /* @@ -651,9 +645,9 @@ TclpOpenFile(path, mode) * * TclpCreateTempFile -- * - * This function opens a unique file with the property that it - * will be deleted when its file handle is closed. The temporary - * file is created in the system temporary directory. + * This function opens a unique file with the property that it will be + * deleted when its file handle is closed. The temporary file is created + * in the system temporary directory. * * Results: * Returns a valid TclFile, or NULL on failure. @@ -665,11 +659,11 @@ TclpOpenFile(path, mode) */ TclFile -TclpCreateTempFile(contents) - CONST char *contents; /* String to write into temp file, or NULL. */ +TclpCreateTempFile( + const char *contents) /* String to write into temp file, or NULL. */ { WCHAR name[MAX_PATH]; - CONST char *native; + const char *native; Tcl_DString dstring; HANDLE handle; @@ -677,8 +671,8 @@ TclpCreateTempFile(contents) return NULL; } - handle = (*tclWinProcs->createFileProc)((TCHAR *) name, - GENERIC_READ | GENERIC_WRITE, 0, NULL, CREATE_ALWAYS, + handle = (*tclWinProcs->createFileProc)((TCHAR *) name, + GENERIC_READ | GENERIC_WRITE, 0, NULL, CREATE_ALWAYS, FILE_ATTRIBUTE_TEMPORARY|FILE_FLAG_DELETE_ON_CLOSE, NULL); if (handle == INVALID_HANDLE_VALUE) { goto error; @@ -690,13 +684,14 @@ TclpCreateTempFile(contents) if (contents != NULL) { DWORD result, length; - CONST char *p; + const char *p; /* * Convert the contents from UTF to native encoding */ + native = Tcl_UtfToExternalDString(NULL, contents, -1, &dstring); - + for (p = native; *p != '\0'; p++) { if (*p == '\n') { length = p - native; @@ -726,7 +721,10 @@ TclpCreateTempFile(contents) return TclWinMakeFile(handle); error: - /* Free the native representation of the contents if necessary */ + /* + * Free the native representation of the contents if necessary. + */ + if (contents != NULL) { Tcl_DStringFree(&dstring); } @@ -753,8 +751,8 @@ TclpCreateTempFile(contents) *---------------------------------------------------------------------- */ -Tcl_Obj* -TclpTempFileName() +Tcl_Obj * +TclpTempFileName(void) { WCHAR fileName[MAX_PATH]; @@ -770,23 +768,23 @@ TclpTempFileName() * * TclpCreatePipe -- * - * Creates an anonymous pipe. + * Creates an anonymous pipe. * * Results: - * Returns 1 on success, 0 on failure. + * Returns 1 on success, 0 on failure. * * Side effects: - * Creates a pipe. + * Creates a pipe. * *---------------------------------------------------------------------- */ int TclpCreatePipe( - TclFile *readPipe, /* Location to store file handle for - * read side of pipe. */ - TclFile *writePipe) /* Location to store file handle for - * write side of pipe. */ + TclFile *readPipe, /* Location to store file handle for read side + * of pipe. */ + TclFile *writePipe) /* Location to store file handle for write + * side of pipe. */ { HANDLE readHandle, writeHandle; @@ -805,7 +803,7 @@ TclpCreatePipe( * * TclpCloseFile -- * - * Closes a pipeline file handle. These handles are created by + * Closes a pipeline file handle. These handles are created by * TclpOpenFile, TclpCreatePipe, or TclpMakeFile. * * Results: @@ -819,33 +817,33 @@ TclpCreatePipe( int TclpCloseFile( - TclFile file) /* The file to close. */ + TclFile file) /* The file to close. */ { WinFile *filePtr = (WinFile *) file; switch (filePtr->type) { - case WIN_FILE: - /* - * Don't close the Win32 handle if the handle is a standard channel - * during the thread exit process. Otherwise, one thread may kill - * the stdio of another. - */ + case WIN_FILE: + /* + * Don't close the Win32 handle if the handle is a standard channel + * during the thread exit process. Otherwise, one thread may kill the + * stdio of another. + */ - if (!TclInThreadExit() - || ((GetStdHandle(STD_INPUT_HANDLE) != filePtr->handle) - && (GetStdHandle(STD_OUTPUT_HANDLE) != filePtr->handle) - && (GetStdHandle(STD_ERROR_HANDLE) != filePtr->handle))) { - if (filePtr->handle != NULL && - CloseHandle(filePtr->handle) == FALSE) { - TclWinConvertError(GetLastError()); - ckfree((char *) filePtr); - return -1; - } + if (!TclInThreadExit() + || ((GetStdHandle(STD_INPUT_HANDLE) != filePtr->handle) + && (GetStdHandle(STD_OUTPUT_HANDLE) != filePtr->handle) + && (GetStdHandle(STD_ERROR_HANDLE) != filePtr->handle))) { + if (filePtr->handle != NULL && + CloseHandle(filePtr->handle) == FALSE) { + TclWinConvertError(GetLastError()); + ckfree((char *) filePtr); + return -1; } - break; + } + break; - default: - panic("TclpCloseFile: unexpected file type"); + default: + Tcl_Panic("TclpCloseFile: unexpected file type"); } ckfree((char *) filePtr); @@ -861,9 +859,9 @@ TclpCloseFile( * child process. * * Results: - * Returns the process id for the child process. If the pid was not - * known by Tcl, either because the pid was not created by Tcl or the - * child process has already been reaped, -1 is returned. + * Returns the process id for the child process. If the pid was not known + * by Tcl, either because the pid was not created by Tcl or the child + * process has already been reaped, -1 is returned. * * Side effects: * None. @@ -895,25 +893,25 @@ TclpGetPid( * * TclpCreateProcess -- * - * Create a child process that has the specified files as its - * standard input, output, and error. The child process runs - * asynchronously under Windows NT and Windows 9x, and runs - * with the same environment variables as the creating process. + * Create a child process that has the specified files as its standard + * input, output, and error. The child process runs asynchronously under + * Windows NT and Windows 9x, and runs with the same environment + * variables as the creating process. * - * The complete Windows search path is searched to find the specified - * executable. If an executable by the given name is not found, - * automatically tries appending ".com", ".exe", and ".bat" to the + * The complete Windows search path is searched to find the specified + * executable. If an executable by the given name is not found, + * automatically tries appending ".com", ".exe", and ".bat" to the * executable name. * * Results: - * The return value is TCL_ERROR and an error message is left in - * the interp's result if there was a problem creating the child - * process. Otherwise, the return value is TCL_OK and *pidPtr is - * filled with the process id of the child process. - * + * The return value is TCL_ERROR and an error message is left in the + * interp's result if there was a problem creating the child process. + * Otherwise, the return value is TCL_OK and *pidPtr is filled with the + * process id of the child process. + * * Side effects: * A process is created. - * + * *---------------------------------------------------------------------- */ @@ -924,27 +922,27 @@ TclpCreateProcess( * Error messages from the child process * itself are sent to errorFile. */ int argc, /* Number of arguments in following array. */ - CONST char **argv, /* Array of argument strings. argv[0] - * contains the name of the executable - * converted to native format (using the - * Tcl_TranslateFileName call). Additional + const char **argv, /* Array of argument strings. argv[0] contains + * the name of the executable converted to + * native format (using the + * Tcl_TranslateFileName call). Additional * arguments have not been converted. */ - TclFile inputFile, /* If non-NULL, gives the file to use as - * input for the child process. If inputFile - * file is not readable or is NULL, the child - * will receive no standard input. */ - TclFile outputFile, /* If non-NULL, gives the file that - * receives output from the child process. If + TclFile inputFile, /* If non-NULL, gives the file to use as input + * for the child process. If inputFile file is + * not readable or is NULL, the child will + * receive no standard input. */ + TclFile outputFile, /* If non-NULL, gives the file that receives + * output from the child process. If * outputFile file is not writeable or is * NULL, output from the child will be * discarded. */ - TclFile errorFile, /* If non-NULL, gives the file that - * receives errors from the child process. If - * errorFile file is not writeable or is NULL, - * errors from the child will be discarded. - * errorFile may be the same as outputFile. */ - Tcl_Pid *pidPtr) /* If this procedure is successful, pidPtr - * is filled with the process id of the child + TclFile errorFile, /* If non-NULL, gives the file that receives + * errors from the child process. If errorFile + * file is not writeable or is NULL, errors + * from the child will be discarded. errorFile + * may be the same as outputFile. */ + Tcl_Pid *pidPtr) /* If this function is successful, pidPtr is + * filled with the process id of the child * process. */ { int result, applType, createFlags; @@ -969,13 +967,13 @@ TclpCreateProcess( /* * STARTF_USESTDHANDLES must be used to pass handles to child process. - * Using SetStdHandle() and/or dup2() only works when a console mode + * Using SetStdHandle() and/or dup2() only works when a console mode * parent process is spawning an attached console mode child process. */ ZeroMemory(&startInfo, sizeof(startInfo)); startInfo.cb = sizeof(startInfo); - startInfo.dwFlags = STARTF_USESTDHANDLES; + startInfo.dwFlags = STARTF_USESTDHANDLES; startInfo.hStdInput = INVALID_HANDLE_VALUE; startInfo.hStdOutput= INVALID_HANDLE_VALUE; startInfo.hStdError = INVALID_HANDLE_VALUE; @@ -985,8 +983,8 @@ TclpCreateProcess( secAtts.bInheritHandle = TRUE; /* - * We have to check the type of each file, since we cannot duplicate - * some file types. + * We have to check the type of each file, since we cannot duplicate some + * file types. */ inputHandle = INVALID_HANDLE_VALUE; @@ -1012,23 +1010,22 @@ TclpCreateProcess( } /* - * Duplicate all the handles which will be passed off as stdin, stdout - * and stderr of the child process. The duplicate handles are set to - * be inheritable, so the child process can use them. + * Duplicate all the handles which will be passed off as stdin, stdout and + * stderr of the child process. The duplicate handles are set to be + * inheritable, so the child process can use them. */ if (inputHandle == INVALID_HANDLE_VALUE) { - /* - * If handle was not set, stdin should return immediate EOF. - * Under Windows95, some applications (both 16 and 32 bit!) - * cannot read from the NUL device; they read from console - * instead. When running tk, this is fatal because the child - * process would hang forever waiting for EOF from the unmapped - * console window used by the helper application. + /* + * If handle was not set, stdin should return immediate EOF. Under + * Windows95, some applications (both 16 and 32 bit!) cannot read from + * the NUL device; they read from console instead. When running tk, + * this is fatal because the child process would hang forever waiting + * for EOF from the unmapped console window used by the helper + * application. * - * Fortunately, the helper application detects a closed pipe - * as an immediate EOF and can pass that information to the - * child process. + * Fortunately, the helper application detects a closed pipe as an + * immediate EOF and can pass that information to the child process. */ if (CreatePipe(&startInfo.hStdInput, &h, &secAtts, 0) != FALSE) { @@ -1047,21 +1044,20 @@ TclpCreateProcess( if (outputHandle == INVALID_HANDLE_VALUE) { /* - * If handle was not set, output should be sent to an infinitely - * deep sink. Under Windows 95, some 16 bit applications cannot - * have stdout redirected to NUL; they send their output to - * the console instead. Some applications, like "more" or "dir /p", - * when outputting multiple pages to the console, also then try and - * read from the console to go the next page. When running tk, this - * is fatal because the child process would hang forever waiting - * for input from the unmapped console window used by the helper - * application. + * If handle was not set, output should be sent to an infinitely deep + * sink. Under Windows 95, some 16 bit applications cannot have stdout + * redirected to NUL; they send their output to the console instead. + * Some applications, like "more" or "dir /p", when outputting + * multiple pages to the console, also then try and read from the + * console to go the next page. When running tk, this is fatal because + * the child process would hang forever waiting for input from the + * unmapped console window used by the helper application. * - * Fortunately, the helper application will detect a closed pipe - * as a sink. + * Fortunately, the helper application will detect a closed pipe as a + * sink. */ - if ((TclWinGetPlatformId() == VER_PLATFORM_WIN32_WINDOWS) + if ((TclWinGetPlatformId() == VER_PLATFORM_WIN32_WINDOWS) && (applType == APPL_DOS)) { if (CreatePipe(&h, &startInfo.hStdOutput, &secAtts, 0) != FALSE) { CloseHandle(h); @@ -1071,8 +1067,8 @@ TclpCreateProcess( &secAtts, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, NULL); } } else { - DuplicateHandle(hProcess, outputHandle, hProcess, &startInfo.hStdOutput, - 0, TRUE, DUPLICATE_SAME_ACCESS); + DuplicateHandle(hProcess, outputHandle, hProcess, + &startInfo.hStdOutput, 0, TRUE, DUPLICATE_SAME_ACCESS); } if (startInfo.hStdOutput == INVALID_HANDLE_VALUE) { TclWinConvertError(GetLastError()); @@ -1083,35 +1079,34 @@ TclpCreateProcess( if (errorHandle == INVALID_HANDLE_VALUE) { /* - * If handle was not set, errors should be sent to an infinitely - * deep sink. + * If handle was not set, errors should be sent to an infinitely deep + * sink. */ startInfo.hStdError = CreateFileA("NUL:", GENERIC_WRITE, 0, &secAtts, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL); } else { - DuplicateHandle(hProcess, errorHandle, hProcess, &startInfo.hStdError, + DuplicateHandle(hProcess, errorHandle, hProcess, &startInfo.hStdError, 0, TRUE, DUPLICATE_SAME_ACCESS); - } + } if (startInfo.hStdError == INVALID_HANDLE_VALUE) { TclWinConvertError(GetLastError()); Tcl_AppendResult(interp, "couldn't duplicate error handle: ", Tcl_PosixError(interp), (char *) NULL); goto end; } - /* - * If we do not have a console window, then we must run DOS and - * WIN32 console mode applications as detached processes. This tells - * the loader that the child application should not inherit the - * console, and that it should not create a new console window for - * the child application. The child application should get its stdio - * from the redirection handles provided by this application, and run - * in the background. + + /* + * If we do not have a console window, then we must run DOS and WIN32 + * console mode applications as detached processes. This tells the loader + * that the child application should not inherit the console, and that it + * should not create a new console window for the child application. The + * child application should get its stdio from the redirection handles + * provided by this application, and run in the background. * - * If we are starting a GUI process, they don't automatically get a + * If we are starting a GUI process, they don't automatically get a * console, so it doesn't matter if they are started as foreground or - * detached processes. The GUI window will still pop up to the - * foreground. + * detached processes. The GUI window will still pop up to the foreground. */ if (TclWinGetPlatformId() == VER_PLATFORM_WIN32_NT) { @@ -1119,11 +1114,11 @@ TclpCreateProcess( createFlags = 0; } else if (applType == APPL_DOS) { /* - * Under NT, 16-bit DOS applications will not run unless they - * can be attached to a console. If we are running without a - * console, run the 16-bit program as an normal process inside - * of a hidden console application, and then run that hidden - * console as a detached process. + * Under NT, 16-bit DOS applications will not run unless they can + * be attached to a console. If we are running without a console, + * run the 16-bit program as an normal process inside of a hidden + * console application, and then run that hidden console as a + * detached process. */ startInfo.wShowWindow = SW_HIDE; @@ -1132,42 +1127,46 @@ TclpCreateProcess( Tcl_DStringAppend(&cmdLine, "cmd.exe /c", -1); } else { createFlags = DETACHED_PROCESS; - } + } } else { if (HasConsole()) { createFlags = 0; } else { createFlags = DETACHED_PROCESS; } - + if (applType == APPL_DOS) { /* - * Under Windows 95, 16-bit DOS applications do not work well - * with pipes: + * Under Windows 95, 16-bit DOS applications do not work well with + * pipes: * - * 1. EOF on a pipe between a detached 16-bit DOS application - * and another application is not seen at the other - * end of the pipe, so the listening process blocks forever on - * reads. This inablity to detect EOF happens when either a - * 16-bit app or the 32-bit app is the listener. + * 1. EOF on a pipe between a detached 16-bit DOS application and + * another application is not seen at the other end of the pipe, + * so the listening process blocks forever on reads. This inablity + * to detect EOF happens when either a 16-bit app or the 32-bit + * app is the listener. * - * 2. If a 16-bit DOS application (detached or not) blocks when + * 2. If a 16-bit DOS application (detached or not) blocks when * writing to a pipe, it will never wake up again, and it * eventually brings the whole system down around it. * - * The 16-bit application is run as a normal process inside - * of a hidden helper console app, and this helper may be run - * as a detached process. If any of the stdio handles is - * a pipe, the helper application accumulates information - * into temp files and forwards it to or from the DOS - * application as appropriate. This means that DOS apps - * must receive EOF from a stdin pipe before they will actually - * begin, and must finish generating stdout or stderr before - * the data will be sent to the next stage of the pipe. + * The 16-bit application is run as a normal process inside of a + * hidden helper console app, and this helper may be run as a + * detached process. If any of the stdio handles is a pipe, the + * helper application accumulates information into temp files and + * forwards it to or from the DOS application as appropriate. + * This means that DOS apps must receive EOF from a stdin pipe + * before they will actually begin, and must finish generating + * stdout or stderr before the data will be sent to the next stage + * of the pipe. * - * The helper app should be located in the same directory as - * the tcl dll. + * The helper app should be located in the same directory as the + * tcl dll. */ + Tcl_Obj *tclExePtr, *pipeDllPtr; + char *start, *end; + int i, fileExists; + Tcl_DString pipeDll; if (createFlags != 0) { startInfo.wShowWindow = SW_HIDE; @@ -1175,63 +1174,69 @@ TclpCreateProcess( createFlags = CREATE_NEW_CONSOLE; } - { - Tcl_Obj *tclExePtr, *pipeDllPtr; - int i, fileExists; - char *start,*end; - Tcl_DString pipeDll; - Tcl_DStringInit(&pipeDll); - Tcl_DStringAppend(&pipeDll, TCL_PIPE_DLL, -1); - tclExePtr = Tcl_NewStringObj(TclpFindExecutable(""), -1); - start = Tcl_GetStringFromObj(tclExePtr, &i); - for (end = start + (i-1); end > start; end--) { - if (*end == '/') - break; - } - if (*end != '/') - panic("no / in executable path name"); - i = (end - start) + 1; - pipeDllPtr = Tcl_NewStringObj(start, i); - Tcl_AppendToObj(pipeDllPtr, Tcl_DStringValue(&pipeDll), -1); - Tcl_IncrRefCount(pipeDllPtr); - if (Tcl_FSConvertToPathType(interp, pipeDllPtr) != TCL_OK) - panic("Tcl_FSConvertToPathType failed"); - fileExists = (Tcl_FSAccess(pipeDllPtr, F_OK) == 0); - if (!fileExists) { - panic("Tcl pipe dll \"%s\" not found", - Tcl_DStringValue(&pipeDll)); + Tcl_DStringInit(&pipeDll); + Tcl_DStringAppend(&pipeDll, TCL_PIPE_DLL, -1); + tclExePtr = TclGetObjNameOfExecutable(); + Tcl_IncrRefCount(tclExePtr); + start = Tcl_GetStringFromObj(tclExePtr, &i); + for (end = start + (i-1); end > start; end--) { + if (*end == '/') { + break; } - Tcl_DStringAppend(&cmdLine, Tcl_DStringValue(&pipeDll), -1); + } + if (*end != '/') { + Tcl_AppendResult(interp, "no / in executable path name \"", + start, "\"", (char *) NULL); + Tcl_DecrRefCount(tclExePtr); + Tcl_DStringFree(&pipeDll); + goto end; + } + i = (end - start) + 1; + pipeDllPtr = Tcl_NewStringObj(start, i); + Tcl_AppendToObj(pipeDllPtr, Tcl_DStringValue(&pipeDll), -1); + Tcl_IncrRefCount(pipeDllPtr); + if (Tcl_FSConvertToPathType(interp, pipeDllPtr) != TCL_OK) { + Tcl_Panic("Tcl_FSConvertToPathType failed"); + } + fileExists = (Tcl_FSAccess(pipeDllPtr, F_OK) == 0); + if (!fileExists) { + Tcl_AppendResult(interp, "Tcl pipe dll \"", + Tcl_DStringValue(&pipeDll), "\" not found", + (char *) NULL); Tcl_DecrRefCount(tclExePtr); Tcl_DecrRefCount(pipeDllPtr); Tcl_DStringFree(&pipeDll); + goto end; } + Tcl_DStringAppend(&cmdLine, Tcl_DStringValue(&pipeDll), -1); + Tcl_DecrRefCount(tclExePtr); + Tcl_DecrRefCount(pipeDllPtr); + Tcl_DStringFree(&pipeDll); } } - + /* * cmdLine gets the full command line used to invoke the executable, - * including the name of the executable itself. The command line - * arguments in argv[] are stored in cmdLine separated by spaces. - * Special characters in individual arguments from argv[] must be - * quoted when being stored in cmdLine. + * including the name of the executable itself. The command line arguments + * in argv[] are stored in cmdLine separated by spaces. Special characters + * in individual arguments from argv[] must be quoted when being stored in + * cmdLine. * - * When calling any application, bear in mind that arguments that - * specify a path name are not converted. If an argument contains - * forward slashes as path separators, it may or may not be - * recognized as a path name, depending on the program. In general, - * most applications accept forward slashes only as option - * delimiters and backslashes only as paths. + * When calling any application, bear in mind that arguments that specify + * a path name are not converted. If an argument contains forward slashes + * as path separators, it may or may not be recognized as a path name, + * depending on the program. In general, most applications accept forward + * slashes only as option delimiters and backslashes only as paths. * - * Additionally, when calling a 16-bit dos or windows application, - * all path names must use the short, cryptic, path format (e.g., - * using ab~1.def instead of "a b.default"). + * Additionally, when calling a 16-bit dos or windows application, all + * path names must use the short, cryptic, path format (e.g., using + * ab~1.def instead of "a b.default"). */ BuildCommandLine(execPath, argc, argv, &cmdLine); - if ((*tclWinProcs->createProcessProc)(NULL, - (TCHAR *) Tcl_DStringValue(&cmdLine), NULL, NULL, TRUE, + if ((*tclWinProcs->createProcessProc)(NULL, + (TCHAR *) Tcl_DStringValue(&cmdLine), NULL, NULL, TRUE, (DWORD) createFlags, NULL, NULL, &startInfo, &procInfo) == 0) { TclWinConvertError(GetLastError()); Tcl_AppendResult(interp, "couldn't execute \"", argv[0], @@ -1240,21 +1245,20 @@ TclpCreateProcess( } /* - * This wait is used to force the OS to give some time to the DOS - * process. + * This wait is used to force the OS to give some time to the DOS process. */ if (applType == APPL_DOS) { WaitForSingleObject(procInfo.hProcess, 50); } - /* - * "When an application spawns a process repeatedly, a new thread - * instance will be created for each process but the previous - * instances may not be cleaned up. This results in a significant - * virtual memory loss each time the process is spawned. If there - * is a WaitForInputIdle() call between CreateProcess() and - * CloseHandle(), the problem does not occur." PSS ID Number: Q124121 + /* + * "When an application spawns a process repeatedly, a new thread instance + * will be created for each process but the previous instances may not be + * cleaned up. This results in a significant virtual memory loss each time + * the process is spawned. If there is a WaitForInputIdle() call between + * CreateProcess() and CloseHandle(), the problem does not occur." PSS ID + * Number: Q124121 */ WaitForInputIdle(procInfo.hProcess, 5000); @@ -1266,13 +1270,13 @@ TclpCreateProcess( } result = TCL_OK; - end: + end: Tcl_DStringFree(&cmdLine); if (startInfo.hStdInput != INVALID_HANDLE_VALUE) { - CloseHandle(startInfo.hStdInput); + CloseHandle(startInfo.hStdInput); } if (startInfo.hStdOutput != INVALID_HANDLE_VALUE) { - CloseHandle(startInfo.hStdOutput); + CloseHandle(startInfo.hStdOutput); } if (startInfo.hStdError != INVALID_HANDLE_VALUE) { CloseHandle(startInfo.hStdError); @@ -1286,8 +1290,7 @@ TclpCreateProcess( * * HasConsole -- * - * Determines whether the current application is attached to a - * console. + * Determines whether the current application is attached to a console. * * Results: * Returns TRUE if this application has a console, else FALSE. @@ -1299,18 +1302,18 @@ TclpCreateProcess( */ static BOOL -HasConsole() +HasConsole(void) { HANDLE handle; - + handle = CreateFileA("CONOUT$", GENERIC_WRITE, FILE_SHARE_WRITE, NULL, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL); if (handle != INVALID_HANDLE_VALUE) { - CloseHandle(handle); + CloseHandle(handle); return TRUE; } else { - return FALSE; + return FALSE; } } @@ -1320,29 +1323,28 @@ HasConsole() * ApplicationType -- * * Search for the specified program and identify if it refers to a DOS, - * Windows 3.X, or Win32 program. Used to determine how to invoke - * a program, or if it can even be invoked. - * - * It is possible to almost positively identify DOS and Windows - * applications that contain the appropriate magic numbers. However, - * DOS .com files do not seem to contain a magic number; if the program - * name ends with .com and could not be identified as a Windows .com - * file, it will be assumed to be a DOS application, even if it was - * just random data. If the program name does not end with .com, no - * such assumption is made. - * - * The Win32 procedure GetBinaryType incorrectly identifies any - * junk file that ends with .exe as a dos executable and some - * executables that don't end with .exe as not executable. Plus it - * doesn't exist under win95, so I won't feel bad about reimplementing - * functionality. + * Windows 3.X, or Win32 program. Used to determine how to invoke a + * program, or if it can even be invoked. + * + * It is possible to almost positively identify DOS and Windows + * applications that contain the appropriate magic numbers. However, DOS + * .com files do not seem to contain a magic number; if the program name + * ends with .com and could not be identified as a Windows .com file, it + * will be assumed to be a DOS application, even if it was just random + * data. If the program name does not end with .com, no such assumption + * is made. + * + * The Win32 function GetBinaryType incorrectly identifies any junk file + * that ends with .exe as a dos executable and some executables that + * don't end with .exe as not executable. Plus it doesn't exist under + * win95, so I won't feel bad about reimplementing functionality. * * Results: - * The return value is one of APPL_DOS, APPL_WIN3X, or APPL_WIN32 - * if the filename referred to the corresponding application type. - * If the file name could not be found or did not refer to any known - * application type, APPL_NONE is returned and an error message is - * left in interp. .bat files are identified as APPL_DOS. + * The return value is one of APPL_DOS, APPL_WIN3X, or APPL_WIN32 if the + * filename referred to the corresponding application type. If the file + * name could not be found or did not refer to any known application + * type, APPL_NONE is returned and an error message is left in interp. + * .bat files are identified as APPL_DOS. * * Side effects: * None. @@ -1351,10 +1353,10 @@ HasConsole() */ static int -ApplicationType(interp, originalName, fullName) - Tcl_Interp *interp; /* Interp, for error message. */ - const char *originalName; /* Name of the application to find. */ - char fullName[]; /* Filled with complete path to +ApplicationType( + Tcl_Interp *interp, /* Interp, for error message. */ + const char *originalName, /* Name of the application to find. */ + char fullName[]) /* Filled with complete path to * application. */ { int applType, i, nameLen, found; @@ -1365,21 +1367,21 @@ ApplicationType(interp, originalName, fullName) DWORD attr, read; IMAGE_DOS_HEADER header; Tcl_DString nameBuf, ds; - CONST TCHAR *nativeName; + const TCHAR *nativeName; WCHAR nativeFullPath[MAX_PATH]; static char extensions[][5] = {"", ".com", ".exe", ".bat"}; - /* Look for the program as an external program. First try the name - * as it is, then try adding .com, .exe, and .bat, in that order, to - * the name, looking for an executable. + /* + * Look for the program as an external program. First try the name as it + * is, then try adding .com, .exe, and .bat, in that order, to the name, + * looking for an executable. * - * Using the raw SearchPath() procedure doesn't do quite what is - * necessary. If the name of the executable already contains a '.' - * character, it will not try appending the specified extension when - * searching (in other words, SearchPath will not find the program - * "a.b.exe" if the arguments specified "a.b" and ".exe"). - * So, first look for the file as it is named. Then manually append - * the extensions, looking for a match. + * Using the raw SearchPath() function doesn't do quite what is necessary. + * If the name of the executable already contains a '.' character, it will + * not try appending the specified extension when searching (in other + * words, SearchPath will not find the program "a.b.exe" if the arguments + * specified "a.b" and ".exe"). So, first look for the file as it is + * named. Then manually append the extensions, looking for a match. */ applType = APPL_NONE; @@ -1390,9 +1392,9 @@ ApplicationType(interp, originalName, fullName) for (i = 0; i < (int) (sizeof(extensions) / sizeof(extensions[0])); i++) { Tcl_DStringSetLength(&nameBuf, nameLen); Tcl_DStringAppend(&nameBuf, extensions[i], -1); - nativeName = Tcl_WinUtfToTChar(Tcl_DStringValue(&nameBuf), + nativeName = Tcl_WinUtfToTChar(Tcl_DStringValue(&nameBuf), Tcl_DStringLength(&nameBuf), &ds); - found = (*tclWinProcs->searchPathProc)(NULL, nativeName, NULL, + found = (*tclWinProcs->searchPathProc)(NULL, nativeName, NULL, MAX_PATH, nativeFullPath, &rest); Tcl_DStringFree(&ds); if (found == 0) { @@ -1400,8 +1402,8 @@ ApplicationType(interp, originalName, fullName) } /* - * Ignore matches on directories or data files, return if identified - * a known type. + * Ignore matches on directories or data files, return if identified a + * known type. */ attr = (*tclWinProcs->getFileAttributesProc)((TCHAR *) nativeFullPath); @@ -1412,13 +1414,13 @@ ApplicationType(interp, originalName, fullName) Tcl_DStringFree(&ds); ext = strrchr(fullName, '.'); - if ((ext != NULL) && (stricmp(ext, ".bat") == 0)) { + if ((ext != NULL) && (strcasecmp(ext, ".bat") == 0)) { applType = APPL_DOS; break; } - - hFile = (*tclWinProcs->createFileProc)((TCHAR *) nativeFullPath, - GENERIC_READ, FILE_SHARE_READ, NULL, OPEN_EXISTING, + + hFile = (*tclWinProcs->createFileProc)((TCHAR *) nativeFullPath, + GENERIC_READ, FILE_SHARE_READ, NULL, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL); if (hFile == INVALID_HANDLE_VALUE) { continue; @@ -1427,25 +1429,25 @@ ApplicationType(interp, originalName, fullName) header.e_magic = 0; ReadFile(hFile, (void *) &header, sizeof(header), &read, NULL); if (header.e_magic != IMAGE_DOS_SIGNATURE) { - /* - * Doesn't have the magic number for relocatable executables. If + /* + * Doesn't have the magic number for relocatable executables. If * filename ends with .com, assume it's a DOS application anyhow. * Note that we didn't make this assumption at first, because some * supposed .com files are really 32-bit executables with all the - * magic numbers and everything. + * magic numbers and everything. */ CloseHandle(hFile); - if ((ext != NULL) && (stricmp(ext, ".com") == 0)) { + if ((ext != NULL) && (strcasecmp(ext, ".com") == 0)) { applType = APPL_DOS; break; } continue; } if (header.e_lfarlc != sizeof(header)) { - /* + /* * All Windows 3.X and Win32 and some DOS programs have this value - * set here. If it doesn't, assume that since it already had the + * set here. If it doesn't, assume that since it already had the * other magic number it was a DOS application. */ @@ -1454,7 +1456,7 @@ ApplicationType(interp, originalName, fullName) break; } - /* + /* * The DWORD at header.e_lfanew points to yet another magic number. */ @@ -1469,11 +1471,11 @@ ApplicationType(interp, originalName, fullName) applType = APPL_WIN32; } else { /* - * Strictly speaking, there should be a test that there - * is an 'L' and 'E' at buf[0..1], to identify the type as - * DOS, but of course we ran into a DOS executable that - * _doesn't_ have the magic number -- specifically, one - * compiled using the Lahey Fortran90 compiler. + * Strictly speaking, there should be a test that there is an 'L' + * and 'E' at buf[0..1], to identify the type as DOS, but of + * course we ran into a DOS executable that _doesn't_ have the + * magic number - specifically, one compiled using the Lahey + * Fortran90 compiler. */ applType = APPL_DOS; @@ -1490,14 +1492,14 @@ ApplicationType(interp, originalName, fullName) } if ((applType == APPL_DOS) || (applType == APPL_WIN3X)) { - /* - * Replace long path name of executable with short path name for - * 16-bit applications. Otherwise the application may not be able - * to correctly parse its own command line to separate off the + /* + * Replace long path name of executable with short path name for + * 16-bit applications. Otherwise the application may not be able to + * correctly parse its own command line to separate off the * application name from the arguments. */ - (*tclWinProcs->getShortPathNameProc)((TCHAR *) nativeFullPath, + (*tclWinProcs->getShortPathNameProc)((TCHAR *) nativeFullPath, nativeFullPath, MAX_PATH); strcpy(fullName, Tcl_WinTCharToUtf((TCHAR *) nativeFullPath, -1, &ds)); Tcl_DStringFree(&ds); @@ -1505,15 +1507,15 @@ ApplicationType(interp, originalName, fullName) return applType; } -/* +/* *---------------------------------------------------------------------- * * BuildCommandLine -- * - * The command line arguments are stored in linePtr separated - * by spaces, in a form that CreateProcess() understands. Special - * characters in individual arguments from argv[] must be quoted - * when being stored in cmdLine. + * The command line arguments are stored in linePtr separated by spaces, + * in a form that CreateProcess() understands. Special characters in + * individual arguments from argv[] must be quoted when being stored in + * cmdLine. * * Results: * None. @@ -1526,26 +1528,27 @@ ApplicationType(interp, originalName, fullName) static void BuildCommandLine( - CONST char *executable, /* Full path of executable (including - * extension). Replacement for argv[0]. */ + const char *executable, /* Full path of executable (including + * extension). Replacement for argv[0]. */ int argc, /* Number of arguments. */ - CONST char **argv, /* Argument strings in UTF. */ + const char **argv, /* Argument strings in UTF. */ Tcl_DString *linePtr) /* Initialized Tcl_DString that receives the * command line (TCHAR). */ { - CONST char *arg, *start, *special; + const char *arg, *start, *special; int quote, i; Tcl_DString ds; Tcl_DStringInit(&ds); /* - * Prime the path. Add a space separator if we were primed with - * something. + * Prime the path. Add a space separator if we were primed with something. */ Tcl_DStringAppend(&ds, Tcl_DStringValue(linePtr), -1); - if (Tcl_DStringLength(&ds) > 0) Tcl_DStringAppend(&ds, " ", 1); + if (Tcl_DStringLength(linePtr) > 0) { + Tcl_DStringAppend(&ds, " ", 1); + } for (i = 0; i < argc; i++) { if (i == 0) { @@ -1562,8 +1565,8 @@ BuildCommandLine( int count; Tcl_UniChar ch; for (start = arg; *start != '\0'; start += count) { - count = Tcl_UtfToUniChar(start, &ch); - if (Tcl_UniCharIsSpace(ch)) { /* INTL: ISO space. */ + count = Tcl_UtfToUniChar(start, &ch); + if (Tcl_UniCharIsSpace(ch)) { /* INTL: ISO space. */ quote = 1; break; } @@ -1572,18 +1575,18 @@ BuildCommandLine( if (quote) { Tcl_DStringAppend(&ds, "\"", 1); } - start = arg; + start = arg; for (special = arg; ; ) { - if ((*special == '\\') && - (special[1] == '\\' || special[1] == '"' || (quote && special[1] == '\0'))) { + if ((*special == '\\') && (special[1] == '\\' || + special[1] == '"' || (quote && special[1] == '\0'))) { Tcl_DStringAppend(&ds, start, (int) (special - start)); start = special; while (1) { special++; if (*special == '"' || (quote && *special == '\0')) { - /* - * N backslashes followed a quote -> insert - * N * 2 + 1 backslashes then a quote. + /* + * N backslashes followed a quote -> insert N * 2 + 1 + * backslashes then a quote. */ Tcl_DStringAppend(&ds, start, @@ -1622,9 +1625,8 @@ BuildCommandLine( * * TclpCreateCommandChannel -- * - * This function is called by Tcl_OpenCommandChannel to perform - * the platform specific channel initialization for a command - * channel. + * This function is called by Tcl_OpenCommandChannel to perform the + * platform specific channel initialization for a command channel. * * Results: * Returns a new channel or NULL on failure. @@ -1677,8 +1679,8 @@ TclpCreateCommandChannel( infoPtr->stopReader = CreateEvent(NULL, TRUE, FALSE, NULL); infoPtr->readThread = CreateThread(NULL, 256, PipeReaderThread, infoPtr, 0, &id); - SetThreadPriority(infoPtr->readThread, THREAD_PRIORITY_HIGHEST); - infoPtr->validMask |= TCL_READABLE; + SetThreadPriority(infoPtr->readThread, THREAD_PRIORITY_HIGHEST); + infoPtr->validMask |= TCL_READABLE; } else { infoPtr->readThread = 0; } @@ -1692,26 +1694,25 @@ TclpCreateCommandChannel( infoPtr->stopWriter = CreateEvent(NULL, TRUE, FALSE, NULL); infoPtr->writeThread = CreateThread(NULL, 256, PipeWriterThread, infoPtr, 0, &id); - SetThreadPriority(infoPtr->readThread, THREAD_PRIORITY_HIGHEST); - infoPtr->validMask |= TCL_WRITABLE; + SetThreadPriority(infoPtr->readThread, THREAD_PRIORITY_HIGHEST); + infoPtr->validMask |= TCL_WRITABLE; } /* - * For backward compatibility with previous versions of Tcl, we - * use "file%d" as the base name for pipes even though it would - * be more natural to use "pipe%d". - * Use the pointer to keep the channel names unique, in case - * channels share handles (stdin/stdout). + * For backward compatibility with previous versions of Tcl, we use + * "file%d" as the base name for pipes even though it would be more + * natural to use "pipe%d". Use the pointer to keep the channel names + * unique, in case channels share handles (stdin/stdout). */ wsprintfA(channelName, "file%lx", infoPtr); infoPtr->channel = Tcl_CreateChannel(&pipeChannelType, channelName, - (ClientData) infoPtr, infoPtr->validMask); + (ClientData) infoPtr, infoPtr->validMask); /* * Pipes have AUTO translation mode on Windows and ^Z eof char, which - * means that a ^Z will be appended to them at close. This is needed - * for Windows programs that expect a ^Z at EOF. + * means that a ^Z will be appended to them at close. This is needed for + * Windows programs that expect a ^Z at EOF. */ Tcl_SetChannelOption((Tcl_Interp *) NULL, infoPtr->channel, @@ -1726,8 +1727,8 @@ TclpCreateCommandChannel( * * TclGetAndDetachPids -- * - * Stores a list of the command PIDs for a command channel in - * the interp's result. + * Stores a list of the command PIDs for a command channel in the + * interp's result. * * Results: * None. @@ -1744,7 +1745,7 @@ TclGetAndDetachPids( Tcl_Channel chan) { PipeInfo *pipePtr; - Tcl_ChannelType *chanTypePtr; + const Tcl_ChannelType *chanTypePtr; int i; char buf[TCL_INTEGER_SPACE]; @@ -1754,18 +1755,18 @@ TclGetAndDetachPids( chanTypePtr = Tcl_GetChannelType(chan); if (chanTypePtr != &pipeChannelType) { - return; + return; } pipePtr = (PipeInfo *) Tcl_GetChannelInstanceData(chan); for (i = 0; i < pipePtr->numPids; i++) { - wsprintfA(buf, "%lu", TclpGetPid(pipePtr->pidPtr[i])); - Tcl_AppendElement(interp, buf); - Tcl_DetachPids(1, &(pipePtr->pidPtr[i])); + wsprintfA(buf, "%lu", TclpGetPid(pipePtr->pidPtr[i])); + Tcl_AppendElement(interp, buf); + Tcl_DetachPids(1, &(pipePtr->pidPtr[i])); } if (pipePtr->numPids > 0) { - ckfree((char *) pipePtr->pidPtr); - pipePtr->numPids = 0; + ckfree((char *) pipePtr->pidPtr); + pipePtr->numPids = 0; } } @@ -1789,10 +1790,10 @@ static int PipeBlockModeProc( ClientData instanceData, /* Instance data for channel. */ int mode) /* TCL_MODE_BLOCKING or - * TCL_MODE_NONBLOCKING. */ + * TCL_MODE_NONBLOCKING. */ { PipeInfo *infoPtr = (PipeInfo *) instanceData; - + /* * Pipes on Windows can not be switched between blocking and nonblocking, * hence we have to emulate the behavior. This is done in the input @@ -1838,18 +1839,19 @@ PipeClose2Proc( DWORD exitCode; errorCode = 0; - if ((!flags || (flags == TCL_CLOSE_READ)) - && (pipePtr->readFile != NULL)) { + result = 0; + + if ((!flags || flags == TCL_CLOSE_READ) && (pipePtr->readFile != NULL)) { /* - * Clean up the background thread if necessary. Note that this - * must be done before we can close the file, since the - * thread may be blocking trying to read from the pipe. + * Clean up the background thread if necessary. Note that this must be + * done before we can close the file, since the thread may be blocking + * trying to read from the pipe. */ if (pipePtr->readThread) { /* - * The thread may already have closed on it's own. Check it's - * exit code. + * The thread may already have closed on its own. Check its exit + * code. */ GetExitCodeThread(pipePtr->readThread, &exitCode); @@ -1864,19 +1866,20 @@ PipeClose2Proc( SetEvent(pipePtr->stopReader); /* - * Wait at most 20 milliseconds for the reader thread to close. + * Wait at most 20 milliseconds for the reader thread to + * close. */ - if (WaitForSingleObject(pipePtr->readThread, 20) - == WAIT_TIMEOUT) { + if (WaitForSingleObject(pipePtr->readThread, + 20) == WAIT_TIMEOUT) { /* * The thread must be blocked waiting for the pipe to - * become readable in ReadFile(). There isn't a clean way - * to exit the thread from this condition. We should + * become readable in ReadFile(). There isn't a clean way + * to exit the thread from this condition. We should * terminate the child process instead to get the reader - * thread to fall out of ReadFile with a FALSE. (below) is - * not the correct way to do this, but will stay here until - * a better solution is found. + * thread to fall out of ReadFile with a FALSE. (below) is + * not the correct way to do this, but will stay here + * until a better solution is found. * * Note that we need to guard against terminating the * thread while it is in the middle of Tcl_ThreadAlert @@ -1903,22 +1906,20 @@ PipeClose2Proc( pipePtr->validMask &= ~TCL_READABLE; pipePtr->readFile = NULL; } - if ((!flags || (flags & TCL_CLOSE_WRITE)) - && (pipePtr->writeFile != NULL)) { - + if ((!flags || flags & TCL_CLOSE_WRITE) + && (pipePtr->writeFile != NULL)) { if (pipePtr->writeThread) { /* - * Wait for the writer thread to finish the current buffer, - * then terminate the thread and close the handles. If the - * channel is nonblocking, there should be no pending write - * operations. + * Wait for the writer thread to finish the current buffer, then + * terminate the thread and close the handles. If the channel is + * nonblocking, there should be no pending write operations. */ WaitForSingleObject(pipePtr->writable, INFINITE); /* - * The thread may already have closed on it's own. Check it's - * exit code. + * The thread may already have closed on it's own. Check its exit + * code. */ GetExitCodeThread(pipePtr->writeThread, &exitCode); @@ -1933,19 +1934,20 @@ PipeClose2Proc( SetEvent(pipePtr->stopWriter); /* - * Wait at most 20 milliseconds for the reader thread to close. + * Wait at most 20 milliseconds for the reader thread to + * close. */ - if (WaitForSingleObject(pipePtr->writeThread, 20) - == WAIT_TIMEOUT) { + if (WaitForSingleObject(pipePtr->writeThread, + 20) == WAIT_TIMEOUT) { /* * The thread must be blocked waiting for the pipe to - * consume input in WriteFile(). There isn't a clean way - * to exit the thread from this condition. We should + * consume input in WriteFile(). There isn't a clean way + * to exit the thread from this condition. We should * terminate the child process instead to get the writer - * thread to fall out of WriteFile with a FALSE. (below) is - * not the correct way to do this, but will stay here until - * a better solution is found. + * thread to fall out of WriteFile with a FALSE. (below) + * is not the correct way to do this, but will stay here + * until a better solution is found. * * Note that we need to guard against terminating the * thread while it is in the middle of Tcl_ThreadAlert @@ -1990,8 +1992,8 @@ PipeClose2Proc( */ for (nextPtrPtr = &(tsdPtr->firstPipePtr), infoPtr = *nextPtrPtr; - infoPtr != NULL; - nextPtrPtr = &infoPtr->nextPtr, infoPtr = *nextPtrPtr) { + infoPtr != NULL; + nextPtrPtr = &infoPtr->nextPtr, infoPtr = *nextPtrPtr) { if (infoPtr == (PipeInfo *)pipePtr) { *nextPtrPtr = infoPtr->nextPtr; break; @@ -2000,9 +2002,9 @@ PipeClose2Proc( if ((pipePtr->flags & PIPE_ASYNC) || TclInExit()) { /* - * If the channel is non-blocking or Tcl is being cleaned up, - * just detach the children PIDs, reap them (important if we are - * in a dynamic load module), and discard the errorFile. + * If the channel is non-blocking or Tcl is being cleaned up, just + * detach the children PIDs, reap them (important if we are in a + * dynamic load module), and discard the errorFile. */ Tcl_DetachPids(pipePtr->numPids, pipePtr->pidPtr); @@ -2010,7 +2012,7 @@ PipeClose2Proc( if (pipePtr->errorFile) { if (TclpCloseFile(pipePtr->errorFile) != 0) { - if ( errorCode == 0 ) { + if (errorCode == 0) { errorCode = errno; } } @@ -2027,18 +2029,18 @@ PipeClose2Proc( filePtr = (WinFile*)pipePtr->errorFile; errChan = Tcl_MakeFileChannel((ClientData) filePtr->handle, - TCL_READABLE); + TCL_READABLE); ckfree((char *) filePtr); } else { errChan = NULL; } result = TclCleanupChildren(interp, pipePtr->numPids, - pipePtr->pidPtr, errChan); + pipePtr->pidPtr, errChan); } if (pipePtr->numPids > 0) { - ckfree((char *) pipePtr->pidPtr); + ckfree((char *) pipePtr->pidPtr); } if (pipePtr->writeBuf != NULL) { @@ -2048,7 +2050,7 @@ PipeClose2Proc( ckfree((char*) pipePtr); if (errorCode == 0) { - return result; + return result; } return errorCode; } @@ -2058,8 +2060,8 @@ PipeClose2Proc( * * PipeInputProc -- * - * Reads input from the IO channel into the buffer given. Returns - * count of how many bytes were actually read, and an error indication. + * Reads input from the IO channel into the buffer given. Returns count + * of how many bytes were actually read, and an error indication. * * Results: * A count of how many bytes were read is returned and an error @@ -2073,11 +2075,11 @@ PipeClose2Proc( static int PipeInputProc( - ClientData instanceData, /* Pipe state. */ - char *buf, /* Where to store data read. */ - int bufSize, /* How much space is available - * in the buffer? */ - int *errorCode) /* Where to store error code. */ + ClientData instanceData, /* Pipe state. */ + char *buf, /* Where to store data read. */ + int bufSize, /* How much space is available in the + * buffer? */ + int *errorCode) /* Where to store error code. */ { PipeInfo *infoPtr = (PipeInfo *) instanceData; WinFile *filePtr = (WinFile*) infoPtr->readFile; @@ -2102,8 +2104,8 @@ PipeInputProc( if (infoPtr->readFlags & PIPE_EXTRABYTE) { /* - * The reader thread consumed 1 byte as a side effect of - * waiting so we need to move it into the buffer. + * The reader thread consumed 1 byte as a side effect of waiting so we + * need to move it into the buffer. */ *buf = infoPtr->extraByte; @@ -2122,9 +2124,9 @@ PipeInputProc( } /* - * Attempt to read bufSize bytes. The read will return immediately - * if there is any data available. Otherwise it will block until - * at least one byte is available or an EOF occurs. + * Attempt to read bufSize bytes. The read will return immediately if + * there is any data available. Otherwise it will block until at least one + * byte is available or an EOF occurs. */ if (ReadFile(filePtr->handle, (LPVOID) buf, (DWORD) bufSize, &count, @@ -2152,12 +2154,12 @@ PipeInputProc( * * PipeOutputProc -- * - * Writes the given output on the IO channel. Returns count of how - * many characters were actually written, and an error indication. + * Writes the given output on the IO channel. Returns count of how many + * characters were actually written, and an error indication. * * Results: - * A count of how many characters were written is returned and an - * error indication is returned in an output argument. + * A count of how many characters were written is returned and an error + * indication is returned in an output argument. * * Side effects: * Writes output on the actual channel. @@ -2167,27 +2169,27 @@ PipeInputProc( static int PipeOutputProc( - ClientData instanceData, /* Pipe state. */ - CONST char *buf, /* The data buffer. */ - int toWrite, /* How many bytes to write? */ - int *errorCode) /* Where to store error code. */ + ClientData instanceData, /* Pipe state. */ + const char *buf, /* The data buffer. */ + int toWrite, /* How many bytes to write? */ + int *errorCode) /* Where to store error code. */ { PipeInfo *infoPtr = (PipeInfo *) instanceData; WinFile *filePtr = (WinFile*) infoPtr->writeFile; DWORD bytesWritten, timeout; - + *errorCode = 0; timeout = (infoPtr->flags & PIPE_ASYNC) ? 0 : INFINITE; if (WaitForSingleObject(infoPtr->writable, timeout) == WAIT_TIMEOUT) { /* - * The writer thread is blocked waiting for a write to complete - * and the channel is in non-blocking mode. + * The writer thread is blocked waiting for a write to complete and + * the channel is in non-blocking mode. */ errno = EAGAIN; goto error; } - + /* * Check for a background error on the last write. */ @@ -2200,8 +2202,8 @@ PipeOutputProc( if (infoPtr->flags & PIPE_ASYNC) { /* - * The pipe is non-blocking, so copy the data into the output - * buffer and restart the writer thread. + * The pipe is non-blocking, so copy the data into the output buffer + * and restart the writer thread. */ if (toWrite > infoPtr->writeBufLen) { @@ -2222,8 +2224,8 @@ PipeOutputProc( bytesWritten = toWrite; } else { /* - * In the blocking case, just try to write the buffer directly. - * This avoids an unnecessary copy. + * In the blocking case, just try to write the buffer directly. This + * avoids an unnecessary copy. */ if (WriteFile(filePtr->handle, (LPVOID) buf, (DWORD) toWrite, @@ -2234,7 +2236,7 @@ PipeOutputProc( } return bytesWritten; - error: + error: *errorCode = errno; return -1; @@ -2245,15 +2247,15 @@ PipeOutputProc( * * PipeEventProc -- * - * This function is invoked by Tcl_ServiceEvent when a file event - * reaches the front of the event queue. This procedure invokes - * Tcl_NotifyChannel on the pipe. + * This function is invoked by Tcl_ServiceEvent when a file event reaches + * the front of the event queue. This function invokes Tcl_NotifyChannel + * on the pipe. * * Results: - * Returns 1 if the event was handled, meaning it should be removed - * from the queue. Returns 0 if the event was not handled, meaning - * it should stay on the queue. The only time the event isn't - * handled is if the TCL_FILE_EVENTS flag bit isn't set. + * Returns 1 if the event was handled, meaning it should be removed from + * the queue. Returns 0 if the event was not handled, meaning it should + * stay on the queue. The only time the event isn't handled is if the + * TCL_FILE_EVENTS flag bit isn't set. * * Side effects: * Whatever the notifier callback does. @@ -2278,9 +2280,9 @@ PipeEventProc( /* * Search through the list of watched pipes for the one whose handle - * matches the event. We do this rather than simply dereferencing - * the handle in the event so that pipes can be deleted while the - * event is in the queue. + * matches the event. We do this rather than simply dereferencing the + * handle in the event so that pipes can be deleted while the event is in + * the queue. */ for (infoPtr = tsdPtr->firstPipePtr; infoPtr != NULL; @@ -2300,9 +2302,9 @@ PipeEventProc( } /* - * Check to see if the pipe is readable. Note - * that we can't tell if a pipe is writable, so we always report it - * as being writable unless we have detected EOF. + * Check to see if the pipe is readable. Note that we can't tell if a pipe + * is writable, so we always report it as being writable unless we have + * detected EOF. */ mask = 0; @@ -2311,8 +2313,7 @@ PipeEventProc( mask = TCL_WRITABLE; } - if ((infoPtr->watchMask & TCL_READABLE) && - (WaitForRead(infoPtr, 0) >= 0)) { + if ((infoPtr->watchMask & TCL_READABLE) && (WaitForRead(infoPtr,0) >= 0)) { if (infoPtr->readFlags & PIPE_EOF) { mask = TCL_READABLE; } else { @@ -2333,8 +2334,7 @@ PipeEventProc( * * PipeWatchProc -- * - * Called by the notifier to set up to watch for events on this - * channel. + * Called by the notifier to set up to watch for events on this channel. * * Results: * None. @@ -2347,10 +2347,10 @@ PipeEventProc( static void PipeWatchProc( - ClientData instanceData, /* Pipe state. */ - int mask) /* What events to watch for, OR-ed - * combination of TCL_READABLE, - * TCL_WRITABLE and TCL_EXCEPTION. */ + ClientData instanceData, /* Pipe state. */ + int mask) /* What events to watch for, OR-ed combination + * of TCL_READABLE, TCL_WRITABLE and + * TCL_EXCEPTION. */ { PipeInfo **nextPtrPtr, *ptr; PipeInfo *infoPtr = (PipeInfo *) instanceData; @@ -2358,9 +2358,8 @@ PipeWatchProc( ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); /* - * Since most of the work is handled by the background threads, - * we just need to update the watchMask and then force the notifier - * to poll once. + * Since most of the work is handled by the background threads, we just + * need to update the watchMask and then force the notifier to poll once. */ infoPtr->watchMask = mask & infoPtr->validMask; @@ -2378,8 +2377,8 @@ PipeWatchProc( */ for (nextPtrPtr = &(tsdPtr->firstPipePtr), ptr = *nextPtrPtr; - ptr != NULL; - nextPtrPtr = &ptr->nextPtr, ptr = *nextPtrPtr) { + ptr != NULL; + nextPtrPtr = &ptr->nextPtr, ptr = *nextPtrPtr) { if (infoPtr == ptr) { *nextPtrPtr = ptr->nextPtr; break; @@ -2394,12 +2393,12 @@ PipeWatchProc( * * PipeGetHandleProc -- * - * Called from Tcl_GetChannelHandle to retrieve OS handles from - * inside a command pipeline based channel. + * Called from Tcl_GetChannelHandle to retrieve OS handles from inside a + * command pipeline based channel. * * Results: - * Returns TCL_OK with the fd in handlePtr, or TCL_ERROR if - * there is no handle for the specified direction. + * Returns TCL_OK with the fd in handlePtr, or TCL_ERROR if there is no + * handle for the specified direction. * * Side effects: * None. @@ -2414,7 +2413,7 @@ PipeGetHandleProc( ClientData *handlePtr) /* Where to store the handle. */ { PipeInfo *infoPtr = (PipeInfo *) instanceData; - WinFile *filePtr; + WinFile *filePtr; if (direction == TCL_READABLE && infoPtr->readFile) { filePtr = (WinFile*) infoPtr->readFile; @@ -2437,13 +2436,12 @@ PipeGetHandleProc( * Emulates the waitpid system call. * * Results: - * Returns 0 if the process is still alive, -1 on an error, or - * the pid on a clean close. + * Returns 0 if the process is still alive, -1 on an error, or the pid on + * a clean close. * * Side effects: - * Unless WNOHANG is set and the wait times out, the process - * information record will be deleted and the process handle - * will be closed. + * Unless WNOHANG is set and the wait times out, the process information + * record will be deleted and the process handle will be closed. * *---------------------------------------------------------------------- */ @@ -2464,7 +2462,7 @@ Tcl_WaitPid( /* * If no pid is specified, do nothing. */ - + if (pid == 0) { *statPtr = 0; return 0; @@ -2472,12 +2470,6 @@ Tcl_WaitPid( /* * Find the process and cut it from the process list. - * SF Tcl Bug 859820, Backport of its fix. - * SF Tcl Bug 1381436, asking for the backport. - * - * [x] Cutting the infoPtr after the closehandle allows the - * pointer to become stale. We do it here, and compensate if the - * process was not done yet. */ Tcl_MutexLock(&pipeMutex); @@ -2495,17 +2487,17 @@ Tcl_WaitPid( * If the pid is not one of the processes we know about (we started it) * then do nothing. */ - + if (infoPtr == NULL) { - *statPtr = 0; + *statPtr = 0; return 0; } /* - * Officially "wait" for it to finish. We either poll (WNOHANG) or - * wait for an infinite amount of time. + * Officially "wait" for it to finish. We either poll (WNOHANG) or wait + * for an infinite amount of time. */ - + if (options & WNOHANG) { flags = 0; } else { @@ -2516,9 +2508,9 @@ Tcl_WaitPid( *statPtr = 0; if (options & WNOHANG) { /* - * Re-insert the cut infoPtr back on the list. - * See [x] for explanation. + * Re-insert this infoPtr back on the list. */ + Tcl_MutexLock(&pipeMutex); infoPtr->nextPtr = procList; procList = infoPtr; @@ -2529,54 +2521,71 @@ Tcl_WaitPid( } } else if (ret == WAIT_OBJECT_0) { GetExitCodeProcess(infoPtr->hProcess, &exitCode); - if (exitCode & 0xC0000000) { - /* - * A fatal exception occured. - */ - switch (exitCode) { - case EXCEPTION_FLT_DENORMAL_OPERAND: - case EXCEPTION_FLT_DIVIDE_BY_ZERO: - case EXCEPTION_FLT_INEXACT_RESULT: - case EXCEPTION_FLT_INVALID_OPERATION: - case EXCEPTION_FLT_OVERFLOW: - case EXCEPTION_FLT_STACK_CHECK: - case EXCEPTION_FLT_UNDERFLOW: - case EXCEPTION_INT_DIVIDE_BY_ZERO: - case EXCEPTION_INT_OVERFLOW: - *statPtr = 0xC0000000 | SIGFPE; - break; - case EXCEPTION_PRIV_INSTRUCTION: - case EXCEPTION_ILLEGAL_INSTRUCTION: - *statPtr = 0xC0000000 | SIGILL; - break; + /* + * Does the exit code look like one of the exception codes? + */ - case EXCEPTION_ACCESS_VIOLATION: - case EXCEPTION_DATATYPE_MISALIGNMENT: - case EXCEPTION_ARRAY_BOUNDS_EXCEEDED: - case EXCEPTION_STACK_OVERFLOW: - case EXCEPTION_NONCONTINUABLE_EXCEPTION: - case EXCEPTION_INVALID_DISPOSITION: - case EXCEPTION_GUARD_PAGE: - case EXCEPTION_INVALID_HANDLE: - *statPtr = 0xC0000000 | SIGSEGV; - break; + switch (exitCode) { + case EXCEPTION_FLT_DENORMAL_OPERAND: + case EXCEPTION_FLT_DIVIDE_BY_ZERO: + case EXCEPTION_FLT_INEXACT_RESULT: + case EXCEPTION_FLT_INVALID_OPERATION: + case EXCEPTION_FLT_OVERFLOW: + case EXCEPTION_FLT_STACK_CHECK: + case EXCEPTION_FLT_UNDERFLOW: + case EXCEPTION_INT_DIVIDE_BY_ZERO: + case EXCEPTION_INT_OVERFLOW: + *statPtr = 0xC0000000 | SIGFPE; + break; - case CONTROL_C_EXIT: - *statPtr = 0xC0000000 | SIGINT; - break; + case EXCEPTION_PRIV_INSTRUCTION: + case EXCEPTION_ILLEGAL_INSTRUCTION: + *statPtr = 0xC0000000 | SIGILL; + break; + + case EXCEPTION_ACCESS_VIOLATION: + case EXCEPTION_ARRAY_BOUNDS_EXCEEDED: + case EXCEPTION_STACK_OVERFLOW: + case EXCEPTION_NONCONTINUABLE_EXCEPTION: + case EXCEPTION_INVALID_DISPOSITION: + case EXCEPTION_GUARD_PAGE: + case EXCEPTION_INVALID_HANDLE: + *statPtr = 0xC0000000 | SIGSEGV; + break; + + case EXCEPTION_DATATYPE_MISALIGNMENT: + *statPtr = 0xC0000000 | SIGBUS; + break; + + case EXCEPTION_BREAKPOINT: + case EXCEPTION_SINGLE_STEP: + *statPtr = 0xC0000000 | SIGTRAP; + break; + + case CONTROL_C_EXIT: + *statPtr = 0xC0000000 | SIGINT; + break; + + default: + /* + * Non-exceptional, normal, exit code. Note that the exit code is + * truncated to a signed short range [-32768,32768) whether it + * fits into this range or not. + * + * BUG: Even though the exit code is a DWORD, it is understood by + * convention to be a signed integer, yet there isn't enough room + * to fit this into the POSIX style waitstatus mask without + * truncating it. + */ - default: - *statPtr = 0xC0000000 | SIGABRT; - break; - } - } else { *statPtr = exitCode; + break; } result = pid; } else { errno = ECHILD; - *statPtr = 0xC0000000 | ECHILD; + *statPtr = 0xC0000000 | ECHILD; result = (Tcl_Pid) -1; } @@ -2595,28 +2604,28 @@ Tcl_WaitPid( * * TclWinAddProcess -- * - * Add a process to the process list so that we can use - * Tcl_WaitPid on the process. + * Add a process to the process list so that we can use Tcl_WaitPid on + * the process. * * Results: - * None + * None * * Side effects: - * Adds the specified process handle to the process list so - * Tcl_WaitPid knows about it. + * Adds the specified process handle to the process list so Tcl_WaitPid + * knows about it. * *---------------------------------------------------------------------- */ void -TclWinAddProcess(hProcess, id) - HANDLE hProcess; /* Handle to process */ - DWORD id; /* Global process identifier */ +TclWinAddProcess( + void *hProcess, /* Handle to process */ + unsigned long id) /* Global process identifier */ { ProcInfo *procPtr = (ProcInfo *) ckalloc(sizeof(ProcInfo)); PipeInit(); - + procPtr->hProcess = hProcess; procPtr->dwProcessId = id; Tcl_MutexLock(&pipeMutex); @@ -2630,8 +2639,8 @@ TclWinAddProcess(hProcess, id) * * Tcl_PidObjCmd -- * - * This procedure is invoked to process the "pid" Tcl command. - * See the user documentation for details on what it does. + * This function is invoked to process the "pid" Tcl command. See the + * user documentation for details on what it does. * * Results: * A standard Tcl result. @@ -2648,10 +2657,10 @@ Tcl_PidObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST *objv) /* Argument strings. */ + Tcl_Obj *const *objv) /* Argument strings. */ { Tcl_Channel chan; - Tcl_ChannelType *chanTypePtr; + const Tcl_ChannelType *chanTypePtr; PipeInfo *pipePtr; int i; Tcl_Obj *resultPtr; @@ -2662,13 +2671,12 @@ Tcl_PidObjCmd( return TCL_ERROR; } if (objc == 1) { - resultPtr = Tcl_GetObjResult(interp); wsprintfA(buf, "%lu", (unsigned long) getpid()); - Tcl_SetStringObj(resultPtr, buf, -1); + Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, -1)); } else { - chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], NULL), + chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], NULL), NULL); - if (chan == (Tcl_Channel) NULL) { + if (chan == (Tcl_Channel) NULL) { return TCL_ERROR; } chanTypePtr = Tcl_GetChannelType(chan); @@ -2676,13 +2684,14 @@ Tcl_PidObjCmd( return TCL_OK; } - pipePtr = (PipeInfo *) Tcl_GetChannelInstanceData(chan); - resultPtr = Tcl_GetObjResult(interp); - for (i = 0; i < pipePtr->numPids; i++) { + pipePtr = (PipeInfo *) Tcl_GetChannelInstanceData(chan); + resultPtr = Tcl_NewObj(); + for (i = 0; i < pipePtr->numPids; i++) { wsprintfA(buf, "%lu", TclpGetPid(pipePtr->pidPtr[i])); Tcl_ListObjAppendElement(/*interp*/ NULL, resultPtr, Tcl_NewStringObj(buf, -1)); } + Tcl_SetObjResult(interp, resultPtr); } return TCL_OK; } @@ -2692,20 +2701,19 @@ Tcl_PidObjCmd( * * WaitForRead -- * - * Wait until some data is available, the pipe is at - * EOF or the reader thread is blocked waiting for data (if the - * channel is in non-blocking mode). + * Wait until some data is available, the pipe is at EOF or the reader + * thread is blocked waiting for data (if the channel is in non-blocking + * mode). * * Results: - * Returns 1 if pipe is readable. Returns 0 if there is no data - * on the pipe, but there is buffered data. Returns -1 if an - * error occurred. If an error occurred, the threads may not - * be synchronized. + * Returns 1 if pipe is readable. Returns 0 if there is no data on the + * pipe, but there is buffered data. Returns -1 if an error occurred. If + * an error occurred, the threads may not be synchronized. * * Side effects: - * Updates the shared state flags and may consume 1 byte of data - * from the pipe. If no error occurred, the reader thread is - * blocked waiting for a signal from the main thread. + * Updates the shared state flags and may consume 1 byte of data from the + * pipe. If no error occurred, the reader thread is blocked waiting for a + * signal from the main thread. * *---------------------------------------------------------------------- */ @@ -2713,8 +2721,8 @@ Tcl_PidObjCmd( static int WaitForRead( PipeInfo *infoPtr, /* Pipe state. */ - int blocking) /* Indicates whether call should be - * blocking or not. */ + int blocking) /* Indicates whether call should be blocking + * or not. */ { DWORD timeout, count; HANDLE *handle = ((WinFile *) infoPtr->readFile)->handle; @@ -2723,7 +2731,7 @@ WaitForRead( /* * Synchronize with the reader thread. */ - + timeout = blocking ? INFINITE : 0; if (WaitForSingleObject(infoPtr->readable, timeout) == WAIT_TIMEOUT) { /* @@ -2736,11 +2744,10 @@ WaitForRead( } /* - * At this point, the two threads are synchronized, so it is safe - * to access shared state. + * At this point, the two threads are synchronized, so it is safe to + * access shared state. */ - /* * If the pipe has hit EOF, it is always readable. */ @@ -2748,7 +2755,7 @@ WaitForRead( if (infoPtr->readFlags & PIPE_EOF) { return 1; } - + /* * Check to see if there is any data sitting in the pipe. */ @@ -2756,6 +2763,7 @@ WaitForRead( if (PeekNamedPipe(handle, (LPVOID) NULL, (DWORD) 0, (LPDWORD) NULL, &count, (LPDWORD) NULL) != TRUE) { TclWinConvertError(GetLastError()); + /* * Check to see if the peek failed because of EOF. */ @@ -2785,8 +2793,8 @@ WaitForRead( } /* - * The pipe isn't readable, but there is some data sitting - * in the buffer, so return immediately. + * The pipe isn't readable, but there is some data sitting in the + * buffer, so return immediately. */ if (infoPtr->readFlags & PIPE_EXTRABYTE) { @@ -2794,10 +2802,9 @@ WaitForRead( } /* - * There wasn't any data available, so reset the thread and - * try again. + * There wasn't any data available, so reset the thread and try again. */ - + ResetEvent(infoPtr->readable); SetEvent(infoPtr->startReader); } @@ -2808,24 +2815,24 @@ WaitForRead( * * PipeReaderThread -- * - * This function runs in a separate thread and waits for input - * to become available on a pipe. + * This function runs in a separate thread and waits for input to become + * available on a pipe. * * Results: * None. * * Side effects: - * Signals the main thread when input become available. May - * cause the main thread to wake up by posting a message. May - * consume one byte from the pipe for each wait operation. Will - * cause a memory leak of ~4k, if forcefully terminated with - * TerminateThread(). + * Signals the main thread when input become available. May cause the + * main thread to wake up by posting a message. May consume one byte from + * the pipe for each wait operation. Will cause a memory leak of ~4k, if + * forcefully terminated with TerminateThread(). * *---------------------------------------------------------------------- */ static DWORD WINAPI -PipeReaderThread(LPVOID arg) +PipeReaderThread( + LPVOID arg) { PipeInfo *infoPtr = (PipeInfo *)arg; HANDLE *handle = ((WinFile *) infoPtr->readFile)->handle; @@ -2839,34 +2846,33 @@ PipeReaderThread(LPVOID arg) while (!done) { /* - * Wait for the main thread to signal before attempting to wait - * on the pipe becoming readable. + * Wait for the main thread to signal before attempting to wait on the + * pipe becoming readable. */ waitResult = WaitForMultipleObjects(2, wEvents, FALSE, INFINITE); if (waitResult != (WAIT_OBJECT_0 + 1)) { /* - * The start event was not signaled. It might be the stop event - * or an error, so exit. + * The start event was not signaled. It might be the stop event or + * an error, so exit. */ break; } /* - * Try waiting for 0 bytes. This will block until some data is - * available on NT, but will return immediately on Win 95. So, - * if no data is available after the first read, we block until - * we can read a single byte off of the pipe. + * Try waiting for 0 bytes. This will block until some data is + * available on NT, but will return immediately on Win 95. So, if no + * data is available after the first read, we block until we can read + * a single byte off of the pipe. */ - if ((ReadFile(handle, NULL, 0, &count, NULL) == FALSE) - || (PeekNamedPipe(handle, NULL, 0, NULL, &count, - NULL) == FALSE)) { + if (ReadFile(handle, NULL, 0, &count, NULL) == FALSE || + PeekNamedPipe(handle, NULL, 0, NULL, &count, NULL) == FALSE) { /* - * The error is a result of an EOF condition, so set the - * EOF bit before signalling the main thread. + * The error is a result of an EOF condition, so set the EOF bit + * before signalling the main thread. */ err = GetLastError(); @@ -2880,8 +2886,8 @@ PipeReaderThread(LPVOID arg) if (ReadFile(handle, &(infoPtr->extraByte), 1, &count, NULL) != FALSE) { /* - * One byte was consumed as a side effect of waiting - * for the pipe to become readable. + * One byte was consumed as a side effect of waiting for the + * pipe to become readable. */ infoPtr->readFlags |= PIPE_EXTRABYTE; @@ -2901,23 +2907,27 @@ PipeReaderThread(LPVOID arg) } } - + /* - * Signal the main thread by signalling the readable event and - * then waking up the notifier thread. + * Signal the main thread by signalling the readable event and then + * waking up the notifier thread. */ SetEvent(infoPtr->readable); - + /* - * Alert the foreground thread. Note that we need to treat this like - * a critical section so the foreground thread does not terminate - * this thread while we are holding a mutex in the notifier code. + * Alert the foreground thread. Note that we need to treat this like a + * critical section so the foreground thread does not terminate this + * thread while we are holding a mutex in the notifier code. */ Tcl_MutexLock(&pipeMutex); if (infoPtr->threadId != NULL) { - /* TIP #218. When in flight ignore the event, no one will receive it anyway */ + /* + * TIP #218. When in flight ignore the event, no one will receive + * it anyway. + */ + Tcl_ThreadAlert(infoPtr->threadId); } Tcl_MutexUnlock(&pipeMutex); @@ -2931,23 +2941,22 @@ PipeReaderThread(LPVOID arg) * * PipeWriterThread -- * - * This function runs in a separate thread and writes data - * onto a pipe. + * This function runs in a separate thread and writes data onto a pipe. * * Results: * Always returns 0. * * Side effects: - * Signals the main thread when an output operation is completed. - * May cause the main thread to wake up by posting a message. + * Signals the main thread when an output operation is completed. May + * cause the main thread to wake up by posting a message. * *---------------------------------------------------------------------- */ static DWORD WINAPI -PipeWriterThread(LPVOID arg) +PipeWriterThread( + LPVOID arg) { - PipeInfo *infoPtr = (PipeInfo *)arg; HANDLE *handle = ((WinFile *) infoPtr->writeFile)->handle; DWORD count, toWrite; @@ -2968,8 +2977,8 @@ PipeWriterThread(LPVOID arg) if (waitResult != (WAIT_OBJECT_0 + 1)) { /* - * The start event was not signaled. It might be the stop event - * or an error, so exit. + * The start event was not signaled. It might be the stop event or + * an error, so exit. */ break; @@ -2985,30 +2994,34 @@ PipeWriterThread(LPVOID arg) while (toWrite > 0) { if (WriteFile(handle, buf, toWrite, &count, NULL) == FALSE) { infoPtr->writeError = GetLastError(); - done = 1; + done = 1; break; } else { toWrite -= count; buf += count; } } - + /* - * Signal the main thread by signalling the writable event and - * then waking up the notifier thread. + * Signal the main thread by signalling the writable event and then + * waking up the notifier thread. */ SetEvent(infoPtr->writable); /* - * Alert the foreground thread. Note that we need to treat this like - * a critical section so the foreground thread does not terminate - * this thread while we are holding a mutex in the notifier code. + * Alert the foreground thread. Note that we need to treat this like a + * critical section so the foreground thread does not terminate this + * thread while we are holding a mutex in the notifier code. */ Tcl_MutexLock(&pipeMutex); if (infoPtr->threadId != NULL) { - /* TIP #218. When in flight ignore the event, no one will receive it anyway */ + /* + * TIP #218. When in flight ignore the event, no one will receive + * it anyway. + */ + Tcl_ThreadAlert(infoPtr->threadId); } Tcl_MutexUnlock(&pipeMutex); @@ -3016,7 +3029,7 @@ PipeWriterThread(LPVOID arg) return 0; } - + /* *---------------------------------------------------------------------- * @@ -3034,33 +3047,43 @@ PipeWriterThread(LPVOID arg) */ static void -PipeThreadActionProc (instanceData, action) - ClientData instanceData; - int action; +PipeThreadActionProc( + ClientData instanceData, + int action) { PipeInfo *infoPtr = (PipeInfo *) instanceData; - /* We do not access firstPipePtr in the thread structures. This is - * not for all pipes managed by the thread, but only those we are - * watching. Removal of the filevent handlers before transfer thus - * takes care of this structure. + /* + * We do not access firstPipePtr in the thread structures. This is not for + * all pipes managed by the thread, but only those we are watching. + * Removal of the filevent handlers before transfer thus takes care of + * this structure. */ Tcl_MutexLock(&pipeMutex); if (action == TCL_CHANNEL_THREAD_INSERT) { - /* We can't copy the thread information from the channel when - * the channel is created. At this time the channel back - * pointer has not been set yet. However in that case the - * threadId has already been set by TclpCreateCommandChannel - * itself, so the structure is still good. + /* + * We can't copy the thread information from the channel when the + * channel is created. At this time the channel back pointer has not + * been set yet. However in that case the threadId has already been + * set by TclpCreateCommandChannel itself, so the structure is still + * good. */ - PipeInit (); - if (infoPtr->channel != NULL) { - infoPtr->threadId = Tcl_GetChannelThread (infoPtr->channel); + PipeInit(); + if (infoPtr->channel != NULL) { + infoPtr->threadId = Tcl_GetChannelThread(infoPtr->channel); } } else { infoPtr->threadId = NULL; } Tcl_MutexUnlock(&pipeMutex); } + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ diff --git a/win/tclWinPort.h b/win/tclWinPort.h index f14e1a9..6d7ffa2 100644 --- a/win/tclWinPort.h +++ b/win/tclWinPort.h @@ -14,9 +14,15 @@ #ifndef _TCLWINPORT #define _TCLWINPORT -#ifndef _TCLINT -# include "tclInt.h" -#endif +#define WIN32_LEAN_AND_MEAN +#include <windows.h> +#undef WIN32_LEAN_AND_MEAN + +/* + * Ask for the winsock function typedefs, also. + */ +#define INCL_WINSOCK_API_TYPEDEFS 1 +#include <winsock2.h> #ifdef CHECK_UNICODE_CALLS # define _UNICODE @@ -34,17 +40,36 @@ *--------------------------------------------------------------------------- */ +#ifdef __CYGWIN__ +# include <unistd.h> +# include <wchar.h> +#else +# include <io.h> +#endif #include <stdio.h> #include <stdlib.h> - #include <errno.h> #include <fcntl.h> #include <float.h> -#include <io.h> #include <malloc.h> #include <process.h> #include <signal.h> #include <string.h> +#include <limits.h> + +#ifdef __CYGWIN__ +# include <unistd.h> +# ifndef _wcsicmp +# define _wcsicmp wcscasecmp +# endif +#else +# ifndef strncasecmp +# define strncasecmp strnicmp +# endif +# ifndef strcasecmp +# define strcasecmp stricmp +# endif +#endif /* * Need to block out these includes for building extensions with MetroWerks @@ -63,21 +88,6 @@ #include <time.h> -#define WIN32_LEAN_AND_MEAN -#include <windows.h> -#undef WIN32_LEAN_AND_MEAN - -/* - * Ask for the winsock function typedefs, also. - */ -#define INCL_WINSOCK_API_TYPEDEFS 1 -#include <winsock2.h> - -#ifdef BUILD_tcl -# undef TCL_STORAGE_CLASS -# define TCL_STORAGE_CLASS DLLEXPORT -#endif /* BUILD_tcl */ - /* * Define EINPROGRESS in terms of WSAEINPROGRESS. */ @@ -242,6 +252,18 @@ #endif /* !EOVERFLOW */ /* + * Signals not known to the standard ANSI signal.h. These are used + * by Tcl_WaitPid() and generic/tclPosixStr.c + */ + +#ifndef SIGTRAP +# define SIGTRAP 5 +#endif +#ifndef SIGBUS +# define SIGBUS 10 +#endif + +/* * Supply definitions for macros to query wait status, if not already * defined in header files above. */ @@ -311,7 +333,7 @@ */ #ifndef S_IFLNK -#define S_IFLNK 0120000 /* Symbolic Link */ +# define S_IFLNK 0120000 /* Symbolic Link */ #endif #ifndef S_ISREG @@ -363,11 +385,11 @@ */ #ifndef MAXPATH -#define MAXPATH MAX_PATH +# define MAXPATH MAX_PATH #endif /* MAXPATH */ #ifndef MAXPATHLEN -#define MAXPATHLEN MAXPATH +# define MAXPATHLEN MAXPATH #endif /* MAXPATHLEN */ /* @@ -388,15 +410,15 @@ */ #if defined(_MSC_VER) || defined(__MINGW32__) -# define environ _environ +# define environ _environ # if defined(_MSC_VER) && (_MSC_VER < 1600) # define hypot _hypot # endif -# define exception _exception -# undef EDEADLOCK -# if defined(__MINGW32__) && !defined(__MSVCRT__) +# define exception _exception +# undef EDEADLOCK +# if defined(__MINGW32__) && !defined(__MSVCRT__) # define timezone _timezone -# endif +# endif #endif /* _MSC_VER || __MINGW32__ */ /* @@ -408,13 +430,27 @@ # define environ _environ #endif /* __BORLANDC__ */ -#ifdef __CYGWIN__ -/* On Cygwin, the environment is imported from the Cygwin DLL. */ - DLLIMPORT extern char **__cygwin_environ; -# define environ __cygwin_environ -# define putenv TclCygwinPutenv -# define timezone _timezone -#endif /* __CYGWIN__ */ +#ifdef __WATCOMC__ + /* + * OpenWatcom uses a wine derived winsock2.h that is missing the + * LPFN_* typedefs. + */ +# define HAVE_NO_LPFN_DECLS +# if !defined(__CHAR_SIGNED__) +# error "You must use the -j switch to ensure char is signed." +# endif +#endif + + +/* + * MSVC 8.0 started to mark many standard C library functions depreciated + * including the *printf family and others. Tell it to shut up. + * (_MSC_VER is 1200 for VC6, 1300 or 1310 for vc7.net, 1400 for 8.0) + */ +#if _MSC_VER >= 1400 +#pragma warning(disable:4996) +#endif + /* * There is no platform-specific panic routine for Windows in the Tcl internals. @@ -424,8 +460,8 @@ /* *--------------------------------------------------------------------------- - * The following macros and declarations represent the interface between - * generic and windows-specific parts of Tcl. Some of the macros may + * The following macros and declarations represent the interface between + * generic and windows-specific parts of Tcl. Some of the macros may * override functions declared in tclInt.h. *--------------------------------------------------------------------------- */ @@ -460,6 +496,13 @@ #endif /* + * Older version of Mingw are known to lack a MWMO_ALERTABLE define. + */ +#if defined(HAVE_NO_MWMO_ALERTABLE) +# define MWMO_ALERTABLE 2 +#endif + +/* * The following defines wrap the system memory allocation routines for * use by tclAlloc.c. */ @@ -492,71 +535,21 @@ /* - * The following macros have trivial definitions, allowing generic code to + * The following macros have trivial definitions, allowing generic code to * address platform-specific issues. */ #define TclpReleaseFile(file) ckfree((char *) file) /* - * The following macros and declarations wrap the C runtime library + * The following macros and declarations wrap the C runtime library * functions. */ #define TclpExit exit -/* - * Declarations for Windows-only functions. - */ - -EXTERN HANDLE TclWinSerialReopen _ANSI_ARGS_(( HANDLE handle, - CONST TCHAR *name, DWORD access)); - -EXTERN Tcl_Channel TclWinOpenSerialChannel _ANSI_ARGS_((HANDLE handle, - char *channelName, int permissions)); - -EXTERN Tcl_Channel TclWinOpenConsoleChannel _ANSI_ARGS_((HANDLE handle, - char *channelName, int permissions)); - -EXTERN Tcl_Channel TclWinOpenFileChannel _ANSI_ARGS_((HANDLE handle, - char *channelName, int permissions, int appendMode)); - -EXTERN TclFile TclWinMakeFile _ANSI_ARGS_((HANDLE handle)); - -/* - * Platform specific mutex definition used by memory allocators. - * These mutexes are statically allocated and explicitly initialized. - * Most modules do not use this, but instead use Tcl_Mutex types and - * Tcl_MutexLock and Tcl_MutexUnlock that are self-initializing. - */ - -#ifdef TCL_THREADS -typedef CRITICAL_SECTION TclpMutex; -EXTERN void TclpMutexInit _ANSI_ARGS_((TclpMutex *mPtr)); -EXTERN void TclpMutexLock _ANSI_ARGS_((TclpMutex *mPtr)); -EXTERN void TclpMutexUnlock _ANSI_ARGS_((TclpMutex *mPtr)); -#else /* !TCL_THREADS */ -typedef int TclpMutex; -#define TclpMutexInit(a) -#define TclpMutexLock(a) -#define TclpMutexUnlock(a) -#endif /* TCL_THREADS */ - -#ifdef TCL_WIDE_INT_TYPE -EXTERN Tcl_WideInt strtoll _ANSI_ARGS_((CONST char *string, - char **endPtr, int base)); -EXTERN Tcl_WideUInt strtoull _ANSI_ARGS_((CONST char *string, - char **endPtr, int base)); -#endif /* TCL_WIDE_INT_TYPE */ - #ifndef INVALID_SET_FILE_POINTER #define INVALID_SET_FILE_POINTER 0xFFFFFFFF #endif /* INVALID_SET_FILE_POINTER */ -#include "tclPlatDecls.h" -#include "tclIntPlatDecls.h" - -#undef TCL_STORAGE_CLASS -#define TCL_STORAGE_CLASS DLLIMPORT - #endif /* _TCLWINPORT */ diff --git a/win/tclWinReg.c b/win/tclWinReg.c index a73be77..8eaf2a7 100644 --- a/win/tclWinReg.c +++ b/win/tclWinReg.c @@ -1,18 +1,21 @@ /* * tclWinReg.c -- * - * This file contains the implementation of the "registry" Tcl - * built-in command. This command is built as a dynamically - * loadable extension in a separate DLL. + * This file contains the implementation of the "registry" Tcl built-in + * command. This command is built as a dynamically loadable extension in + * a separate DLL. * * Copyright (c) 1997 by Sun Microsystems, Inc. * Copyright (c) 1998-1999 by Scriptics Corporation. * - * See the file "license.terms" for information on usage and redistribution - * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ -#include <tclPort.h> +#include "tclInt.h" +#ifdef _MSC_VER +# pragma comment (lib, "advapi32.lib") +#endif #include <stdlib.h> /* @@ -32,15 +35,15 @@ #define SWAPLONG(x) MAKELONG(SWAPWORD(HIWORD(x)), SWAPWORD(LOWORD(x))) /* - * The following flag is used in OpenKeys to indicate that the specified - * key should be created if it doesn't currently exist. + * The following flag is used in OpenKeys to indicate that the specified key + * should be created if it doesn't currently exist. */ #define REG_CREATE 1 /* - * The following tables contain the mapping from registry root names - * to the system predefined keys. + * The following tables contain the mapping from registry root names to the + * system predefined keys. */ static CONST char *rootKeyNames[] = { @@ -54,11 +57,12 @@ static HKEY rootKeys[] = { HKEY_CURRENT_CONFIG, HKEY_PERFORMANCE_DATA, HKEY_DYN_DATA }; +static CONST char REGISTRY_ASSOC_KEY[] = "registry::command"; + /* - * The following table maps from registry types to strings. Note that - * the indices for this array are the same as the constants for the - * known registry types so we don't need a separate table to hold the - * mapping. + * The following table maps from registry types to strings. Note that the + * indices for this array are the same as the constants for the known registry + * types so we don't need a separate table to hold the mapping. */ static CONST char *typeNames[] = { @@ -70,9 +74,9 @@ static DWORD lastType = REG_RESOURCE_LIST; /* * The following structures allow us to select between the Unicode and ASCII - * interfaces at run time based on whether Unicode APIs are available. The - * Unicode APIs are preferable because they will handle characters outside - * of the current code page. + * interfaces at run time based on whether Unicode APIs are available. The + * Unicode APIs are preferable because they will handle characters outside of + * the current code page. */ typedef struct RegWinProcs { @@ -80,7 +84,7 @@ typedef struct RegWinProcs { LONG (WINAPI *regConnectRegistryProc)(CONST TCHAR *, HKEY, PHKEY); LONG (WINAPI *regCreateKeyExProc)(HKEY, CONST TCHAR *, DWORD, TCHAR *, - DWORD, REGSAM, SECURITY_ATTRIBUTES *, HKEY *, DWORD *); + DWORD, REGSAM, SECURITY_ATTRIBUTES *, HKEY *, DWORD *); LONG (WINAPI *regDeleteKeyProc)(HKEY, CONST TCHAR *); LONG (WINAPI *regDeleteValueProc)(HKEY, CONST TCHAR *); LONG (WINAPI *regEnumKeyProc)(HKEY, DWORD, TCHAR *, DWORD); @@ -107,7 +111,7 @@ static RegWinProcs asciiProcs = { (LONG (WINAPI *)(CONST TCHAR *, HKEY, PHKEY)) RegConnectRegistryA, (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD, TCHAR *, DWORD, REGSAM, SECURITY_ATTRIBUTES *, HKEY *, - DWORD *)) RegCreateKeyExA, + DWORD *)) RegCreateKeyExA, (LONG (WINAPI *)(HKEY, CONST TCHAR *)) RegDeleteKeyA, (LONG (WINAPI *)(HKEY, CONST TCHAR *)) RegDeleteValueA, (LONG (WINAPI *)(HKEY, DWORD, TCHAR *, DWORD)) RegEnumKeyA, @@ -132,7 +136,7 @@ static RegWinProcs unicodeProcs = { (LONG (WINAPI *)(CONST TCHAR *, HKEY, PHKEY)) RegConnectRegistryW, (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD, TCHAR *, DWORD, REGSAM, SECURITY_ATTRIBUTES *, HKEY *, - DWORD *)) RegCreateKeyExW, + DWORD *)) RegCreateKeyExW, (LONG (WINAPI *)(HKEY, CONST TCHAR *)) RegDeleteKeyW, (LONG (WINAPI *)(HKEY, CONST TCHAR *)) RegDeleteValueW, (LONG (WINAPI *)(HKEY, DWORD, TCHAR *, DWORD)) RegEnumKeyW, @@ -160,6 +164,7 @@ static void AppendSystemError(Tcl_Interp *interp, DWORD error); static int BroadcastValue(Tcl_Interp *interp, int objc, Tcl_Obj * CONST objv[]); static DWORD ConvertDWORD(DWORD type, DWORD value); +static void DeleteCmd(ClientData clientData); static int DeleteKey(Tcl_Interp *interp, Tcl_Obj *keyNameObj); static int DeleteValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj, Tcl_Obj *valueNameObj); @@ -188,14 +193,15 @@ static int SetValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj, Tcl_Obj *valueNameObj, Tcl_Obj *dataObj, Tcl_Obj *typeObj); -EXTERN int Registry_Init(Tcl_Interp *interp); +EXTERN int Registry_Init(Tcl_Interp *interp); +EXTERN int Registry_Unload(Tcl_Interp *interp, int flags); /* *---------------------------------------------------------------------- * * Registry_Init -- * - * This procedure initializes the registry command. + * This function initializes the registry command. * * Results: * A standard Tcl result. @@ -210,7 +216,9 @@ int Registry_Init( Tcl_Interp *interp) { - if (!Tcl_InitStubs(interp, "8.0", 0)) { + Tcl_Command cmd; + + if (Tcl_InitStubs(interp, "8.1", 0) == NULL) { return TCL_ERROR; } @@ -225,8 +233,80 @@ Registry_Init( regWinProcs = &asciiProcs; } - Tcl_CreateObjCommand(interp, "registry", RegistryObjCmd, NULL, NULL); - return Tcl_PkgProvide(interp, "registry", "1.1.5"); + cmd = Tcl_CreateObjCommand(interp, "registry", RegistryObjCmd, + (ClientData)interp, DeleteCmd); + Tcl_SetAssocData(interp, REGISTRY_ASSOC_KEY, NULL, (ClientData)cmd); + return Tcl_PkgProvide(interp, "registry", "1.2.1"); +} + +/* + *---------------------------------------------------------------------- + * + * Registry_Unload -- + * + * This function removes the registry command. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * The registry command is deleted and the dll may be unloaded. + * + *---------------------------------------------------------------------- + */ + +int +Registry_Unload( + Tcl_Interp *interp, /* Interpreter for unloading */ + int flags) /* Flags passed by the unload system */ +{ + Tcl_Command cmd; + Tcl_Obj *objv[3]; + + /* + * Unregister the registry package. There is no Tcl_PkgForget() + */ + + objv[0] = Tcl_NewStringObj("package", -1); + objv[1] = Tcl_NewStringObj("forget", -1); + objv[2] = Tcl_NewStringObj("registry", -1); + Tcl_EvalObjv(interp, 3, objv, TCL_EVAL_GLOBAL); + + /* + * Delete the originally registered command. + */ + + cmd = (Tcl_Command)Tcl_GetAssocData(interp, REGISTRY_ASSOC_KEY, NULL); + if (cmd != NULL) { + Tcl_DeleteCommandFromToken(interp, cmd); + } + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * DeleteCmd -- + * + * Cleanup the interp command token so that unloading doesn't try to + * re-delete the command (which will crash). + * + * Results: + * None. + * + * Side effects: + * The unload command will not attempt to delete this command. + * + *---------------------------------------------------------------------- + */ + +static void +DeleteCmd( + ClientData clientData) +{ + Tcl_Interp *interp = clientData; + Tcl_SetAssocData(interp, REGISTRY_ASSOC_KEY, NULL, (ClientData)NULL); } /* @@ -256,8 +336,7 @@ RegistryObjCmd( char *errString = NULL; static CONST char *subcommands[] = { - "broadcast", "delete", "get", "keys", "set", "type", "values", - (char *) NULL + "broadcast", "delete", "get", "keys", "set", "type", "values", NULL }; enum SubCmdIdx { BroadcastIdx, DeleteIdx, GetIdx, KeysIdx, SetIdx, TypeIdx, ValuesIdx @@ -274,65 +353,64 @@ RegistryObjCmd( } switch (index) { - case BroadcastIdx: /* broadcast */ - return BroadcastValue(interp, objc, objv); - break; - case DeleteIdx: /* delete */ - if (objc == 3) { - return DeleteKey(interp, objv[2]); - } else if (objc == 4) { - return DeleteValue(interp, objv[2], objv[3]); - } - errString = "keyName ?valueName?"; - break; - case GetIdx: /* get */ - if (objc == 4) { - return GetValue(interp, objv[2], objv[3]); - } - errString = "keyName valueName"; - break; - case KeysIdx: /* keys */ - if (objc == 3) { - return GetKeyNames(interp, objv[2], NULL); - } else if (objc == 4) { - return GetKeyNames(interp, objv[2], objv[3]); - } - errString = "keyName ?pattern?"; - break; - case SetIdx: /* set */ - if (objc == 3) { - HKEY key; + case BroadcastIdx: /* broadcast */ + return BroadcastValue(interp, objc, objv); + break; + case DeleteIdx: /* delete */ + if (objc == 3) { + return DeleteKey(interp, objv[2]); + } else if (objc == 4) { + return DeleteValue(interp, objv[2], objv[3]); + } + errString = "keyName ?valueName?"; + break; + case GetIdx: /* get */ + if (objc == 4) { + return GetValue(interp, objv[2], objv[3]); + } + errString = "keyName valueName"; + break; + case KeysIdx: /* keys */ + if (objc == 3) { + return GetKeyNames(interp, objv[2], NULL); + } else if (objc == 4) { + return GetKeyNames(interp, objv[2], objv[3]); + } + errString = "keyName ?pattern?"; + break; + case SetIdx: /* set */ + if (objc == 3) { + HKEY key; - /* - * Create the key and then close it immediately. - */ + /* + * Create the key and then close it immediately. + */ - if (OpenKey(interp, objv[2], KEY_ALL_ACCESS, 1, &key) - != TCL_OK) { - return TCL_ERROR; - } - RegCloseKey(key); - return TCL_OK; - } else if (objc == 5 || objc == 6) { - Tcl_Obj *typeObj = (objc == 5) ? NULL : objv[5]; - return SetValue(interp, objv[2], objv[3], objv[4], typeObj); - } - errString = "keyName ?valueName data ?type??"; - break; - case TypeIdx: /* type */ - if (objc == 4) { - return GetType(interp, objv[2], objv[3]); - } - errString = "keyName valueName"; - break; - case ValuesIdx: /* values */ - if (objc == 3) { - return GetValueNames(interp, objv[2], NULL); - } else if (objc == 4) { - return GetValueNames(interp, objv[2], objv[3]); + if (OpenKey(interp, objv[2], KEY_ALL_ACCESS, 1, &key) != TCL_OK) { + return TCL_ERROR; } - errString = "keyName ?pattern?"; - break; + RegCloseKey(key); + return TCL_OK; + } else if (objc == 5 || objc == 6) { + Tcl_Obj *typeObj = (objc == 5) ? NULL : objv[5]; + return SetValue(interp, objv[2], objv[3], objv[4], typeObj); + } + errString = "keyName ?valueName data ?type??"; + break; + case TypeIdx: /* type */ + if (objc == 4) { + return GetType(interp, objv[2], objv[3]); + } + errString = "keyName valueName"; + break; + case ValuesIdx: /* values */ + if (objc == 3) { + return GetValueNames(interp, objv[2], NULL); + } else if (objc == 4) { + return GetValueNames(interp, objv[2], objv[3]); + } + errString = "keyName ?pattern?"; + break; } Tcl_WrongNumArgs(interp, 2, objv, errString); return TCL_ERROR; @@ -364,7 +442,6 @@ DeleteKey( HKEY rootKey, subkey; DWORD result; int length; - Tcl_Obj *resultPtr; Tcl_DString buf; /* @@ -375,15 +452,15 @@ DeleteKey( buffer = ckalloc((unsigned int) length + 1); strcpy(buffer, keyName); - if (ParseKeyName(interp, buffer, &hostName, &rootKey, &keyName) - != TCL_OK) { + if (ParseKeyName(interp, buffer, &hostName, &rootKey, + &keyName) != TCL_OK) { ckfree(buffer); return TCL_ERROR; } - resultPtr = Tcl_GetObjResult(interp); if (*keyName == '\0') { - Tcl_AppendToObj(resultPtr, "bad key: cannot delete root keys", -1); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "bad key: cannot delete root keys", -1)); ckfree(buffer); return TCL_ERROR; } @@ -402,11 +479,11 @@ DeleteKey( ckfree(buffer); if (result == ERROR_FILE_NOT_FOUND) { return TCL_OK; - } else { - Tcl_AppendToObj(resultPtr, "unable to delete key: ", -1); - AppendSystemError(interp, result); - return TCL_ERROR; } + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "unable to delete key: ", -1)); + AppendSystemError(interp, result); + return TCL_ERROR; } /* @@ -418,7 +495,8 @@ DeleteKey( Tcl_DStringFree(&buf); if (result != ERROR_SUCCESS && result != ERROR_FILE_NOT_FOUND) { - Tcl_AppendToObj(resultPtr, "unable to delete key: ", -1); + Tcl_SetObjResult(interp, + Tcl_NewStringObj("unable to delete key: ", -1)); AppendSystemError(interp, result); result = TCL_ERROR; } else { @@ -456,7 +534,6 @@ DeleteValue( char *valueName; int length; DWORD result; - Tcl_Obj *resultPtr; Tcl_DString ds; /* @@ -468,13 +545,12 @@ DeleteValue( return TCL_ERROR; } - resultPtr = Tcl_GetObjResult(interp); valueName = Tcl_GetStringFromObj(valueNameObj, &length); Tcl_WinUtfToTChar(valueName, length, &ds); result = (*regWinProcs->regDeleteValueProc)(key, Tcl_DStringValue(&ds)); Tcl_DStringFree(&ds); if (result != ERROR_SUCCESS) { - Tcl_AppendStringsToObj(resultPtr, "unable to delete value \"", + Tcl_AppendResult(interp, "unable to delete value \"", Tcl_GetString(valueNameObj), "\" from key \"", Tcl_GetString(keyNameObj), "\": ", NULL); AppendSystemError(interp, result); @@ -491,13 +567,13 @@ DeleteValue( * * GetKeyNames -- * - * This function enumerates the subkeys of a given key. If the - * optional pattern is supplied, then only keys that match the - * pattern will be returned. + * This function enumerates the subkeys of a given key. If the optional + * pattern is supplied, then only keys that match the pattern will be + * returned. * * Results: - * Returns the list of subkeys in the result object of the - * interpreter, or an error message on failure. + * Returns the list of subkeys in the result object of the interpreter, + * or an error message on failure. * * Side effects: * None. @@ -537,17 +613,17 @@ GetKeyNames( return TCL_ERROR; } - /* + /* * Determine how big a buffer is needed for enumerating subkeys, and * how many subkeys there are */ result = (*regWinProcs->regQueryInfoKeyProc) - (key, NULL, NULL, NULL, &subKeyCount, &maxSubKeyLen, NULL, NULL, + (key, NULL, NULL, NULL, &subKeyCount, &maxSubKeyLen, NULL, NULL, NULL, NULL, NULL, NULL); if (result != ERROR_SUCCESS) { Tcl_SetObjResult(interp, Tcl_NewObj()); - Tcl_AppendResult(interp, "unable to query key \"", + Tcl_AppendResult(interp, "unable to query key \"", Tcl_GetString(keyNameObj), "\": ", NULL); AppendSystemError(interp, result); RegCloseKey(key); @@ -607,8 +683,8 @@ GetKeyNames( * * GetType -- * - * This function gets the type of a given registry value and - * places it in the interpreter result. + * This function gets the type of a given registry value and places it in + * the interpreter result. * * Results: * Returns a normal Tcl result. @@ -626,7 +702,6 @@ GetType( Tcl_Obj *valueNameObj) /* Name of value to get. */ { HKEY key; - Tcl_Obj *resultPtr; DWORD result; DWORD type; Tcl_DString ds; @@ -647,8 +722,6 @@ GetType( * Get the type of the value. */ - resultPtr = Tcl_GetObjResult(interp); - valueName = Tcl_GetStringFromObj(valueNameObj, &length); nativeValue = Tcl_WinUtfToTChar(valueName, length, &ds); result = (*regWinProcs->regQueryValueExProc)(key, nativeValue, NULL, &type, @@ -657,7 +730,7 @@ GetType( RegCloseKey(key); if (result != ERROR_SUCCESS) { - Tcl_AppendStringsToObj(resultPtr, "unable to get type of value \"", + Tcl_AppendResult(interp, "unable to get type of value \"", Tcl_GetString(valueNameObj), "\" from key \"", Tcl_GetString(keyNameObj), "\": ", NULL); AppendSystemError(interp, result); @@ -665,14 +738,14 @@ GetType( } /* - * Set the type into the result. Watch out for unknown types. - * If we don't know about the type, just use the numeric value. + * Set the type into the result. Watch out for unknown types. If we don't + * know about the type, just use the numeric value. */ - if (type > lastType || type < 0) { - Tcl_SetIntObj(resultPtr, (int) type); + if (type > lastType) { + Tcl_SetObjResult(interp, Tcl_NewIntObj((int) type)); } else { - Tcl_SetStringObj(resultPtr, typeNames[type], -1); + Tcl_SetObjResult(interp, Tcl_NewStringObj(typeNames[type], -1)); } return TCL_OK; } @@ -682,9 +755,8 @@ GetType( * * GetValue -- * - * This function gets the contents of a registry value and places - * a list containing the data and the type in the interpreter - * result. + * This function gets the contents of a registry value and places a list + * containing the data and the type in the interpreter result. * * Results: * Returns a normal Tcl result. @@ -705,7 +777,6 @@ GetValue( char *valueName; CONST char *nativeValue; DWORD result, length, type; - Tcl_Obj *resultPtr; Tcl_DString data, buf; int nameLen; @@ -713,16 +784,15 @@ GetValue( * Attempt to open the key for reading. */ - if (OpenKey(interp, keyNameObj, KEY_QUERY_VALUE, 0, &key) - != TCL_OK) { + if (OpenKey(interp, keyNameObj, KEY_QUERY_VALUE, 0, &key) != TCL_OK) { return TCL_ERROR; } /* - * Initialize a Dstring to maximum statically allocated size - * we could get one more byte by avoiding Tcl_DStringSetLength() - * and just setting length to TCL_DSTRING_STATIC_SIZE, but this - * should be safer if the implementation of Dstrings changes. + * Initialize a Dstring to maximum statically allocated size we could get + * one more byte by avoiding Tcl_DStringSetLength() and just setting + * length to TCL_DSTRING_STATIC_SIZE, but this should be safer if the + * implementation of Dstrings changes. * * This allows short values to be read from the registy in one call. * Longer values need a second call with an expanded DString. @@ -732,8 +802,6 @@ GetValue( length = TCL_DSTRING_STATIC_SIZE - 1; Tcl_DStringSetLength(&data, (int) length); - resultPtr = Tcl_GetObjResult(interp); - valueName = Tcl_GetStringFromObj(valueNameObj, &nameLen); nativeValue = Tcl_WinUtfToTChar(valueName, nameLen, &buf); @@ -741,19 +809,20 @@ GetValue( (BYTE *) Tcl_DStringValue(&data), &length); while (result == ERROR_MORE_DATA) { /* - * The Windows docs say that in this error case, we just need - * to expand our buffer and request more data. - * Required for HKEY_PERFORMANCE_DATA + * The Windows docs say that in this error case, we just need to + * expand our buffer and request more data. Required for + * HKEY_PERFORMANCE_DATA */ + length *= 2; - Tcl_DStringSetLength(&data, (int) length); - result = (*regWinProcs->regQueryValueExProc)(key, (char *) nativeValue, + Tcl_DStringSetLength(&data, (int) length); + result = (*regWinProcs->regQueryValueExProc)(key, (char *) nativeValue, NULL, &type, (BYTE *) Tcl_DStringValue(&data), &length); } Tcl_DStringFree(&buf); RegCloseKey(key); if (result != ERROR_SUCCESS) { - Tcl_AppendStringsToObj(resultPtr, "unable to get value \"", + Tcl_AppendResult(interp, "unable to get value \"", Tcl_GetString(valueNameObj), "\" from key \"", Tcl_GetString(keyNameObj), "\": ", NULL); AppendSystemError(interp, result); @@ -762,26 +831,27 @@ GetValue( } /* - * If the data is a 32-bit quantity, store it as an integer object. If it - * is a multi-string, store it as a list of strings. For null-terminated - * strings, append up the to first null. Otherwise, store it as a binary + * If the data is a 32-bit quantity, store it as an integer object. If it + * is a multi-string, store it as a list of strings. For null-terminated + * strings, append up the to first null. Otherwise, store it as a binary * string. */ if (type == REG_DWORD || type == REG_DWORD_BIG_ENDIAN) { - Tcl_SetIntObj(resultPtr, (int) ConvertDWORD(type, - *((DWORD*) Tcl_DStringValue(&data)))); + Tcl_SetObjResult(interp, Tcl_NewIntObj((int) ConvertDWORD(type, + *((DWORD*) Tcl_DStringValue(&data))))); } else if (type == REG_MULTI_SZ) { char *p = Tcl_DStringValue(&data); char *end = Tcl_DStringValue(&data) + length; + Tcl_Obj *resultPtr = Tcl_NewObj(); /* * Multistrings are stored as an array of null-terminated strings, - * terminated by two null characters. Also do a bounds check in - * case we get bogus data. + * terminated by two null characters. Also do a bounds check in case + * we get bogus data. */ - - while (p < end && ((regWinProcs->useWide) + + while (p < end && ((regWinProcs->useWide) ? *((Tcl_UniChar *)p) : *p) != 0) { Tcl_WinTCharToUtf((TCHAR *) p, -1, &buf); Tcl_ListObjAppendElement(interp, resultPtr, @@ -796,17 +866,17 @@ GetValue( } Tcl_DStringFree(&buf); } + Tcl_SetObjResult(interp, resultPtr); } else if ((type == REG_SZ) || (type == REG_EXPAND_SZ)) { Tcl_WinTCharToUtf((TCHAR *) Tcl_DStringValue(&data), -1, &buf); - Tcl_SetStringObj(resultPtr, Tcl_DStringValue(&buf), - Tcl_DStringLength(&buf)); - Tcl_DStringFree(&buf); + Tcl_DStringResult(interp, &buf); } else { /* * Save binary data as a byte array. */ - Tcl_SetByteArrayObj(resultPtr, (BYTE *) Tcl_DStringValue(&data), (int) length); + Tcl_SetObjResult(interp, Tcl_NewByteArrayObj( + (BYTE *) Tcl_DStringValue(&data), (int) length)); } Tcl_DStringFree(&data); return result; @@ -817,9 +887,9 @@ GetValue( * * GetValueNames -- * - * This function enumerates the values of the a given key. If - * the optional pattern is supplied, then only value names that - * match the pattern will be returned. + * This function enumerates the values of the a given key. If the + * optional pattern is supplied, then only value names that match the + * pattern will be returned. * * Results: * Returns the list of value names in the result object of the @@ -852,8 +922,6 @@ GetValueNames( return TCL_ERROR; } - resultPtr = Tcl_GetObjResult(interp); - /* * Query the key to determine the appropriate buffer size to hold the * largest value name plus the terminating null. @@ -862,7 +930,7 @@ GetValueNames( result = (*regWinProcs->regQueryInfoKeyProc)(key, NULL, NULL, NULL, NULL, NULL, NULL, &index, &maxSize, NULL, NULL, NULL); if (result != ERROR_SUCCESS) { - Tcl_AppendStringsToObj(resultPtr, "unable to query key \"", + Tcl_AppendResult(interp, "unable to query key \"", Tcl_GetString(keyNameObj), "\": ", NULL); AppendSystemError(interp, result); RegCloseKey(key); @@ -871,7 +939,7 @@ GetValueNames( } maxSize++; - + resultPtr = Tcl_NewObj(); Tcl_DStringInit(&buffer); Tcl_DStringSetLength(&buffer, (int) ((regWinProcs->useWide) ? maxSize*2 : maxSize)); @@ -886,8 +954,8 @@ GetValueNames( /* * Enumerate the values under the given subkey until we get an error, - * indicating the end of the list. Note that we need to reset size - * after each iteration because RegEnumValue smashes the old value. + * indicating the end of the list. Note that we need to reset size after + * each iteration because RegEnumValue smashes the old value. */ size = maxSize; @@ -899,7 +967,8 @@ GetValueNames( size *= 2; } - Tcl_WinTCharToUtf((TCHAR *) Tcl_DStringValue(&buffer), (int) size, &ds); + Tcl_WinTCharToUtf((TCHAR *) Tcl_DStringValue(&buffer), (int) size, + &ds); name = Tcl_DStringValue(&ds); if (!pattern || Tcl_StringMatch(name, pattern)) { result = Tcl_ListObjAppendElement(interp, resultPtr, @@ -914,9 +983,10 @@ GetValueNames( index++; size = maxSize; } + Tcl_SetObjResult(interp, resultPtr); Tcl_DStringFree(&buffer); - done: + done: RegCloseKey(key); return result; } @@ -926,12 +996,11 @@ GetValueNames( * * OpenKey -- * - * This function opens the specified key. This function is a - * simple wrapper around ParseKeyName and OpenSubKey. + * This function opens the specified key. This function is a simple + * wrapper around ParseKeyName and OpenSubKey. * * Results: - * Returns the opened key in the keyPtr argument and a Tcl - * result code. + * Returns the opened key in the keyPtr argument and a Tcl result code. * * Side effects: * None. @@ -960,8 +1029,8 @@ OpenKey( if (result == TCL_OK) { result = OpenSubKey(hostName, rootKey, keyName, mode, flags, keyPtr); if (result != ERROR_SUCCESS) { - Tcl_Obj *resultPtr = Tcl_GetObjResult(interp); - Tcl_AppendToObj(resultPtr, "unable to open key: ", -1); + Tcl_SetObjResult(interp, + Tcl_NewStringObj("unable to open key: ", -1)); AppendSystemError(interp, result); result = TCL_ERROR; } else { @@ -978,12 +1047,12 @@ OpenKey( * * OpenSubKey -- * - * This function opens a given subkey of a root key on the - * specified host. + * This function opens a given subkey of a root key on the specified + * host. * * Results: - * Returns the opened key in the keyPtr and a Windows error code - * as the return value. + * Returns the opened key in the keyPtr and a Windows error code as the + * return value. * * Side effects: * None. @@ -1018,8 +1087,8 @@ OpenSubKey( } /* - * Now open the specified key with the requested permissions. Note - * that this key must be closed by the caller. + * Now open the specified key with the requested permissions. Note that + * this key must be closed by the caller. */ keyName = (char *) Tcl_WinUtfToTChar(keyName, -1, &buf); @@ -1027,19 +1096,16 @@ OpenSubKey( DWORD create; result = (*regWinProcs->regCreateKeyExProc)(rootKey, keyName, 0, NULL, REG_OPTION_NON_VOLATILE, mode, NULL, keyPtr, &create); + } else if (rootKey == HKEY_PERFORMANCE_DATA) { + /* + * Here we fudge it for this special root key. See MSDN for more info + * on HKEY_PERFORMANCE_DATA and the peculiarities surrounding it. + */ + *keyPtr = HKEY_PERFORMANCE_DATA; + result = ERROR_SUCCESS; } else { - if (rootKey == HKEY_PERFORMANCE_DATA) { - /* - * Here we fudge it for this special root key. - * See MSDN for more info on HKEY_PERFORMANCE_DATA and - * the peculiarities surrounding it - */ - *keyPtr = HKEY_PERFORMANCE_DATA; - result = ERROR_SUCCESS; - } else { - result = (*regWinProcs->regOpenKeyExProc)(rootKey, keyName, 0, - mode, keyPtr); - } + result = (*regWinProcs->regOpenKeyExProc)(rootKey, keyName, 0, mode, + keyPtr); } Tcl_DStringFree(&buf); @@ -1058,15 +1124,12 @@ OpenSubKey( * * ParseKeyName -- * - * This function parses a key name into the host, root, and subkey - * parts. + * This function parses a key name into the host, root, and subkey parts. * * Results: - * The pointers to the start of the host and subkey names are - * returned in the hostNamePtr and keyNamePtr variables. The - * specified root HKEY is returned in rootKeyPtr. Returns - * a standard Tcl result. - * + * The pointers to the start of the host and subkey names are returned in + * the hostNamePtr and keyNamePtr variables. The specified root HKEY is + * returned in rootKeyPtr. Returns a standard Tcl result. * * Side effects: * Modifies the name string by inserting nulls. @@ -1084,7 +1147,7 @@ ParseKeyName( { char *rootName; int result, index; - Tcl_Obj *rootObj, *resultPtr = Tcl_GetObjResult(interp); + Tcl_Obj *rootObj; /* * Split the key into host and root portions. @@ -1105,7 +1168,7 @@ ParseKeyName( rootName = name; } if (!rootName) { - Tcl_AppendStringsToObj(resultPtr, "bad key \"", name, + Tcl_AppendResult(interp, "bad key \"", name, "\": must start with a valid root", NULL); return TCL_ERROR; } @@ -1142,9 +1205,9 @@ ParseKeyName( * * RecursiveDeleteKey -- * - * This function recursively deletes all the keys below a starting - * key. Although Windows 95 does this automatically, we still need - * to do this for Windows NT. + * This function recursively deletes all the keys below a starting key. + * Although Windows 95 does this automatically, we still need to do this + * for Windows NT. * * Results: * Returns a Windows error code. @@ -1214,9 +1277,9 @@ RecursiveDeleteKey( * * SetValue -- * - * This function sets the contents of a registry value. If - * the key or value does not exist, it will be created. If it - * does exist, then the data and type will be replaced. + * This function sets the contents of a registry value. If the key or + * value does not exist, it will be created. If it does exist, then the + * data and type will be replaced. * * Results: * Returns a normal Tcl result. @@ -1235,11 +1298,11 @@ SetValue( Tcl_Obj *dataObj, /* Data to be written. */ Tcl_Obj *typeObj) /* Type of data to be written. */ { - DWORD type, result; + int type; + DWORD result; HKEY key; int length; char *valueName; - Tcl_Obj *resultPtr; Tcl_DString nameBuf; if (typeObj == NULL) { @@ -1257,19 +1320,19 @@ SetValue( valueName = Tcl_GetStringFromObj(valueNameObj, &length); valueName = (char *) Tcl_WinUtfToTChar(valueName, length, &nameBuf); - resultPtr = Tcl_GetObjResult(interp); if (type == REG_DWORD || type == REG_DWORD_BIG_ENDIAN) { - DWORD value; - if (Tcl_GetIntFromObj(interp, dataObj, (int*) &value) != TCL_OK) { + int value; + + if (Tcl_GetIntFromObj(interp, dataObj, &value) != TCL_OK) { RegCloseKey(key); Tcl_DStringFree(&nameBuf); return TCL_ERROR; } - value = ConvertDWORD(type, value); - result = (*regWinProcs->regSetValueExProc)(key, valueName, 0, type, - (BYTE*) &value, sizeof(DWORD)); + value = ConvertDWORD((DWORD)type, (DWORD)value); + result = (*regWinProcs->regSetValueExProc)(key, valueName, 0, + (DWORD) type, (BYTE *) &value, sizeof(DWORD)); } else if (type == REG_MULTI_SZ) { Tcl_DString data, buf; int objc, i; @@ -1282,9 +1345,9 @@ SetValue( } /* - * Append the elements as null terminated strings. Note that - * we must not assume the length of the string in case there are - * embedded nulls, which aren't allowed in REG_MULTI_SZ values. + * Append the elements as null terminated strings. Note that we must + * not assume the length of the string in case there are embedded + * nulls, which aren't allowed in REG_MULTI_SZ values. */ Tcl_DStringInit(&data); @@ -1292,8 +1355,8 @@ SetValue( Tcl_DStringAppend(&data, Tcl_GetString(objv[i]), -1); /* - * Add a null character to separate this value from the next. - * We accomplish this by growing the string by one byte. Since the + * Add a null character to separate this value from the next. We + * accomplish this by growing the string by one byte. Since the * DString always tacks on an extra null byte, the new byte will * already be set to null. */ @@ -1303,16 +1366,16 @@ SetValue( Tcl_WinUtfToTChar(Tcl_DStringValue(&data), Tcl_DStringLength(&data)+1, &buf); - result = (*regWinProcs->regSetValueExProc)(key, valueName, 0, type, - (BYTE *) Tcl_DStringValue(&buf), + result = (*regWinProcs->regSetValueExProc)(key, valueName, 0, + (DWORD) type, (BYTE *) Tcl_DStringValue(&buf), (DWORD) Tcl_DStringLength(&buf)); Tcl_DStringFree(&data); Tcl_DStringFree(&buf); } else if (type == REG_SZ || type == REG_EXPAND_SZ) { Tcl_DString buf; - char *data = Tcl_GetStringFromObj(dataObj, &length); + CONST char *data = Tcl_GetStringFromObj(dataObj, &length); - data = (char *) Tcl_WinUtfToTChar(data, length, &buf); + data = Tcl_WinUtfToTChar(data, length, &buf); /* * Include the null in the length, padding if needed for Unicode. @@ -1323,8 +1386,8 @@ SetValue( } length = Tcl_DStringLength(&buf) + 1; - result = (*regWinProcs->regSetValueExProc)(key, valueName, 0, type, - (BYTE*)data, (DWORD) length); + result = (*regWinProcs->regSetValueExProc)(key, valueName, 0, + (DWORD) type, (BYTE *) data, (DWORD) length); Tcl_DStringFree(&buf); } else { BYTE *data; @@ -1333,14 +1396,17 @@ SetValue( * Store binary data in the registry. */ - data = Tcl_GetByteArrayFromObj(dataObj, &length); - result = (*regWinProcs->regSetValueExProc)(key, valueName, 0, type, - data, (DWORD) length); + data = (BYTE *) Tcl_GetByteArrayFromObj(dataObj, &length); + result = (*regWinProcs->regSetValueExProc)(key, valueName, 0, + (DWORD) type, data, (DWORD) length); } + Tcl_DStringFree(&nameBuf); RegCloseKey(key); + if (result != ERROR_SUCCESS) { - Tcl_AppendToObj(resultPtr, "unable to set value: ", -1); + Tcl_SetObjResult(interp, + Tcl_NewStringObj("unable to set value: ", -1)); AppendSystemError(interp, result); return TCL_ERROR; } @@ -1352,9 +1418,8 @@ SetValue( * * BroadcastValue -- * - * This function broadcasts a WM_SETTINGCHANGE message to indicate - * to other programs that we have changed the contents of a registry - * value. + * This function broadcasts a WM_SETTINGCHANGE message to indicate to + * other programs that we have changed the contents of a registry value. * * Results: * Returns a normal Tcl result. @@ -1369,13 +1434,13 @@ static int BroadcastValue( Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj * CONST objv[]) /* Argument values. */ + Tcl_Obj *CONST objv[]) /* Argument values. */ { LRESULT result; DWORD_PTR sendResult; UINT timeout = 3000; int len; - char *str; + CONST char *str; Tcl_Obj *objPtr; if ((objc != 3) && (objc != 5)) { @@ -1385,7 +1450,8 @@ BroadcastValue( if (objc > 3) { str = Tcl_GetStringFromObj(objv[3], &len); - if ((len < 2) || (*str != '-') || strncmp(str, "-timeout", (size_t) len)) { + if ((len < 2) || (*str != '-') + || strncmp(str, "-timeout", (size_t) len)) { Tcl_WrongNumArgs(interp, 2, objv, "keyName ?-timeout millisecs?"); return TCL_ERROR; } @@ -1402,6 +1468,7 @@ BroadcastValue( /* * Use the ignore the result. */ + result = SendMessageTimeout(HWND_BROADCAST, WM_SETTINGCHANGE, (WPARAM) 0, (LPARAM) str, SMTO_ABORTIFHUNG, timeout, &sendResult); @@ -1418,8 +1485,8 @@ BroadcastValue( * * AppendSystemError -- * - * This routine formats a Windows system error message and places - * it into the interpreter result. + * This routine formats a Windows system error message and places it into + * the interpreter result. * * Results: * None. @@ -1436,15 +1503,18 @@ AppendSystemError( DWORD error) /* Result code from error. */ { int length; - WCHAR *wMsgPtr; + WCHAR *wMsgPtr, **wMsgPtrPtr = &wMsgPtr; char *msg; char id[TCL_INTEGER_SPACE], msgBuf[24 + TCL_INTEGER_SPACE]; Tcl_DString ds; Tcl_Obj *resultPtr = Tcl_GetObjResult(interp); + if (Tcl_IsShared(resultPtr)) { + resultPtr = Tcl_DuplicateObj(resultPtr); + } length = FormatMessageW(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_ALLOCATE_BUFFER, NULL, error, - MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (WCHAR *) &wMsgPtr, + MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (WCHAR *) wMsgPtrPtr, 0, NULL); if (length == 0) { char *msgPtr; @@ -1481,6 +1551,7 @@ AppendSystemError( /* * Trim the trailing CR/LF from the system message. */ + if (msg[length-1] == '\n') { msg[--length] = 0; } @@ -1490,8 +1561,9 @@ AppendSystemError( } sprintf(id, "%ld", error); - Tcl_SetErrorCode(interp, "WINDOWS", id, msg, (char *) NULL); + Tcl_SetErrorCode(interp, "WINDOWS", id, msg, NULL); Tcl_AppendToObj(resultPtr, msg, length); + Tcl_SetObjResult(interp, resultPtr); if (length != 0) { Tcl_DStringFree(&ds); @@ -1503,8 +1575,8 @@ AppendSystemError( * * ConvertDWORD -- * - * This function determines whether a DWORD needs to be byte - * swapped, and returns the appropriately swapped value. + * This function determines whether a DWORD needs to be byte swapped, and + * returns the appropriately swapped value. * * Results: * Returns a converted DWORD. @@ -1527,6 +1599,14 @@ ConvertDWORD( * Check to see if the low bit is in the first byte. */ - localType = (*((char*)(&order)) == 1) ? REG_DWORD : REG_DWORD_BIG_ENDIAN; - return (type != localType) ? SWAPLONG(value) : value; + localType = (*((char*) &order) == 1) ? REG_DWORD : REG_DWORD_BIG_ENDIAN; + return (type != localType) ? (DWORD) SWAPLONG(value) : value; } + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ diff --git a/win/tclWinSerial.c b/win/tclWinSerial.c index 24c6a67..fb092ff 100644 --- a/win/tclWinSerial.c +++ b/win/tclWinSerial.c @@ -1,21 +1,19 @@ /* * tclWinSerial.c -- * - * This file implements the Windows-specific serial port functions, - * and the "serial" channel driver. + * This file implements the Windows-specific serial port functions, and + * the "serial" channel driver. * * Copyright (c) 1999 by Scriptics Corp. * - * See the file "license.terms" for information on usage and redistribution - * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. * * Serial functionality implemented by Rolf.Schroedter@dlr.de */ #include "tclWinInt.h" -#include <fcntl.h> -#include <io.h> #include <sys/stat.h> /* @@ -37,27 +35,30 @@ TCL_DECLARE_MUTEX(serialMutex) * Bit masks used in the flags field of the SerialInfo structure below. */ -#define SERIAL_PENDING (1<<0) /* Message is pending in the queue. */ -#define SERIAL_ASYNC (1<<1) /* Channel is non-blocking. */ +#define SERIAL_PENDING (1<<0) /* Message is pending in the queue. */ +#define SERIAL_ASYNC (1<<1) /* Channel is non-blocking. */ /* * Bit masks used in the sharedFlags field of the SerialInfo structure below. */ -#define SERIAL_EOF (1<<2) /* Serial has reached EOF. */ -#define SERIAL_ERROR (1<<4) +#define SERIAL_EOF (1<<2) /* Serial has reached EOF. */ +#define SERIAL_ERROR (1<<4) /* * Default time to block between checking status on the serial port. */ -#define SERIAL_DEFAULT_BLOCKTIME 10 /* 10 msec */ + +#define SERIAL_DEFAULT_BLOCKTIME 10 /* 10 msec */ /* * Define Win32 read/write error masks returned by ClearCommError() */ -#define SERIAL_READ_ERRORS ( CE_RXOVER | CE_OVERRUN | CE_RXPARITY \ - | CE_FRAME | CE_BREAK ) -#define SERIAL_WRITE_ERRORS ( CE_TXFULL | CE_PTO ) + +#define SERIAL_READ_ERRORS \ + (CE_RXOVER | CE_OVERRUN | CE_RXPARITY | CE_FRAME | CE_BREAK) +#define SERIAL_WRITE_ERRORS \ + (CE_TXFULL | CE_PTO) /* * This structure describes per-instance data for a serial based channel. @@ -65,68 +66,66 @@ TCL_DECLARE_MUTEX(serialMutex) typedef struct SerialInfo { HANDLE handle; - struct SerialInfo *nextPtr; /* Pointer to next registered serial. */ - Tcl_Channel channel; /* Pointer to channel structure. */ - int validMask; /* OR'ed combination of TCL_READABLE, - * TCL_WRITABLE, or TCL_EXCEPTION: indicates - * which operations are valid on the file. */ - int watchMask; /* OR'ed combination of TCL_READABLE, - * TCL_WRITABLE, or TCL_EXCEPTION: indicates - * which events should be reported. */ - int flags; /* State flags, see above for a list. */ - int readable; /* flag that the channel is readable */ - int writable; /* flag that the channel is writable */ - int blockTime; /* max. blocktime in msec */ - unsigned int lastEventTime; /* Time in milliseconds since last readable event */ + struct SerialInfo *nextPtr; /* Pointer to next registered serial. */ + Tcl_Channel channel; /* Pointer to channel structure. */ + int validMask; /* OR'ed combination of TCL_READABLE, + * TCL_WRITABLE, or TCL_EXCEPTION: indicates + * which operations are valid on the file. */ + int watchMask; /* OR'ed combination of TCL_READABLE, + * TCL_WRITABLE, or TCL_EXCEPTION: indicates + * which events should be reported. */ + int flags; /* State flags, see above for a list. */ + int readable; /* Flag that the channel is readable. */ + int writable; /* Flag that the channel is writable. */ + int blockTime; /* Maximum blocktime in msec. */ + unsigned int lastEventTime; /* Time in milliseconds since last readable + * event. */ /* Next readable event only after blockTime */ - DWORD error; /* pending error code returned by - * ClearCommError() */ - DWORD lastError; /* last error code, can be fetched with - * fconfigure chan -lasterror */ - DWORD sysBufRead; /* Win32 system buffer size for read ops, - * default=4096 */ - DWORD sysBufWrite; /* Win32 system buffer size for write ops, - * default=4096 */ - - Tcl_ThreadId threadId; /* Thread to which events should be reported. - * This value is used by the reader/writer - * threads. */ - OVERLAPPED osRead; /* OVERLAPPED structure for read operations */ - OVERLAPPED osWrite; /* OVERLAPPED structure for write operations */ - HANDLE writeThread; /* Handle to writer thread. */ - CRITICAL_SECTION csWrite; /* Writer thread synchronisation */ - HANDLE evWritable; /* Manual-reset event to signal when the - * writer thread has finished waiting for - * the current buffer to be written. */ - HANDLE evStartWriter; /* Auto-reset event used by the main thread to - * signal when the writer thread should attempt - * to write to the serial. */ + DWORD error; /* pending error code returned by + * ClearCommError() */ + DWORD lastError; /* last error code, can be fetched with + * fconfigure chan -lasterror */ + DWORD sysBufRead; /* Win32 system buffer size for read ops, + * default=4096 */ + DWORD sysBufWrite; /* Win32 system buffer size for write ops, + * default=4096 */ + + Tcl_ThreadId threadId; /* Thread to which events should be reported. + * This value is used by the reader/writer + * threads. */ + OVERLAPPED osRead; /* OVERLAPPED structure for read operations. */ + OVERLAPPED osWrite; /* OVERLAPPED structure for write operations */ + HANDLE writeThread; /* Handle to writer thread. */ + CRITICAL_SECTION csWrite; /* Writer thread synchronisation. */ + HANDLE evWritable; /* Manual-reset event to signal when the + * writer thread has finished waiting for the + * current buffer to be written. */ + HANDLE evStartWriter; /* Auto-reset event used by the main thread to + * signal when the writer thread should + * attempt to write to the serial. */ HANDLE evStopWriter; /* Auto-reset event used by the main thread to - * signal when the writer thread should close. + * signal when the writer thread should close. */ - DWORD writeError; /* An error caused by the last background - * write. Set to 0 if no error has been - * detected. This word is shared with the - * writer thread so access must be - * synchronized with the evWritable object. - */ - char *writeBuf; /* Current background output buffer. - * Access is synchronized with the evWritable - * object. */ - int writeBufLen; /* Size of write buffer. Access is - * synchronized with the evWritable - * object. */ - int toWrite; /* Current amount to be written. Access is - * synchronized with the evWritable object. */ - int writeQueue; /* Number of bytes pending in output queue. - * Offset to DCB.cbInQue. - * Used to query [fconfigure -queue] */ + DWORD writeError; /* An error caused by the last background + * write. Set to 0 if no error has been + * detected. This word is shared with the + * writer thread so access must be + * synchronized with the evWritable object. */ + char *writeBuf; /* Current background output buffer. Access is + * synchronized with the evWritable object. */ + int writeBufLen; /* Size of write buffer. Access is + * synchronized with the evWritable object. */ + int toWrite; /* Current amount to be written. Access is + * synchronized with the evWritable object. */ + int writeQueue; /* Number of bytes pending in output queue. + * Offset to DCB.cbInQue. Used to query + * [fconfigure -queue] */ } SerialInfo; typedef struct ThreadSpecificData { /* - * The following pointer refers to the head of the list of serials - * that are being watched for file events. + * The following pointer refers to the head of the list of serials that + * are being watched for file events. */ SerialInfo *firstSerialPtr; @@ -135,17 +134,17 @@ typedef struct ThreadSpecificData { static Tcl_ThreadDataKey dataKey; /* - * The following structure is what is added to the Tcl event queue when - * serial events are generated. + * The following structure is what is added to the Tcl event queue when serial + * events are generated. */ typedef struct SerialEvent { - Tcl_Event header; /* Information that is standard for - * all events. */ - SerialInfo *infoPtr; /* Pointer to serial info structure. Note - * that we still have to verify that the - * serial exists before dereferencing this - * pointer. */ + Tcl_Event header; /* Information that is standard for all + * events. */ + SerialInfo *infoPtr; /* Pointer to serial info structure. Note that + * we still have to verify that the serial + * exists before dereferencing this + * pointer. */ } SerialEvent; /* @@ -153,43 +152,47 @@ typedef struct SerialEvent { */ static COMMTIMEOUTS no_timeout = { - 0, /* ReadIntervalTimeout */ - 0, /* ReadTotalTimeoutMultiplier */ - 0, /* ReadTotalTimeoutConstant */ - 0, /* WriteTotalTimeoutMultiplier */ - 0, /* WriteTotalTimeoutConstant */ + 0, /* ReadIntervalTimeout */ + 0, /* ReadTotalTimeoutMultiplier */ + 0, /* ReadTotalTimeoutConstant */ + 0, /* WriteTotalTimeoutMultiplier */ + 0, /* WriteTotalTimeoutConstant */ }; /* * Declarations for functions used only in this file. */ -static int SerialBlockProc(ClientData instanceData, int mode); -static void SerialCheckProc(ClientData clientData, int flags); -static int SerialCloseProc(ClientData instanceData, - Tcl_Interp *interp); -static int SerialEventProc(Tcl_Event *evPtr, int flags); -static void SerialExitHandler(ClientData clientData); -static int SerialGetHandleProc(ClientData instanceData, - int direction, ClientData *handlePtr); +static int SerialBlockProc(ClientData instanceData, int mode); +static void SerialCheckProc(ClientData clientData, int flags); +static int SerialCloseProc(ClientData instanceData, + Tcl_Interp *interp); +static int SerialEventProc(Tcl_Event *evPtr, int flags); +static void SerialExitHandler(ClientData clientData); +static int SerialGetHandleProc(ClientData instanceData, + int direction, ClientData *handlePtr); static ThreadSpecificData *SerialInit(void); -static int SerialInputProc(ClientData instanceData, char *buf, - int toRead, int *errorCode); -static int SerialOutputProc(ClientData instanceData, CONST char *buf, - int toWrite, int *errorCode); -static void SerialSetupProc(ClientData clientData, int flags); -static void SerialWatchProc(ClientData instanceData, int mask); -static void ProcExitHandler(ClientData clientData); -static int SerialGetOptionProc _ANSI_ARGS_((ClientData instanceData, - Tcl_Interp *interp, CONST char *optionName, - Tcl_DString *dsPtr)); -static int SerialSetOptionProc _ANSI_ARGS_((ClientData instanceData, - Tcl_Interp *interp, CONST char *optionName, - CONST char *value)); -static DWORD WINAPI SerialWriterThread(LPVOID arg); - -static void SerialThreadActionProc _ANSI_ARGS_ (( - ClientData instanceData, int action)); +static int SerialInputProc(ClientData instanceData, char *buf, + int toRead, int *errorCode); +static int SerialOutputProc(ClientData instanceData, + CONST char *buf, int toWrite, int *errorCode); +static void SerialSetupProc(ClientData clientData, int flags); +static void SerialWatchProc(ClientData instanceData, int mask); +static void ProcExitHandler(ClientData clientData); +static int SerialGetOptionProc(ClientData instanceData, + Tcl_Interp *interp, CONST char *optionName, + Tcl_DString *dsPtr); +static int SerialSetOptionProc(ClientData instanceData, + Tcl_Interp *interp, CONST char *optionName, + CONST char *value); +static DWORD WINAPI SerialWriterThread(LPVOID arg); +static void SerialThreadActionProc(ClientData instanceData, + int action); +static int SerialBlockingRead(SerialInfo *infoPtr, LPVOID buf, + DWORD bufSize, LPDWORD lpRead, LPOVERLAPPED osPtr); +static int SerialBlockingWrite(SerialInfo *infoPtr, LPVOID buf, + DWORD bufSize, LPDWORD lpWritten, + LPOVERLAPPED osPtr); /* * This structure describes the channel type structure for command serial @@ -197,42 +200,43 @@ static void SerialThreadActionProc _ANSI_ARGS_ (( */ static Tcl_ChannelType serialChannelType = { - "serial", /* Type name. */ - TCL_CHANNEL_VERSION_4, /* v4 channel */ - SerialCloseProc, /* Close proc. */ - SerialInputProc, /* Input proc. */ - SerialOutputProc, /* Output proc. */ - NULL, /* Seek proc. */ - SerialSetOptionProc, /* Set option proc. */ - SerialGetOptionProc, /* Get option proc. */ - SerialWatchProc, /* Set up notifier to watch the channel. */ - SerialGetHandleProc, /* Get an OS handle from channel. */ - NULL, /* close2proc. */ - SerialBlockProc, /* Set blocking or non-blocking mode.*/ - NULL, /* flush proc. */ - NULL, /* handler proc. */ - NULL, /* wide seek proc */ - SerialThreadActionProc, /* thread action proc */ + "serial", /* Type name. */ + TCL_CHANNEL_VERSION_5, /* v5 channel */ + SerialCloseProc, /* Close proc. */ + SerialInputProc, /* Input proc. */ + SerialOutputProc, /* Output proc. */ + NULL, /* Seek proc. */ + SerialSetOptionProc, /* Set option proc. */ + SerialGetOptionProc, /* Get option proc. */ + SerialWatchProc, /* Set up notifier to watch the channel. */ + SerialGetHandleProc, /* Get an OS handle from channel. */ + NULL, /* close2proc. */ + SerialBlockProc, /* Set blocking or non-blocking mode.*/ + NULL, /* flush proc. */ + NULL, /* handler proc. */ + NULL, /* wide seek proc */ + SerialThreadActionProc, /* thread action proc */ + NULL, /* truncate */ }; - + /* *---------------------------------------------------------------------- * * SerialInit -- * - * This function initializes the static variables for this file. + * This function initializes the static variables for this file. * * Results: - * None. + * None. * * Side effects: - * Creates a new event source. + * Creates a new event source. * *---------------------------------------------------------------------- */ static ThreadSpecificData * -SerialInit() +SerialInit(void) { ThreadSpecificData *tsdPtr; @@ -242,104 +246,107 @@ SerialInit() */ if (!initialized) { - Tcl_MutexLock(&serialMutex); - if (!initialized) { - initialized = 1; - Tcl_CreateExitHandler(ProcExitHandler, NULL); - } - Tcl_MutexUnlock(&serialMutex); + Tcl_MutexLock(&serialMutex); + if (!initialized) { + initialized = 1; + Tcl_CreateExitHandler(ProcExitHandler, NULL); + } + Tcl_MutexUnlock(&serialMutex); } - tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); + tsdPtr = (ThreadSpecificData *) TclThreadDataKeyGet(&dataKey); if (tsdPtr == NULL) { - tsdPtr = TCL_TSD_INIT(&dataKey); - tsdPtr->firstSerialPtr = NULL; - Tcl_CreateEventSource(SerialSetupProc, SerialCheckProc, NULL); - Tcl_CreateThreadExitHandler(SerialExitHandler, NULL); + tsdPtr = TCL_TSD_INIT(&dataKey); + tsdPtr->firstSerialPtr = NULL; + Tcl_CreateEventSource(SerialSetupProc, SerialCheckProc, NULL); + Tcl_CreateThreadExitHandler(SerialExitHandler, NULL); } return tsdPtr; } - + /* *---------------------------------------------------------------------- * * SerialExitHandler -- * - * This function is called to cleanup the serial module before - * Tcl is unloaded. + * This function is called to cleanup the serial module before Tcl is + * unloaded. * * Results: - * None. + * None. * * Side effects: - * Removes the serial event source. + * Removes the serial event source. * *---------------------------------------------------------------------- */ static void SerialExitHandler( - ClientData clientData) /* Old window proc */ + ClientData clientData) /* Old window proc */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); SerialInfo *infoPtr; /* - * Clear all eventually pending output. - * Otherwise Tcl's exit could totally block, - * because it performs a blocking flush on all open channels. - * Note that serial write operations may be blocked due to handshake. + * Clear all eventually pending output. Otherwise Tcl's exit could totally + * block, because it performs a blocking flush on all open channels. Note + * that serial write operations may be blocked due to handshake. */ - for (infoPtr = tsdPtr->firstSerialPtr; infoPtr != NULL; - infoPtr = infoPtr->nextPtr) { - PurgeComm(infoPtr->handle, PURGE_TXABORT | PURGE_RXABORT | PURGE_TXCLEAR - | PURGE_RXCLEAR); + for (infoPtr = tsdPtr->firstSerialPtr; infoPtr != NULL; + infoPtr = infoPtr->nextPtr) { + PurgeComm(infoPtr->handle, + PURGE_TXABORT | PURGE_RXABORT | PURGE_TXCLEAR | PURGE_RXCLEAR); } Tcl_DeleteEventSource(SerialSetupProc, SerialCheckProc, NULL); } - + /* *---------------------------------------------------------------------- * * ProcExitHandler -- * - * This function is called to cleanup the process list before - * Tcl is unloaded. + * This function is called to cleanup the process list before Tcl is + * unloaded. * * Results: - * None. + * None. * * Side effects: - * Resets the process list. + * Resets the process list. * *---------------------------------------------------------------------- */ static void ProcExitHandler( - ClientData clientData) /* Old window proc */ + ClientData clientData) /* Old window proc */ { Tcl_MutexLock(&serialMutex); initialized = 0; Tcl_MutexUnlock(&serialMutex); } - + /* *---------------------------------------------------------------------- * * SerialBlockTime -- * - * Wrapper to set Tcl's block time in msec + * Wrapper to set Tcl's block time in msec * * Results: - * None. + * None. + * + * Side effects: + * Updates the maximum blocking time. + * *---------------------------------------------------------------------- */ static void SerialBlockTime( - int msec) /* milli-seconds */ + int msec) /* milli-seconds */ { Tcl_Time blockTime; @@ -347,22 +354,25 @@ SerialBlockTime( blockTime.usec = (msec % 1000) * 1000; Tcl_SetMaxBlockTime(&blockTime); } + /* *---------------------------------------------------------------------- * * SerialGetMilliseconds -- * - * Get current time in milliseconds, - * Don't care about integer overruns + * Get current time in milliseconds,ignoring integer overruns. * * Results: - * None. + * The current time. + * + * Side effects: + * None. + * *---------------------------------------------------------------------- */ static unsigned int -SerialGetMilliseconds( - void) +SerialGetMilliseconds(void) { Tcl_Time time; @@ -370,82 +380,83 @@ SerialGetMilliseconds( return (time.sec * 1000 + time.usec / 1000); } + /* *---------------------------------------------------------------------- * * SerialSetupProc -- * - * This procedure is invoked before Tcl_DoOneEvent blocks waiting - * for an event. + * This procedure is invoked before Tcl_DoOneEvent blocks waiting for an + * event. * * Results: - * None. + * None. * * Side effects: - * Adjusts the block time if needed. + * Adjusts the block time if needed. * *---------------------------------------------------------------------- */ void SerialSetupProc( - ClientData data, /* Not used. */ - int flags) /* Event flags as passed to Tcl_DoOneEvent. */ + ClientData data, /* Not used. */ + int flags) /* Event flags as passed to Tcl_DoOneEvent. */ { SerialInfo *infoPtr; int block = 1; - int msec = INT_MAX; /* min. found block time */ + int msec = INT_MAX; /* min. found block time */ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); if (!(flags & TCL_FILE_EVENTS)) { - return; + return; } /* - * Look to see if any events handlers installed. If they are, do not block. + * Look to see if any events handlers installed. If they are, do not + * block. */ - for (infoPtr = tsdPtr->firstSerialPtr; infoPtr != NULL; - infoPtr = infoPtr->nextPtr) { - - if (infoPtr->watchMask & TCL_WRITABLE) { - if (WaitForSingleObject(infoPtr->evWritable, 0) != WAIT_TIMEOUT) { - block = 0; - msec = min( msec, infoPtr->blockTime ); - } - } - if( infoPtr->watchMask & TCL_READABLE ) { - block = 0; - msec = min( msec, infoPtr->blockTime ); - } + for (infoPtr=tsdPtr->firstSerialPtr ; infoPtr!=NULL ; + infoPtr=infoPtr->nextPtr) { + if (infoPtr->watchMask & TCL_WRITABLE) { + if (WaitForSingleObject(infoPtr->evWritable, 0) != WAIT_TIMEOUT) { + block = 0; + msec = min(msec, infoPtr->blockTime); + } + } + if (infoPtr->watchMask & TCL_READABLE) { + block = 0; + msec = min(msec, infoPtr->blockTime); + } } if (!block) { - SerialBlockTime(msec); + SerialBlockTime(msec); } } - + /* *---------------------------------------------------------------------- * * SerialCheckProc -- * - * This procedure is called by Tcl_DoOneEvent to check the serial - * event source for events. + * This procedure is called by Tcl_DoOneEvent to check the serial event + * source for events. * * Results: - * None. + * None. * * Side effects: - * May queue an event. + * May queue an event. * *---------------------------------------------------------------------- */ static void SerialCheckProc( - ClientData data, /* Not used. */ - int flags) /* Event flags as passed to Tcl_DoOneEvent. */ + ClientData data, /* Not used. */ + int flags) /* Event flags as passed to Tcl_DoOneEvent. */ { SerialInfo *infoPtr; SerialEvent *evPtr; @@ -455,7 +466,7 @@ SerialCheckProc( unsigned int time; if (!(flags & TCL_FILE_EVENTS)) { - return; + return; } /* @@ -463,81 +474,81 @@ SerialCheckProc( * queued. */ - for (infoPtr = tsdPtr->firstSerialPtr; infoPtr != NULL; - infoPtr = infoPtr->nextPtr) { - if (infoPtr->flags & SERIAL_PENDING) { - continue; - } - - needEvent = 0; - - /* - * If WRITABLE watch mask is set - * look for infoPtr->evWritable object - */ - if (infoPtr->watchMask & TCL_WRITABLE) { - if (WaitForSingleObject(infoPtr->evWritable, 0) != WAIT_TIMEOUT) { - infoPtr->writable = 1; - needEvent = 1; - } - } - - /* - * If READABLE watch mask is set - * call ClearCommError to poll cbInQue - * Window errors are ignored here - */ - - if( infoPtr->watchMask & TCL_READABLE ) { - if( ClearCommError( infoPtr->handle, &infoPtr->error, &cStat ) ) { - /* - * Look for characters already pending in windows queue. - * If they are, poll. - */ - - if( infoPtr->watchMask & TCL_READABLE ) { - /* - * force fileevent after serial read error - */ - if( (cStat.cbInQue > 0) || - (infoPtr->error & SERIAL_READ_ERRORS) ) { - infoPtr->readable = 1; + for (infoPtr=tsdPtr->firstSerialPtr ; infoPtr!=NULL ; + infoPtr=infoPtr->nextPtr) { + if (infoPtr->flags & SERIAL_PENDING) { + continue; + } + + needEvent = 0; + + /* + * If WRITABLE watch mask is set look for infoPtr->evWritable object. + */ + + if (infoPtr->watchMask & TCL_WRITABLE && + WaitForSingleObject(infoPtr->evWritable, 0) != WAIT_TIMEOUT) { + infoPtr->writable = 1; + needEvent = 1; + } + + /* + * If READABLE watch mask is set call ClearCommError to poll cbInQue. + * Window errors are ignored here. + */ + + if (infoPtr->watchMask & TCL_READABLE) { + if (ClearCommError(infoPtr->handle, &infoPtr->error, &cStat)) { + /* + * Look for characters already pending in windows queue. If + * they are, poll. + */ + + if (infoPtr->watchMask & TCL_READABLE) { + /* + * Force fileevent after serial read error. + */ + + if ((cStat.cbInQue > 0) || + (infoPtr->error & SERIAL_READ_ERRORS)) { + infoPtr->readable = 1; time = SerialGetMilliseconds(); if ((unsigned int) (time - infoPtr->lastEventTime) >= (unsigned int) infoPtr->blockTime) { needEvent = 1; infoPtr->lastEventTime = time; } - } - } - } - } - - /* - * Queue an event if the serial is signaled for reading or writing. - */ - if (needEvent) { - infoPtr->flags |= SERIAL_PENDING; - evPtr = (SerialEvent *) ckalloc(sizeof(SerialEvent)); - evPtr->header.proc = SerialEventProc; - evPtr->infoPtr = infoPtr; - Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL); - } + } + } + } + } + + /* + * Queue an event if the serial is signaled for reading or writing. + */ + + if (needEvent) { + infoPtr->flags |= SERIAL_PENDING; + evPtr = (SerialEvent *) ckalloc(sizeof(SerialEvent)); + evPtr->header.proc = SerialEventProc; + evPtr->infoPtr = infoPtr; + Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL); + } } } - + /* *---------------------------------------------------------------------- * * SerialBlockProc -- * - * Set blocking or non-blocking mode on channel. + * Set blocking or non-blocking mode on channel. * * Results: - * 0 if successful, errno when failed. + * 0 if successful, errno when failed. * * Side effects: - * Sets the device into blocking or non-blocking mode. + * Sets the device into blocking or non-blocking mode. * *---------------------------------------------------------------------- */ @@ -545,39 +556,38 @@ SerialCheckProc( static int SerialBlockProc( ClientData instanceData, /* Instance data for channel. */ - int mode) /* TCL_MODE_BLOCKING or - * TCL_MODE_NONBLOCKING. */ + int mode) /* TCL_MODE_BLOCKING or + * TCL_MODE_NONBLOCKING. */ { int errorCode = 0; - SerialInfo *infoPtr = (SerialInfo *) instanceData; /* - * Only serial READ can be switched between blocking & nonblocking - * using COMMTIMEOUTS. - * Serial write emulates blocking & nonblocking by the SerialWriterThread. + * Only serial READ can be switched between blocking & nonblocking using + * COMMTIMEOUTS. Serial write emulates blocking & nonblocking by the + * SerialWriterThread. */ if (mode == TCL_MODE_NONBLOCKING) { - infoPtr->flags |= SERIAL_ASYNC; + infoPtr->flags |= SERIAL_ASYNC; } else { - infoPtr->flags &= ~(SERIAL_ASYNC); + infoPtr->flags &= ~(SERIAL_ASYNC); } return errorCode; } - + /* *---------------------------------------------------------------------- * * SerialCloseProc -- * - * Closes a serial based IO channel. + * Closes a serial based IO channel. * * Results: - * 0 on success, errno otherwise. + * 0 on success, errno otherwise. * * Side effects: - * Closes the physical channel. + * Closes the physical channel. * *---------------------------------------------------------------------- */ @@ -585,7 +595,7 @@ SerialBlockProc( static int SerialCloseProc( ClientData instanceData, /* Pointer to SerialInfo structure. */ - Tcl_Interp *interp) /* For error reporting. */ + Tcl_Interp *interp) /* For error reporting. */ { SerialInfo *serialPtr = (SerialInfo *) instanceData; int errorCode, result = 0; @@ -596,48 +606,45 @@ SerialCloseProc( errorCode = 0; if (serialPtr->validMask & TCL_READABLE) { - PurgeComm(serialPtr->handle, PURGE_RXABORT | PURGE_RXCLEAR); - CloseHandle(serialPtr->osRead.hEvent); + PurgeComm(serialPtr->handle, PURGE_RXABORT | PURGE_RXCLEAR); + CloseHandle(serialPtr->osRead.hEvent); } serialPtr->validMask &= ~TCL_READABLE; - - if (serialPtr->validMask & TCL_WRITABLE) { - /* - * Generally we cannot wait for a pending write operation - * because it may hang due to handshake - * WaitForSingleObject(serialPtr->evWritable, INFINITE); - */ + if (serialPtr->validMask & TCL_WRITABLE) { + /* + * Generally we cannot wait for a pending write operation because it + * may hang due to handshake + * WaitForSingleObject(serialPtr->evWritable, INFINITE); + */ /* - * The thread may have already closed on it's own. Check it's - * exit code. + * The thread may have already closed on it's own. Check it's exit + * code. */ GetExitCodeThread(serialPtr->writeThread, &exitCode); if (exitCode == STILL_ACTIVE) { /* - * Set the stop event so that if the writer thread is - * blocked in SerialWriterThread on WaitForMultipleEvents, it - * will exit cleanly. + * Set the stop event so that if the writer thread is blocked in + * SerialWriterThread on WaitForMultipleEvents, it will exit + * cleanly. */ SetEvent(serialPtr->evStopWriter); /* - * Wait at most 20 milliseconds for the writer thread to - * close. + * Wait at most 20 milliseconds for the writer thread to close. */ - if (WaitForSingleObject(serialPtr->writeThread, 20) - == WAIT_TIMEOUT) { + if (WaitForSingleObject(serialPtr->writeThread, + 20) == WAIT_TIMEOUT) { /* - * Forcibly terminate the background thread as a last - * resort. Note that we need to guard against - * terminating the thread while it is in the middle of - * Tcl_ThreadAlert because it won't be able to release - * the notifier lock. + * Forcibly terminate the background thread as a last resort. + * Note that we need to guard against terminating the thread + * while it is in the middle of Tcl_ThreadAlert because it + * won't be able to release the notifier lock. */ Tcl_MutexLock(&serialMutex); @@ -649,33 +656,33 @@ SerialCloseProc( } } - CloseHandle(serialPtr->writeThread); + CloseHandle(serialPtr->writeThread); CloseHandle(serialPtr->osWrite.hEvent); - CloseHandle(serialPtr->evWritable); - CloseHandle(serialPtr->evStartWriter); - CloseHandle(serialPtr->evStopWriter); - serialPtr->writeThread = NULL; + CloseHandle(serialPtr->evWritable); + CloseHandle(serialPtr->evStartWriter); + CloseHandle(serialPtr->evStopWriter); + serialPtr->writeThread = NULL; - PurgeComm(serialPtr->handle, PURGE_TXABORT | PURGE_TXCLEAR); + PurgeComm(serialPtr->handle, PURGE_TXABORT | PURGE_TXCLEAR); } serialPtr->validMask &= ~TCL_WRITABLE; DeleteCriticalSection(&serialPtr->csWrite); /* - * Don't close the Win32 handle if the handle is a standard channel - * during the thread exit process. Otherwise, one thread may kill - * the stdio of another. + * Don't close the Win32 handle if the handle is a standard channel during + * the thread exit process. Otherwise, one thread may kill the stdio of + * another. */ if (!TclInThreadExit() - || ((GetStdHandle(STD_INPUT_HANDLE) != serialPtr->handle) - && (GetStdHandle(STD_OUTPUT_HANDLE) != serialPtr->handle) - && (GetStdHandle(STD_ERROR_HANDLE) != serialPtr->handle))) { - if (CloseHandle(serialPtr->handle) == FALSE) { - TclWinConvertError(GetLastError()); - errorCode = errno; - } + || ((GetStdHandle(STD_INPUT_HANDLE) != serialPtr->handle) + && (GetStdHandle(STD_OUTPUT_HANDLE) != serialPtr->handle) + && (GetStdHandle(STD_ERROR_HANDLE) != serialPtr->handle))) { + if (CloseHandle(serialPtr->handle) == FALSE) { + TclWinConvertError(GetLastError()); + errorCode = errno; + } } serialPtr->watchMask &= serialPtr->validMask; @@ -684,148 +691,176 @@ SerialCloseProc( * Remove the file from the list of watched files. */ - for (nextPtrPtr = &(tsdPtr->firstSerialPtr), infoPtr = *nextPtrPtr; - infoPtr != NULL; - nextPtrPtr = &infoPtr->nextPtr, infoPtr = *nextPtrPtr) { - if (infoPtr == (SerialInfo *)serialPtr) { - *nextPtrPtr = infoPtr->nextPtr; - break; - } + for (nextPtrPtr=&(tsdPtr->firstSerialPtr), infoPtr=*nextPtrPtr; + infoPtr!=NULL; + nextPtrPtr=&infoPtr->nextPtr, infoPtr=*nextPtrPtr) { + if (infoPtr == (SerialInfo *)serialPtr) { + *nextPtrPtr = infoPtr->nextPtr; + break; + } } /* - * Wrap the error file into a channel and give it to the cleanup - * routine. + * Wrap the error file into a channel and give it to the cleanup routine. */ + if (serialPtr->writeBuf != NULL) { - ckfree(serialPtr->writeBuf); - serialPtr->writeBuf = NULL; + ckfree(serialPtr->writeBuf); + serialPtr->writeBuf = NULL; } ckfree((char*) serialPtr); if (errorCode == 0) { - return result; + return result; } return errorCode; } - + /* *---------------------------------------------------------------------- * - * blockingRead -- + * SerialBlockingRead -- * - * Perform a blocking read into the buffer given. Returns - * count of how many bytes were actually read, and an error indication. + * Perform a blocking read into the buffer given. Returns count of how + * many bytes were actually read, and an error indication. * * Results: - * A count of how many bytes were read is returned and an error - * indication is returned. + * A count of how many bytes were read is returned and an error + * indication is returned. * * Side effects: - * Reads input from the actual channel. + * Reads input from the actual channel. * *---------------------------------------------------------------------- */ + static int -blockingRead( - SerialInfo *infoPtr, /* Serial info structure */ - LPVOID buf, /* The input buffer pointer */ - DWORD bufSize, /* The number of bytes to read */ - LPDWORD lpRead, /* Returns number of bytes read */ - LPOVERLAPPED osPtr ) /* OVERLAPPED structure */ +SerialBlockingRead( + SerialInfo *infoPtr, /* Serial info structure */ + LPVOID buf, /* The input buffer pointer */ + DWORD bufSize, /* The number of bytes to read */ + LPDWORD lpRead, /* Returns number of bytes read */ + LPOVERLAPPED osPtr) /* OVERLAPPED structure */ { /* - * Perform overlapped blocking read. + * Perform overlapped blocking read. * 1. Reset the overlapped event * 2. Start overlapped read operation * 3. Wait for completion */ - /* + /* * Set Offset to ZERO, otherwise NT4.0 may report an error. */ + osPtr->Offset = osPtr->OffsetHigh = 0; ResetEvent(osPtr->hEvent); - if (! ReadFile(infoPtr->handle, buf, bufSize, lpRead, osPtr) ) { - if (GetLastError() != ERROR_IO_PENDING) { - /* ReadFile failed, but it isn't delayed. Report error. */ - return FALSE; - } else { - /* Read is pending, wait for completion, timeout ? */ - if (! GetOverlappedResult(infoPtr->handle, osPtr, lpRead, TRUE) ) { - return FALSE; - } - } + if (!ReadFile(infoPtr->handle, buf, bufSize, lpRead, osPtr)) { + if (GetLastError() != ERROR_IO_PENDING) { + /* + * ReadFile failed, but it isn't delayed. Report error. + */ + + return FALSE; + } else { + /* + * Read is pending, wait for completion, timeout? + */ + + if (!GetOverlappedResult(infoPtr->handle, osPtr, lpRead, TRUE)) { + return FALSE; + } + } } else { - /* ReadFile completed immediately. */ + /* + * ReadFile completed immediately. + */ } return TRUE; } - + /* *---------------------------------------------------------------------- * - * blockingWrite -- + * SerialBlockingWrite -- * - * Perform a blocking write from the buffer given. Returns - * count of how many bytes were actually written, and an error indication. + * Perform a blocking write from the buffer given. Returns count of how + * many bytes were actually written, and an error indication. * * Results: - * A count of how many bytes were written is returned and an error - * indication is returned. + * A count of how many bytes were written is returned and an error + * indication is returned. * * Side effects: - * Writes output to the actual channel. + * Writes output to the actual channel. * *---------------------------------------------------------------------- */ + static int -blockingWrite( - SerialInfo *infoPtr, /* Serial info structure */ - LPVOID buf, /* The output buffer pointer */ - DWORD bufSize, /* The number of bytes to write */ - LPDWORD lpWritten, /* Returns number of bytes written */ - LPOVERLAPPED osPtr ) /* OVERLAPPED structure */ +SerialBlockingWrite( + SerialInfo *infoPtr, /* Serial info structure */ + LPVOID buf, /* The output buffer pointer */ + DWORD bufSize, /* The number of bytes to write */ + LPDWORD lpWritten, /* Returns number of bytes written */ + LPOVERLAPPED osPtr) /* OVERLAPPED structure */ { int result; + /* - * Perform overlapped blocking write. - * 1. Reset the overlapped event - * 2. Remove these bytes from the output queue counter - * 3. Start overlapped write operation - * 3. Remove these bytes from the output queue counter - * 4. Wait for completion - * 5. Adjust the output queue counter - */ + * Perform overlapped blocking write. + * 1. Reset the overlapped event + * 2. Remove these bytes from the output queue counter + * 3. Start overlapped write operation + * 3. Remove these bytes from the output queue counter + * 4. Wait for completion + * 5. Adjust the output queue counter + */ + ResetEvent(osPtr->hEvent); EnterCriticalSection(&infoPtr->csWrite); infoPtr->writeQueue -= bufSize; - /* - * Set Offset to ZERO, otherwise NT4.0 may report an error - */ - osPtr->Offset = osPtr->OffsetHigh = 0; + + /* + * Set Offset to ZERO, otherwise NT4.0 may report an error + */ + + osPtr->Offset = osPtr->OffsetHigh = 0; result = WriteFile(infoPtr->handle, buf, bufSize, lpWritten, osPtr); LeaveCriticalSection(&infoPtr->csWrite); - if (result == FALSE ) { - int err = GetLastError(); - switch (err) { - case ERROR_IO_PENDING: - /* Write is pending, wait for completion */ - if (! GetOverlappedResult(infoPtr->handle, osPtr, lpWritten, TRUE) ) { - return FALSE; - } - break; - case ERROR_COUNTER_TIMEOUT: - /* Write timeout handled in SerialOutputProc */ - break; - default: - /* WriteFile failed, but it isn't delayed. Report error */ - return FALSE; - } + if (result == FALSE) { + int err = GetLastError(); + + switch (err) { + case ERROR_IO_PENDING: + /* + * Write is pending, wait for completion. + */ + + if (!GetOverlappedResult(infoPtr->handle, osPtr, lpWritten, + TRUE)) { + return FALSE; + } + break; + case ERROR_COUNTER_TIMEOUT: + /* + * Write timeout handled in SerialOutputProc. + */ + + break; + default: + /* + * WriteFile failed, but it isn't delayed. Report error. + */ + + return FALSE; + } } else { - /* WriteFile completed immediately. */ + /* + * WriteFile completed immediately. + */ } EnterCriticalSection(&infoPtr->csWrite); @@ -834,31 +869,32 @@ blockingWrite( return TRUE; } - + /* *---------------------------------------------------------------------- * * SerialInputProc -- * - * Reads input from the IO channel into the buffer given. Returns - * count of how many bytes were actually read, and an error indication. + * Reads input from the IO channel into the buffer given. Returns count + * of how many bytes were actually read, and an error indication. * * Results: - * A count of how many bytes were read is returned and an error - * indication is returned in an output argument. + * A count of how many bytes were read is returned and an error + * indication is returned in an output argument. * * Side effects: - * Reads input from the actual channel. + * Reads input from the actual channel. * *---------------------------------------------------------------------- */ + static int SerialInputProc( - ClientData instanceData, /* Serial state. */ - char *buf, /* Where to store data read. */ - int bufSize, /* How much space is available - * in the buffer? */ - int *errorCode) /* Where to store error code. */ + ClientData instanceData, /* Serial state. */ + char *buf, /* Where to store data read. */ + int bufSize, /* How much space is available in the + * buffer? */ + int *errorCode) /* Where to store error code. */ { SerialInfo *infoPtr = (SerialInfo *) instanceData; DWORD bytesRead = 0; @@ -869,104 +905,102 @@ SerialInputProc( /* * Check if there is a CommError pending from SerialCheckProc */ - if( infoPtr->error & SERIAL_READ_ERRORS ){ - goto commError; + + if (infoPtr->error & SERIAL_READ_ERRORS) { + goto commError; } /* - * Look for characters already pending in windows queue. - * This is the mainly restored good old code from Tcl8.0 + * Look for characters already pending in windows queue. This is the + * mainly restored good old code from Tcl8.0 */ - if( ClearCommError( infoPtr->handle, &infoPtr->error, &cStat ) ) { - /* - * Check for errors here, but not in the evSetup/Check procedures - */ - - if( infoPtr->error & SERIAL_READ_ERRORS ) { - goto commError; - } - if( infoPtr->flags & SERIAL_ASYNC ) { - /* - * NON_BLOCKING mode: - * Avoid blocking by reading more bytes than available - * in input buffer - */ - - if( cStat.cbInQue > 0 ) { - if( (DWORD) bufSize > cStat.cbInQue ) { - bufSize = cStat.cbInQue; - } - } else { - errno = *errorCode = EAGAIN; - return -1; - } - } else { - /* - * BLOCKING mode: - * Tcl trys to read a full buffer of 4 kBytes here - */ - - if( cStat.cbInQue > 0 ) { - if( (DWORD) bufSize > cStat.cbInQue ) { - bufSize = cStat.cbInQue; - } - } else { - bufSize = 1; - } - } - } - - if( bufSize == 0 ) { - return bytesRead = 0; + if (ClearCommError(infoPtr->handle, &infoPtr->error, &cStat)) { + /* + * Check for errors here, but not in the evSetup/Check procedures. + */ + + if (infoPtr->error & SERIAL_READ_ERRORS) { + goto commError; + } + if (infoPtr->flags & SERIAL_ASYNC) { + /* + * NON_BLOCKING mode: Avoid blocking by reading more bytes than + * available in input buffer. + */ + + if (cStat.cbInQue > 0) { + if ((DWORD) bufSize > cStat.cbInQue) { + bufSize = cStat.cbInQue; + } + } else { + errno = *errorCode = EAGAIN; + return -1; + } + } else { + /* + * BLOCKING mode: Tcl trys to read a full buffer of 4 kBytes here. + */ + + if (cStat.cbInQue > 0) { + if ((DWORD) bufSize > cStat.cbInQue) { + bufSize = cStat.cbInQue; + } + } else { + bufSize = 1; + } + } + } + + if (bufSize == 0) { + return bytesRead = 0; } /* - * Perform blocking read. Doesn't block in non-blocking mode, - * because we checked the number of available bytes. - */ - if (blockingRead(infoPtr, (LPVOID) buf, (DWORD) bufSize, &bytesRead, - &infoPtr->osRead) == FALSE) { - goto error; + * Perform blocking read. Doesn't block in non-blocking mode, because we + * checked the number of available bytes. + */ + + if (SerialBlockingRead(infoPtr, (LPVOID) buf, (DWORD) bufSize, &bytesRead, + &infoPtr->osRead) == FALSE) { + TclWinConvertError(GetLastError()); + *errorCode = errno; + return -1; } return bytesRead; -error: - TclWinConvertError(GetLastError()); - *errorCode = errno; - return -1; - -commError: - infoPtr->lastError = infoPtr->error; /* save last error code */ - infoPtr->error = 0; /* reset error code */ - *errorCode = EIO; /* to return read-error only once */ + commError: + infoPtr->lastError = infoPtr->error; + /* save last error code */ + infoPtr->error = 0; /* reset error code */ + *errorCode = EIO; /* to return read-error only once */ return -1; } - + /* *---------------------------------------------------------------------- * * SerialOutputProc -- * - * Writes the given output on the IO channel. Returns count of how - * many characters were actually written, and an error indication. + * Writes the given output on the IO channel. Returns count of how many + * characters were actually written, and an error indication. * * Results: - * A count of how many characters were written is returned and an - * error indication is returned in an output argument. + * A count of how many characters were written is returned and an error + * indication is returned in an output argument. * * Side effects: - * Writes output on the actual channel. + * Writes output on the actual channel. * *---------------------------------------------------------------------- */ static int SerialOutputProc( - ClientData instanceData, /* Serial state. */ - CONST char *buf, /* The data buffer. */ - int toWrite, /* How many bytes to write? */ - int *errorCode) /* Where to store error code. */ + ClientData instanceData, /* Serial state. */ + CONST char *buf, /* The data buffer. */ + int toWrite, /* How many bytes to write? */ + int *errorCode) /* Where to store error code. */ { SerialInfo *infoPtr = (SerialInfo *) instanceData; DWORD bytesWritten, timeout; @@ -974,136 +1008,145 @@ SerialOutputProc( *errorCode = 0; /* - * At EXIT Tcl trys to flush all open channels in blocking mode. - * We avoid blocking output after ExitProc or CloseHandler(chan) - * has been called by checking the corrresponding variables. + * At EXIT Tcl trys to flush all open channels in blocking mode. We avoid + * blocking output after ExitProc or CloseHandler(chan) has been called by + * checking the corrresponding variables. */ - if( ! initialized || TclInExit() ) { - return toWrite; + + if (!initialized || TclInExit()) { + return toWrite; } /* * Check if there is a CommError pending from SerialCheckProc */ - if( infoPtr->error & SERIAL_WRITE_ERRORS ){ - infoPtr->lastError = infoPtr->error; /* save last error code */ - infoPtr->error = 0; /* reset error code */ - errno = EIO; - goto error; + + if (infoPtr->error & SERIAL_WRITE_ERRORS) { + infoPtr->lastError = infoPtr->error; + /* save last error code */ + infoPtr->error = 0; /* reset error code */ + errno = EIO; + goto error; } timeout = (infoPtr->flags & SERIAL_ASYNC) ? 0 : INFINITE; if (WaitForSingleObject(infoPtr->evWritable, timeout) == WAIT_TIMEOUT) { - /* - * The writer thread is blocked waiting for a write to complete - * and the channel is in non-blocking mode. - */ + /* + * The writer thread is blocked waiting for a write to complete and + * the channel is in non-blocking mode. + */ - errno = EWOULDBLOCK; - goto error1; + errno = EWOULDBLOCK; + goto error1; } + /* * Check for a background error on the last write. */ if (infoPtr->writeError) { - TclWinConvertError(infoPtr->writeError); - infoPtr->writeError = 0; - goto error1; + TclWinConvertError(infoPtr->writeError); + infoPtr->writeError = 0; + goto error1; } /* * Remember the number of bytes in output queue */ + EnterCriticalSection(&infoPtr->csWrite); infoPtr->writeQueue += toWrite; LeaveCriticalSection(&infoPtr->csWrite); if (infoPtr->flags & SERIAL_ASYNC) { - /* - * The serial is non-blocking, so copy the data into the output - * buffer and restart the writer thread. - */ - - if (toWrite > infoPtr->writeBufLen) { - /* - * Reallocate the buffer to be large enough to hold the data. - */ - - if (infoPtr->writeBuf) { - ckfree(infoPtr->writeBuf); - } - infoPtr->writeBufLen = toWrite; - infoPtr->writeBuf = ckalloc((unsigned int) toWrite); - } - memcpy(infoPtr->writeBuf, buf, (size_t) toWrite); - infoPtr->toWrite = toWrite; - ResetEvent(infoPtr->evWritable); - SetEvent(infoPtr->evStartWriter); - bytesWritten = (DWORD) toWrite; + /* + * The serial is non-blocking, so copy the data into the output buffer + * and restart the writer thread. + */ + + if (toWrite > infoPtr->writeBufLen) { + /* + * Reallocate the buffer to be large enough to hold the data. + */ + + if (infoPtr->writeBuf) { + ckfree(infoPtr->writeBuf); + } + infoPtr->writeBufLen = toWrite; + infoPtr->writeBuf = ckalloc((unsigned int) toWrite); + } + memcpy(infoPtr->writeBuf, buf, (size_t) toWrite); + infoPtr->toWrite = toWrite; + ResetEvent(infoPtr->evWritable); + SetEvent(infoPtr->evStartWriter); + bytesWritten = (DWORD) toWrite; } else { - /* - * In the blocking case, just try to write the buffer directly. - * This avoids an unnecessary copy. - */ - if (! blockingWrite(infoPtr, (LPVOID) buf, (DWORD) toWrite, - &bytesWritten, &infoPtr->osWrite) ) { - goto writeError; - } - if (bytesWritten != (DWORD) toWrite) { - /* Write timeout */ - infoPtr->lastError |= CE_PTO; - errno = EIO; - goto error; - } + /* + * In the blocking case, just try to write the buffer directly. This + * avoids an unnecessary copy. + */ + + if (!SerialBlockingWrite(infoPtr, (LPVOID) buf, (DWORD) toWrite, + &bytesWritten, &infoPtr->osWrite)) { + goto writeError; + } + if (bytesWritten != (DWORD) toWrite) { + /* + * Write timeout. + */ + infoPtr->lastError |= CE_PTO; + errno = EIO; + goto error; + } } return (int) bytesWritten; -writeError: + writeError: TclWinConvertError(GetLastError()); -error: - /* - * Reset the output queue counter on error during blocking output + error: + /* + * Reset the output queue counter on error during blocking output */ -/* - EnterCriticalSection(&infoPtr->csWrite); - infoPtr->writeQueue = 0; - LeaveCriticalSection(&infoPtr->csWrite); -*/ - error1: + + /* + * EnterCriticalSection(&infoPtr->csWrite); + * infoPtr->writeQueue = 0; + * LeaveCriticalSection(&infoPtr->csWrite); + */ + error1: *errorCode = errno; return -1; } - + /* *---------------------------------------------------------------------- * * SerialEventProc -- * - * This function is invoked by Tcl_ServiceEvent when a file event - * reaches the front of the event queue. This procedure invokes - * Tcl_NotifyChannel on the serial. + * This function is invoked by Tcl_ServiceEvent when a file event reaches + * the front of the event queue. This procedure invokes Tcl_NotifyChannel + * on the serial. * * Results: - * Returns 1 if the event was handled, meaning it should be removed - * from the queue. Returns 0 if the event was not handled, meaning - * it should stay on the queue. The only time the event isn't - * handled is if the TCL_FILE_EVENTS flag bit isn't set. + * Returns 1 if the event was handled, meaning it should be removed from + * the queue. Returns 0 if the event was not handled, meaning it should + * stay on the queue. The only time the event isn't handled is if the + * TCL_FILE_EVENTS flag bit isn't set. * * Side effects: - * Whatever the notifier callback does. + * Whatever the notifier callback does. * *---------------------------------------------------------------------- */ static int SerialEventProc( - Tcl_Event *evPtr, /* Event to service. */ - int flags) /* Flags that indicate what events to - * handle, such as TCL_FILE_EVENTS. */ + Tcl_Event *evPtr, /* Event to service. */ + int flags) /* Flags that indicate what events to handle, + * such as TCL_FILE_EVENTS. */ { SerialEvent *serialEvPtr = (SerialEvent *)evPtr; SerialInfo *infoPtr; @@ -1111,22 +1154,22 @@ SerialEventProc( ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); if (!(flags & TCL_FILE_EVENTS)) { - return 0; + return 0; } /* * Search through the list of watched serials for the one whose handle - * matches the event. We do this rather than simply dereferencing - * the handle in the event so that serials can be deleted while the - * event is in the queue. + * matches the event. We do this rather than simply dereferencing the + * handle in the event so that serials can be deleted while the event is + * in the queue. */ for (infoPtr = tsdPtr->firstSerialPtr; infoPtr != NULL; - infoPtr = infoPtr->nextPtr) { - if (serialEvPtr->infoPtr == infoPtr) { - infoPtr->flags &= ~(SERIAL_PENDING); - break; - } + infoPtr = infoPtr->nextPtr) { + if (serialEvPtr->infoPtr == infoPtr) { + infoPtr->flags &= ~(SERIAL_PENDING); + break; + } } /* @@ -1134,28 +1177,28 @@ SerialEventProc( */ if (!infoPtr) { - return 1; + return 1; } /* - * Check to see if the serial is readable. Note - * that we can't tell if a serial is writable, so we always report it - * as being writable unless we have detected EOF. + * Check to see if the serial is readable. Note that we can't tell if a + * serial is writable, so we always report it as being writable unless we + * have detected EOF. */ mask = 0; - if( infoPtr->watchMask & TCL_WRITABLE ) { - if( infoPtr->writable ) { - mask |= TCL_WRITABLE; - infoPtr->writable = 0; - } + if (infoPtr->watchMask & TCL_WRITABLE) { + if (infoPtr->writable) { + mask |= TCL_WRITABLE; + infoPtr->writable = 0; + } } - if( infoPtr->watchMask & TCL_READABLE ) { - if( infoPtr->readable ) { - mask |= TCL_READABLE; - infoPtr->readable = 0; - } + if (infoPtr->watchMask & TCL_READABLE) { + if (infoPtr->readable) { + mask |= TCL_READABLE; + infoPtr->readable = 0; + } } /* @@ -1165,30 +1208,29 @@ SerialEventProc( Tcl_NotifyChannel(infoPtr->channel, infoPtr->watchMask & mask); return 1; } - + /* *---------------------------------------------------------------------- * * SerialWatchProc -- * - * Called by the notifier to set up to watch for events on this - * channel. + * Called by the notifier to set up to watch for events on this channel. * * Results: - * None. + * None. * * Side effects: - * None. + * None. * *---------------------------------------------------------------------- */ static void SerialWatchProc( - ClientData instanceData, /* Serial state. */ - int mask) /* What events to watch for, OR-ed - * combination of TCL_READABLE, - * TCL_WRITABLE and TCL_EXCEPTION. */ + ClientData instanceData, /* Serial state. */ + int mask) /* What events to watch for, OR-ed combination + * of TCL_READABLE, TCL_WRITABLE and + * TCL_EXCEPTION. */ { SerialInfo **nextPtrPtr, *ptr; SerialInfo *infoPtr = (SerialInfo *) instanceData; @@ -1196,232 +1238,240 @@ SerialWatchProc( ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); /* - * Since the file is always ready for events, we set the block time - * so we will poll. + * Since the file is always ready for events, we set the block time so we + * will poll. */ infoPtr->watchMask = mask & infoPtr->validMask; if (infoPtr->watchMask) { - if (!oldMask) { - infoPtr->nextPtr = tsdPtr->firstSerialPtr; - tsdPtr->firstSerialPtr = infoPtr; - } - SerialBlockTime(infoPtr->blockTime); - } else { - if (oldMask) { - /* - * Remove the serial port from the list of watched serial ports. - */ - - for (nextPtrPtr = &(tsdPtr->firstSerialPtr), ptr = *nextPtrPtr; - ptr != NULL; - nextPtrPtr = &ptr->nextPtr, ptr = *nextPtrPtr) { - if (infoPtr == ptr) { - *nextPtrPtr = ptr->nextPtr; - break; - } - } - } + if (!oldMask) { + infoPtr->nextPtr = tsdPtr->firstSerialPtr; + tsdPtr->firstSerialPtr = infoPtr; + } + SerialBlockTime(infoPtr->blockTime); + } else if (oldMask) { + /* + * Remove the serial port from the list of watched serial ports. + */ + + for (nextPtrPtr=&(tsdPtr->firstSerialPtr), ptr=*nextPtrPtr; ptr!=NULL; + nextPtrPtr=&ptr->nextPtr, ptr=*nextPtrPtr) { + if (infoPtr == ptr) { + *nextPtrPtr = ptr->nextPtr; + break; + } + } } } - + /* *---------------------------------------------------------------------- * * SerialGetHandleProc -- * - * Called from Tcl_GetChannelHandle to retrieve OS handles from - * inside a command serial port based channel. + * Called from Tcl_GetChannelHandle to retrieve OS handles from inside a + * command serial port based channel. * * Results: - * Returns TCL_OK with the fd in handlePtr, or TCL_ERROR if - * there is no handle for the specified direction. + * Returns TCL_OK with the fd in handlePtr, or TCL_ERROR if there is no + * handle for the specified direction. * * Side effects: - * None. + * None. * *---------------------------------------------------------------------- */ static int SerialGetHandleProc( - ClientData instanceData, /* The serial state. */ - int direction, /* TCL_READABLE or TCL_WRITABLE */ - ClientData *handlePtr) /* Where to store the handle. */ + ClientData instanceData, /* The serial state. */ + int direction, /* TCL_READABLE or TCL_WRITABLE */ + ClientData *handlePtr) /* Where to store the handle. */ { SerialInfo *infoPtr = (SerialInfo *) instanceData; *handlePtr = (ClientData) infoPtr->handle; return TCL_OK; } - + /* *---------------------------------------------------------------------- * * SerialWriterThread -- * - * This function runs in a separate thread and writes data - * onto a serial. + * This function runs in a separate thread and writes data onto a serial. * * Results: - * Always returns 0. + * Always returns 0. * * Side effects: - * Signals the main thread when an output operation is completed. - * May cause the main thread to wake up by posting a message. + * Signals the main thread when an output operation is completed. May + * cause the main thread to wake up by posting a message. * *---------------------------------------------------------------------- */ static DWORD WINAPI -SerialWriterThread(LPVOID arg) +SerialWriterThread( + LPVOID arg) { - SerialInfo *infoPtr = (SerialInfo *)arg; DWORD bytesWritten, toWrite, waitResult; char *buf; - OVERLAPPED myWrite; /* have an own OVERLAPPED in this thread */ + OVERLAPPED myWrite; /* Have an own OVERLAPPED in this thread. */ HANDLE wEvents[2]; /* * The stop event takes precedence by being first in the list. */ + wEvents[0] = infoPtr->evStopWriter; wEvents[1] = infoPtr->evStartWriter; for (;;) { - /* - * Wait for the main thread to signal before attempting to write. - */ + /* + * Wait for the main thread to signal before attempting to write. + */ waitResult = WaitForMultipleObjects(2, wEvents, FALSE, INFINITE); if (waitResult != (WAIT_OBJECT_0 + 1)) { /* - * The start event was not signaled. It might be the stop event - * or an error, so exit. + * The start event was not signaled. It might be the stop event or + * an error, so exit. */ break; } - buf = infoPtr->writeBuf; - toWrite = infoPtr->toWrite; - - myWrite.hEvent = CreateEvent(NULL, TRUE, FALSE, NULL); - - /* - * Loop until all of the bytes are written or an error occurs. - */ - - while (toWrite > 0) { - /* - * Check for pending writeError - * Ignore all write operations until the user has been notified - */ - if (infoPtr->writeError) { - break; - } - if (blockingWrite(infoPtr, (LPVOID) buf, (DWORD) toWrite, - &bytesWritten, &myWrite) == FALSE) { - infoPtr->writeError = GetLastError(); - break; - } - if (bytesWritten != toWrite) { - /* Write timeout */ - infoPtr->writeError = ERROR_WRITE_FAULT; - break; - } - toWrite -= bytesWritten; - buf += bytesWritten; - } - - CloseHandle(myWrite.hEvent); - /* - * Signal the main thread by signalling the evWritable event and - * then waking up the notifier thread. - */ - SetEvent(infoPtr->evWritable); - - /* - * Alert the foreground thread. Note that we need to treat this like - * a critical section so the foreground thread does not terminate - * this thread while we are holding a mutex in the notifier code. - */ - - Tcl_MutexLock(&serialMutex); + buf = infoPtr->writeBuf; + toWrite = infoPtr->toWrite; + + myWrite.hEvent = CreateEvent(NULL, TRUE, FALSE, NULL); + + /* + * Loop until all of the bytes are written or an error occurs. + */ + + while (toWrite > 0) { + /* + * Check for pending writeError. Ignore all write operations until + * the user has been notified. + */ + + if (infoPtr->writeError) { + break; + } + if (SerialBlockingWrite(infoPtr, (LPVOID) buf, (DWORD) toWrite, + &bytesWritten, &myWrite) == FALSE) { + infoPtr->writeError = GetLastError(); + break; + } + if (bytesWritten != toWrite) { + /* + * Write timeout. + */ + + infoPtr->writeError = ERROR_WRITE_FAULT; + break; + } + toWrite -= bytesWritten; + buf += bytesWritten; + } + + CloseHandle(myWrite.hEvent); + + /* + * Signal the main thread by signalling the evWritable event and then + * waking up the notifier thread. + */ + + SetEvent(infoPtr->evWritable); + + /* + * Alert the foreground thread. Note that we need to treat this like a + * critical section so the foreground thread does not terminate this + * thread while we are holding a mutex in the notifier code. + */ + + Tcl_MutexLock(&serialMutex); if (infoPtr->threadId != NULL) { - /* TIP #218. When in flight ignore the event, no one will receive it anyway */ + /* + * TIP #218: When in flight ignore the event, no one will receive + * it anyway. + */ + Tcl_ThreadAlert(infoPtr->threadId); } - Tcl_MutexUnlock(&serialMutex); + Tcl_MutexUnlock(&serialMutex); } return 0; } - - + /* *---------------------------------------------------------------------- * * TclWinSerialReopen -- * - * Reopens the serial port with the OVERLAPPED FLAG set + * Reopens the serial port with the OVERLAPPED FLAG set * * Results: - * Returns the new handle, or INVALID_HANDLE_VALUE - * Normally there shouldn't be any error, - * because the same channel has previously been succeesfully opened. + * Returns the new handle, or INVALID_HANDLE_VALUE. Normally there + * shouldn't be any error, because the same channel has previously been + * succeesfully opened. * * Side effects: - * May close the original handle + * May close the original handle * *---------------------------------------------------------------------- */ HANDLE -TclWinSerialReopen(handle, name, access) - HANDLE handle; - CONST TCHAR *name; - DWORD access; +TclWinSerialReopen( + HANDLE handle, + CONST TCHAR *name, + DWORD access) { SerialInit(); - /* - * Multithreaded I/O needs the overlapped flag set - * otherwise ClearCommError blocks under Windows NT/2000 until serial - * output is finished - */ + /* + * Multithreaded I/O needs the overlapped flag set otherwise + * ClearCommError blocks under Windows NT/2000 until serial output is + * finished + */ + if (CloseHandle(handle) == FALSE) { - return INVALID_HANDLE_VALUE; + return INVALID_HANDLE_VALUE; } - handle = (*tclWinProcs->createFileProc)(name, access, - 0, 0, OPEN_EXISTING, FILE_FLAG_OVERLAPPED, 0); + handle = (*tclWinProcs->createFileProc)(name, access, 0, 0, + OPEN_EXISTING, FILE_FLAG_OVERLAPPED, 0); return handle; } + /* *---------------------------------------------------------------------- * * TclWinOpenSerialChannel -- * - * Constructs a Serial port channel for the specified standard OS handle. - * This is a helper function to break up the construction of - * channels into File, Console, or Serial. + * Constructs a Serial port channel for the specified standard OS handle. + * This is a helper function to break up the construction of channels + * into File, Console, or Serial. * * Results: - * Returns the new channel, or NULL. + * Returns the new channel, or NULL. * * Side effects: - * May open the channel + * May open the channel * *---------------------------------------------------------------------- */ Tcl_Channel -TclWinOpenSerialChannel(handle, channelName, permissions) - HANDLE handle; - char *channelName; - int permissions; +TclWinOpenSerialChannel( + HANDLE handle, + char *channelName, + int permissions) { SerialInfo *infoPtr; DWORD id; @@ -1431,60 +1481,60 @@ TclWinOpenSerialChannel(handle, channelName, permissions) infoPtr = (SerialInfo *) ckalloc((unsigned) sizeof(SerialInfo)); memset(infoPtr, 0, sizeof(SerialInfo)); - infoPtr->validMask = permissions; - infoPtr->handle = handle; - infoPtr->channel = (Tcl_Channel) NULL; - infoPtr->readable = 0; - infoPtr->writable = 1; - infoPtr->toWrite = infoPtr->writeQueue = 0; - infoPtr->blockTime = SERIAL_DEFAULT_BLOCKTIME; + infoPtr->validMask = permissions; + infoPtr->handle = handle; + infoPtr->channel = (Tcl_Channel) NULL; + infoPtr->readable = 0; + infoPtr->writable = 1; + infoPtr->toWrite = infoPtr->writeQueue = 0; + infoPtr->blockTime = SERIAL_DEFAULT_BLOCKTIME; infoPtr->lastEventTime = 0; - infoPtr->lastError = infoPtr->error = 0; - infoPtr->threadId = Tcl_GetCurrentThread(); - infoPtr->sysBufRead = 4096; - infoPtr->sysBufWrite = 4096; + infoPtr->lastError = infoPtr->error = 0; + infoPtr->threadId = Tcl_GetCurrentThread(); + infoPtr->sysBufRead = 4096; + infoPtr->sysBufWrite = 4096; /* - * Use the pointer to keep the channel names unique, in case - * the handles are shared between multiple channels (stdin/stdout). + * Use the pointer to keep the channel names unique, in case the handles + * are shared between multiple channels (stdin/stdout). */ - wsprintfA(channelName, "file%lx", (int) infoPtr); + wsprintfA(channelName, "file%lx", PTR2INT(infoPtr)); infoPtr->channel = Tcl_CreateChannel(&serialChannelType, channelName, - (ClientData) infoPtr, permissions); + (ClientData) infoPtr, permissions); SetupComm(handle, infoPtr->sysBufRead, infoPtr->sysBufWrite); - PurgeComm(handle, PURGE_TXABORT | PURGE_RXABORT | PURGE_TXCLEAR - | PURGE_RXCLEAR); + PurgeComm(handle, + PURGE_TXABORT | PURGE_RXABORT | PURGE_TXCLEAR | PURGE_RXCLEAR); /* - * default is blocking + * Default is blocking. */ + SetCommTimeouts(handle, &no_timeout); InitializeCriticalSection(&infoPtr->csWrite); - if (permissions & TCL_READABLE) { - infoPtr->osRead.hEvent = CreateEvent(NULL, TRUE, FALSE, NULL); + infoPtr->osRead.hEvent = CreateEvent(NULL, TRUE, FALSE, NULL); } if (permissions & TCL_WRITABLE) { - /* - * Initially the channel is writable - * and the writeThread is idle. - */ - infoPtr->osWrite.hEvent = CreateEvent(NULL, TRUE, FALSE, NULL); - infoPtr->evWritable = CreateEvent(NULL, TRUE, TRUE, NULL); - infoPtr->evStartWriter = CreateEvent(NULL, FALSE, FALSE, NULL); + /* + * Initially the channel is writable and the writeThread is idle. + */ + + infoPtr->osWrite.hEvent = CreateEvent(NULL, TRUE, FALSE, NULL); + infoPtr->evWritable = CreateEvent(NULL, TRUE, TRUE, NULL); + infoPtr->evStartWriter = CreateEvent(NULL, FALSE, FALSE, NULL); infoPtr->evStopWriter = CreateEvent(NULL, FALSE, FALSE, NULL); - infoPtr->writeThread = CreateThread(NULL, 256, SerialWriterThread, - infoPtr, 0, &id); + infoPtr->writeThread = CreateThread(NULL, 256, SerialWriterThread, + infoPtr, 0, &id); } /* - * Files have default translation of AUTO and ^Z eof char, which - * means that a ^Z will be accepted as EOF when reading. + * Files have default translation of AUTO and ^Z eof char, which means + * that a ^Z will be accepted as EOF when reading. */ Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto"); @@ -1492,61 +1542,77 @@ TclWinOpenSerialChannel(handle, channelName, permissions) return infoPtr->channel; } - + /* *---------------------------------------------------------------------- * * SerialErrorStr -- * - * Converts a Win32 serial error code to a list of readable errors + * Converts a Win32 serial error code to a list of readable errors. + * + * Results: + * None. + * + * Side effects: + * Generates readable errors in the supplied DString. * *---------------------------------------------------------------------- */ + static void -SerialErrorStr(error, dsPtr) - DWORD error; /* Win32 serial error code */ - Tcl_DString *dsPtr; /* Where to store string */ +SerialErrorStr( + DWORD error, /* Win32 serial error code. */ + Tcl_DString *dsPtr) /* Where to store string. */ { - if( (error & CE_RXOVER) != 0) { - Tcl_DStringAppendElement(dsPtr, "RXOVER"); + if (error & CE_RXOVER) { + Tcl_DStringAppendElement(dsPtr, "RXOVER"); } - if( (error & CE_OVERRUN) != 0) { - Tcl_DStringAppendElement(dsPtr, "OVERRUN"); + if (error & CE_OVERRUN) { + Tcl_DStringAppendElement(dsPtr, "OVERRUN"); } - if( (error & CE_RXPARITY) != 0) { - Tcl_DStringAppendElement(dsPtr, "RXPARITY"); + if (error & CE_RXPARITY) { + Tcl_DStringAppendElement(dsPtr, "RXPARITY"); } - if( (error & CE_FRAME) != 0) { - Tcl_DStringAppendElement(dsPtr, "FRAME"); + if (error & CE_FRAME) { + Tcl_DStringAppendElement(dsPtr, "FRAME"); } - if( (error & CE_BREAK) != 0) { - Tcl_DStringAppendElement(dsPtr, "BREAK"); + if (error & CE_BREAK) { + Tcl_DStringAppendElement(dsPtr, "BREAK"); } - if( (error & CE_TXFULL) != 0) { - Tcl_DStringAppendElement(dsPtr, "TXFULL"); + if (error & CE_TXFULL) { + Tcl_DStringAppendElement(dsPtr, "TXFULL"); } - if( (error & CE_PTO) != 0) { /* PTO used to signal WRITE-TIMEOUT */ - Tcl_DStringAppendElement(dsPtr, "TIMEOUT"); + if (error & CE_PTO) { /* PTO used to signal WRITE-TIMEOUT */ + Tcl_DStringAppendElement(dsPtr, "TIMEOUT"); } - if( (error & ~((DWORD) (SERIAL_READ_ERRORS | SERIAL_WRITE_ERRORS))) != 0) { - char buf[TCL_INTEGER_SPACE + 1]; - wsprintfA(buf, "%d", error); - Tcl_DStringAppendElement(dsPtr, buf); + if (error & ~((DWORD) (SERIAL_READ_ERRORS | SERIAL_WRITE_ERRORS))) { + char buf[TCL_INTEGER_SPACE + 1]; + + wsprintfA(buf, "%d", error); + Tcl_DStringAppendElement(dsPtr, buf); } } + /* *---------------------------------------------------------------------- * * SerialModemStatusStr -- * - * Converts a Win32 modem status list of readable flags + * Converts a Win32 modem status list of readable flags + * + * Result: + * None. + * + * Side effects: + * Appends modem status flag strings to the given DString. * *---------------------------------------------------------------------- */ + static void -SerialModemStatusStr(status, dsPtr) - DWORD status; /* Win32 modem status */ - Tcl_DString *dsPtr; /* Where to store string */ +SerialModemStatusStr( + DWORD status, /* Win32 modem status. */ + Tcl_DString *dsPtr) /* Where to store string. */ { Tcl_DStringAppendElement(dsPtr, "CTS"); Tcl_DStringAppendElement(dsPtr, (status & MS_CTS_ON) ? "1" : "0"); @@ -1557,29 +1623,30 @@ SerialModemStatusStr(status, dsPtr) Tcl_DStringAppendElement(dsPtr, "DCD"); Tcl_DStringAppendElement(dsPtr, (status & MS_RLSD_ON) ? "1" : "0"); } - + /* *---------------------------------------------------------------------- * * SerialSetOptionProc -- * - * Sets an option on a channel. + * Sets an option on a channel. * * Results: - * A standard Tcl result. Also sets the interp's result on error if - * interp is not NULL. + * A standard Tcl result. Also sets the interp's result on error if + * interp is not NULL. * * Side effects: - * May modify an option on a device. + * May modify an option on a device. * *---------------------------------------------------------------------- */ + static int -SerialSetOptionProc(instanceData, interp, optionName, value) - ClientData instanceData; /* File state. */ - Tcl_Interp *interp; /* For error reporting - can be NULL. */ - CONST char *optionName; /* Which option to set? */ - CONST char *value; /* New value for option. */ +SerialSetOptionProc( + ClientData instanceData, /* File state. */ + Tcl_Interp *interp, /* For error reporting - can be NULL. */ + CONST char *optionName, /* Which option to set? */ + CONST char *value) /* New value for option. */ { SerialInfo *infoPtr; DCB dcb; @@ -1593,19 +1660,21 @@ SerialSetOptionProc(instanceData, interp, optionName, value) infoPtr = (SerialInfo *) instanceData; /* - * Parse options + * Parse options. This would be far easier if we had Tcl_Objs to work with + * as that would let us use Tcl_GetIndexFromObj()... */ + len = strlen(optionName); vlen = strlen(value); /* * Option -mode baud,parity,databits,stopbits */ + if ((len > 2) && (strncmp(optionName, "-mode", len) == 0)) { - if (! GetCommState(infoPtr->handle, &dcb)) { - if (interp) { - Tcl_AppendResult(interp, - "can't get comm state", (char *) NULL); + if (!GetCommState(infoPtr->handle, &dcb)) { + if (interp != NULL) { + Tcl_AppendResult(interp, "can't get comm state", NULL); } return TCL_ERROR; } @@ -1614,24 +1683,25 @@ SerialSetOptionProc(instanceData, interp, optionName, value) Tcl_DStringFree(&ds); if (result == FALSE) { - if (interp) { - Tcl_AppendResult(interp, - "bad value for -mode: should be baud,parity,data,stop", - (char *) NULL); + if (interp != NULL) { + Tcl_AppendResult(interp, "bad value \"", value, + "\" for -mode: should be baud,parity,data,stop", NULL); } return TCL_ERROR; } - /* Default settings for serial communications */ + /* + * Default settings for serial communications. + */ + dcb.fBinary = TRUE; dcb.fErrorChar = FALSE; dcb.fNull = FALSE; dcb.fAbortOnError = FALSE; - if (! SetCommState(infoPtr->handle, &dcb) ) { - if (interp) { - Tcl_AppendResult(interp, - "can't set comm state", (char *) NULL); + if (!SetCommState(infoPtr->handle, &dcb)) { + if (interp != NULL) { + Tcl_AppendResult(interp, "can't set comm state", NULL); } return TCL_ERROR; } @@ -1641,18 +1711,19 @@ SerialSetOptionProc(instanceData, interp, optionName, value) /* * Option -handshake none|xonxoff|rtscts|dtrdsr */ + if ((len > 1) && (strncmp(optionName, "-handshake", len) == 0)) { - if (! GetCommState(infoPtr->handle, &dcb)) { - if (interp) { - Tcl_AppendResult(interp, - "can't get comm state", (char *) NULL); + if (!GetCommState(infoPtr->handle, &dcb)) { + if (interp != NULL) { + Tcl_AppendResult(interp, "can't get comm state", NULL); } return TCL_ERROR; } + /* - * Reset all handshake options - * DTR and RTS are ON by default + * Reset all handshake options. DTR and RTS are ON by default. */ + dcb.fOutX = dcb.fInX = FALSE; dcb.fOutxCtsFlow = dcb.fOutxDsrFlow = dcb.fDsrSensitivity = FALSE; dcb.fDtrControl = DTR_CONTROL_ENABLE; @@ -1660,35 +1731,37 @@ SerialSetOptionProc(instanceData, interp, optionName, value) dcb.fTXContinueOnXoff = FALSE; /* - * Adjust the handshake limits. - * Yes, the XonXoff limits seem to influence even hardware handshake + * Adjust the handshake limits. Yes, the XonXoff limits seem to + * influence even hardware handshake. */ + dcb.XonLim = (WORD) (infoPtr->sysBufRead*1/2); dcb.XoffLim = (WORD) (infoPtr->sysBufRead*1/4); - if (strnicmp(value, "NONE", vlen) == 0) { - /* leave all handshake options disabled */ - } else if (strnicmp(value, "XONXOFF", vlen) == 0) { + if (strncasecmp(value, "NONE", vlen) == 0) { + /* + * Leave all handshake options disabled. + */ + } else if (strncasecmp(value, "XONXOFF", vlen) == 0) { dcb.fOutX = dcb.fInX = TRUE; - } else if (strnicmp(value, "RTSCTS", vlen) == 0) { + } else if (strncasecmp(value, "RTSCTS", vlen) == 0) { dcb.fOutxCtsFlow = TRUE; dcb.fRtsControl = RTS_CONTROL_HANDSHAKE; - } else if (strnicmp(value, "DTRDSR", vlen) == 0) { + } else if (strncasecmp(value, "DTRDSR", vlen) == 0) { dcb.fOutxDsrFlow = TRUE; dcb.fDtrControl = DTR_CONTROL_HANDSHAKE; } else { - if (interp) { - Tcl_AppendResult(interp, "bad value for -handshake: ", - "must be one of xonxoff, rtscts, dtrdsr or none", - (char *) NULL); - return TCL_ERROR; + if (interp != NULL) { + Tcl_AppendResult(interp, "bad value \"", value, + "\" for -handshake: must be one of xonxoff, rtscts, " + "dtrdsr or none", NULL); } + return TCL_ERROR; } - if (! SetCommState(infoPtr->handle, &dcb)) { - if (interp) { - Tcl_AppendResult(interp, - "can't set comm state", (char *) NULL); + if (!SetCommState(infoPtr->handle, &dcb)) { + if (interp != NULL) { + Tcl_AppendResult(interp, "can't set comm state", NULL); } return TCL_ERROR; } @@ -1698,11 +1771,11 @@ SerialSetOptionProc(instanceData, interp, optionName, value) /* * Option -xchar {\x11 \x13} */ + if ((len > 1) && (strncmp(optionName, "-xchar", len) == 0)) { - if (! GetCommState(infoPtr->handle, &dcb)) { - if (interp) { - Tcl_AppendResult(interp, - "can't get comm state", (char *) NULL); + if (!GetCommState(infoPtr->handle, &dcb)) { + if (interp != NULL) { + Tcl_AppendResult(interp, "can't get comm state", NULL); } return TCL_ERROR; } @@ -1710,24 +1783,49 @@ SerialSetOptionProc(instanceData, interp, optionName, value) if (Tcl_SplitList(interp, value, &argc, &argv) == TCL_ERROR) { return TCL_ERROR; } - if (argc == 2) { - dcb.XonChar = argv[0][0]; - dcb.XoffChar = argv[1][0]; - ckfree((char *) argv); - } else { - if (interp) { - Tcl_AppendResult(interp, - "bad value for -xchar: should be a list of two elements", - (char *) NULL); + if (argc != 2) { + badXchar: + if (interp != NULL) { + Tcl_AppendResult(interp, "bad value for -xchar: should be " + "a list of two elements with each a single character", + NULL); } ckfree((char *) argv); return TCL_ERROR; } - if (! SetCommState(infoPtr->handle, &dcb)) { - if (interp) { - Tcl_AppendResult(interp, - "can't set comm state", (char *) NULL); + /* + * These dereferences are safe, even in the zero-length string cases, + * because that just makes the xon/xoff character into NUL. When the + * character looks like it is UTF-8 encoded, decode it before casting + * into the format required for the Win guts. Note that this does not + * convert character sets; it is expected that when people set the + * control characters to something large and custom, they'll know the + * hex/octal value rather than the printable form. + */ + + dcb.XonChar = argv[0][0]; + dcb.XoffChar = argv[1][0]; + if (argv[0][0] & 0x80 || argv[1][0] & 0x80) { + Tcl_UniChar character; + int charLen; + + charLen = Tcl_UtfToUniChar(argv[0], &character); + if (argv[0][charLen]) { + goto badXchar; + } + dcb.XonChar = (char) character; + charLen = Tcl_UtfToUniChar(argv[1], &character); + if (argv[1][charLen]) { + goto badXchar; + } + dcb.XoffChar = (char) character; + } + ckfree((char *) argv); + + if (!SetCommState(infoPtr->handle, &dcb)) { + if (interp != NULL) { + Tcl_AppendResult(interp, "can't set comm state", NULL); } return TCL_ERROR; } @@ -1737,6 +1835,7 @@ SerialSetOptionProc(instanceData, interp, optionName, value) /* * Option -ttycontrol {DTR 1 RTS 0 BREAK 0} */ + if ((len > 4) && (strncmp(optionName, "-ttycontrol", len) == 0)) { int i, result = TCL_OK; @@ -1744,53 +1843,52 @@ SerialSetOptionProc(instanceData, interp, optionName, value) return TCL_ERROR; } if ((argc % 2) == 1) { - if (interp) { - Tcl_AppendResult(interp, - "bad value for -ttycontrol: should be a list of signal,value pairs", - (char *) NULL); + if (interp != NULL) { + Tcl_AppendResult(interp, "bad value \"", value, + "\" for -ttycontrol: should be a list of " + "signal,value pairs", NULL); } ckfree((char *) argv); return TCL_ERROR; } + for (i = 0; i < argc - 1; i += 2) { if (Tcl_GetBoolean(interp, argv[i+1], &flag) == TCL_ERROR) { result = TCL_ERROR; break; } - if (strnicmp(argv[i], "DTR", strlen(argv[i])) == 0) { - if (!EscapeCommFunction(infoPtr->handle, flag ? - (DWORD) SETDTR : (DWORD) CLRDTR)) { - if (interp) { - Tcl_AppendResult(interp, - "can't set DTR signal", (char *) NULL); + if (strncasecmp(argv[i], "DTR", strlen(argv[i])) == 0) { + if (!EscapeCommFunction(infoPtr->handle, + (DWORD) (flag ? SETDTR : CLRDTR))) { + if (interp != NULL) { + Tcl_AppendResult(interp, "can't set DTR signal", NULL); } result = TCL_ERROR; break; } - } else if (strnicmp(argv[i], "RTS", strlen(argv[i])) == 0) { - if (!EscapeCommFunction(infoPtr->handle, flag ? - (DWORD) SETRTS : (DWORD) CLRRTS)) { - if (interp) { - Tcl_AppendResult(interp, - "can't set RTS signal", (char *) NULL); + } else if (strncasecmp(argv[i], "RTS", strlen(argv[i])) == 0) { + if (!EscapeCommFunction(infoPtr->handle, + (DWORD) (flag ? SETRTS : CLRRTS))) { + if (interp != NULL) { + Tcl_AppendResult(interp, "can't set RTS signal", NULL); } result = TCL_ERROR; break; } - } else if (strnicmp(argv[i], "BREAK", strlen(argv[i])) == 0) { - if (!EscapeCommFunction(infoPtr->handle, flag ? - (DWORD) SETBREAK : (DWORD) CLRBREAK)) { - if (interp) { - Tcl_AppendResult(interp, - "can't set BREAK signal", (char *) NULL); + } else if (strncasecmp(argv[i], "BREAK", strlen(argv[i])) == 0) { + if (!EscapeCommFunction(infoPtr->handle, + (DWORD) (flag ? SETBREAK : CLRBREAK))) { + if (interp != NULL) { + Tcl_AppendResult(interp,"can't set BREAK signal",NULL); } result = TCL_ERROR; break; } } else { - if (interp) { - Tcl_AppendResult(interp, "bad signal for -ttycontrol: ", - "must be DTR, RTS or BREAK", (char *) NULL); + if (interp != NULL) { + Tcl_AppendResult(interp, "bad signal name \"", argv[i], + "\" for -ttycontrol: must be DTR, RTS or BREAK", + NULL); } result = TCL_ERROR; break; @@ -1803,12 +1901,14 @@ SerialSetOptionProc(instanceData, interp, optionName, value) /* * Option -sysbuffer {read_size write_size} - * Option -sysbuffer read_size + * Option -sysbuffer read_size */ + if ((len > 1) && (strncmp(optionName, "-sysbuffer", len) == 0)) { /* * -sysbuffer 4096 or -sysbuffer {64536 4096} */ + size_t inSize = (size_t) -1, outSize = (size_t) -1; if (Tcl_SplitList(interp, value, &argc, &argv) == TCL_ERROR) { @@ -1822,18 +1922,19 @@ SerialSetOptionProc(instanceData, interp, optionName, value) outSize = atoi(argv[1]); } ckfree((char *) argv); - if ((inSize <= 0) || (outSize <= 0)) { - if (interp) { - Tcl_AppendResult(interp, - "bad value for -sysbuffer: should be a list of one or two integers > 0", - (char *) NULL); + + if ((argc < 1) || (argc > 2) || (inSize <= 0) || (outSize <= 0)) { + if (interp != NULL) { + Tcl_AppendResult(interp, "bad value \"", value, + "\" for -sysbuffer: should be a list of one or two " + "integers > 0", NULL); } return TCL_ERROR; } - if (! SetupComm(infoPtr->handle, inSize, outSize)) { - if (interp) { - Tcl_AppendResult(interp, - "can't setup comm buffers", (char *) NULL); + + if (!SetupComm(infoPtr->handle, inSize, outSize)) { + if (interp != NULL) { + Tcl_AppendResult(interp, "can't setup comm buffers", NULL); } return TCL_ERROR; } @@ -1841,22 +1942,21 @@ SerialSetOptionProc(instanceData, interp, optionName, value) infoPtr->sysBufWrite = outSize; /* - * Adjust the handshake limits. - * Yes, the XonXoff limits seem to influence even hardware handshake + * Adjust the handshake limits. Yes, the XonXoff limits seem to + * influence even hardware handshake. */ - if (! GetCommState(infoPtr->handle, &dcb)) { - if (interp) { - Tcl_AppendResult(interp, - "can't get comm state", (char *) NULL); + + if (!GetCommState(infoPtr->handle, &dcb)) { + if (interp != NULL) { + Tcl_AppendResult(interp, "can't get comm state", NULL); } return TCL_ERROR; } dcb.XonLim = (WORD) (infoPtr->sysBufRead*1/2); dcb.XoffLim = (WORD) (infoPtr->sysBufRead*1/4); - if (! SetCommState(infoPtr->handle, &dcb)) { - if (interp) { - Tcl_AppendResult(interp, - "can't set comm state", (char *) NULL); + if (!SetCommState(infoPtr->handle, &dcb)) { + if (interp != NULL) { + Tcl_AppendResult(interp, "can't set comm state", NULL); } return TCL_ERROR; } @@ -1866,9 +1966,9 @@ SerialSetOptionProc(instanceData, interp, optionName, value) /* * Option -pollinterval msec */ - if ((len > 1) && (strncmp(optionName, "-pollinterval", len) == 0)) { - if ( Tcl_GetInt(interp, value, &(infoPtr->blockTime)) != TCL_OK ) { + if ((len > 1) && (strncmp(optionName, "-pollinterval", len) == 0)) { + if (Tcl_GetInt(interp, value, &(infoPtr->blockTime)) != TCL_OK) { return TCL_ERROR; } return TCL_OK; @@ -1877,18 +1977,18 @@ SerialSetOptionProc(instanceData, interp, optionName, value) /* * Option -timeout msec */ + if ((len > 2) && (strncmp(optionName, "-timeout", len) == 0)) { int msec; COMMTIMEOUTS tout = {0,0,0,0,0}; - if ( Tcl_GetInt(interp, value, &msec) != TCL_OK ) { + if (Tcl_GetInt(interp, value, &msec) != TCL_OK) { return TCL_ERROR; } tout.ReadTotalTimeoutConstant = msec; - if (! SetCommTimeouts(infoPtr->handle, &tout)) { - if (interp) { - Tcl_AppendResult(interp, - "can't set comm timeouts", (char *) NULL); + if (!SetCommTimeouts(infoPtr->handle, &tout)) { + if (interp != NULL) { + Tcl_AppendResult(interp, "can't set comm timeouts", NULL); } return TCL_ERROR; } @@ -1899,38 +1999,39 @@ SerialSetOptionProc(instanceData, interp, optionName, value) return Tcl_BadChannelOption(interp, optionName, "mode handshake pollinterval sysbuffer timeout ttycontrol xchar"); } - + /* *---------------------------------------------------------------------- * * SerialGetOptionProc -- * - * Gets a mode associated with an IO channel. If the optionName arg - * is non NULL, retrieves the value of that option. If the optionName - * arg is NULL, retrieves a list of alternating option names and - * values for the given channel. + * Gets a mode associated with an IO channel. If the optionName arg is + * non NULL, retrieves the value of that option. If the optionName arg is + * NULL, retrieves a list of alternating option names and values for the + * given channel. * * Results: - * A standard Tcl result. Also sets the supplied DString to the - * string value of the option(s) returned. + * A standard Tcl result. Also sets the supplied DString to the string + * value of the option(s) returned. * * Side effects: - * The string returned by this function is in static storage and - * may be reused at any time subsequent to the call. + * The string returned by this function is in static storage and may be + * reused at any time subsequent to the call. * *---------------------------------------------------------------------- */ + static int -SerialGetOptionProc(instanceData, interp, optionName, dsPtr) - ClientData instanceData; /* File state. */ - Tcl_Interp *interp; /* For error reporting - can be NULL. */ - CONST char *optionName; /* Option to get. */ - Tcl_DString *dsPtr; /* Where to store value(s). */ +SerialGetOptionProc( + ClientData instanceData, /* File state. */ + Tcl_Interp *interp, /* For error reporting - can be NULL. */ + CONST char *optionName, /* Option to get. */ + Tcl_DString *dsPtr) /* Where to store value(s). */ { SerialInfo *infoPtr; DCB dcb; size_t len; - int valid = 0; /* flag if valid option parsed */ + int valid = 0; /* Flag if valid option parsed. */ infoPtr = (SerialInfo *) instanceData; @@ -1941,23 +2042,20 @@ SerialGetOptionProc(instanceData, interp, optionName, dsPtr) } /* - * get option -mode + * Get option -mode */ if (len == 0) { Tcl_DStringAppendElement(dsPtr, "-mode"); } - if ((len == 0) || - ((len > 2) && (strncmp(optionName, "-mode", len) == 0))) { - + if (len==0 || (len>2 && (strncmp(optionName, "-mode", len) == 0))) { char parity; char *stop; char buf[2 * TCL_INTEGER_SPACE + 16]; - if (! GetCommState(infoPtr->handle, &dcb)) { - if (interp) { - Tcl_AppendResult(interp, - "can't get comm state", (char *) NULL); + if (!GetCommState(infoPtr->handle, &dcb)) { + if (interp != NULL) { + Tcl_AppendResult(interp, "can't get comm state", NULL); } return TCL_ERROR; } @@ -1968,7 +2066,7 @@ SerialGetOptionProc(instanceData, interp, optionName, dsPtr) parity = "noems"[dcb.Parity]; } stop = (dcb.StopBits == ONESTOPBIT) ? "1" : - (dcb.StopBits == ONE5STOPBITS) ? "1.5" : "2"; + (dcb.StopBits == ONE5STOPBITS) ? "1.5" : "2"; wsprintfA(buf, "%d,%c,%d,%s", dcb.BaudRate, parity, dcb.ByteSize, stop); @@ -1976,14 +2074,13 @@ SerialGetOptionProc(instanceData, interp, optionName, dsPtr) } /* - * get option -pollinterval + * Get option -pollinterval */ if (len == 0) { Tcl_DStringAppendElement(dsPtr, "-pollinterval"); } - if ((len == 0) || - ((len > 1) && (strncmp(optionName, "-pollinterval", len) == 0))) { + if (len==0 || (len>1 && strncmp(optionName, "-pollinterval", len)==0)) { char buf[TCL_INTEGER_SPACE + 1]; valid = 1; @@ -1992,16 +2089,14 @@ SerialGetOptionProc(instanceData, interp, optionName, dsPtr) } /* - * get option -sysbuffer + * Get option -sysbuffer */ if (len == 0) { Tcl_DStringAppendElement(dsPtr, "-sysbuffer"); Tcl_DStringStartSublist(dsPtr); } - if ((len == 0) || - ((len > 1) && (strncmp(optionName, "-sysbuffer", len) == 0))) { - + if (len==0 || (len>1 && strncmp(optionName, "-sysbuffer", len) == 0)) { char buf[TCL_INTEGER_SPACE + 1]; valid = 1; @@ -2015,23 +2110,20 @@ SerialGetOptionProc(instanceData, interp, optionName, dsPtr) } /* - * get option -xchar + * Get option -xchar */ if (len == 0) { Tcl_DStringAppendElement(dsPtr, "-xchar"); Tcl_DStringStartSublist(dsPtr); } - if ((len == 0) || - ((len > 1) && (strncmp(optionName, "-xchar", len) == 0))) { - + if (len==0 || (len>1 && strncmp(optionName, "-xchar", len) == 0)) { char buf[4]; valid = 1; - if (! GetCommState(infoPtr->handle, &dcb)) { - if (interp) { - Tcl_AppendResult(interp, - "can't get comm state", (char *) NULL); + if (!GetCommState(infoPtr->handle, &dcb)) { + if (interp != NULL) { + Tcl_AppendResult(interp, "can't get comm state", NULL); } return TCL_ERROR; } @@ -2045,22 +2137,24 @@ SerialGetOptionProc(instanceData, interp, optionName, dsPtr) } /* - * get option -lasterror - * option is readonly and returned by [fconfigure chan -lasterror] - * but not returned by unnamed [fconfigure chan] + * Get option -lasterror + * + * Option is readonly and returned by [fconfigure chan -lasterror] but not + * returned by unnamed [fconfigure chan]. */ - if ( (len > 1) && (strncmp(optionName, "-lasterror", len) == 0) ) { + if (len>1 && strncmp(optionName, "-lasterror", len)==0) { valid = 1; SerialErrorStr(infoPtr->lastError, dsPtr); } /* * get option -queue - * option is readonly and returned by [fconfigure chan -queue] + * + * Option is readonly and returned by [fconfigure chan -queue]. */ - if ((len > 1) && (strncmp(optionName, "-queue", len) == 0)) { + if (len>1 && strncmp(optionName, "-queue", len)==0) { char buf[TCL_INTEGER_SPACE + 1]; COMSTAT cStat; DWORD error; @@ -2068,9 +2162,10 @@ SerialGetOptionProc(instanceData, interp, optionName, dsPtr) valid = 1; - /* - * Query the pending data in Tcl's internal queues + /* + * Query the pending data in Tcl's internal queues. */ + inBuffered = Tcl_InputBuffered(infoPtr->channel); outBuffered = Tcl_OutputBuffered(infoPtr->channel); @@ -2080,30 +2175,31 @@ SerialGetOptionProc(instanceData, interp, optionName, dsPtr) * 2. The bytes in the system drivers buffer * The writer thread should not interfere this action. */ + EnterCriticalSection(&infoPtr->csWrite); - ClearCommError( infoPtr->handle, &error, &cStat ); - count = (int)cStat.cbOutQue + infoPtr->writeQueue; + ClearCommError(infoPtr->handle, &error, &cStat); + count = (int) cStat.cbOutQue + infoPtr->writeQueue; LeaveCriticalSection(&infoPtr->csWrite); - wsprintfA(buf, "%d", inBuffered + cStat.cbInQue); + wsprintfA(buf, "%d", inBuffered + cStat.cbInQue); Tcl_DStringAppendElement(dsPtr, buf); - wsprintfA(buf, "%d", outBuffered + count); + wsprintfA(buf, "%d", outBuffered + count); Tcl_DStringAppendElement(dsPtr, buf); } /* * get option -ttystatus - * option is readonly and returned by [fconfigure chan -ttystatus] - * but not returned by unnamed [fconfigure chan] + * + * Option is readonly and returned by [fconfigure chan -ttystatus] but not + * returned by unnamed [fconfigure chan]. */ - if ((len > 4) && (strncmp(optionName, "-ttystatus", len) == 0)) { + if (len>4 && strncmp(optionName, "-ttystatus", len)==0) { DWORD status; - if (! GetCommModemStatus(infoPtr->handle, &status)) { - if (interp) { - Tcl_AppendResult(interp, - "can't get tty status", (char *) NULL); + if (!GetCommModemStatus(infoPtr->handle, &status)) { + if (interp != NULL) { + Tcl_AppendResult(interp, "can't get tty status", NULL); } return TCL_ERROR; } @@ -2136,33 +2232,43 @@ SerialGetOptionProc(instanceData, interp, optionName, dsPtr) */ static void -SerialThreadActionProc (instanceData, action) - ClientData instanceData; - int action; +SerialThreadActionProc( + ClientData instanceData, + int action) { SerialInfo *infoPtr = (SerialInfo *) instanceData; - /* We do not access firstSerialPtr in the thread structures. This is - * not for all serials managed by the thread, but only those we are - * watching. Removal of the filevent handlers before transfer thus - * takes care of this structure. + /* + * We do not access firstSerialPtr in the thread structures. This is not + * for all serials managed by the thread, but only those we are watching. + * Removal of the filevent handlers before transfer thus takes care of + * this structure. */ Tcl_MutexLock(&serialMutex); if (action == TCL_CHANNEL_THREAD_INSERT) { - /* We can't copy the thread information from the channel when - * the channel is created. At this time the channel back - * pointer has not been set yet. However in that case the - * threadId has already been set by TclpCreateCommandChannel - * itself, so the structure is still good. + /* + * We can't copy the thread information from the channel when the + * channel is created. At this time the channel back pointer has not + * been set yet. However in that case the threadId has already been + * set by TclpCreateCommandChannel itself, so the structure is still + * good. */ - SerialInit (); - if (infoPtr->channel != NULL) { - infoPtr->threadId = Tcl_GetChannelThread (infoPtr->channel); + SerialInit(); + if (infoPtr->channel != NULL) { + infoPtr->threadId = Tcl_GetChannelThread(infoPtr->channel); } } else { infoPtr->threadId = NULL; } Tcl_MutexUnlock(&serialMutex); } + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ diff --git a/win/tclWinSock.c b/win/tclWinSock.c index f3fe979..1bf4f97 100644 --- a/win/tclWinSock.c +++ b/win/tclWinSock.c @@ -1,12 +1,12 @@ -/* +/* * tclWinSock.c -- * * This file contains Windows-specific socket related code. * * Copyright (c) 1995-1997 Sun Microsystems, Inc. * - * See the file "license.terms" for information on usage and redistribution - * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. * * ----------------------------------------------------------------------- * @@ -47,10 +47,22 @@ #include "tclWinInt.h" +#ifdef _MSC_VER +# pragma comment (lib, "ws2_32") +#endif + +/* + * Support for control over sockets' KEEPALIVE and NODELAY behavior is + * currently disabled. + */ + +#undef TCL_FEATURE_KEEPALIVE_NAGLE + /* - * Make sure to remove the redirection defines set in tclWinPort.h - * that is in use in other sections of the core, except for us. + * Make sure to remove the redirection defines set in tclWinPort.h that is in + * use in other sections of the core, except for us. */ + #undef getservbyname #undef getsockopt #undef ntohs @@ -58,114 +70,21 @@ /* * The following variable is used to tell whether this module has been - * initialized. + * initialized. If 1, initialization of sockets was successful, if -1 then + * socket initialization failed (WSAStartup failed). */ static int initialized = 0; - -static int hostnameInitialized = 0; -static char hostname[255]; /* This buffer should be big enough for - * hostname plus domain name. */ - TCL_DECLARE_MUTEX(socketMutex) - -/* - * Mingw and Cygwin may not have LPFN_* typedefs. - */ - -#ifdef HAVE_NO_LPFN_DECLS - typedef SOCKET (PASCAL FAR *LPFN_ACCEPT)(SOCKET s, - struct sockaddr FAR * addr, int FAR * addrlen); - typedef int (PASCAL FAR *LPFN_BIND)(SOCKET s, - const struct sockaddr FAR *addr, int namelen); - typedef int (PASCAL FAR *LPFN_CLOSESOCKET)(SOCKET s); - typedef int (PASCAL FAR *LPFN_CONNECT)(SOCKET s, - const struct sockaddr FAR *name, int namelen); - typedef struct hostent FAR * (PASCAL FAR *LPFN_GETHOSTBYADDR) - (const char FAR *addr, int addrlen, int addrtype); - typedef struct hostent FAR * (PASCAL FAR *LPFN_GETHOSTBYNAME) - (const char FAR * name); - typedef int (PASCAL FAR *LPFN_GETHOSTNAME)(char FAR * name, - int namelen); - typedef int (PASCAL FAR *LPFN_GETPEERNAME)(SOCKET sock, - struct sockaddr FAR *name, int FAR *namelen); - typedef struct servent FAR * (PASCAL FAR *LPFN_GETSERVBYNAME) - (const char FAR * name, const char FAR * proto); - typedef int (PASCAL FAR *LPFN_GETSOCKNAME)(SOCKET sock, - struct sockaddr FAR *name, int FAR *namelen); - typedef int (PASCAL FAR *LPFN_GETSOCKOPT)(SOCKET s, int level, - int optname, char FAR * optval, int FAR *optlen); - typedef u_short (PASCAL FAR *LPFN_HTONS)(u_short hostshort); - typedef unsigned long (PASCAL FAR *LPFN_INET_ADDR) - (const char FAR * cp); - typedef char FAR * (PASCAL FAR *LPFN_INET_NTOA) - (struct in_addr in); - typedef int (PASCAL FAR *LPFN_IOCTLSOCKET)(SOCKET s, - long cmd, u_long FAR *argp); - typedef int (PASCAL FAR *LPFN_LISTEN)(SOCKET s, int backlog); - typedef u_short (PASCAL FAR *LPFN_NTOHS)(u_short netshort); - typedef int (PASCAL FAR *LPFN_RECV)(SOCKET s, char FAR * buf, - int len, int flags); - typedef int (PASCAL FAR *LPFN_SELECT)(int nfds, - fd_set FAR * readfds, fd_set FAR * writefds, - fd_set FAR * exceptfds, - const struct timeval FAR * timeout); - typedef int (PASCAL FAR *LPFN_SEND)(SOCKET s, - const char FAR * buf, int len, int flags); - typedef int (PASCAL FAR *LPFN_SETSOCKOPT)(SOCKET s, - int level, int optname, const char FAR * optval, - int optlen); - typedef SOCKET (PASCAL FAR *LPFN_SOCKET)(int af, - int type, int protocol); - typedef int (PASCAL FAR *LPFN_WSAASYNCSELECT)(SOCKET s, - HWND hWnd, u_int wMsg, long lEvent); - typedef int (PASCAL FAR *LPFN_WSACLEANUP)(void); - typedef int (PASCAL FAR *LPFN_WSAGETLASTERROR)(void); - typedef int (PASCAL FAR *LPFN_WSASTARTUP)(WORD wVersionRequired, - LPWSADATA lpWSAData); -#endif - - /* - * The following structure contains pointers to all of the WinSock API - * entry points used by Tcl. It is initialized by InitSockets. Since - * we dynamically load the Winsock DLL on demand, we must use this - * function table to refer to functions in the winsock API. + * The following variable holds the network name of this host. */ -static struct { - HMODULE hModule; /* Handle to WinSock library. */ - - /* Winsock 1.1 functions */ - LPFN_ACCEPT accept; - LPFN_BIND bind; - LPFN_CLOSESOCKET closesocket; - LPFN_CONNECT connect; - LPFN_GETHOSTBYADDR gethostbyaddr; - LPFN_GETHOSTBYNAME gethostbyname; - LPFN_GETHOSTNAME gethostname; - LPFN_GETPEERNAME getpeername; - LPFN_GETSERVBYNAME getservbyname; - LPFN_GETSOCKNAME getsockname; - LPFN_GETSOCKOPT getsockopt; - LPFN_HTONS htons; - LPFN_INET_ADDR inet_addr; - LPFN_INET_NTOA inet_ntoa; - LPFN_IOCTLSOCKET ioctlsocket; - LPFN_LISTEN listen; - LPFN_NTOHS ntohs; - LPFN_RECV recv; - LPFN_SELECT select; - LPFN_SEND send; - LPFN_SETSOCKOPT setsockopt; - LPFN_SOCKET socket; - LPFN_WSAASYNCSELECT WSAAsyncSelect; - LPFN_WSACLEANUP WSACleanup; - LPFN_WSAGETLASTERROR WSAGetLastError; - LPFN_WSASTARTUP WSAStartup; - -} winSock; +static TclInitProcessGlobalValueProc InitializeHostName; +static ProcessGlobalValue hostName = { + 0, 0, NULL, NULL, InitializeHostName, NULL, NULL +}; /* * The following defines declare the messages used on socket windows. @@ -178,52 +97,48 @@ static struct { #define UNSELECT FALSE /* - * The following structure is used to store the data associated with - * each socket. + * The following structure is used to store the data associated with each + * socket. */ typedef struct SocketInfo { - Tcl_Channel channel; /* Channel associated with this - * socket. */ - SOCKET socket; /* Windows SOCKET handle. */ - int flags; /* Bit field comprised of the flags - * described below. */ - int watchEvents; /* OR'ed combination of FD_READ, - * FD_WRITE, FD_CLOSE, FD_ACCEPT and - * FD_CONNECT that indicate which - * events are interesting. */ - int readyEvents; /* OR'ed combination of FD_READ, - * FD_WRITE, FD_CLOSE, FD_ACCEPT and - * FD_CONNECT that indicate which - * events have occurred. */ - int selectEvents; /* OR'ed combination of FD_READ, - * FD_WRITE, FD_CLOSE, FD_ACCEPT and - * FD_CONNECT that indicate which - * events are currently being - * selected. */ - int acceptEventCount; /* Count of the current number of - * FD_ACCEPTs that have arrived and - * not yet processed. */ - Tcl_TcpAcceptProc *acceptProc; /* Proc to call on accept. */ - ClientData acceptProcData; /* The data for the accept proc. */ - int lastError; /* Error code from last message. */ - struct SocketInfo *nextPtr; /* The next socket on the per-thread - * socket list. */ + Tcl_Channel channel; /* Channel associated with this socket. */ + SOCKET socket; /* Windows SOCKET handle. */ + int flags; /* Bit field comprised of the flags described + * below. */ + int watchEvents; /* OR'ed combination of FD_READ, FD_WRITE, + * FD_CLOSE, FD_ACCEPT and FD_CONNECT that + * indicate which events are interesting. */ + int readyEvents; /* OR'ed combination of FD_READ, FD_WRITE, + * FD_CLOSE, FD_ACCEPT and FD_CONNECT that + * indicate which events have occurred. */ + int selectEvents; /* OR'ed combination of FD_READ, FD_WRITE, + * FD_CLOSE, FD_ACCEPT and FD_CONNECT that + * indicate which events are currently being + * selected. */ + int acceptEventCount; /* Count of the current number of FD_ACCEPTs + * that have arrived and not yet processed. */ + Tcl_TcpAcceptProc *acceptProc; + /* Proc to call on accept. */ + ClientData acceptProcData; /* The data for the accept proc. */ + int lastError; /* Error code from last message. */ + struct SocketInfo *nextPtr; /* The next socket on the per-thread socket + * list. */ } SocketInfo; /* - * The following structure is what is added to the Tcl event queue when - * a socket event occurs. + * The following structure is what is added to the Tcl event queue when a + * socket event occurs. */ typedef struct SocketEvent { - Tcl_Event header; /* Information that is standard for - * all events. */ - SOCKET socket; /* Socket descriptor that is ready. Used - * to find the SocketInfo structure for - * the file (can't point directly to the - * SocketInfo structure because it could - * go away while the event is queued). */ + Tcl_Event header; /* Information that is standard for all + * events. */ + SOCKET socket; /* Socket descriptor that is ready. Used to + * find the SocketInfo structure for the file + * (can't point directly to the SocketInfo + * structure because it could go away while + * the event is queued). */ } SocketEvent; /* @@ -233,30 +148,28 @@ typedef struct SocketEvent { #define TCP_BUFFER_SIZE 4096 /* - * The following macros may be used to set the flags field of - * a SocketInfo structure. + * The following macros may be used to set the flags field of a SocketInfo + * structure. */ -#define SOCKET_ASYNC (1<<0) /* The socket is in blocking - * mode. */ -#define SOCKET_EOF (1<<1) /* A zero read happened on - * the socket. */ -#define SOCKET_ASYNC_CONNECT (1<<2) /* This socket uses async - * connect. */ -#define SOCKET_PENDING (1<<3) /* A message has been sent - * for this socket */ +#define SOCKET_ASYNC (1<<0) /* The socket is in blocking mode. */ +#define SOCKET_EOF (1<<1) /* A zero read happened on the + * socket. */ +#define SOCKET_ASYNC_CONNECT (1<<2) /* This socket uses async connect. */ +#define SOCKET_PENDING (1<<3) /* A message has been sent for this + * socket */ typedef struct ThreadSpecificData { - HWND hwnd; /* Handle to window for socket messages. */ - HANDLE socketThread; /* Thread handling the window */ - Tcl_ThreadId threadId; /* Parent thread. */ - HANDLE readyEvent; /* Event indicating that a socket event is - * ready. Also used to indicate that the - * socketThread has been initialized and has - * started. */ - HANDLE socketListLock; /* Win32 Event to lock the socketList */ - SocketInfo *socketList; /* Every open socket in this thread has an - * entry on this list. */ + HWND hwnd; /* Handle to window for socket messages. */ + HANDLE socketThread; /* Thread handling the window */ + Tcl_ThreadId threadId; /* Parent thread. */ + HANDLE readyEvent; /* Event indicating that a socket event is + * ready. Also used to indicate that the + * socketThread has been initialized and has + * started. */ + HANDLE socketListLock; /* Win32 Event to lock the socketList */ + SocketInfo *socketList; /* Every open socket in this thread has an + * entry on this list. */ } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; @@ -266,25 +179,27 @@ static WNDCLASS windowClass; * Static functions defined in this file. */ -static SocketInfo * CreateSocket _ANSI_ARGS_((Tcl_Interp *interp, - int port, CONST char *host, - int server, CONST char *myaddr, - int myport, int async)); -static int CreateSocketAddress _ANSI_ARGS_( - (LPSOCKADDR_IN sockaddrPtr, - CONST char *host, int port)); -static void InitSockets _ANSI_ARGS_((void)); -static SocketInfo * NewSocketInfo _ANSI_ARGS_((SOCKET socket)); -static Tcl_EventCheckProc SocketCheckProc; -static Tcl_EventProc SocketEventProc; -static void SocketExitHandler _ANSI_ARGS_(( - ClientData clientData)); -static LRESULT CALLBACK SocketProc _ANSI_ARGS_((HWND hwnd, - UINT message, WPARAM wParam, - LPARAM lParam)); -static Tcl_EventSetupProc SocketSetupProc; -static int SocketsEnabled _ANSI_ARGS_((void)); -static void TcpAccept _ANSI_ARGS_((SocketInfo *infoPtr)); +static SocketInfo * CreateSocket(Tcl_Interp *interp, int port, + const char *host, int server, const char *myaddr, + int myport, int async); +static int CreateSocketAddress(LPSOCKADDR_IN sockaddrPtr, + const char *host, int port); +static void InitSockets(void); +static SocketInfo * NewSocketInfo(SOCKET socket); +static void SocketExitHandler(ClientData clientData); +static LRESULT CALLBACK SocketProc(HWND hwnd, UINT message, WPARAM wParam, + LPARAM lParam); +static int SocketsEnabled(void); +static void TcpAccept(SocketInfo *infoPtr); +static int WaitForSocketEvent(SocketInfo *infoPtr, int events, + int *errorCodePtr); +static DWORD WINAPI SocketThread(LPVOID arg); +static void TcpThreadActionProc(ClientData instanceData, + int action); + +static Tcl_EventCheckProc SocketCheckProc; +static Tcl_EventProc SocketEventProc; +static Tcl_EventSetupProc SocketSetupProc; static Tcl_DriverBlockModeProc TcpBlockProc; static Tcl_DriverCloseProc TcpCloseProc; static Tcl_DriverSetOptionProc TcpSetOptionProc; @@ -293,14 +208,6 @@ static Tcl_DriverInputProc TcpInputProc; static Tcl_DriverOutputProc TcpOutputProc; static Tcl_DriverWatchProc TcpWatchProc; static Tcl_DriverGetHandleProc TcpGetHandleProc; -static int WaitForSocketEvent _ANSI_ARGS_(( - SocketInfo *infoPtr, int events, - int *errorCodePtr)); -static DWORD WINAPI SocketThread _ANSI_ARGS_((LPVOID arg)); - -static void TcpThreadActionProc _ANSI_ARGS_ (( - ClientData instanceData, int action)); - /* * This structure describes the channel type structure for TCP socket @@ -309,7 +216,7 @@ static void TcpThreadActionProc _ANSI_ARGS_ (( static Tcl_ChannelType tcpChannelType = { "tcp", /* Type name. */ - TCL_CHANNEL_VERSION_4, /* v4 channel */ + TCL_CHANNEL_VERSION_5, /* v5 channel */ TcpCloseProc, /* Close proc. */ TcpInputProc, /* Input proc. */ TcpOutputProc, /* Output proc. */ @@ -322,18 +229,17 @@ static Tcl_ChannelType tcpChannelType = { TcpBlockProc, /* Set socket into (non-)blocking mode. */ NULL, /* flush proc. */ NULL, /* handler proc. */ - NULL, /* wide seek proc */ + NULL, /* wide seek proc */ TcpThreadActionProc, /* thread action proc */ + NULL, /* truncate */ }; - /* *---------------------------------------------------------------------- * * InitSockets -- * - * Initialize the socket module. Attempts to load the wsock32.dll - * library and set up the winSock function table. If successful, + * Initialize the socket module. If winsock startup is successful, * registers the event window for the socket notifier code. * * Assumes socketMutex is held. @@ -342,132 +248,32 @@ static Tcl_ChannelType tcpChannelType = { * None. * * Side effects: - * Dynamically loads wsock32.dll, and registers a new window - * class and creates a window for use in asynchronous socket - * notification. + * Initializes winsock, registers a new window class and creates a + * window for use in asynchronous socket notification. * *---------------------------------------------------------------------- */ static void -InitSockets() +InitSockets(void) { DWORD id; WSADATA wsaData; DWORD err; - ThreadSpecificData *tsdPtr = - (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + TclThreadDataKeyGet(&dataKey); if (!initialized) { initialized = 1; TclCreateLateExitHandler(SocketExitHandler, (ClientData) NULL); - winSock.hModule = LoadLibraryA("wsock32.dll"); - - if (winSock.hModule == NULL) { - return; - } - /* - * Initialize the function table. + * Create the async notification window with a new class. We must + * create a new class to avoid a Windows 95 bug that causes us to get + * the wrong message number for socket events if the message window is + * a subclass of a static control. */ - winSock.accept = (LPFN_ACCEPT) - GetProcAddress(winSock.hModule, "accept"); - winSock.bind = (LPFN_BIND) - GetProcAddress(winSock.hModule, "bind"); - winSock.closesocket = (LPFN_CLOSESOCKET) - GetProcAddress(winSock.hModule, "closesocket"); - winSock.connect = (LPFN_CONNECT) - GetProcAddress(winSock.hModule, "connect"); - winSock.gethostbyaddr = (LPFN_GETHOSTBYADDR) - GetProcAddress(winSock.hModule, "gethostbyaddr"); - winSock.gethostbyname = (LPFN_GETHOSTBYNAME) - GetProcAddress(winSock.hModule, "gethostbyname"); - winSock.gethostname = (LPFN_GETHOSTNAME) - GetProcAddress(winSock.hModule, "gethostname"); - winSock.getpeername = (LPFN_GETPEERNAME) - GetProcAddress(winSock.hModule, "getpeername"); - winSock.getservbyname = (LPFN_GETSERVBYNAME) - GetProcAddress(winSock.hModule, "getservbyname"); - winSock.getsockname = (LPFN_GETSOCKNAME) - GetProcAddress(winSock.hModule, "getsockname"); - winSock.getsockopt = (LPFN_GETSOCKOPT) - GetProcAddress(winSock.hModule, "getsockopt"); - winSock.htons = (LPFN_HTONS) - GetProcAddress(winSock.hModule, "htons"); - winSock.inet_addr = (LPFN_INET_ADDR) - GetProcAddress(winSock.hModule, "inet_addr"); - winSock.inet_ntoa = (LPFN_INET_NTOA) - GetProcAddress(winSock.hModule, "inet_ntoa"); - winSock.ioctlsocket = (LPFN_IOCTLSOCKET) - GetProcAddress(winSock.hModule, "ioctlsocket"); - winSock.listen = (LPFN_LISTEN) - GetProcAddress(winSock.hModule, "listen"); - winSock.ntohs = (LPFN_NTOHS) - GetProcAddress(winSock.hModule, "ntohs"); - winSock.recv = (LPFN_RECV) - GetProcAddress(winSock.hModule, "recv"); - winSock.select = (LPFN_SELECT) - GetProcAddress(winSock.hModule, "select"); - winSock.send = (LPFN_SEND) - GetProcAddress(winSock.hModule, "send"); - winSock.setsockopt = (LPFN_SETSOCKOPT) - GetProcAddress(winSock.hModule, "setsockopt"); - winSock.socket = (LPFN_SOCKET) - GetProcAddress(winSock.hModule, "socket"); - winSock.WSAAsyncSelect = (LPFN_WSAASYNCSELECT) - GetProcAddress(winSock.hModule, "WSAAsyncSelect"); - winSock.WSACleanup = (LPFN_WSACLEANUP) - GetProcAddress(winSock.hModule, "WSACleanup"); - winSock.WSAGetLastError = (LPFN_WSAGETLASTERROR) - GetProcAddress(winSock.hModule, "WSAGetLastError"); - winSock.WSAStartup = (LPFN_WSASTARTUP) - GetProcAddress(winSock.hModule, "WSAStartup"); - - /* - * Now check that all fields are properly initialized. If not, - * return zero to indicate that we failed to initialize - * properly. - */ - - if ((winSock.accept == NULL) || - (winSock.bind == NULL) || - (winSock.closesocket == NULL) || - (winSock.connect == NULL) || - (winSock.gethostbyname == NULL) || - (winSock.gethostbyaddr == NULL) || - (winSock.gethostname == NULL) || - (winSock.getpeername == NULL) || - (winSock.getservbyname == NULL) || - (winSock.getsockname == NULL) || - (winSock.getsockopt == NULL) || - (winSock.htons == NULL) || - (winSock.inet_addr == NULL) || - (winSock.inet_ntoa == NULL) || - (winSock.ioctlsocket == NULL) || - (winSock.listen == NULL) || - (winSock.ntohs == NULL) || - (winSock.recv == NULL) || - (winSock.select == NULL) || - (winSock.send == NULL) || - (winSock.setsockopt == NULL) || - (winSock.socket == NULL) || - (winSock.WSAAsyncSelect == NULL) || - (winSock.WSACleanup == NULL) || - (winSock.WSAGetLastError == NULL) || - (winSock.WSAStartup == NULL)) - { - goto unloadLibrary; - } - - /* - * Create the async notification window with a new class. We - * must create a new class to avoid a Windows 95 bug that causes - * us to get the wrong message number for socket events if the - * message window is a subclass of a static control. - */ - windowClass.style = 0; windowClass.cbClsExtra = 0; windowClass.cbWndExtra = 0; @@ -481,35 +287,36 @@ InitSockets() if (!RegisterClassA(&windowClass)) { TclWinConvertError(GetLastError()); - goto unloadLibrary; + goto initFailure; } /* - * Initialize the winsock library and check the interface - * version actually loaded. We only ask for the 1.1 interface - * and do require that it not be less than 1.1. + * Initialize the winsock library and check the interface version + * actually loaded. We only ask for the 1.1 interface and do require + * that it not be less than 1.1. */ -#define WSA_VERSION_MAJOR 1 -#define WSA_VERSION_MINOR 1 -#define WSA_VERSION_REQD MAKEWORD(WSA_VERSION_MAJOR, WSA_VERSION_MINOR) +#define WSA_VERSION_MAJOR 1 +#define WSA_VERSION_MINOR 1 +#define WSA_VERSION_REQD MAKEWORD(WSA_VERSION_MAJOR, WSA_VERSION_MINOR) - if ((err = winSock.WSAStartup(WSA_VERSION_REQD, &wsaData)) != 0) { + err = WSAStartup((WORD)WSA_VERSION_REQD, &wsaData); + if (err != 0) { TclWinConvertWSAError(err); - goto unloadLibrary; + goto initFailure; } /* - * Note the byte positions are swapped for the comparison, so - * that 0x0002 (2.0, MAKEWORD(2,0)) doesn't look less than 0x0101 - * (1.1). We want the comparison to be 0x0200 < 0x0101. + * Note the byte positions are swapped for the comparison, so that + * 0x0002 (2.0, MAKEWORD(2,0)) doesn't look less than 0x0101 (1.1). + * We want the comparison to be 0x0200 < 0x0101. */ if (MAKEWORD(HIBYTE(wsaData.wVersion), LOBYTE(wsaData.wVersion)) < MAKEWORD(WSA_VERSION_MINOR, WSA_VERSION_MAJOR)) { TclWinConvertWSAError(WSAVERNOTSUPPORTED); - winSock.WSACleanup(); - goto unloadLibrary; + WSACleanup(); + goto initFailure; } #undef WSA_VERSION_REQD @@ -528,39 +335,38 @@ InitSockets() tsdPtr->threadId = Tcl_GetCurrentThread(); tsdPtr->readyEvent = CreateEvent(NULL, FALSE, FALSE, NULL); if (tsdPtr->readyEvent == NULL) { - goto unloadLibrary; + goto initFailure; } tsdPtr->socketListLock = CreateEvent(NULL, FALSE, TRUE, NULL); if (tsdPtr->socketListLock == NULL) { - goto unloadLibrary; + goto initFailure; } - tsdPtr->socketThread = CreateThread(NULL, 256, SocketThread, - tsdPtr, 0, &id); + tsdPtr->socketThread = CreateThread(NULL, 256, SocketThread, tsdPtr, + 0, &id); if (tsdPtr->socketThread == NULL) { - goto unloadLibrary; + goto initFailure; } SetThreadPriority(tsdPtr->socketThread, THREAD_PRIORITY_HIGHEST); /* - * Wait for the thread to signal when the window has - * been created and if it is ready to go. + * Wait for the thread to signal when the window has been created and + * if it is ready to go. */ WaitForSingleObject(tsdPtr->readyEvent, INFINITE); if (tsdPtr->hwnd == NULL) { - goto unloadLibrary; /* Trouble creating the window */ + goto initFailure; /* Trouble creating the window */ } Tcl_CreateEventSource(SocketSetupProc, SocketCheckProc, NULL); } return; -unloadLibrary: + initFailure: TclpFinalizeSockets(); - FreeLibrary(winSock.hModule); - winSock.hModule = NULL; + initialized = -1; return; } @@ -569,7 +375,7 @@ unloadLibrary: * * SocketsEnabled -- * - * Check that the WinSock DLL is loaded and ready. + * Check that the WinSock was successfully initialized. * * Results: * 1 if it is. @@ -582,11 +388,11 @@ unloadLibrary: /* ARGSUSED */ static int -SocketsEnabled() +SocketsEnabled(void) { int enabled; Tcl_MutexLock(&socketMutex); - enabled = (winSock.hModule != NULL); + enabled = (initialized == 1); Tcl_MutexUnlock(&socketMutex); return enabled; } @@ -597,7 +403,7 @@ SocketsEnabled() * * SocketExitHandler -- * - * Callback invoked during app exit clean up to delete the socket + * Callback invoked during exit clean up to delete the socket * communication window and to release the WinSock DLL. * * Results: @@ -611,23 +417,19 @@ SocketsEnabled() /* ARGSUSED */ static void -SocketExitHandler(clientData) - ClientData clientData; /* Not used. */ +SocketExitHandler( + ClientData clientData) /* Not used. */ { Tcl_MutexLock(&socketMutex); - if (winSock.hModule) { - /* - * Make sure the socket event handling window is cleaned-up - * for, at most, this thread. - */ - TclpFinalizeSockets(); - UnregisterClass("TclSocket", TclWinGetTclInstance()); - winSock.WSACleanup(); - FreeLibrary(winSock.hModule); - winSock.hModule = NULL; - } + /* + * Make sure the socket event handling window is cleaned-up for, at + * most, this thread. + */ + + TclpFinalizeSockets(); + UnregisterClass("TclSocket", TclWinGetTclInstance()); + WSACleanup(); initialized = 0; - hostnameInitialized = 0; Tcl_MutexUnlock(&socketMutex); } @@ -636,10 +438,10 @@ SocketExitHandler(clientData) * * TclpFinalizeSockets -- * - * This function is called from Tcl_FinalizeThread to finalize - * the platform specific socket subsystem. - * Also, it may be called from within this module to cleanup - * the state if unable to initialize the sockets subsystem. + * This function is called from Tcl_FinalizeThread to finalize the + * platform specific socket subsystem. Also, it may be called from within + * this module to cleanup the state if unable to initialize the sockets + * subsystem. * * Results: * None. @@ -651,19 +453,21 @@ SocketExitHandler(clientData) */ void -TclpFinalizeSockets() +TclpFinalizeSockets(void) { ThreadSpecificData *tsdPtr; - tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); + tsdPtr = (ThreadSpecificData *) TclThreadDataKeyGet(&dataKey); if (tsdPtr != NULL) { if (tsdPtr->socketThread != NULL) { if (tsdPtr->hwnd != NULL) { PostMessage(tsdPtr->hwnd, SOCKET_TERMINATE, 0, 0); + /* * Wait for the thread to exit. This ensures that we are * completely cleaned up before we leave this function. */ + WaitForSingleObject(tsdPtr->readyEvent, INFINITE); tsdPtr->hwnd = NULL; } @@ -687,25 +491,27 @@ TclpFinalizeSockets() * * TclpHasSockets -- * - * This function determines whether sockets are available on the - * current system and returns an error in interp if they are not. - * Note that interp may be NULL. + * This function determines whether sockets are available on the current + * system and returns an error in interp if they are not. Note that + * interp may be NULL. * * Results: - * Returns TCL_OK if the system supports sockets, or TCL_ERROR with - * an error in interp. + * Returns TCL_OK if the system supports sockets, or TCL_ERROR with an + * error in interp (if non-NULL). * * Side effects: - * If not already prepared, initializes the TSD structure and - * socket message handling thread associated to the calling thread - * for the subsystem of the driver. + * If not already prepared, initializes the TSD structure and socket + * message handling thread associated to the calling thread for the + * subsystem of the driver. * *---------------------------------------------------------------------- */ int -TclpHasSockets(interp) - Tcl_Interp *interp; +TclpHasSockets( + Tcl_Interp *interp) /* Where to write an error message if sockets + * are not present, or NULL if no such message + * is to be written. */ { Tcl_MutexLock(&socketMutex); InitSockets(); @@ -726,8 +532,8 @@ TclpHasSockets(interp) * * SocketSetupProc -- * - * This procedure is invoked before Tcl_DoOneEvent blocks waiting - * for an event. + * This function is invoked before Tcl_DoOneEvent blocks waiting for an + * event. * * Results: * None. @@ -739,9 +545,9 @@ TclpHasSockets(interp) */ void -SocketSetupProc(data, flags) - ClientData data; /* Not used. */ - int flags; /* Event flags as passed to Tcl_DoOneEvent. */ +SocketSetupProc( + ClientData data, /* Not used. */ + int flags) /* Event flags as passed to Tcl_DoOneEvent. */ { SocketInfo *infoPtr; Tcl_Time blockTime = { 0, 0 }; @@ -750,13 +556,13 @@ SocketSetupProc(data, flags) if (!(flags & TCL_FILE_EVENTS)) { return; } - + /* - * Check to see if there is a ready socket. If so, poll. + * Check to see if there is a ready socket. If so, poll. */ WaitForSingleObject(tsdPtr->socketListLock, INFINITE); - for (infoPtr = tsdPtr->socketList; infoPtr != NULL; + for (infoPtr = tsdPtr->socketList; infoPtr != NULL; infoPtr = infoPtr->nextPtr) { if (infoPtr->readyEvents & infoPtr->watchEvents) { Tcl_SetMaxBlockTime(&blockTime); @@ -771,8 +577,8 @@ SocketSetupProc(data, flags) * * SocketCheckProc -- * - * This procedure is called by Tcl_DoOneEvent to check the socket - * event source for events. + * This function is called by Tcl_DoOneEvent to check the socket event + * source for events. * * Results: * None. @@ -784,9 +590,9 @@ SocketSetupProc(data, flags) */ static void -SocketCheckProc(data, flags) - ClientData data; /* Not used. */ - int flags; /* Event flags as passed to Tcl_DoOneEvent. */ +SocketCheckProc( + ClientData data, /* Not used. */ + int flags) /* Event flags as passed to Tcl_DoOneEvent. */ { SocketInfo *infoPtr; SocketEvent *evPtr; @@ -795,7 +601,7 @@ SocketCheckProc(data, flags) if (!(flags & TCL_FILE_EVENTS)) { return; } - + /* * Queue events for any ready sockets that don't already have events * queued (caused by persistent states that won't generate WinSock @@ -803,7 +609,7 @@ SocketCheckProc(data, flags) */ WaitForSingleObject(tsdPtr->socketListLock, INFINITE); - for (infoPtr = tsdPtr->socketList; infoPtr != NULL; + for (infoPtr = tsdPtr->socketList; infoPtr != NULL; infoPtr = infoPtr->nextPtr) { if ((infoPtr->readyEvents & infoPtr->watchEvents) && !(infoPtr->flags & SOCKET_PENDING)) { @@ -822,27 +628,27 @@ SocketCheckProc(data, flags) * * SocketEventProc -- * - * This procedure is called by Tcl_ServiceEvent when a socket event - * reaches the front of the event queue. This procedure is - * responsible for notifying the generic channel code. + * This function is called by Tcl_ServiceEvent when a socket event + * reaches the front of the event queue. This function is responsible for + * notifying the generic channel code. * * Results: - * Returns 1 if the event was handled, meaning it should be removed - * from the queue. Returns 0 if the event was not handled, meaning - * it should stay on the queue. The only time the event isn't - * handled is if the TCL_FILE_EVENTS flag bit isn't set. + * Returns 1 if the event was handled, meaning it should be removed from + * the queue. Returns 0 if the event was not handled, meaning it should + * stay on the queue. The only time the event isn't handled is if the + * TCL_FILE_EVENTS flag bit isn't set. * * Side effects: - * Whatever the channel callback procedures do. + * Whatever the channel callback functions do. * *---------------------------------------------------------------------- */ static int -SocketEventProc(evPtr, flags) - Tcl_Event *evPtr; /* Event to service. */ - int flags; /* Flags that indicate what events to - * handle, such as TCL_FILE_EVENTS. */ +SocketEventProc( + Tcl_Event *evPtr, /* Event to service. */ + int flags) /* Flags that indicate what events to handle, + * such as TCL_FILE_EVENTS. */ { SocketInfo *infoPtr; SocketEvent *eventPtr = (SocketEvent *) evPtr; @@ -859,7 +665,7 @@ SocketEventProc(evPtr, flags) */ WaitForSingleObject(tsdPtr->socketListLock, INFINITE); - for (infoPtr = tsdPtr->socketList; infoPtr != NULL; + for (infoPtr = tsdPtr->socketList; infoPtr != NULL; infoPtr = infoPtr->nextPtr) { if (infoPtr->socket == eventPtr->socket) { break; @@ -887,21 +693,21 @@ SocketEventProc(evPtr, flags) } /* - * Mask off unwanted events and compute the read/write mask so - * we can notify the channel. + * Mask off unwanted events and compute the read/write mask so we can + * notify the channel. */ events = infoPtr->readyEvents & infoPtr->watchEvents; if (events & FD_CLOSE) { /* - * If the socket was closed and the channel is still interested - * in read events, then we need to ensure that we keep polling - * for this event until someone does something with the channel. - * Note that we do this before calling Tcl_NotifyChannel so we don't - * have to watch out for the channel being deleted out from under - * us. This may cause a redundant trip through the event loop, but - * it's simpler than trying to do unwind protection. + * If the socket was closed and the channel is still interested in + * read events, then we need to ensure that we keep polling for this + * event until someone does something with the channel. Note that we + * do this before calling Tcl_NotifyChannel so we don't have to watch + * out for the channel being deleted out from under us. This may cause + * a redundant trip through the event loop, but it's simpler than + * trying to do unwind protection. */ Tcl_Time blockTime = { 0, 0 }; @@ -913,10 +719,10 @@ SocketEventProc(evPtr, flags) /* * We must check to see if data is really available, since someone - * could have consumed the data in the meantime. Turn off async - * notification so select will work correctly. If the socket is - * still readable, notify the channel driver, otherwise reset the - * async select handler and keep waiting. + * could have consumed the data in the meantime. Turn off async + * notification so select will work correctly. If the socket is still + * readable, notify the channel driver, otherwise reset the async + * select handler and keep waiting. */ SendMessage(tsdPtr->hwnd, SOCKET_SELECT, @@ -926,8 +732,8 @@ SocketEventProc(evPtr, flags) FD_SET(infoPtr->socket, &readFds); timeout.tv_usec = 0; timeout.tv_sec = 0; - - if (winSock.select(0, &readFds, NULL, NULL, &timeout) != 0) { + + if (select(0, &readFds, NULL, NULL, &timeout) != 0) { mask |= TCL_READABLE; } else { infoPtr->readyEvents &= ~(FD_READ); @@ -938,7 +744,10 @@ SocketEventProc(evPtr, flags) if (events & (FD_WRITE | FD_CONNECT)) { mask |= TCL_WRITABLE; if (events & FD_CONNECT && infoPtr->lastError != NO_ERROR) { - /* connect errors should also fire the readable handler. */ + /* + * Connect errors should also fire the readable handler. + */ + mask |= TCL_READABLE; } } @@ -966,10 +775,10 @@ SocketEventProc(evPtr, flags) */ static int -TcpBlockProc(instanceData, mode) - ClientData instanceData; /* The socket to block/un-block. */ - int mode; /* TCL_MODE_BLOCKING or - * TCL_MODE_NONBLOCKING. */ +TcpBlockProc( + ClientData instanceData, /* The socket to block/un-block. */ + int mode) /* TCL_MODE_BLOCKING or + * TCL_MODE_NONBLOCKING. */ { SocketInfo *infoPtr = (SocketInfo *) instanceData; @@ -986,9 +795,9 @@ TcpBlockProc(instanceData, mode) * * TcpCloseProc -- * - * This procedure is called by the generic IO level to perform - * channel type specific cleanup on a socket based channel - * when the channel is closed. + * This function is called by the generic IO level to perform channel + * type specific cleanup on a socket based channel when the channel is + * closed. * * Results: * 0 if successful, the value of errno if failed. @@ -1001,41 +810,41 @@ TcpBlockProc(instanceData, mode) /* ARGSUSED */ static int -TcpCloseProc(instanceData, interp) - ClientData instanceData; /* The socket to close. */ - Tcl_Interp *interp; /* Unused. */ +TcpCloseProc( + ClientData instanceData, /* The socket to close. */ + Tcl_Interp *interp) /* Unused. */ { SocketInfo *infoPtr = (SocketInfo *) instanceData; /* TIP #218 */ int errorCode = 0; + /* ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); */ /* - * Check that WinSock is initialized; do not call it if not, to - * prevent system crashes. This can happen at exit time if the exit - * handler for WinSock ran before other exit handlers that want to - * use sockets. + * Check that WinSock is initialized; do not call it if not, to prevent + * system crashes. This can happen at exit time if the exit handler for + * WinSock ran before other exit handlers that want to use sockets. */ if (SocketsEnabled()) { - /* - * Clean up the OS socket handle. The default Windows setting - * for a socket is SO_DONTLINGER, which does a graceful shutdown - * in the background. - */ - - if (winSock.closesocket(infoPtr->socket) == SOCKET_ERROR) { - TclWinConvertWSAError((DWORD) winSock.WSAGetLastError()); - errorCode = Tcl_GetErrno(); - } - } - - /* TIP #218. Removed the code removing the structure - * from the global socket list. This is now done by - * the thread action callbacks, and only there. This - * happens before this code is called. We can free - * without fear of damanging the list. + * Clean up the OS socket handle. The default Windows setting for a + * socket is SO_DONTLINGER, which does a graceful shutdown in the + * background. + */ + + if (closesocket(infoPtr->socket) == SOCKET_ERROR) { + TclWinConvertWSAError((DWORD) WSAGetLastError()); + errorCode = Tcl_GetErrno(); + } + } + + /* + * TIP #218. Removed the code removing the structure from the global + * socket list. This is now done by the thread action callbacks, and only + * there. This happens before this code is called. We can free without + * fear of damaging the list. */ + ckfree((char *) infoPtr); return errorCode; } @@ -1045,8 +854,7 @@ TcpCloseProc(instanceData, interp) * * NewSocketInfo -- * - * This function allocates and initializes a new SocketInfo - * structure. + * This function allocates and initializes a new SocketInfo structure. * * Results: * Returns a newly allocated SocketInfo. @@ -1058,12 +866,14 @@ TcpCloseProc(instanceData, interp) */ static SocketInfo * -NewSocketInfo(socket) - SOCKET socket; +NewSocketInfo( + SOCKET socket) { SocketInfo *infoPtr; + /* ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); */ infoPtr = (SocketInfo *) ckalloc((unsigned) sizeof(SocketInfo)); + infoPtr->channel = 0; infoPtr->socket = socket; infoPtr->flags = 0; infoPtr->watchEvents = 0; @@ -1071,14 +881,17 @@ NewSocketInfo(socket) infoPtr->selectEvents = 0; infoPtr->acceptEventCount = 0; infoPtr->acceptProc = NULL; + infoPtr->acceptProcData = NULL; infoPtr->lastError = 0; - /* TIP #218. Removed the code inserting the new structure - * into the global list. This is now handled in the thread - * action callbacks, and only there. + /* + * TIP #218. Removed the code inserting the new structure into the global + * list. This is now handled in the thread action callbacks, and only + * there. */ + infoPtr->nextPtr = NULL; - + return infoPtr; } @@ -1087,8 +900,8 @@ NewSocketInfo(socket) * * CreateSocket -- * - * This function opens a new socket and initializes the - * SocketInfo structure. + * This function opens a new socket and initializes the SocketInfo + * structure. * * Results: * Returns a new SocketInfo, or NULL with an error in interp. @@ -1100,58 +913,57 @@ NewSocketInfo(socket) */ static SocketInfo * -CreateSocket(interp, port, host, server, myaddr, myport, async) - Tcl_Interp *interp; /* For error reporting; can be NULL. */ - int port; /* Port number to open. */ - CONST char *host; /* Name of host on which to open port. */ - int server; /* 1 if socket should be a server socket, - * else 0 for a client socket. */ - CONST char *myaddr; /* Optional client-side address */ - int myport; /* Optional client-side port */ - int async; /* If nonzero, connect client socket +CreateSocket( + Tcl_Interp *interp, /* For error reporting; can be NULL. */ + int port, /* Port number to open. */ + const char *host, /* Name of host on which to open port. */ + int server, /* 1 if socket should be a server socket, else + * 0 for a client socket. */ + const char *myaddr, /* Optional client-side address */ + int myport, /* Optional client-side port */ + int async) /* If nonzero, connect client socket * asynchronously. */ { u_long flag = 1; /* Indicates nonblocking mode. */ - int asyncConnect = 0; /* Will be 1 if async connect is - * in progress. */ + int asyncConnect = 0; /* Will be 1 if async connect is in + * progress. */ SOCKADDR_IN sockaddr; /* Socket address */ SOCKADDR_IN mysockaddr; /* Socket address for client */ SOCKET sock = INVALID_SOCKET; SocketInfo *infoPtr; /* The returned value. */ - ThreadSpecificData *tsdPtr = - (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + TclThreadDataKeyGet(&dataKey); /* - * Check that WinSock is initialized; do not call it if not, to - * prevent system crashes. This can happen at exit time if the exit - * handler for WinSock ran before other exit handlers that want to - * use sockets. + * Check that WinSock is initialized; do not call it if not, to prevent + * system crashes. This can happen at exit time if the exit handler for + * WinSock ran before other exit handlers that want to use sockets. */ if (!SocketsEnabled()) { - return NULL; + return NULL; } - if (! CreateSocketAddress(&sockaddr, host, port)) { + if (!CreateSocketAddress(&sockaddr, host, port)) { goto error; } if ((myaddr != NULL || myport != 0) && - ! CreateSocketAddress(&mysockaddr, myaddr, myport)) { + !CreateSocketAddress(&mysockaddr, myaddr, myport)) { goto error; } - sock = winSock.socket(AF_INET, SOCK_STREAM, 0); + sock = socket(AF_INET, SOCK_STREAM, 0); if (sock == INVALID_SOCKET) { goto error; } /* - * Win-NT has a misfeature that sockets are inherited in child - * processes by default. Turn off the inherit bit. + * Win-NT has a misfeature that sockets are inherited in child processes + * by default. Turn off the inherit bit. */ - SetHandleInformation( (HANDLE) sock, HANDLE_FLAG_INHERIT, 0 ); - + SetHandleInformation((HANDLE) sock, HANDLE_FLAG_INHERIT, 0); + /* * Set kernel space buffering */ @@ -1160,27 +972,27 @@ CreateSocket(interp, port, host, server, myaddr, myport, async) if (server) { /* - * Bind to the specified port. Note that we must not call setsockopt + * Bind to the specified port. Note that we must not call setsockopt * with SO_REUSEADDR because Microsoft allows addresses to be reused * even if they are still in use. - * - * Bind should not be affected by the socket having already been - * set into nonblocking mode. If there is trouble, this is one place - * to look for bugs. + * + * Bind should not be affected by the socket having already been set + * into nonblocking mode. If there is trouble, this is one place to + * look for bugs. */ - - if (winSock.bind(sock, (SOCKADDR *) &sockaddr, - sizeof(SOCKADDR_IN)) == SOCKET_ERROR) { - goto error; - } - - /* - * Set the maximum number of pending connect requests to the - * max value allowed on each platform (Win32 and Win32s may be - * different, and there may be differences between TCP/IP stacks). - */ - - if (winSock.listen(sock, SOMAXCONN) == SOCKET_ERROR) { + + if (bind(sock, (SOCKADDR *) &sockaddr, sizeof(SOCKADDR_IN)) + == SOCKET_ERROR) { + goto error; + } + + /* + * Set the maximum number of pending connect requests to the max value + * allowed on each platform (Win32 and Win32s may be different, and + * there may be differences between TCP/IP stacks). + */ + + if (listen(sock, SOMAXCONN) == SOCKET_ERROR) { goto error; } @@ -1198,25 +1010,24 @@ CreateSocket(interp, port, host, server, myaddr, myport, async) infoPtr->watchEvents |= FD_ACCEPT; } else { + /* + * Try to bind to a local port, if specified. + */ - /* - * Try to bind to a local port, if specified. - */ - - if (myaddr != NULL || myport != 0) { - if (winSock.bind(sock, (SOCKADDR *) &mysockaddr, - sizeof(SOCKADDR_IN)) == SOCKET_ERROR) { + if (myaddr != NULL || myport != 0) { + if (bind(sock, (SOCKADDR *) &mysockaddr, sizeof(SOCKADDR_IN)) + == SOCKET_ERROR) { goto error; } - } - + } + /* - * Set the socket into nonblocking mode if the connect should be - * done in the background. + * Set the socket into nonblocking mode if the connect should be done + * in the background. */ - + if (async) { - if (winSock.ioctlsocket(sock, (long) FIONBIO, &flag) == SOCKET_ERROR) { + if (ioctlsocket(sock, (long) FIONBIO, &flag) == SOCKET_ERROR) { goto error; } } @@ -1225,9 +1036,9 @@ CreateSocket(interp, port, host, server, myaddr, myport, async) * Attempt to connect to the remote socket. */ - if (winSock.connect(sock, (SOCKADDR *) &sockaddr, + if (connect(sock, (SOCKADDR *) &sockaddr, sizeof(SOCKADDR_IN)) == SOCKET_ERROR) { - TclWinConvertWSAError((DWORD) winSock.WSAGetLastError()); + TclWinConvertWSAError((DWORD) WSAGetLastError()); if (Tcl_GetErrno() != EWOULDBLOCK) { goto error; } @@ -1237,7 +1048,7 @@ CreateSocket(interp, port, host, server, myaddr, myport, async) */ asyncConnect = 1; - } + } /* * Add this socket to the global list of sockets. @@ -1246,7 +1057,7 @@ CreateSocket(interp, port, host, server, myaddr, myport, async) infoPtr = NewSocketInfo(sock); /* - * Set up the select mask for read/write events. If the connect + * Set up the select mask for read/write events. If the connect * attempt has not completed, include connect events. */ @@ -1258,24 +1069,23 @@ CreateSocket(interp, port, host, server, myaddr, myport, async) } /* - * Register for interest in events in the select mask. Note that this + * Register for interest in events in the select mask. Note that this * automatically places the socket into non-blocking mode. */ - winSock.ioctlsocket(sock, (long) FIONBIO, &flag); - SendMessage(tsdPtr->hwnd, SOCKET_SELECT, - (WPARAM) SELECT, (LPARAM) infoPtr); + ioctlsocket(sock, (long) FIONBIO, &flag); + SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT, (LPARAM) infoPtr); return infoPtr; -error: - TclWinConvertWSAError((DWORD) winSock.WSAGetLastError()); + error: + TclWinConvertWSAError((DWORD) WSAGetLastError()); if (interp != NULL) { Tcl_AppendResult(interp, "couldn't open socket: ", - Tcl_PosixError(interp), (char *) NULL); + Tcl_PosixError(interp), NULL); } if (sock != INVALID_SOCKET) { - winSock.closesocket(sock); + closesocket(sock); } return NULL; } @@ -1288,8 +1098,8 @@ error: * This function initializes a sockaddr structure for a host and port. * * Results: - * 1 if the host was valid, 0 if the host could not be converted to - * an IP address. + * 1 if the host was valid, 0 if the host could not be converted to an IP + * address. * * Side effects: * Fills in the *sockaddrPtr structure. @@ -1298,43 +1108,42 @@ error: */ static int -CreateSocketAddress(sockaddrPtr, host, port) - LPSOCKADDR_IN sockaddrPtr; /* Socket address */ - CONST char *host; /* Host. NULL implies INADDR_ANY */ - int port; /* Port number */ +CreateSocketAddress( + LPSOCKADDR_IN sockaddrPtr, /* Socket address */ + const char *host, /* Host. NULL implies INADDR_ANY */ + int port) /* Port number */ { - struct hostent *hostent; /* Host database entry */ - struct in_addr addr; /* For 64/32 bit madness */ + struct hostent *hostent; /* Host database entry */ + struct in_addr addr; /* For 64/32 bit madness */ /* - * Check that WinSock is initialized; do not call it if not, to - * prevent system crashes. This can happen at exit time if the exit - * handler for WinSock ran before other exit handlers that want to - * use sockets. + * Check that WinSock is initialized; do not call it if not, to prevent + * system crashes. This can happen at exit time if the exit handler for + * WinSock ran before other exit handlers that want to use sockets. */ if (!SocketsEnabled()) { - Tcl_SetErrno(EFAULT); - return 0; + Tcl_SetErrno(EFAULT); + return 0; } ZeroMemory(sockaddrPtr, sizeof(SOCKADDR_IN)); sockaddrPtr->sin_family = AF_INET; - sockaddrPtr->sin_port = winSock.htons((u_short) (port & 0xFFFF)); + sockaddrPtr->sin_port = htons((u_short) (port & 0xFFFF)); if (host == NULL) { addr.s_addr = INADDR_ANY; } else { - addr.s_addr = winSock.inet_addr(host); - if (addr.s_addr == INADDR_NONE) { - hostent = winSock.gethostbyname(host); - if (hostent != NULL) { - memcpy(&addr, hostent->h_addr, (size_t) hostent->h_length); - } else { + addr.s_addr = inet_addr(host); + if (addr.s_addr == INADDR_NONE) { + hostent = gethostbyname(host); + if (hostent != NULL) { + memcpy(&addr, hostent->h_addr, (size_t) hostent->h_length); + } else { #ifdef EHOSTUNREACH - Tcl_SetErrno(EHOSTUNREACH); + Tcl_SetErrno(EHOSTUNREACH); #else #ifdef ENXIO - Tcl_SetErrno(ENXIO); + Tcl_SetErrno(ENXIO); #endif #endif return 0; /* Error. */ @@ -1343,14 +1152,14 @@ CreateSocketAddress(sockaddrPtr, host, port) } /* - * NOTE: On 64 bit machines the assignment below is rumored to not - * do the right thing. Please report errors related to this if you - * observe incorrect behavior on 64 bit machines such as DEC Alphas. - * Should we modify this code to do an explicit memcpy? + * NOTE: On 64 bit machines the assignment below is rumored to not do the + * right thing. Please report errors related to this if you observe + * incorrect behavior on 64 bit machines such as DEC Alphas. Should we + * modify this code to do an explicit memcpy? */ sockaddrPtr->sin_addr.s_addr = addr.s_addr; - return 1; /* Success. */ + return 1; /* Success. */ } /* @@ -1371,34 +1180,33 @@ CreateSocketAddress(sockaddrPtr, host, port) */ static int -WaitForSocketEvent(infoPtr, events, errorCodePtr) - SocketInfo *infoPtr; /* Information about this socket. */ - int events; /* Events to look for. */ - int *errorCodePtr; /* Where to store errors? */ +WaitForSocketEvent( + SocketInfo *infoPtr, /* Information about this socket. */ + int events, /* Events to look for. */ + int *errorCodePtr) /* Where to store errors? */ { int result = 1; int oldMode; - ThreadSpecificData *tsdPtr = - (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + TclThreadDataKeyGet(&dataKey); /* * Be sure to disable event servicing so we are truly modal. */ oldMode = Tcl_SetServiceMode(TCL_SERVICE_NONE); - + /* * Reset WSAAsyncSelect so we have a fresh set of events pending. */ - SendMessage(tsdPtr->hwnd, SOCKET_SELECT, - (WPARAM) UNSELECT, (LPARAM) infoPtr); + SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) UNSELECT, + (LPARAM) infoPtr); - SendMessage(tsdPtr->hwnd, SOCKET_SELECT, - (WPARAM) SELECT, (LPARAM) infoPtr); + SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT, + (LPARAM) infoPtr); while (1) { - if (infoPtr->lastError) { *errorCodePtr = infoPtr->lastError; result = 0; @@ -1414,9 +1222,10 @@ WaitForSocketEvent(infoPtr, events, errorCodePtr) /* * Wait until something happens. */ + WaitForSingleObject(tsdPtr->readyEvent, INFINITE); } - + (void) Tcl_SetServiceMode(oldMode); return result; } @@ -1429,8 +1238,8 @@ WaitForSocketEvent(infoPtr, events, errorCodePtr) * Opens a TCP client socket and creates a channel around it. * * Results: - * The channel or NULL if failed. An error message is returned - * in the interpreter on failure. + * The channel or NULL if failed. An error message is returned in the + * interpreter on failure. * * Side effects: * Opens a client socket and creates a new channel. @@ -1439,14 +1248,14 @@ WaitForSocketEvent(infoPtr, events, errorCodePtr) */ Tcl_Channel -Tcl_OpenTcpClient(interp, port, host, myaddr, myport, async) - Tcl_Interp *interp; /* For error reporting; can be NULL. */ - int port; /* Port number to open. */ - CONST char *host; /* Host on which to open port. */ - CONST char *myaddr; /* Client-side address */ - int myport; /* Client-side port */ - int async; /* If nonzero, should connect - * client socket asynchronously. */ +Tcl_OpenTcpClient( + Tcl_Interp *interp, /* For error reporting; can be NULL. */ + int port, /* Port number to open. */ + const char *host, /* Host on which to open port. */ + const char *myaddr, /* Client-side address */ + int myport, /* Client-side port */ + int async) /* If nonzero, should connect client socket + * asynchronously. */ { SocketInfo *infoPtr; char channelName[16 + TCL_INTEGER_SPACE]; @@ -1470,13 +1279,13 @@ Tcl_OpenTcpClient(interp, port, host, myaddr, myport, async) (ClientData) infoPtr, (TCL_READABLE | TCL_WRITABLE)); if (Tcl_SetChannelOption(interp, infoPtr->channel, "-translation", "auto crlf") == TCL_ERROR) { - Tcl_Close((Tcl_Interp *) NULL, infoPtr->channel); - return (Tcl_Channel) NULL; + Tcl_Close((Tcl_Interp *) NULL, infoPtr->channel); + return (Tcl_Channel) NULL; } if (Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "") == TCL_ERROR) { - Tcl_Close((Tcl_Interp *) NULL, infoPtr->channel); - return (Tcl_Channel) NULL; + Tcl_Close((Tcl_Interp *) NULL, infoPtr->channel); + return (Tcl_Channel) NULL; } return infoPtr->channel; } @@ -1500,8 +1309,8 @@ Tcl_OpenTcpClient(interp, port, host, myaddr, myport, async) */ Tcl_Channel -Tcl_MakeTcpClientChannel(sock) - ClientData sock; /* The socket to wrap up into a channel. */ +Tcl_MakeTcpClientChannel( + ClientData sock) /* The socket to wrap up into a channel. */ { SocketInfo *infoPtr; char channelName[16 + TCL_INTEGER_SPACE]; @@ -1517,7 +1326,7 @@ Tcl_MakeTcpClientChannel(sock) * Set kernel space buffering and non-blocking. */ - TclSockMinimumBuffers((int) sock, TCP_BUFFER_SIZE); + TclSockMinimumBuffers(PTR2INT(sock), TCP_BUFFER_SIZE); infoPtr = NewSocketInfo((SOCKET) sock); @@ -1544,8 +1353,8 @@ Tcl_MakeTcpClientChannel(sock) * Opens a TCP server socket and creates a channel around it. * * Results: - * The channel or NULL if failed. An error message is returned - * in the interpreter on failure. + * The channel or NULL if failed. An error message is returned in the + * interpreter on failure. * * Side effects: * Opens a server socket and creates a new channel. @@ -1554,14 +1363,14 @@ Tcl_MakeTcpClientChannel(sock) */ Tcl_Channel -Tcl_OpenTcpServer(interp, port, host, acceptProc, acceptProcData) - Tcl_Interp *interp; /* For error reporting - may be - * NULL. */ - int port; /* Port number to open. */ - CONST char *host; /* Name of local host. */ - Tcl_TcpAcceptProc *acceptProc; /* Callback for accepting connections - * from new clients. */ - ClientData acceptProcData; /* Data for the callback. */ +Tcl_OpenTcpServer( + Tcl_Interp *interp, /* For error reporting - may be NULL. */ + int port, /* Port number to open. */ + const char *host, /* Name of local host. */ + Tcl_TcpAcceptProc *acceptProc, + /* Callback for accepting connections from new + * clients. */ + ClientData acceptProcData) /* Data for the callback. */ { SocketInfo *infoPtr; char channelName[16 + TCL_INTEGER_SPACE]; @@ -1588,8 +1397,8 @@ Tcl_OpenTcpServer(interp, port, host, acceptProc, acceptProcData) (ClientData) infoPtr, 0); if (Tcl_SetChannelOption(interp, infoPtr->channel, "-eofchar", "") == TCL_ERROR) { - Tcl_Close((Tcl_Interp *) NULL, infoPtr->channel); - return (Tcl_Channel) NULL; + Tcl_Close((Tcl_Interp *) NULL, infoPtr->channel); + return (Tcl_Channel) NULL; } return infoPtr->channel; @@ -1599,9 +1408,9 @@ Tcl_OpenTcpServer(interp, port, host, acceptProc, acceptProcData) *---------------------------------------------------------------------- * * TcpAccept -- - * Accept a TCP socket connection. This is called by - * SocketEventProc and it in turns calls the registered accept - * procedure. + * + * Accept a TCP socket connection. This is called by SocketEventProc and + * it in turns calls the registered accept function. * * Results: * None. @@ -1613,16 +1422,16 @@ Tcl_OpenTcpServer(interp, port, host, acceptProc, acceptProcData) */ static void -TcpAccept(infoPtr) - SocketInfo *infoPtr; /* Socket to accept. */ +TcpAccept( + SocketInfo *infoPtr) /* Socket to accept. */ { SOCKET newSocket; SocketInfo *newInfoPtr; SOCKADDR_IN addr; int len; char channelName[16 + TCL_INTEGER_SPACE]; - ThreadSpecificData *tsdPtr = - (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + TclThreadDataKeyGet(&dataKey); /* * Accept the incoming connection request. @@ -1630,7 +1439,7 @@ TcpAccept(infoPtr) len = sizeof(SOCKADDR_IN); - newSocket = winSock.accept(infoPtr->socket, (SOCKADDR *)&addr, + newSocket = accept(infoPtr->socket, (SOCKADDR *)&addr, &len); /* @@ -1640,9 +1449,9 @@ TcpAccept(infoPtr) WaitForSingleObject(tsdPtr->socketListLock, INFINITE); /* - * Clear the ready mask so we can detect the next connection request. - * Note that connection requests are level triggered, so if there is - * a request already pending, a new event will be generated. + * Clear the ready mask so we can detect the next connection request. Note + * that connection requests are level triggered, so if there is a request + * already pending, a new event will be generated. */ if (newSocket == INVALID_SOCKET) { @@ -1655,7 +1464,7 @@ TcpAccept(infoPtr) /* * It is possible that more than one FD_ACCEPT has been sent, so an extra - * count must be kept. Decrement the count, and reset the readyEvent bit + * count must be kept. Decrement the count, and reset the readyEvent bit * if the count is no longer > 0. */ @@ -1668,11 +1477,11 @@ TcpAccept(infoPtr) SetEvent(tsdPtr->socketListLock); /* - * Win-NT has a misfeature that sockets are inherited in child - * processes by default. Turn off the inherit bit. + * Win-NT has a misfeature that sockets are inherited in child processes + * by default. Turn off the inherit bit. */ - SetHandleInformation( (HANDLE) newSocket, HANDLE_FLAG_INHERIT, 0 ); + SetHandleInformation((HANDLE) newSocket, HANDLE_FLAG_INHERIT, 0); /* * Add this socket to the global list of sockets. @@ -1703,14 +1512,12 @@ TcpAccept(infoPtr) } /* - * Invoke the accept callback procedure. + * Invoke the accept callback function. */ if (infoPtr->acceptProc != NULL) { - (infoPtr->acceptProc) (infoPtr->acceptProcData, - newInfoPtr->channel, - winSock.inet_ntoa(addr.sin_addr), - winSock.ntohs(addr.sin_port)); + (infoPtr->acceptProc) (infoPtr->acceptProcData, newInfoPtr->channel, + inet_ntoa(addr.sin_addr), ntohs(addr.sin_port)); } } @@ -1719,8 +1526,8 @@ TcpAccept(infoPtr) * * TcpInputProc -- * - * This procedure is called by the generic IO level to read data from - * a socket based channel. + * This function is called by the generic IO level to read data from a + * socket based channel. * * Results: * The number of bytes read or -1 on error. @@ -1732,35 +1539,34 @@ TcpAccept(infoPtr) */ static int -TcpInputProc(instanceData, buf, toRead, errorCodePtr) - ClientData instanceData; /* The socket state. */ - char *buf; /* Where to store data. */ - int toRead; /* Maximum number of bytes to read. */ - int *errorCodePtr; /* Where to store error codes. */ +TcpInputProc( + ClientData instanceData, /* The socket state. */ + char *buf, /* Where to store data. */ + int toRead, /* Maximum number of bytes to read. */ + int *errorCodePtr) /* Where to store error codes. */ { SocketInfo *infoPtr = (SocketInfo *) instanceData; int bytesRead; DWORD error; - ThreadSpecificData *tsdPtr = - (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); - + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + TclThreadDataKeyGet(&dataKey); + *errorCodePtr = 0; /* - * Check that WinSock is initialized; do not call it if not, to - * prevent system crashes. This can happen at exit time if the exit - * handler for WinSock ran before other exit handlers that want to - * use sockets. + * Check that WinSock is initialized; do not call it if not, to prevent + * system crashes. This can happen at exit time if the exit handler for + * WinSock ran before other exit handlers that want to use sockets. */ if (!SocketsEnabled()) { - *errorCodePtr = EFAULT; - return -1; + *errorCodePtr = EFAULT; + return -1; } /* - * First check to see if EOF was already detected, to prevent - * calling the socket stack after the first time EOF is detected. + * First check to see if EOF was already detected, to prevent calling the + * socket stack after the first time EOF is detected. */ if (infoPtr->flags & SOCKET_EOF) { @@ -1772,63 +1578,63 @@ TcpInputProc(instanceData, buf, toRead, errorCodePtr) */ if ((infoPtr->flags & SOCKET_ASYNC_CONNECT) - && ! WaitForSocketEvent(infoPtr, FD_CONNECT, errorCodePtr)) { + && !WaitForSocketEvent(infoPtr, FD_CONNECT, errorCodePtr)) { return -1; } - + /* - * No EOF, and it is connected, so try to read more from the socket. - * Note that we clear the FD_READ bit because read events are level - * triggered so a new event will be generated if there is still data - * available to be read. We have to simulate blocking behavior here - * since we are always using non-blocking sockets. + * No EOF, and it is connected, so try to read more from the socket. Note + * that we clear the FD_READ bit because read events are level triggered + * so a new event will be generated if there is still data available to be + * read. We have to simulate blocking behavior here since we are always + * using non-blocking sockets. */ while (1) { SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) UNSELECT, (LPARAM) infoPtr); - bytesRead = winSock.recv(infoPtr->socket, buf, toRead, 0); + bytesRead = recv(infoPtr->socket, buf, toRead, 0); infoPtr->readyEvents &= ~(FD_READ); - + /* * Check for end-of-file condition or successful read. */ - + if (bytesRead == 0) { infoPtr->flags |= SOCKET_EOF; } if (bytesRead != SOCKET_ERROR) { break; } - + /* - * If an error occurs after the FD_CLOSE has arrived, - * then ignore the error and report an EOF. + * If an error occurs after the FD_CLOSE has arrived, then ignore the + * error and report an EOF. */ - + if (infoPtr->readyEvents & FD_CLOSE) { infoPtr->flags |= SOCKET_EOF; bytesRead = 0; break; } - - error = winSock.WSAGetLastError(); - - /* - * If an RST comes, then ignore the error and report an EOF just like - * on unix. - */ - - if (error == WSAECONNRESET) { - infoPtr->flags |= SOCKET_EOF; - bytesRead = 0; - break; - } - + + error = WSAGetLastError(); + + /* + * If an RST comes, then ignore the error and report an EOF just like + * on unix. + */ + + if (error == WSAECONNRESET) { + infoPtr->flags |= SOCKET_EOF; + bytesRead = 0; + break; + } + /* * Check for error condition or underflow in non-blocking case. */ - + if ((infoPtr->flags & SOCKET_ASYNC) || (error != WSAEWOULDBLOCK)) { TclWinConvertWSAError(error); *errorCodePtr = Tcl_GetErrno(); @@ -1837,19 +1643,19 @@ TcpInputProc(instanceData, buf, toRead, errorCodePtr) } /* - * In the blocking case, wait until the file becomes readable - * or closed and try again. + * In the blocking case, wait until the file becomes readable or + * closed and try again. */ if (!WaitForSocketEvent(infoPtr, FD_READ|FD_CLOSE, errorCodePtr)) { bytesRead = -1; break; - } + } } - + SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT, (LPARAM) infoPtr); - + return bytesRead; } @@ -1858,8 +1664,8 @@ TcpInputProc(instanceData, buf, toRead, errorCodePtr) * * TcpOutputProc -- * - * This procedure is called by the generic IO level to write data - * to a socket based channel. + * This function is called by the generic IO level to write data to a + * socket based channel. * * Results: * The number of bytes written or -1 on failure. @@ -1871,38 +1677,37 @@ TcpInputProc(instanceData, buf, toRead, errorCodePtr) */ static int -TcpOutputProc(instanceData, buf, toWrite, errorCodePtr) - ClientData instanceData; /* The socket state. */ - CONST char *buf; /* Where to get data. */ - int toWrite; /* Maximum number of bytes to write. */ - int *errorCodePtr; /* Where to store error codes. */ +TcpOutputProc( + ClientData instanceData, /* The socket state. */ + const char *buf, /* Where to get data. */ + int toWrite, /* Maximum number of bytes to write. */ + int *errorCodePtr) /* Where to store error codes. */ { SocketInfo *infoPtr = (SocketInfo *) instanceData; int bytesWritten; DWORD error; - ThreadSpecificData *tsdPtr = - (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + TclThreadDataKeyGet(&dataKey); *errorCodePtr = 0; /* - * Check that WinSock is initialized; do not call it if not, to - * prevent system crashes. This can happen at exit time if the exit - * handler for WinSock ran before other exit handlers that want to - * use sockets. + * Check that WinSock is initialized; do not call it if not, to prevent + * system crashes. This can happen at exit time if the exit handler for + * WinSock ran before other exit handlers that want to use sockets. */ if (!SocketsEnabled()) { - *errorCodePtr = EFAULT; - return -1; + *errorCodePtr = EFAULT; + return -1; } /* * Check to see if the socket is connected before trying to write. */ - + if ((infoPtr->flags & SOCKET_ASYNC_CONNECT) - && ! WaitForSocketEvent(infoPtr, FD_CONNECT, errorCodePtr)) { + && !WaitForSocketEvent(infoPtr, FD_CONNECT, errorCodePtr)) { return -1; } @@ -1910,36 +1715,36 @@ TcpOutputProc(instanceData, buf, toWrite, errorCodePtr) SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) UNSELECT, (LPARAM) infoPtr); - bytesWritten = winSock.send(infoPtr->socket, buf, toWrite, 0); + bytesWritten = send(infoPtr->socket, buf, toWrite, 0); if (bytesWritten != SOCKET_ERROR) { /* - * Since Windows won't generate a new write event until we hit - * an overflow condition, we need to force the event loop to - * poll until the condition changes. + * Since Windows won't generate a new write event until we hit an + * overflow condition, we need to force the event loop to poll + * until the condition changes. */ if (infoPtr->watchEvents & FD_WRITE) { Tcl_Time blockTime = { 0, 0 }; Tcl_SetMaxBlockTime(&blockTime); - } + } break; } - + /* - * Check for error condition or overflow. In the event of overflow, we + * Check for error condition or overflow. In the event of overflow, we * need to clear the FD_WRITE flag so we can detect the next writable - * event. Note that Windows only sends a new writable event after a + * event. Note that Windows only sends a new writable event after a * send fails with WSAEWOULDBLOCK. */ - error = winSock.WSAGetLastError(); + error = WSAGetLastError(); if (error == WSAEWOULDBLOCK) { infoPtr->readyEvents &= ~(FD_WRITE); if (infoPtr->flags & SOCKET_ASYNC) { *errorCodePtr = EWOULDBLOCK; bytesWritten = -1; break; - } + } } else { TclWinConvertWSAError(error); *errorCodePtr = Tcl_GetErrno(); @@ -1948,8 +1753,8 @@ TcpOutputProc(instanceData, buf, toWrite, errorCodePtr) } /* - * In the blocking case, wait until the file becomes writable - * or closed and try again. + * In the blocking case, wait until the file becomes writable or + * closed and try again. */ if (!WaitForSocketEvent(infoPtr, FD_WRITE|FD_CLOSE, errorCodePtr)) { @@ -1960,7 +1765,7 @@ TcpOutputProc(instanceData, buf, toWrite, errorCodePtr) SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT, (LPARAM) infoPtr); - + return bytesWritten; } @@ -1981,45 +1786,48 @@ TcpOutputProc(instanceData, buf, toWrite, errorCodePtr) */ static int -TcpSetOptionProc ( +TcpSetOptionProc( ClientData instanceData, /* Socket state. */ Tcl_Interp *interp, /* For error reporting - can be NULL. */ - CONST char *optionName, /* Name of the option to set. */ - CONST char *value) /* New value for option. */ + const char *optionName, /* Name of the option to set. */ + const char *value) /* New value for option. */ { -/* +#ifdef TCL_FEATURE_KEEPALIVE_NAGLE SocketInfo *infoPtr; SOCKET sock; - BOOL val = FALSE; - int boolVar, rtn; -*/ +#endif + /* - * Check that WinSock is initialized; do not call it if not, to - * prevent system crashes. This can happen at exit time if the exit - * handler for WinSock ran before other exit handlers that want to - * use sockets. + * Check that WinSock is initialized; do not call it if not, to prevent + * system crashes. This can happen at exit time if the exit handler for + * WinSock ran before other exit handlers that want to use sockets. */ if (!SocketsEnabled()) { if (interp) { Tcl_AppendResult(interp, "winsock is not initialized", NULL); } - return TCL_ERROR; + return TCL_ERROR; } -/* +#ifdef TCL_FEATURE_KEEPALIVE_NAGLE infoPtr = (SocketInfo *) instanceData; sock = infoPtr->socket; - if (!stricmp(optionName, "-keepalive")) { + if (!strcasecmp(optionName, "-keepalive")) { + BOOL val = FALSE; + int boolVar, rtn; + if (Tcl_GetBoolean(interp, value, &boolVar) != TCL_OK) { return TCL_ERROR; } - if (boolVar) val = TRUE; - rtn = winSock.setsockopt(sock, SOL_SOCKET, SO_KEEPALIVE, + if (boolVar) { + val = TRUE; + } + rtn = setsockopt(sock, SOL_SOCKET, SO_KEEPALIVE, (const char *) &val, sizeof(BOOL)); if (rtn != 0) { - TclWinConvertWSAError(winSock.WSAGetLastError()); + TclWinConvertWSAError(WSAGetLastError()); if (interp) { Tcl_AppendResult(interp, "couldn't set socket option: ", Tcl_PosixError(interp), NULL); @@ -2027,16 +1835,20 @@ TcpSetOptionProc ( return TCL_ERROR; } return TCL_OK; + } else if (!strcasecmp(optionName, "-nagle")) { + BOOL val = FALSE; + int boolVar, rtn; - } else if (!stricmp(optionName, "-nagle")) { if (Tcl_GetBoolean(interp, value, &boolVar) != TCL_OK) { return TCL_ERROR; } - if (!boolVar) val = TRUE; - rtn = winSock.setsockopt(sock, IPPROTO_TCP, TCP_NODELAY, + if (!boolVar) { + val = TRUE; + } + rtn = setsockopt(sock, IPPROTO_TCP, TCP_NODELAY, (const char *) &val, sizeof(BOOL)); if (rtn != 0) { - TclWinConvertWSAError(winSock.WSAGetLastError()); + TclWinConvertWSAError(WSAGetLastError()); if (interp) { Tcl_AppendResult(interp, "couldn't set socket option: ", Tcl_PosixError(interp), NULL); @@ -2047,8 +1859,9 @@ TcpSetOptionProc ( } return Tcl_BadChannelOption(interp, optionName, "keepalive nagle"); -*/ +#else return Tcl_BadChannelOption(interp, optionName, ""); +#endif /*TCL_FEATURE_KEEPALIVE_NAGLE*/ } /* @@ -2056,15 +1869,14 @@ TcpSetOptionProc ( * * TcpGetOptionProc -- * - * Computes an option value for a TCP socket based channel, or a - * list of all options and their values. + * Computes an option value for a TCP socket based channel, or a list of + * all options and their values. * * Note: This code is based on code contributed by John Haxby. * * Results: - * A standard Tcl result. The value of the specified option or a - * list of all options and their values is returned in the - * supplied DString. + * A standard Tcl result. The value of the specified option or a list of + * all options and their values is returned in the supplied DString. * * Side effects: * None. @@ -2073,15 +1885,14 @@ TcpSetOptionProc ( */ static int -TcpGetOptionProc(instanceData, interp, optionName, dsPtr) - ClientData instanceData; /* Socket state. */ - Tcl_Interp *interp; /* For error reporting - can be NULL */ - CONST char *optionName; /* Name of the option to - * retrieve the value for, or - * NULL to get all options and - * their values. */ - Tcl_DString *dsPtr; /* Where to store the computed - * value; initialized by caller. */ +TcpGetOptionProc( + ClientData instanceData, /* Socket state. */ + Tcl_Interp *interp, /* For error reporting - can be NULL */ + const char *optionName, /* Name of the option to retrieve the value + * for, or NULL to get all options and their + * values. */ + Tcl_DString *dsPtr) /* Where to store the computed value; + * initialized by caller. */ { SocketInfo *infoPtr; SOCKADDR_IN sockname; @@ -2093,23 +1904,22 @@ TcpGetOptionProc(instanceData, interp, optionName, dsPtr) char buf[TCL_INTEGER_SPACE]; /* - * Check that WinSock is initialized; do not call it if not, to - * prevent system crashes. This can happen at exit time if the exit - * handler for WinSock ran before other exit handlers that want to - * use sockets. + * Check that WinSock is initialized; do not call it if not, to prevent + * system crashes. This can happen at exit time if the exit handler for + * WinSock ran before other exit handlers that want to use sockets. */ if (!SocketsEnabled()) { if (interp) { Tcl_AppendResult(interp, "winsock is not initialized", NULL); } - return TCL_ERROR; + return TCL_ERROR; } - + infoPtr = (SocketInfo *) instanceData; sock = (int) infoPtr->socket; - if (optionName != (char *) NULL) { - len = strlen(optionName); + if (optionName != NULL) { + len = strlen(optionName); } if ((len > 1) && (optionName[1] == 'e') && @@ -2117,12 +1927,12 @@ TcpGetOptionProc(instanceData, interp, optionName, dsPtr) int optlen; DWORD err; int ret; - + optlen = sizeof(int); - ret = TclWinGetSockOpt(sock, SOL_SOCKET, SO_ERROR, + ret = TclWinGetSockOpt((int)sock, SOL_SOCKET, SO_ERROR, (char *)&err, &optlen); if (ret == SOCKET_ERROR) { - err = winSock.WSAGetLastError(); + err = WSAGetLastError(); } if (err) { TclWinConvertWSAError(err); @@ -2131,140 +1941,136 @@ TcpGetOptionProc(instanceData, interp, optionName, dsPtr) return TCL_OK; } - if ((len == 0) || - ((len > 1) && (optionName[1] == 'p') && - (strncmp(optionName, "-peername", len) == 0))) { - if (winSock.getpeername(sock, (LPSOCKADDR) &peername, &size) - == 0) { - if (len == 0) { - Tcl_DStringAppendElement(dsPtr, "-peername"); - Tcl_DStringStartSublist(dsPtr); - } - Tcl_DStringAppendElement(dsPtr, - winSock.inet_ntoa(peername.sin_addr)); + if ((len == 0) || ((len > 1) && (optionName[1] == 'p') && + (strncmp(optionName, "-peername", len) == 0))) { + if (getpeername(sock, (LPSOCKADDR) &peername, &size) == 0) { + if (len == 0) { + Tcl_DStringAppendElement(dsPtr, "-peername"); + Tcl_DStringStartSublist(dsPtr); + } + Tcl_DStringAppendElement(dsPtr, inet_ntoa(peername.sin_addr)); if (peername.sin_addr.s_addr == 0) { - hostEntPtr = (struct hostent *) NULL; + hostEntPtr = NULL; + } else { + hostEntPtr = gethostbyaddr((char *) &(peername.sin_addr), + sizeof(peername.sin_addr), AF_INET); + } + if (hostEntPtr != NULL) { + Tcl_DStringAppendElement(dsPtr, hostEntPtr->h_name); } else { - hostEntPtr = winSock.gethostbyaddr( - (char *) &(peername.sin_addr), sizeof(peername.sin_addr), - AF_INET); + Tcl_DStringAppendElement(dsPtr, inet_ntoa(peername.sin_addr)); + } + TclFormatInt(buf, ntohs(peername.sin_port)); + Tcl_DStringAppendElement(dsPtr, buf); + if (len == 0) { + Tcl_DStringEndSublist(dsPtr); + } else { + return TCL_OK; + } + } else { + /* + * getpeername failed - but if we were asked for all the options + * (len==0), don't flag an error at that point because it could be + * an fconfigure request on a server socket (such sockets have no + * peer). {Copied from unix/tclUnixChan.c} + */ + + if (len) { + TclWinConvertWSAError((DWORD) WSAGetLastError()); + if (interp) { + Tcl_AppendResult(interp, "can't get peername: ", + Tcl_PosixError(interp), NULL); + } + return TCL_ERROR; + } + } + } + + if ((len == 0) || ((len > 1) && (optionName[1] == 's') && + (strncmp(optionName, "-sockname", len) == 0))) { + if (getsockname(sock, (LPSOCKADDR) &sockname, &size) == 0) { + if (len == 0) { + Tcl_DStringAppendElement(dsPtr, "-sockname"); + Tcl_DStringStartSublist(dsPtr); } - if (hostEntPtr != (struct hostent *) NULL) { - Tcl_DStringAppendElement(dsPtr, hostEntPtr->h_name); - } else { - Tcl_DStringAppendElement(dsPtr, - winSock.inet_ntoa(peername.sin_addr)); - } - TclFormatInt(buf, winSock.ntohs(peername.sin_port)); - Tcl_DStringAppendElement(dsPtr, buf); - if (len == 0) { - Tcl_DStringEndSublist(dsPtr); - } else { - return TCL_OK; - } - } else { - /* - * getpeername failed - but if we were asked for all the options - * (len==0), don't flag an error at that point because it could - * be an fconfigure request on a server socket. (which have - * no peer). {copied from unix/tclUnixChan.c} - */ - if (len) { - TclWinConvertWSAError((DWORD) winSock.WSAGetLastError()); - if (interp) { - Tcl_AppendResult(interp, "can't get peername: ", - Tcl_PosixError(interp), - (char *) NULL); - } - return TCL_ERROR; - } - } - } - - if ((len == 0) || - ((len > 1) && (optionName[1] == 's') && - (strncmp(optionName, "-sockname", len) == 0))) { - if (winSock.getsockname(sock, (LPSOCKADDR) &sockname, &size) - == 0) { - if (len == 0) { - Tcl_DStringAppendElement(dsPtr, "-sockname"); - Tcl_DStringStartSublist(dsPtr); - } - Tcl_DStringAppendElement(dsPtr, - winSock.inet_ntoa(sockname.sin_addr)); + Tcl_DStringAppendElement(dsPtr, inet_ntoa(sockname.sin_addr)); if (sockname.sin_addr.s_addr == 0) { - hostEntPtr = (struct hostent *) NULL; + hostEntPtr = NULL; } else { - hostEntPtr = winSock.gethostbyaddr( - (char *) &(sockname.sin_addr), sizeof(peername.sin_addr), - AF_INET); + hostEntPtr = gethostbyaddr((char *) &(sockname.sin_addr), + sizeof(peername.sin_addr), AF_INET); } - if (hostEntPtr != (struct hostent *) NULL) { - Tcl_DStringAppendElement(dsPtr, hostEntPtr->h_name); - } else { - Tcl_DStringAppendElement(dsPtr, - winSock.inet_ntoa(sockname.sin_addr)); - } - TclFormatInt(buf, winSock.ntohs(sockname.sin_port)); - Tcl_DStringAppendElement(dsPtr, buf); - if (len == 0) { - Tcl_DStringEndSublist(dsPtr); - } else { - return TCL_OK; - } - } else { + if (hostEntPtr != NULL) { + Tcl_DStringAppendElement(dsPtr, hostEntPtr->h_name); + } else { + Tcl_DStringAppendElement(dsPtr, inet_ntoa(sockname.sin_addr)); + } + TclFormatInt(buf, ntohs(sockname.sin_port)); + Tcl_DStringAppendElement(dsPtr, buf); + if (len == 0) { + Tcl_DStringEndSublist(dsPtr); + } else { + return TCL_OK; + } + } else { if (interp) { - TclWinConvertWSAError((DWORD) winSock.WSAGetLastError()); + TclWinConvertWSAError((DWORD) WSAGetLastError()); Tcl_AppendResult(interp, "can't get sockname: ", - Tcl_PosixError(interp), - (char *) NULL); + Tcl_PosixError(interp), NULL); } return TCL_ERROR; } } -/* +#ifdef TCL_FEATURE_KEEPALIVE_NAGLE if (len == 0 || !strncmp(optionName, "-keepalive", len)) { int optlen; BOOL opt = FALSE; - - if (len == 0) { - Tcl_DStringAppendElement(dsPtr, "-keepalive"); - } + + if (len == 0) { + Tcl_DStringAppendElement(dsPtr, "-keepalive"); + } optlen = sizeof(BOOL); - winSock.getsockopt(sock, SOL_SOCKET, SO_KEEPALIVE, (char *)&opt, - &optlen); + getsockopt(sock, SOL_SOCKET, SO_KEEPALIVE, (char *)&opt, &optlen); if (opt) { Tcl_DStringAppendElement(dsPtr, "1"); } else { Tcl_DStringAppendElement(dsPtr, "0"); } - if (len > 0) return TCL_OK; + if (len > 0) { + return TCL_OK; + } } if (len == 0 || !strncmp(optionName, "-nagle", len)) { int optlen; BOOL opt = FALSE; - - if (len == 0) { - Tcl_DStringAppendElement(dsPtr, "-nagle"); - } + + if (len == 0) { + Tcl_DStringAppendElement(dsPtr, "-nagle"); + } optlen = sizeof(BOOL); - winSock.getsockopt(sock, IPPROTO_TCP, TCP_NODELAY, (char *)&opt, + getsockopt(sock, IPPROTO_TCP, TCP_NODELAY, (char *)&opt, &optlen); if (opt) { Tcl_DStringAppendElement(dsPtr, "0"); } else { Tcl_DStringAppendElement(dsPtr, "1"); } - if (len > 0) return TCL_OK; + if (len > 0) { + return TCL_OK; + } } -*/ +#endif /*TCL_FEATURE_KEEPALIVE_NAGLE*/ if (len > 0) { - /*return Tcl_BadChannelOption(interp, optionName, "peername sockname keepalive nagle");*/ - return Tcl_BadChannelOption(interp, optionName, "peername sockname"); +#ifdef TCL_FEATURE_KEEPALIVE_NAGLE + return Tcl_BadChannelOption(interp, optionName, + "peername sockname keepalive nagle"); +#else + return Tcl_BadChannelOption(interp, optionName, "peername sockname"); +#endif /*TCL_FEATURE_KEEPALIVE_NAGLE*/ } return TCL_OK; @@ -2275,45 +2081,45 @@ TcpGetOptionProc(instanceData, interp, optionName, dsPtr) * * TcpWatchProc -- * - * Informs the channel driver of the events that the generic - * channel code wishes to receive on this socket. + * Informs the channel driver of the events that the generic channel code + * wishes to receive on this socket. * * Results: * None. * * Side effects: - * May cause the notifier to poll if any of the specified - * conditions are already true. + * May cause the notifier to poll if any of the specified conditions are + * already true. * *---------------------------------------------------------------------- */ static void -TcpWatchProc(instanceData, mask) - ClientData instanceData; /* The socket state. */ - int mask; /* Events of interest; an OR-ed - * combination of TCL_READABLE, - * TCL_WRITABLE and TCL_EXCEPTION. */ +TcpWatchProc( + ClientData instanceData, /* The socket state. */ + int mask) /* Events of interest; an OR-ed combination of + * TCL_READABLE, TCL_WRITABLE and + * TCL_EXCEPTION. */ { SocketInfo *infoPtr = (SocketInfo *) instanceData; - + /* - * Update the watch events mask. Only if the socket is not a - * server socket. Fix for SF Tcl Bug #557878. + * Update the watch events mask. Only if the socket is not a server + * socket. Fix for SF Tcl Bug #557878. */ - if (!infoPtr->acceptProc) { - infoPtr->watchEvents = 0; + if (!infoPtr->acceptProc) { + infoPtr->watchEvents = 0; if (mask & TCL_READABLE) { infoPtr->watchEvents |= (FD_READ|FD_CLOSE|FD_ACCEPT); } if (mask & TCL_WRITABLE) { infoPtr->watchEvents |= (FD_WRITE|FD_CLOSE|FD_CONNECT); } - + /* - * If there are any conditions already set, then tell the notifier to poll - * rather than block. + * If there are any conditions already set, then tell the notifier to + * poll rather than block. */ if (infoPtr->readyEvents & infoPtr->watchEvents) { @@ -2341,10 +2147,10 @@ TcpWatchProc(instanceData, mask) */ static int -TcpGetHandleProc(instanceData, direction, handlePtr) - ClientData instanceData; /* The socket state. */ - int direction; /* Not used. */ - ClientData *handlePtr; /* Where to store the handle. */ +TcpGetHandleProc( + ClientData instanceData, /* The socket state. */ + int direction, /* Not used. */ + ClientData *handlePtr) /* Where to store the handle. */ { SocketInfo *statePtr = (SocketInfo *) instanceData; @@ -2369,7 +2175,8 @@ TcpGetHandleProc(instanceData, direction, handlePtr) */ static DWORD WINAPI -SocketThread(LPVOID arg) +SocketThread( + LPVOID arg) { MSG msg; ThreadSpecificData *tsdPtr = (ThreadSpecificData *)(arg); @@ -2378,7 +2185,7 @@ SocketThread(LPVOID arg) * Create a dummy window receiving socket events. */ - tsdPtr->hwnd = CreateWindow("TclSocket", "TclSocket", + tsdPtr->hwnd = CreateWindow("TclSocket", "TclSocket", WS_TILED, 0, 0, 0, 0, NULL, NULL, windowClass.hInstance, arg); /* @@ -2396,9 +2203,9 @@ SocketThread(LPVOID arg) } /* - * Process all messages on the socket window until WM_QUIT. - * This threads exits only when instructed to do so by the - * call to PostMessage(SOCKET_TERMINATE) in TclpFinalizeSockets(). + * Process all messages on the socket window until WM_QUIT. This threads + * exits only when instructed to do so by the call to + * PostMessage(SOCKET_TERMINATE) in TclpFinalizeSockets(). */ while (GetMessage(&msg, NULL, 0, 0) > 0) { @@ -2411,7 +2218,7 @@ SocketThread(LPVOID arg) SetEvent(tsdPtr->readyEvent); - return (DWORD)msg.wParam; + return msg.wParam; } @@ -2420,152 +2227,147 @@ SocketThread(LPVOID arg) * * SocketProc -- * - * This function is called when WSAAsyncSelect has been used - * to register interest in a socket event, and the event has - * occurred. + * This function is called when WSAAsyncSelect has been used to register + * interest in a socket event, and the event has occurred. * * Results: * 0 on success. * * Side effects: - * The flags for the given socket are updated to reflect the - * event that occured. + * The flags for the given socket are updated to reflect the event that + * occured. * *---------------------------------------------------------------------- */ static LRESULT CALLBACK -SocketProc(hwnd, message, wParam, lParam) - HWND hwnd; - UINT message; - WPARAM wParam; - LPARAM lParam; +SocketProc( + HWND hwnd, + UINT message, + WPARAM wParam, + LPARAM lParam) { int event, error; SOCKET socket; SocketInfo *infoPtr; - ThreadSpecificData *tsdPtr = + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) #ifdef _WIN64 - (ThreadSpecificData *) GetWindowLongPtr(hwnd, GWLP_USERDATA); + GetWindowLongPtr(hwnd, GWLP_USERDATA); #else - (ThreadSpecificData *) GetWindowLong(hwnd, GWL_USERDATA); + GetWindowLong(hwnd, GWL_USERDATA); #endif switch (message) { + default: + return DefWindowProc(hwnd, message, wParam, lParam); + break; - default: - return DefWindowProc(hwnd, message, wParam, lParam); - break; - - case WM_CREATE: - /* - * store the initial tsdPtr, it's from a different thread, so it's - * not directly accessible, but needed. - */ + case WM_CREATE: + /* + * Store the initial tsdPtr, it's from a different thread, so it's not + * directly accessible, but needed. + */ #ifdef _WIN64 - SetWindowLongPtr(hwnd, GWLP_USERDATA, - (LONG_PTR) ((LPCREATESTRUCT)lParam)->lpCreateParams); + SetWindowLongPtr(hwnd, GWLP_USERDATA, + (LONG_PTR) ((LPCREATESTRUCT)lParam)->lpCreateParams); #else - SetWindowLong(hwnd, GWL_USERDATA, - (LONG) ((LPCREATESTRUCT)lParam)->lpCreateParams); + SetWindowLong(hwnd, GWL_USERDATA, + (LONG) ((LPCREATESTRUCT)lParam)->lpCreateParams); #endif - break; + break; - case WM_DESTROY: - PostQuitMessage(0); - break; + case WM_DESTROY: + PostQuitMessage(0); + break; - case SOCKET_MESSAGE: - event = WSAGETSELECTEVENT(lParam); - error = WSAGETSELECTERROR(lParam); - socket = (SOCKET) wParam; + case SOCKET_MESSAGE: + event = WSAGETSELECTEVENT(lParam); + error = WSAGETSELECTERROR(lParam); + socket = (SOCKET) wParam; - /* - * Find the specified socket on the socket list and update its - * eventState flag. - */ + /* + * Find the specified socket on the socket list and update its + * eventState flag. + */ - WaitForSingleObject(tsdPtr->socketListLock, INFINITE); - for (infoPtr = tsdPtr->socketList; infoPtr != NULL; - infoPtr = infoPtr->nextPtr) { - if (infoPtr->socket == socket) { + WaitForSingleObject(tsdPtr->socketListLock, INFINITE); + for (infoPtr = tsdPtr->socketList; infoPtr != NULL; + infoPtr = infoPtr->nextPtr) { + if (infoPtr->socket == socket) { + /* + * Update the socket state. + * + * A count of FD_ACCEPTS is stored, so if an FD_CLOSE event + * happens, then clear the FD_ACCEPT count. Otherwise, + * increment the count if the current event is an FD_ACCEPT. + */ + + if (event & FD_CLOSE) { + infoPtr->acceptEventCount = 0; + infoPtr->readyEvents &= ~(FD_WRITE|FD_ACCEPT); + } else if (event & FD_ACCEPT) { + infoPtr->acceptEventCount++; + } + + if (event & FD_CONNECT) { /* - * Update the socket state. + * The socket is now connected, clear the async connect + * flag. */ + infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT); + /* - * A count of FD_ACCEPTS is stored, so if an FD_CLOSE - * event happens, then clear the FD_ACCEPT count. - * Otherwise, increment the count if the current - * event is an FD_ACCEPT. + * Remember any error that occurred so we can report + * connection failures. */ - if (event & FD_CLOSE) { - infoPtr->acceptEventCount = 0; - infoPtr->readyEvents &= ~(FD_WRITE|FD_ACCEPT); - } else if (event & FD_ACCEPT) { - infoPtr->acceptEventCount++; + if (error != ERROR_SUCCESS) { + TclWinConvertWSAError((DWORD) error); + infoPtr->lastError = Tcl_GetErrno(); } + } - if (event & FD_CONNECT) { - /* - * The socket is now connected, - * clear the async connect flag. - */ - - infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT); - - /* - * Remember any error that occurred so we can report - * connection failures. - */ - - if (error != ERROR_SUCCESS) { - TclWinConvertWSAError((DWORD) error); - infoPtr->lastError = Tcl_GetErrno(); - } - - } - if(infoPtr->flags & SOCKET_ASYNC_CONNECT) { - infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT); - if (error != ERROR_SUCCESS) { - TclWinConvertWSAError((DWORD) error); - infoPtr->lastError = Tcl_GetErrno(); - } - infoPtr->readyEvents |= FD_WRITE; + if (infoPtr->flags & SOCKET_ASYNC_CONNECT) { + infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT); + if (error != ERROR_SUCCESS) { + TclWinConvertWSAError((DWORD) error); + infoPtr->lastError = Tcl_GetErrno(); } - infoPtr->readyEvents |= event; - - /* - * Wake up the Main Thread. - */ - SetEvent(tsdPtr->readyEvent); - Tcl_ThreadAlert(tsdPtr->threadId); - break; + infoPtr->readyEvents |= FD_WRITE; } - } - SetEvent(tsdPtr->socketListLock); - break; - - case SOCKET_SELECT: - infoPtr = (SocketInfo *) lParam; - if (wParam == SELECT) { + infoPtr->readyEvents |= event; - winSock.WSAAsyncSelect(infoPtr->socket, hwnd, - SOCKET_MESSAGE, infoPtr->selectEvents); - } else { /* - * Clear the selection mask + * Wake up the Main Thread. */ - winSock.WSAAsyncSelect(infoPtr->socket, hwnd, 0, 0); + SetEvent(tsdPtr->readyEvent); + Tcl_ThreadAlert(tsdPtr->threadId); + break; } - break; + } + SetEvent(tsdPtr->socketListLock); + break; - case SOCKET_TERMINATE: - DestroyWindow(hwnd); - break; + case SOCKET_SELECT: + infoPtr = (SocketInfo *) lParam; + if (wParam == SELECT) { + WSAAsyncSelect(infoPtr->socket, hwnd, + SOCKET_MESSAGE, infoPtr->selectEvents); + } else { + /* + * Clear the selection mask + */ + + WSAAsyncSelect(infoPtr->socket, hwnd, 0, 0); + } + break; + + case SOCKET_TERMINATE: + DestroyWindow(hwnd); + break; } return 0; @@ -2579,49 +2381,82 @@ SocketProc(hwnd, message, wParam, lParam) * Returns the name of the local host. * * Results: - * A string containing the network name for this machine, or - * an empty string if we can't figure out the name. The caller - * must not modify or free this string. + * A string containing the network name for this machine. The caller must + * not modify or free this string. * * Side effects: + * Caches the name to return for future calls. + * + *---------------------------------------------------------------------- + */ + +const char * +Tcl_GetHostName(void) +{ + return Tcl_GetString(TclGetProcessGlobalValue(&hostName)); +} + +/* + *---------------------------------------------------------------------- + * + * InitializeHostName -- + * + * This routine sets the process global value of the name of the local + * host on which the process is running. + * + * Results: * None. * *---------------------------------------------------------------------- */ -CONST char * -Tcl_GetHostName() +void +InitializeHostName( + char **valuePtr, + int *lengthPtr, + Tcl_Encoding *encodingPtr) { - DWORD length; WCHAR wbuf[MAX_COMPUTERNAME_LENGTH + 1]; + DWORD length = sizeof(wbuf) / sizeof(WCHAR); + Tcl_DString ds; - Tcl_MutexLock(&socketMutex); - InitSockets(); - - if (!hostnameInitialized) { + if ((*tclWinProcs->getComputerNameProc)(wbuf, &length) != 0) { /* - * Convert hostname from native to UTF then change to lowercase. + * Convert string from native to UTF then change to lowercase. */ - Tcl_DString ds; - - length = sizeof(hostname); - /* same as SocketsEnabled without the socketMutex lock */ - if ((winSock.hModule != NULL) - && (winSock.gethostname(hostname, length) == 0)) { - Tcl_ExternalToUtfDString(NULL, hostname, -1, &ds); - } else if ((*tclWinProcs->getComputerNameProc)(wbuf, &length) != 0) { - Tcl_WinTCharToUtf((TCHAR *) wbuf, -1, &ds); - } else { - Tcl_DStringInit(&ds); - Tcl_DStringSetLength(&ds, 0); + + Tcl_UtfToLower(Tcl_WinTCharToUtf((TCHAR *) wbuf, -1, &ds)); + + } else { + Tcl_DStringInit(&ds); + if (TclpHasSockets(NULL) == TCL_OK) { + /* + * Buffer length of 255 copied slavishly from previous version of + * this routine. Presumably there's a more "correct" macro value + * for a properly sized buffer for a gethostname() call. + * Maintainers are welcome to supply it. + */ + + Tcl_DString inDs; + + Tcl_DStringInit(&inDs); + Tcl_DStringSetLength(&inDs, 255); + if (gethostname(Tcl_DStringValue(&inDs), + Tcl_DStringLength(&inDs)) == 0) { + Tcl_DStringSetLength(&ds, 0); + } else { + Tcl_ExternalToUtfDString(NULL, + Tcl_DStringValue(&inDs), -1, &ds); + } + Tcl_DStringFree(&inDs); } - lstrcpynA(hostname, Tcl_DStringValue(&ds), sizeof(hostname)); - Tcl_DStringFree(&ds); - Tcl_UtfToLower(hostname); - hostnameInitialized = 1; } - Tcl_MutexUnlock(&socketMutex); - return hostname; + + *encodingPtr = Tcl_GetEncoding(NULL, "utf-8"); + *lengthPtr = Tcl_DStringLength(&ds); + *valuePtr = ckalloc((unsigned int) (*lengthPtr)+1); + memcpy(*valuePtr, Tcl_DStringValue(&ds), (size_t)(*lengthPtr)+1); + Tcl_DStringFree(&ds); } /* @@ -2629,10 +2464,10 @@ Tcl_GetHostName() * * TclWinGetSockOpt, et al. -- * - * These functions are wrappers that let us bind the WinSock - * API dynamically so we can run on systems that don't have - * the wsock32.dll. We need wrappers for these interfaces - * because they are called from the generic Tcl code. + * These functions are wrappers that let us bind the WinSock API + * dynamically so we can run on systems that don't have the wsock32.dll. + * We need wrappers for these interfaces because they are called from the + * generic Tcl code. * * Results: * As defined for each function. @@ -2644,71 +2479,80 @@ Tcl_GetHostName() */ int -TclWinGetSockOpt(SOCKET s, int level, int optname, char * optval, - int FAR *optlen) +TclWinGetSockOpt( + int s, + int level, + int optname, + char * optval, + int FAR *optlen) { /* - * Check that WinSock is initialized; do not call it if not, to - * prevent system crashes. This can happen at exit time if the exit - * handler for WinSock ran before other exit handlers that want to - * use sockets. + * Check that WinSock is initialized; do not call it if not, to prevent + * system crashes. This can happen at exit time if the exit handler for + * WinSock ran before other exit handlers that want to use sockets. */ if (!SocketsEnabled()) { - return SOCKET_ERROR; + return SOCKET_ERROR; } - - return winSock.getsockopt(s, level, optname, optval, optlen); + + return getsockopt((SOCKET)s, level, optname, optval, optlen); } int -TclWinSetSockOpt(SOCKET s, int level, int optname, const char * optval, - int optlen) +TclWinSetSockOpt( + int s, + int level, + int optname, + const char * optval, + int optlen) { /* - * Check that WinSock is initialized; do not call it if not, to - * prevent system crashes. This can happen at exit time if the exit - * handler for WinSock ran before other exit handlers that want to - * use sockets. + * Check that WinSock is initialized; do not call it if not, to prevent + * system crashes. This can happen at exit time if the exit handler for + * WinSock ran before other exit handlers that want to use sockets. */ + if (!SocketsEnabled()) { - return SOCKET_ERROR; + return SOCKET_ERROR; } - return winSock.setsockopt(s, level, optname, optval, optlen); + return setsockopt((SOCKET)s, level, optname, optval, optlen); } u_short -TclWinNToHS(u_short netshort) +TclWinNToHS( + u_short netshort) { /* - * Check that WinSock is initialized; do not call it if not, to - * prevent system crashes. This can happen at exit time if the exit - * handler for WinSock ran before other exit handlers that want to - * use sockets. + * Check that WinSock is initialized; do not call it if not, to prevent + * system crashes. This can happen at exit time if the exit handler for + * WinSock ran before other exit handlers that want to use sockets. */ if (!SocketsEnabled()) { - return (u_short) -1; + return (u_short) -1; } - return winSock.ntohs(netshort); + return ntohs(netshort); } struct servent * -TclWinGetServByName(const char * name, const char * proto) +TclWinGetServByName( + const char *name, + const char *proto) { /* - * Check that WinSock is initialized; do not call it if not, to - * prevent system crashes. This can happen at exit time if the exit - * handler for WinSock ran before other exit handlers that want to - * use sockets. + * Check that WinSock is initialized; do not call it if not, to prevent + * system crashes. This can happen at exit time if the exit handler for + * WinSock ran before other exit handlers that want to use sockets. */ + if (!SocketsEnabled()) { - return (struct servent *) NULL; + return NULL; } - return winSock.getservbyname(name, proto); + return getservbyname(name, proto); } /* @@ -2728,21 +2572,21 @@ TclWinGetServByName(const char * name, const char * proto) */ static void -TcpThreadActionProc (instanceData, action) - ClientData instanceData; - int action; +TcpThreadActionProc( + ClientData instanceData, + int action) { ThreadSpecificData *tsdPtr; SocketInfo *infoPtr = (SocketInfo *) instanceData; - int notifyCmd; + int notifyCmd; if (action == TCL_CHANNEL_THREAD_INSERT) { - /* - * Ensure that socket subsystem is initialized in this thread, or - * else sockets will not work. + /* + * Ensure that socket subsystem is initialized in this thread, or else + * sockets will not work. */ - Tcl_MutexLock(&socketMutex); + Tcl_MutexLock(&socketMutex); InitSockets(); Tcl_MutexUnlock(&socketMutex); @@ -2758,14 +2602,18 @@ TcpThreadActionProc (instanceData, action) SocketInfo **nextPtrPtr; int removed = 0; - tsdPtr = TCL_TSD_INIT(&dataKey); + tsdPtr = TCL_TSD_INIT(&dataKey); + + /* + * TIP #218, Bugfix: All access to socketList has to be protected by + * the lock. + */ - /* TIP #218, Bugfix: All access to socketList has to be protected by the lock */ WaitForSingleObject(tsdPtr->socketListLock, INFINITE); for (nextPtrPtr = &(tsdPtr->socketList); (*nextPtrPtr) != NULL; - nextPtrPtr = &((*nextPtrPtr)->nextPtr)) { + nextPtrPtr = &((*nextPtrPtr)->nextPtr)) { if ((*nextPtrPtr) == infoPtr) { - (*nextPtrPtr) = infoPtr->nextPtr; + (*nextPtrPtr) = infoPtr->nextPtr; removed = 1; break; } @@ -2773,9 +2621,9 @@ TcpThreadActionProc (instanceData, action) SetEvent(tsdPtr->socketListLock); /* - * This could happen if the channel was created in one thread - * and then moved to another without updating the thread - * local data in each thread. + * This could happen if the channel was created in one thread and then + * moved to another without updating the thread local data in each + * thread. */ if (!removed) { @@ -2786,9 +2634,18 @@ TcpThreadActionProc (instanceData, action) } /* - * Ensure that, or stop, notifications for the socket occur in this thread. + * Ensure that, or stop, notifications for the socket occur in this + * thread. */ SendMessage(tsdPtr->hwnd, SOCKET_SELECT, - (WPARAM) notifyCmd, (LPARAM) infoPtr); + (WPARAM) notifyCmd, (LPARAM) infoPtr); } + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ diff --git a/win/tclWinTest.c b/win/tclWinTest.c index 0ddd76b..d0bbb09 100644 --- a/win/tclWinTest.c +++ b/win/tclWinTest.c @@ -1,16 +1,15 @@ -/* +/* * tclWinTest.c -- * * Contains commands for platform specific tests on Windows. * * Copyright (c) 1996 Sun Microsystems, Inc. * - * See the file "license.terms" for information on usage and redistribution - * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ -#define USE_COMPAT_CONST -#include "tclWinInt.h" +#include "tclInt.h" /* * For TestplatformChmod on Windows @@ -27,40 +26,33 @@ #endif /* - * Forward declarations of procedures defined later in this file: + * Forward declarations of functions defined later in this file: */ -int TclplatformtestInit _ANSI_ARGS_((Tcl_Interp *interp)); -static int TesteventloopCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, CONST84 char **argv)); -static int TestvolumetypeCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[])); -static int TestwinclockCmd _ANSI_ARGS_(( ClientData dummy, - Tcl_Interp* interp, - int objc, - Tcl_Obj *CONST objv[] )); -static int TestwinsleepCmd _ANSI_ARGS_(( ClientData dummy, - Tcl_Interp* interp, - int objc, - Tcl_Obj *CONST objv[] )); -static Tcl_ObjCmdProc TestExceptionCmd; -static int TestwincpuidCmd _ANSI_ARGS_(( ClientData dummy, - Tcl_Interp* interp, - int objc, - Tcl_Obj *CONST objv[] )); -static int TestplatformChmod _ANSI_ARGS_((CONST char *nativePath, - int pmode)); -static int TestchmodCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, CONST84 char **argv)); +int TclplatformtestInit(Tcl_Interp *interp); +static int TesteventloopCmd(ClientData dummy, Tcl_Interp *interp, + int argc, const char **argv); +static int TestvolumetypeCmd(ClientData dummy, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +static int TestwinclockCmd(ClientData dummy, Tcl_Interp* interp, + int objc, Tcl_Obj *const objv[]); +static int TestwinsleepCmd(ClientData dummy, Tcl_Interp* interp, + int objc, Tcl_Obj *const objv[]); +static Tcl_ObjCmdProc TestExceptionCmd; +static int TestwincpuidCmd(ClientData dummy, Tcl_Interp* interp, + int objc, Tcl_Obj *const objv[]); +static int TestplatformChmod(const char *nativePath, int pmode); +static int TestchmodCmd(ClientData dummy, + Tcl_Interp *interp, int argc, const char **argv); /* *---------------------------------------------------------------------- * * TclplatformtestInit -- * - * Defines commands that test platform specific functionality for - * Windows platforms. + * Defines commands that test platform specific functionality for Windows + * platforms. * * Results: * A standard Tcl result. @@ -72,27 +64,21 @@ static int TestchmodCmd _ANSI_ARGS_((ClientData dummy, */ int -TclplatformtestInit(interp) - Tcl_Interp *interp; /* Interpreter to add commands to. */ +TclplatformtestInit( + Tcl_Interp *interp) /* Interpreter to add commands to. */ { /* * Add commands for platform specific tests for Windows here. */ - Tcl_CreateCommand(interp, "testchmod", TestchmodCmd, - (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); - Tcl_CreateCommand(interp, "testeventloop", TesteventloopCmd, - (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); + Tcl_CreateCommand(interp, "testchmod", TestchmodCmd, NULL, NULL); + Tcl_CreateCommand(interp, "testeventloop", TesteventloopCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testvolumetype", TestvolumetypeCmd, - (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); - Tcl_CreateObjCommand(interp, "testwinclock", TestwinclockCmd, - (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); - Tcl_CreateObjCommand(interp, "testwincpuid", TestwincpuidCmd, - (ClientData) 0, (Tcl_CmdDeleteProc*) NULL ); - Tcl_CreateObjCommand(interp, "testwinsleep", TestwinsleepCmd, - (ClientData) 0, (Tcl_CmdDeleteProc *) NULL ); - Tcl_CreateObjCommand(interp, "testexcept", TestExceptionCmd, - (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); + NULL, NULL); + Tcl_CreateObjCommand(interp, "testwinclock", TestwinclockCmd, NULL, NULL); + Tcl_CreateObjCommand(interp, "testwincpuid", TestwincpuidCmd, NULL, NULL); + Tcl_CreateObjCommand(interp, "testwinsleep", TestwinsleepCmd, NULL, NULL); + Tcl_CreateObjCommand(interp, "testexcept", TestExceptionCmd, NULL, NULL); return TCL_OK; } @@ -101,9 +87,9 @@ TclplatformtestInit(interp) * * TesteventloopCmd -- * - * This procedure implements the "testeventloop" command. It is - * used to test the Tcl notifier from an "external" event loop - * (i.e. not Tcl_DoOneEvent()). + * This function implements the "testeventloop" command. It is used to + * test the Tcl notifier from an "external" event loop (i.e. not + * Tcl_DoOneEvent()). * * Results: * A standard Tcl result. @@ -115,27 +101,25 @@ TclplatformtestInit(interp) */ static int -TesteventloopCmd(clientData, interp, argc, argv) - ClientData clientData; /* Not used. */ - Tcl_Interp *interp; /* Current interpreter. */ - int argc; /* Number of arguments. */ - CONST84 char **argv; /* Argument strings. */ +TesteventloopCmd( + ClientData clientData, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int argc, /* Number of arguments. */ + const char **argv) /* Argument strings. */ { - static int *framePtr = NULL; /* Pointer to integer on stack frame of - * innermost invocation of the "wait" - * subcommand. */ + static int *framePtr = NULL;/* Pointer to integer on stack frame of + * innermost invocation of the "wait" + * subcommand. */ - if (argc < 2) { + if (argc < 2) { Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0], - " option ... \"", (char *) NULL); - return TCL_ERROR; + " option ... \"", NULL); + return TCL_ERROR; } if (strcmp(argv[1], "done") == 0) { *framePtr = 1; } else if (strcmp(argv[1], "wait") == 0) { - int *oldFramePtr; - int done; - MSG msg; + int *oldFramePtr, done; int oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL); /* @@ -146,19 +130,21 @@ TesteventloopCmd(clientData, interp, argc, argv) framePtr = &done; /* - * Enter a standard Windows event loop until the flag changes. - * Note that we do not explicitly call Tcl_ServiceEvent(). + * Enter a standard Windows event loop until the flag changes. Note + * that we do not explicitly call Tcl_ServiceEvent(). */ done = 0; while (!done) { + MSG msg; + if (!GetMessage(&msg, NULL, 0, 0)) { /* - * The application is exiting, so repost the quit message - * and start unwinding. + * The application is exiting, so repost the quit message and + * start unwinding. */ - PostQuitMessage((int)msg.wParam); + PostQuitMessage((int) msg.wParam); break; } TranslateMessage(&msg); @@ -168,7 +154,7 @@ TesteventloopCmd(clientData, interp, argc, argv) framePtr = oldFramePtr; } else { Tcl_AppendResult(interp, "bad option \"", argv[1], - "\": must be done or wait", (char *) NULL); + "\": must be done or wait", NULL); return TCL_ERROR; } return TCL_OK; @@ -179,8 +165,8 @@ TesteventloopCmd(clientData, interp, argc, argv) * * Testvolumetype -- * - * This procedure implements the "testvolumetype" command. It is - * used to check the volume type (FAT, NTFS) of a volume. + * This function implements the "testvolumetype" command. It is used to + * check the volume type (FAT, NTFS) of a volume. * * Results: * A standard Tcl result. @@ -192,11 +178,11 @@ TesteventloopCmd(clientData, interp, argc, argv) */ static int -TestvolumetypeCmd(clientData, interp, objc, objv) - ClientData clientData; /* Not used. */ - Tcl_Interp *interp; /* Current interpreter. */ - int objc; /* Number of arguments. */ - Tcl_Obj *CONST objv[]; /* Argument objects. */ +TestvolumetypeCmd( + ClientData clientData, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { #define VOL_BUF_SIZE 32 int found; @@ -205,23 +191,24 @@ TestvolumetypeCmd(clientData, interp, objc, objv) if (objc > 2) { Tcl_WrongNumArgs(interp, 1, objv, "?name?"); - return TCL_ERROR; + return TCL_ERROR; } if (objc == 2) { /* - * path has to be really a proper volume, but we don't - * get query APIs for that until NT5 + * path has to be really a proper volume, but we don't get query APIs + * for that until NT5 */ + path = Tcl_GetString(objv[1]); } else { path = NULL; } - found = GetVolumeInformationA(path, NULL, 0, NULL, NULL, - NULL, volType, VOL_BUF_SIZE); + found = GetVolumeInformationA(path, NULL, 0, NULL, NULL, NULL, volType, + VOL_BUF_SIZE); if (found == 0) { Tcl_AppendResult(interp, "could not get volume type for \"", - (path?path:""), "\"", (char *) NULL); + (path?path:""), "\"", NULL); TclWinConvertError(GetLastError()); return TCL_ERROR; } @@ -235,9 +222,9 @@ TestvolumetypeCmd(clientData, interp, objc, objv) * * TestwinclockCmd -- * - * Command that returns the seconds and microseconds portions of - * the system clock and of the Tcl clock so that they can be - * compared to validate that the Tcl clock is staying in sync. + * Command that returns the seconds and microseconds portions of the + * system clock and of the Tcl clock so that they can be compared to + * validate that the Tcl clock is staying in sync. * * Usage: * testclock @@ -246,9 +233,9 @@ TestvolumetypeCmd(clientData, interp, objc, objv) * None. * * Results: - * Returns a standard Tcl result comprising a four-element list: - * the seconds and microseconds portions of the system clock, - * and the seconds and microseconds portions of the Tcl clock. + * Returns a standard Tcl result comprising a four-element list: the + * seconds and microseconds portions of the system clock, and the seconds + * and microseconds portions of the Tcl clock. * * Side effects: * None. @@ -257,54 +244,50 @@ TestvolumetypeCmd(clientData, interp, objc, objv) */ static int -TestwinclockCmd( ClientData dummy, - /* Unused */ - Tcl_Interp* interp, - /* Tcl interpreter */ - int objc, - /* Argument count */ - Tcl_Obj *CONST objv[] ) - /* Argument vector */ +TestwinclockCmd( + ClientData dummy, /* Unused */ + Tcl_Interp* interp, /* Tcl interpreter */ + int objc, /* Argument count */ + Tcl_Obj *const objv[]) /* Argument vector */ { - static CONST FILETIME posixEpoch = { 0xD53E8000, 0x019DB1DE }; - /* The Posix epoch, expressed as a - * Windows FILETIME */ + static const FILETIME posixEpoch = { 0xD53E8000, 0x019DB1DE }; + /* The Posix epoch, expressed as a Windows + * FILETIME */ Tcl_Time tclTime; /* Tcl clock */ FILETIME sysTime; /* System clock */ - Tcl_Obj* result; /* Result of the command */ + Tcl_Obj *result; /* Result of the command */ LARGE_INTEGER t1, t2; LARGE_INTEGER p1, p2; - if ( objc != 1 ) { - Tcl_WrongNumArgs( interp, 1, objv, "" ); + if (objc != 1) { + Tcl_WrongNumArgs(interp, 1, objv, ""); return TCL_ERROR; } - QueryPerformanceCounter( &p1 ); + QueryPerformanceCounter(&p1); - Tcl_GetTime( &tclTime ); - GetSystemTimeAsFileTime( &sysTime ); + Tcl_GetTime(&tclTime); + GetSystemTimeAsFileTime(&sysTime); t1.LowPart = posixEpoch.dwLowDateTime; t1.HighPart = posixEpoch.dwHighDateTime; t2.LowPart = sysTime.dwLowDateTime; t2.HighPart = sysTime.dwHighDateTime; t2.QuadPart -= t1.QuadPart; - QueryPerformanceCounter( &p2 ); + QueryPerformanceCounter(&p2); result = Tcl_NewObj(); - Tcl_ListObjAppendElement - ( interp, result, Tcl_NewIntObj( (int) (t2.QuadPart / 10000000 ) ) ); - Tcl_ListObjAppendElement - ( interp, result, - Tcl_NewIntObj( (int) ( (t2.QuadPart / 10 ) % 1000000 ) ) ); - Tcl_ListObjAppendElement( interp, result, Tcl_NewIntObj( tclTime.sec ) ); - Tcl_ListObjAppendElement( interp, result, Tcl_NewIntObj( tclTime.usec ) ); + Tcl_ListObjAppendElement(interp, result, + Tcl_NewIntObj((int) (t2.QuadPart / 10000000))); + Tcl_ListObjAppendElement(interp, result, + Tcl_NewIntObj((int) ((t2.QuadPart / 10) % 1000000))); + Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj(tclTime.sec)); + Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj(tclTime.usec)); - Tcl_ListObjAppendElement( interp, result, Tcl_NewWideIntObj( p1.QuadPart ) ); - Tcl_ListObjAppendElement( interp, result, Tcl_NewWideIntObj( p2.QuadPart ) ); + Tcl_ListObjAppendElement(interp, result, Tcl_NewWideIntObj(p1.QuadPart)); + Tcl_ListObjAppendElement(interp, result, Tcl_NewWideIntObj(p2.QuadPart)); - Tcl_SetObjResult( interp, result ); + Tcl_SetObjResult(interp, result); return TCL_OK; } @@ -323,8 +306,8 @@ TestwinclockCmd( ClientData dummy, * eax - The value to pass in the EAX register to a CPUID instruction. * * Results: - * Returns a four-element list containing the values from the - * EAX, EBX, ECX and EDX registers returned from the CPUID instruction. + * Returns a four-element list containing the values from the EAX, EBX, + * ECX and EDX registers returned from the CPUID instruction. * * Side effects: * None. @@ -333,36 +316,34 @@ TestwinclockCmd( ClientData dummy, */ static int -TestwincpuidCmd( ClientData dummy, - Tcl_Interp* interp, /* Tcl interpreter */ - int objc, /* Parameter count */ - Tcl_Obj *CONST * objv ) /* Parameter vector */ +TestwincpuidCmd( + ClientData dummy, + Tcl_Interp* interp, /* Tcl interpreter */ + int objc, /* Parameter count */ + Tcl_Obj *const * objv) /* Parameter vector */ { - int status; - int index; + int status, index, i; unsigned int regs[4]; - Tcl_Obj * regsObjs[4]; - int i; + Tcl_Obj *regsObjs[4]; - if ( objc != 2 ) { - Tcl_WrongNumArgs( interp, 1, objv, "eax" ); + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "eax"); return TCL_ERROR; } - if ( Tcl_GetIntFromObj( interp, objv[1], &index ) != TCL_OK ) { + if (Tcl_GetIntFromObj(interp, objv[1], &index) != TCL_OK) { return TCL_ERROR; } - status = TclWinCPUID( (unsigned int) index, regs ); - if ( status != TCL_OK ) { - Tcl_SetObjResult( interp, Tcl_NewStringObj( "operation not available", - -1 ) ); + status = TclWinCPUID((unsigned) index, regs); + if (status != TCL_OK) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("operation not available", -1)); return status; } - for ( i = 0; i < 4; ++i ) { - regsObjs[i] = Tcl_NewIntObj( (int) regs[i] ); + for (i=0 ; i<4 ; ++i) { + regsObjs[i] = Tcl_NewIntObj((int) regs[i]); } - Tcl_SetObjResult( interp, Tcl_NewListObj( 4, regsObjs ) ); + Tcl_SetObjResult(interp, Tcl_NewListObj(4, regsObjs)); return TCL_OK; - } /* @@ -370,8 +351,8 @@ TestwincpuidCmd( ClientData dummy, * * TestwinsleepCmd -- * - * Causes this process to wait for the given number of milliseconds - * by means of a direct call to Sleep. + * Causes this process to wait for the given number of milliseconds by + * means of a direct call to Sleep. * * Usage: * testwinsleep <n> @@ -389,24 +370,22 @@ TestwincpuidCmd( ClientData dummy, */ static int -TestwinsleepCmd( ClientData clientData, - /* Unused */ - Tcl_Interp* interp, - /* Tcl interpreter */ - int objc, - /* Parameter count */ - Tcl_Obj * CONST * objv ) - /* Parameter vector */ +TestwinsleepCmd( + ClientData clientData, /* Unused */ + Tcl_Interp* interp, /* Tcl interpreter */ + int objc, /* Parameter count */ + Tcl_Obj *const * objv) /* Parameter vector */ { int ms; - if ( objc != 2 ) { - Tcl_WrongNumArgs( interp, 1, objv, "ms" ); + + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "ms"); return TCL_ERROR; } - if ( Tcl_GetIntFromObj( interp, objv[1], &ms ) != TCL_OK ) { + if (Tcl_GetIntFromObj(interp, objv[1], &ms) != TCL_OK) { return TCL_ERROR; } - Sleep( (DWORD) ms ); + Sleep((DWORD) ms); return TCL_OK; } @@ -415,8 +394,8 @@ TestwinsleepCmd( ClientData clientData, * * TestExceptionCmd -- * - * Causes this process to end with the named exception. Used for - * testing Tcl_WaitPid(). + * Causes this process to end with the named exception. Used for testing + * Tcl_WaitPid(). * * Usage: * testexcept <type> @@ -438,58 +417,32 @@ TestExceptionCmd( ClientData dummy, /* Unused */ Tcl_Interp* interp, /* Tcl interpreter */ int objc, /* Argument count */ - Tcl_Obj *CONST objv[]) /* Argument vector */ + Tcl_Obj *const objv[]) /* Argument vector */ { - static char *cmds[] = { - "access_violation", - "datatype_misalignment", - "array_bounds", - "float_denormal", - "float_divbyzero", - "float_inexact", - "float_invalidop", - "float_overflow", - "float_stack", - "float_underflow", - "int_divbyzero", - "int_overflow", - "private_instruction", - "inpageerror", - "illegal_instruction", - "noncontinue", - "stack_overflow", - "invalid_disp", - "guard_page", - "invalid_handle", - "ctrl+c", - NULL + static const char *cmds[] = { + "access_violation", "datatype_misalignment", "array_bounds", + "float_denormal", "float_divbyzero", "float_inexact", + "float_invalidop", "float_overflow", "float_stack", "float_underflow", + "int_divbyzero", "int_overflow", "private_instruction", "inpageerror", + "illegal_instruction", "noncontinue", "stack_overflow", + "invalid_disp", "guard_page", "invalid_handle", "ctrl+c", + NULL }; static DWORD exceptions[] = { - EXCEPTION_ACCESS_VIOLATION, - EXCEPTION_DATATYPE_MISALIGNMENT, - EXCEPTION_ARRAY_BOUNDS_EXCEEDED, - EXCEPTION_FLT_DENORMAL_OPERAND, - EXCEPTION_FLT_DIVIDE_BY_ZERO, - EXCEPTION_FLT_INEXACT_RESULT, - EXCEPTION_FLT_INVALID_OPERATION, - EXCEPTION_FLT_OVERFLOW, - EXCEPTION_FLT_STACK_CHECK, - EXCEPTION_FLT_UNDERFLOW, - EXCEPTION_INT_DIVIDE_BY_ZERO, - EXCEPTION_INT_OVERFLOW, - EXCEPTION_PRIV_INSTRUCTION, - EXCEPTION_IN_PAGE_ERROR, - EXCEPTION_ILLEGAL_INSTRUCTION, - EXCEPTION_NONCONTINUABLE_EXCEPTION, - EXCEPTION_STACK_OVERFLOW, - EXCEPTION_INVALID_DISPOSITION, - EXCEPTION_GUARD_PAGE, - EXCEPTION_INVALID_HANDLE, - CONTROL_C_EXIT + EXCEPTION_ACCESS_VIOLATION, EXCEPTION_DATATYPE_MISALIGNMENT, + EXCEPTION_ARRAY_BOUNDS_EXCEEDED, EXCEPTION_FLT_DENORMAL_OPERAND, + EXCEPTION_FLT_DIVIDE_BY_ZERO, EXCEPTION_FLT_INEXACT_RESULT, + EXCEPTION_FLT_INVALID_OPERATION, EXCEPTION_FLT_OVERFLOW, + EXCEPTION_FLT_STACK_CHECK, EXCEPTION_FLT_UNDERFLOW, + EXCEPTION_INT_DIVIDE_BY_ZERO, EXCEPTION_INT_OVERFLOW, + EXCEPTION_PRIV_INSTRUCTION, EXCEPTION_IN_PAGE_ERROR, + EXCEPTION_ILLEGAL_INSTRUCTION, EXCEPTION_NONCONTINUABLE_EXCEPTION, + EXCEPTION_STACK_OVERFLOW, EXCEPTION_INVALID_DISPOSITION, + EXCEPTION_GUARD_PAGE, EXCEPTION_INVALID_HANDLE, CONTROL_C_EXIT }; int cmd; - if ( objc != 2 ) { + if (objc != 2) { Tcl_WrongNumArgs(interp, 0, objv, "<type-of-exception>"); return TCL_ERROR; } @@ -518,68 +471,46 @@ TestExceptionCmd( return TCL_OK; } -static int -TestplatformChmod(CONST char *nativePath, int pmode) +static int +TestplatformChmod( + const char *nativePath, + int pmode) { - SID_IDENTIFIER_AUTHORITY userSidAuthority = - { SECURITY_WORLD_SID_AUTHORITY }; + typedef DWORD (WINAPI *getSidLengthRequiredDef)(UCHAR); + typedef BOOL (WINAPI *initializeSidDef)(PSID, PSID_IDENTIFIER_AUTHORITY, + BYTE); + typedef PDWORD (WINAPI *getSidSubAuthorityDef)(PSID, DWORD); + typedef DWORD (WINAPI *setNamedSecurityInfoADef)(IN LPSTR, + IN SE_OBJECT_TYPE, IN SECURITY_INFORMATION, IN PSID, IN PSID, + IN PACL, IN PACL); + typedef BOOL (WINAPI *getAceDef)(PACL, DWORD, LPVOID *); + typedef BOOL (WINAPI *addAceDef)(PACL, DWORD, DWORD, LPVOID, DWORD); + typedef BOOL (WINAPI *equalSidDef)(PSID, PSID); + typedef BOOL (WINAPI *addAccessDeniedAceDef)(PACL, DWORD, DWORD, PSID); + typedef BOOL (WINAPI *initializeAclDef)(PACL, DWORD, DWORD); + typedef DWORD (WINAPI *getLengthSidDef)(PSID); + typedef BOOL (WINAPI *getAclInformationDef)(PACL, LPVOID, DWORD, + ACL_INFORMATION_CLASS); + typedef BOOL (WINAPI *getSecurityDescriptorDaclDef)(PSECURITY_DESCRIPTOR, + LPBOOL, PACL *, LPBOOL); + typedef BOOL (WINAPI *lookupAccountNameADef)(LPCSTR, LPCSTR, PSID, + PDWORD, LPSTR, LPDWORD, PSID_NAME_USE); + typedef BOOL (WINAPI *getFileSecurityADef)(LPCSTR, SECURITY_INFORMATION, + PSECURITY_DESCRIPTOR, DWORD, LPDWORD); + + static const SECURITY_INFORMATION infoBits = OWNER_SECURITY_INFORMATION + | GROUP_SECURITY_INFORMATION | DACL_SECURITY_INFORMATION; + static const DWORD readOnlyMask = FILE_DELETE_CHILD | FILE_ADD_FILE + | FILE_ADD_SUBDIRECTORY | FILE_WRITE_EA | FILE_APPEND_DATA + | FILE_WRITE_DATA | DELETE; - typedef DWORD (WINAPI *getSidLengthRequiredDef) ( UCHAR ); - typedef BOOL (WINAPI *initializeSidDef) ( PSID, - PSID_IDENTIFIER_AUTHORITY, BYTE ); - typedef PDWORD (WINAPI *getSidSubAuthorityDef) ( PSID, DWORD ); + /* + * References to security functions (only available on NT and later). + */ static getSidLengthRequiredDef getSidLengthRequiredProc; static initializeSidDef initializeSidProc; static getSidSubAuthorityDef getSidSubAuthorityProc; - static const SECURITY_INFORMATION infoBits = OWNER_SECURITY_INFORMATION - | GROUP_SECURITY_INFORMATION | DACL_SECURITY_INFORMATION; - static const DWORD readOnlyMask = FILE_DELETE_CHILD | FILE_ADD_FILE - | FILE_ADD_SUBDIRECTORY | FILE_WRITE_EA | FILE_APPEND_DATA - | FILE_WRITE_DATA | DELETE; - - PSECURITY_DESCRIPTOR secDesc = 0; - DWORD secDescLen; - - const BOOL set_readOnly = !(pmode & 0222); - BOOL acl_readOnly_found = FALSE; - - ACL_SIZE_INFORMATION ACLSize; - BOOL curAclPresent, curAclDefaulted; - PACL curAcl; - PACL newAcl = 0; - DWORD newAclSize; - - WORD j; - - SID *userSid = 0; - TCHAR *userDomain = NULL; - - DWORD attr; - - int res = 0; - - /* - * One time initialization, dynamically load Windows NT features - */ - typedef DWORD (WINAPI *setNamedSecurityInfoADef)( IN LPSTR, - IN SE_OBJECT_TYPE, IN SECURITY_INFORMATION, IN PSID, IN PSID, - IN PACL, IN PACL ); - typedef BOOL (WINAPI *getAceDef) (PACL, DWORD, LPVOID *); - typedef BOOL (WINAPI *addAceDef) ( PACL, DWORD, DWORD, LPVOID, DWORD ); - typedef BOOL (WINAPI *equalSidDef) ( PSID, PSID ); - typedef BOOL (WINAPI *addAccessDeniedAceDef) ( PACL, DWORD, DWORD, PSID ); - typedef BOOL (WINAPI *initializeAclDef) ( PACL, DWORD, DWORD ); - typedef DWORD (WINAPI *getLengthSidDef) ( PSID ); - typedef BOOL (WINAPI *getAclInformationDef) (PACL, LPVOID, DWORD, - ACL_INFORMATION_CLASS ); - typedef BOOL (WINAPI *getSecurityDescriptorDaclDef) (PSECURITY_DESCRIPTOR, - LPBOOL, PACL *, LPBOOL ); - typedef BOOL (WINAPI *lookupAccountNameADef) ( LPCSTR, LPCSTR, PSID, - PDWORD, LPSTR, LPDWORD, PSID_NAME_USE ); - typedef BOOL (WINAPI *getFileSecurityADef) ( LPCSTR, SECURITY_INFORMATION, - PSECURITY_DESCRIPTOR, DWORD, LPDWORD ); - static setNamedSecurityInfoADef setNamedSecurityInfoProc; static getAceDef getAceProc; static addAceDef addAceProc; @@ -589,183 +520,258 @@ TestplatformChmod(CONST char *nativePath, int pmode) static getLengthSidDef getLengthSidProc; static getAclInformationDef getAclInformationProc; static getSecurityDescriptorDaclDef getSecurityDescriptorDaclProc; - static lookupAccountNameADef lookupAccountNameProc; + static lookupAccountNameADef lookupAccountNameProc; static getFileSecurityADef getFileSecurityProc; - static int initialized = 0; + + const BOOL set_readOnly = !(pmode & 0222); + BOOL acl_readOnly_found = FALSE, curAclPresent, curAclDefaulted; + SID_IDENTIFIER_AUTHORITY userSidAuthority = { + SECURITY_WORLD_SID_AUTHORITY + }; + BYTE *secDesc = 0; + DWORD secDescLen, attr, newAclSize; + ACL_SIZE_INFORMATION ACLSize; + PACL curAcl, newAcl = 0; + WORD j; + SID *userSid = 0; + TCHAR *userDomain = 0; + int res = 0; + + /* + * One time initialization, dynamically load Windows NT features + */ + if (!initialized) { TCL_DECLARE_MUTEX(initializeMutex) Tcl_MutexLock(&initializeMutex); if (!initialized) { HINSTANCE hInstance = LoadLibrary("Advapi32"); + if (hInstance != NULL) { setNamedSecurityInfoProc = (setNamedSecurityInfoADef) - GetProcAddress(hInstance, "SetNamedSecurityInfoA"); + GetProcAddress(hInstance, "SetNamedSecurityInfoA"); getFileSecurityProc = (getFileSecurityADef) - GetProcAddress(hInstance, "GetFileSecurityA"); + GetProcAddress(hInstance, "GetFileSecurityA"); getAceProc = (getAceDef) - GetProcAddress(hInstance, "GetAce"); + GetProcAddress(hInstance, "GetAce"); addAceProc = (addAceDef) - GetProcAddress(hInstance, "AddAce"); + GetProcAddress(hInstance, "AddAce"); equalSidProc = (equalSidDef) - GetProcAddress(hInstance, "EqualSid"); + GetProcAddress(hInstance, "EqualSid"); addAccessDeniedAceProc = (addAccessDeniedAceDef) - GetProcAddress(hInstance, "AddAccessDeniedAce"); + GetProcAddress(hInstance, "AddAccessDeniedAce"); initializeAclProc = (initializeAclDef) - GetProcAddress(hInstance, "InitializeAcl"); + GetProcAddress(hInstance, "InitializeAcl"); getLengthSidProc = (getLengthSidDef) - GetProcAddress(hInstance, "GetLengthSid"); + GetProcAddress(hInstance, "GetLengthSid"); getAclInformationProc = (getAclInformationDef) - GetProcAddress(hInstance, "GetAclInformation"); + GetProcAddress(hInstance, "GetAclInformation"); getSecurityDescriptorDaclProc = (getSecurityDescriptorDaclDef) - GetProcAddress(hInstance, "GetSecurityDescriptorDacl"); + GetProcAddress(hInstance, "GetSecurityDescriptorDacl"); lookupAccountNameProc = (lookupAccountNameADef) - GetProcAddress(hInstance, "LookupAccountNameA"); + GetProcAddress(hInstance, "LookupAccountNameA"); getSidLengthRequiredProc = (getSidLengthRequiredDef) - GetProcAddress(hInstance, "GetSidLengthRequired"); + GetProcAddress(hInstance, "GetSidLengthRequired"); initializeSidProc = (initializeSidDef) - GetProcAddress(hInstance, "InitializeSid"); + GetProcAddress(hInstance, "InitializeSid"); getSidSubAuthorityProc = (getSidSubAuthorityDef) - GetProcAddress(hInstance, "GetSidSubAuthority"); - if (setNamedSecurityInfoProc && getAceProc - && addAceProc && equalSidProc && addAccessDeniedAceProc - && initializeAclProc && getLengthSidProc - && getAclInformationProc && getSecurityDescriptorDaclProc - && lookupAccountNameProc && getFileSecurityProc - && getSidLengthRequiredProc && initializeSidProc - && getSidSubAuthorityProc) + GetProcAddress(hInstance, "GetSidSubAuthority"); + + if (setNamedSecurityInfoProc && getAceProc && addAceProc + && equalSidProc && addAccessDeniedAceProc + && initializeAclProc && getLengthSidProc + && getAclInformationProc + && getSecurityDescriptorDaclProc + && lookupAccountNameProc && getFileSecurityProc + && getSidLengthRequiredProc && initializeSidProc + && getSidSubAuthorityProc) { initialized = 1; + } } - if (!initialized) + if (!initialized) { initialized = -1; + } } Tcl_MutexUnlock(&initializeMutex); } - /* Process the chmod request */ + /* + * Process the chmod request. + */ + attr = GetFileAttributes(nativePath); - /* nativePath not found */ + /* + * nativePath not found + */ + if (attr == 0xffffffff) { res = -1; goto done; } - /* If no ACL API is present or nativePath is not a directory, - * there is no special handling + /* + * If no ACL API is present or nativePath is not a directory, there is no + * special handling. */ + if (initialized < 0 || !(attr & FILE_ATTRIBUTE_DIRECTORY)) { goto done; } - - /* Set the result to error, if the ACL change is successful it will - * be reset to 0 + + /* + * Set the result to error, if the ACL change is successful it will be + * reset to 0. */ + res = -1; /* - * Read the security descriptor for the directory. Note the - * first call obtains the size of the security descriptor. + * Read the security descriptor for the directory. Note the first call + * obtains the size of the security descriptor. */ + if (!getFileSecurityProc(nativePath, infoBits, NULL, 0, &secDescLen)) { - if (GetLastError() == ERROR_INSUFFICIENT_BUFFER) { - DWORD secDescLen2 = 0; - secDesc = (PSECURITY_DESCRIPTOR) ckalloc(secDescLen); - if (!getFileSecurityProc(nativePath, infoBits, secDesc, - secDescLen, &secDescLen2) + DWORD secDescLen2 = 0; + + if (GetLastError() != ERROR_INSUFFICIENT_BUFFER) { + goto done; + } + + secDesc = (BYTE *) ckalloc(secDescLen); + if (!getFileSecurityProc(nativePath, infoBits, + (PSECURITY_DESCRIPTOR) secDesc, secDescLen, &secDescLen2) || (secDescLen < secDescLen2)) { - goto done; - } - } else { goto done; } } - /* Get the World SID */ - userSid = (SID*) ckalloc(getSidLengthRequiredProc((UCHAR)1)); - initializeSidProc( userSid, &userSidAuthority, (BYTE)1); - *(getSidSubAuthorityProc( userSid, 0)) = SECURITY_WORLD_RID; + /* + * Get the World SID. + */ + + 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(secDesc, &curAclPresent, - &curAcl, &curAclDefaulted)) - goto done; + /* + * If curAclPresent == false then curAcl and curAclDefaulted not valid. + */ + if (!getSecurityDescriptorDaclProc((PSECURITY_DESCRIPTOR) secDesc, + &curAclPresent, &curAcl, &curAclDefaulted)) { + goto done; + } if (!curAclPresent || !curAcl) { ACLSize.AclBytesInUse = 0; ACLSize.AceCount = 0; - } else if (!getAclInformationProc(curAcl, &ACLSize, sizeof(ACLSize), - AclSizeInformation)) + } else if (!getAclInformationProc(curAcl, &ACLSize, sizeof(ACLSize), + AclSizeInformation)) { goto done; + } - /* Allocate memory for the new ACL */ - newAclSize = ACLSize.AclBytesInUse + sizeof (ACCESS_DENIED_ACE) - + getLengthSidProc(userSid) - sizeof (DWORD); - newAcl = (ACL *) ckalloc (newAclSize); - - /* Initialize the new ACL */ - if(!initializeAclProc(newAcl, newAclSize, ACL_REVISION)) { + /* + * Allocate memory for the new ACL. + */ + + newAclSize = ACLSize.AclBytesInUse + sizeof(ACCESS_DENIED_ACE) + + getLengthSidProc(userSid) - sizeof(DWORD); + newAcl = (ACL *) ckalloc(newAclSize); + + /* + * Initialize the new ACL. + */ + + if (!initializeAclProc(newAcl, newAclSize, ACL_REVISION)) { goto done; } - - /* Add denied to make readonly, this will be known as a "read-only tag" */ - if (set_readOnly && !addAccessDeniedAceProc(newAcl, ACL_REVISION, - readOnlyMask, userSid)) { + + /* + * Add denied to make readonly, this will be known as a "read-only tag". + */ + + if (set_readOnly && !addAccessDeniedAceProc(newAcl, ACL_REVISION, + readOnlyMask, userSid)) { goto done; } - + acl_readOnly_found = FALSE; for (j = 0; j < ACLSize.AceCount; j++) { - PACL *pACE2; + LPVOID pACE2; ACE_HEADER *phACE2; - if (! getAceProc (curAcl, j, (LPVOID*) &pACE2)) { + + if (!getAceProc(curAcl, j, &pACE2)) { goto done; } - - phACE2 = ((ACE_HEADER *) pACE2); - /* Do NOT propagate inherited ACEs */ + phACE2 = (ACE_HEADER *) pACE2; + + /* + * Do NOT propagate inherited ACEs. + */ + if (phACE2->AceFlags & INHERITED_ACE) { continue; } - - /* Skip the "read-only tag" restriction (either added above, or it - * is being removed) + + /* + * Skip the "read-only tag" restriction (either added above, or it is + * being removed). */ + if (phACE2->AceType == ACCESS_DENIED_ACE_TYPE) { - ACCESS_DENIED_ACE *pACEd = (ACCESS_DENIED_ACE *)phACE2; - if (pACEd->Mask == readOnlyMask && equalSidProc(userSid, - (PSID)&(pACEd->SidStart))) { + ACCESS_DENIED_ACE *pACEd = (ACCESS_DENIED_ACE *) phACE2; + + if (pACEd->Mask == readOnlyMask + && equalSidProc(userSid, (PSID) &pACEd->SidStart)) { acl_readOnly_found = TRUE; continue; } } - /* Copy the current ACE from the old to the new ACL */ - if(! addAceProc (newAcl, ACL_REVISION, MAXDWORD, pACE2, - ((PACE_HEADER) pACE2)->AceSize)) { + /* + * Copy the current ACE from the old to the new ACL. + */ + + if (!addAceProc(newAcl, ACL_REVISION, MAXDWORD, (PACL *)pACE2, + ((PACE_HEADER) pACE2)->AceSize)) { goto done; } } - /* Apply the new ACL */ - if (set_readOnly == acl_readOnly_found - || setNamedSecurityInfoProc((LPSTR)nativePath, SE_FILE_OBJECT, - DACL_SECURITY_INFORMATION, NULL, NULL, newAcl, NULL) - == ERROR_SUCCESS ) { + /* + * Apply the new ACL. + */ + + if (set_readOnly == acl_readOnly_found || setNamedSecurityInfoProc( + (LPSTR) nativePath, SE_FILE_OBJECT, DACL_SECURITY_INFORMATION, + NULL, NULL, newAcl, NULL) == ERROR_SUCCESS) { res = 0; } - done: - if (secDesc) ckfree((char *)secDesc); - if (newAcl) ckfree((char *)newAcl); - if (userSid) ckfree((char *)userSid); - if (userDomain) ckfree(userDomain); + done: + if (secDesc) { + ckfree((char *) secDesc); + } + if (newAcl) { + ckfree((char *) newAcl); + } + if (userSid) { + ckfree((char *) userSid); + } + if (userDomain) { + ckfree(userDomain); + } - if (res != 0) + if (res != 0) { return res; - - /* Run normal chmod command */ + } + + /* + * Run normal chmod command. + */ + return chmod(nativePath, pmode); } @@ -774,10 +780,10 @@ TestplatformChmod(CONST char *nativePath, int pmode) * * TestchmodCmd -- * - * Implements the "testchmod" cmd. Used when testing "file" command. - * The only attribute used by the Windows platform is the user write - * flag; if this is not set, the file is made read-only. Otehrwise, the - * file is made read-write. + * Implements the "testchmod" cmd. Used when testing "file" command. The + * only attribute used by the Windows platform is the user write flag; if + * this is not set, the file is made read-only. Otherwise, the file is + * made read-write. * * Results: * A standard Tcl result. @@ -789,17 +795,17 @@ TestplatformChmod(CONST char *nativePath, int pmode) */ static int -TestchmodCmd(dummy, interp, argc, argv) - ClientData dummy; /* Not used. */ - Tcl_Interp *interp; /* Current interpreter. */ - int argc; /* Number of arguments. */ - CONST84 char **argv; /* Argument strings. */ +TestchmodCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int argc, /* Number of arguments. */ + const char **argv) /* Argument strings. */ { int i, mode; char *rest; if (argc < 2) { - usage: + usage: Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " mode file ?file ...?", NULL); return TCL_ERROR; @@ -812,7 +818,7 @@ TestchmodCmd(dummy, interp, argc, argv) for (i = 2; i < argc; i++) { Tcl_DString buffer; - CONST char *translated; + const char *translated; translated = Tcl_TranslateFileName(interp, argv[i], &buffer); if (translated == NULL) { @@ -827,3 +833,11 @@ TestchmodCmd(dummy, interp, argc, argv) } return TCL_OK; } + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ diff --git a/win/tclWinThrd.c b/win/tclWinThrd.c index 13fd411..8544e71 100644 --- a/win/tclWinThrd.c +++ b/win/tclWinThrd.c @@ -1,4 +1,4 @@ -/* +/* * tclWinThread.c -- * * This file implements the Windows-specific thread operations. @@ -6,25 +6,23 @@ * Copyright (c) 1998 by Sun Microsystems, Inc. * Copyright (c) 1999 by Scriptics Corporation * - * See the file "license.terms" for information on usage and redistribution - * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclWinInt.h" -#include <fcntl.h> -#include <io.h> #include <sys/stat.h> /* - * This is the master lock used to serialize access to other - * serialization data structures. + * This is the master lock used to serialize access to other serialization + * data structures. */ static CRITICAL_SECTION masterLock; static int init = 0; -#define MASTER_LOCK TclpMasterLock() -#define MASTER_UNLOCK TclpMasterUnlock() +#define MASTER_LOCK TclpMasterLock() +#define MASTER_UNLOCK TclpMasterUnlock() /* @@ -35,38 +33,39 @@ static int init = 0; static CRITICAL_SECTION initLock; /* - * allocLock is used by Tcl's version of malloc for synchronization. - * For obvious reasons, cannot use any dyamically allocated storage. + * allocLock is used by Tcl's version of malloc for synchronization. For + * obvious reasons, cannot use any dyamically allocated storage. */ #ifdef TCL_THREADS -static CRITICAL_SECTION allocLock; -static Tcl_Mutex allocLockPtr = (Tcl_Mutex) &allocLock; +static struct Tcl_Mutex_ { + CRITICAL_SECTION crit; +} allocLock; +static Tcl_Mutex allocLockPtr = &allocLock; static int allocOnce = 0; #endif /* TCL_THREADS */ /* * The joinLock serializes Create- and ExitThread. This is necessary to - * prevent a race where a new joinable thread exits before the creating - * thread had the time to create the necessary data structures in the - * emulation layer. + * prevent a race where a new joinable thread exits before the creating thread + * had the time to create the necessary data structures in the emulation + * layer. */ static CRITICAL_SECTION joinLock; /* - * Condition variables are implemented with a combination of a - * per-thread Windows Event and a per-condition waiting queue. - * The idea is that each thread has its own Event that it waits - * on when it is doing a ConditionWait; it uses the same event for - * all condition variables because it only waits on one at a time. - * Each condition variable has a queue of waiting threads, and a - * mutex used to serialize access to this queue. - * - * Special thanks to David Nichols and - * Jim Davidson for advice on the Condition Variable implementation. + * Condition variables are implemented with a combination of a per-thread + * Windows Event and a per-condition waiting queue. The idea is that each + * thread has its own Event that it waits on when it is doing a ConditionWait; + * it uses the same event for all condition variables because it only waits on + * one at a time. Each condition variable has a queue of waiting threads, and + * a mutex used to serialize access to this queue. + * + * Special thanks to David Nichols and Jim Davidson for advice on the + * Condition Variable implementation. */ /* @@ -86,42 +85,42 @@ static Tcl_ThreadDataKey dataKey; #endif /* TCL_THREADS */ /* - * Additions by AOL for specialized thread memory allocator. - */ - -#if defined(USE_THREAD_ALLOC) && !defined(TCL_MEM_DEBUG) -static int once; -static DWORD tlsKey; - -typedef struct allocMutex { - Tcl_Mutex tlock; - CRITICAL_SECTION wlock; -} allocMutex; -#endif - -/* * State bits for the thread. - * WIN_THREAD_UNINIT Uninitialized. Must be zero because - * of the way ThreadSpecificData is created. + * WIN_THREAD_UNINIT Uninitialized. Must be zero because of the way + * ThreadSpecificData is created. * WIN_THREAD_RUNNING Running, not waiting. * WIN_THREAD_BLOCKED Waiting, or trying to wait. - */ + */ #define WIN_THREAD_UNINIT 0x0 #define WIN_THREAD_RUNNING 0x1 #define WIN_THREAD_BLOCKED 0x2 /* - * The per condition queue pointers and the - * Mutex used to serialize access to the queue. + * The per condition queue pointers and the Mutex used to serialize access to + * the queue. */ typedef struct WinCondition { - CRITICAL_SECTION condLock; /* Lock to serialize queuing on the condition */ + CRITICAL_SECTION condLock; /* Lock to serialize queuing on the + * condition. */ struct ThreadSpecificData *firstPtr; /* Queue pointers */ struct ThreadSpecificData *lastPtr; } WinCondition; +/* + * Additions by AOL for specialized thread memory allocator. + */ + +#ifdef USE_THREAD_ALLOC +static int once; +static DWORD tlsKey; + +typedef struct allocMutex { + Tcl_Mutex tlock; + CRITICAL_SECTION wlock; +} allocMutex; +#endif /* USE_THREAD_ALLOC */ /* *---------------------------------------------------------------------- @@ -131,8 +130,8 @@ typedef struct WinCondition { * This procedure creates a new thread. * * Results: - * TCL_OK if the thread could be created. The thread ID is - * returned in a parameter. + * TCL_OK if the thread could be created. The thread ID is returned in a + * parameter. * * Side effects: * A new thread is created. @@ -141,21 +140,25 @@ typedef struct WinCondition { */ int -TclpThreadCreate(idPtr, proc, clientData, stackSize, flags) - Tcl_ThreadId *idPtr; /* Return, the ID of the thread */ - Tcl_ThreadCreateProc proc; /* Main() function of the thread */ - ClientData clientData; /* The one argument to Main() */ - int stackSize; /* Size of stack for the new thread */ - int flags; /* Flags controlling behaviour of - * the new thread */ +TclpThreadCreate( + Tcl_ThreadId *idPtr, /* Return, the ID of the thread. */ + Tcl_ThreadCreateProc proc, /* Main() function of the thread. */ + ClientData clientData, /* The one argument to Main(). */ + int stackSize, /* Size of stack for the new thread. */ + int flags) /* Flags controlling behaviour of the new + * thread. */ { HANDLE tHandle; EnterCriticalSection(&joinLock); + *idPtr = 0; /* must initialize as Tcl_Thread is a pointer and + * on WIN64 sizeof void* != sizeof unsigned + */ + #if defined(_MSC_VER) || defined(__MSVCRT__) || defined(__BORLANDC__) tHandle = (HANDLE) _beginthreadex(NULL, (unsigned) stackSize, proc, - clientData, 0, (unsigned *)idPtr); + clientData, 0, (unsigned *)idPtr); #else tHandle = CreateThread(NULL, (DWORD) stackSize, (LPTHREAD_START_ROUTINE) proc, (LPVOID) clientData, @@ -163,11 +166,11 @@ TclpThreadCreate(idPtr, proc, clientData, stackSize, flags) #endif if (tHandle == NULL) { - LeaveCriticalSection(&joinLock); + LeaveCriticalSection(&joinLock); return TCL_ERROR; } else { - if (flags & TCL_THREAD_JOINABLE) { - TclRememberJoinableThread (*idPtr); + if (flags & TCL_THREAD_JOINABLE) { + TclRememberJoinableThread(*idPtr); } /* @@ -199,13 +202,12 @@ TclpThreadCreate(idPtr, proc, clientData, stackSize, flags) */ int -Tcl_JoinThread(threadId, result) - Tcl_ThreadId threadId; /* Id of the thread to wait upon */ - int* result; /* Reference to the storage the result - * of the thread we wait upon will be - * written into. */ +Tcl_JoinThread( + Tcl_ThreadId threadId, /* Id of the thread to wait upon */ + int *result) /* Reference to the storage the result of the + * thread we wait upon will be written into. */ { - return TclJoinThread (threadId, result); + return TclJoinThread(threadId, result); } /* @@ -225,11 +227,11 @@ Tcl_JoinThread(threadId, result) */ void -TclpThreadExit(status) - int status; +TclpThreadExit( + int status) { EnterCriticalSection(&joinLock); - TclSignalExitThread (Tcl_GetCurrentThread (), status); + TclSignalExitThread(Tcl_GetCurrentThread(), status); LeaveCriticalSection(&joinLock); #if defined(_MSC_VER) || defined(__MSVCRT__) || defined(__BORLANDC__) @@ -256,9 +258,9 @@ TclpThreadExit(status) */ Tcl_ThreadId -Tcl_GetCurrentThread() +Tcl_GetCurrentThread(void) { - return (Tcl_ThreadId)GetCurrentThreadId(); + return (Tcl_ThreadId) INT2PTR(GetCurrentThreadId()); } /* @@ -267,9 +269,9 @@ Tcl_GetCurrentThread() * TclpInitLock * * This procedure is used to grab a lock that serializes initialization - * and finalization of Tcl. On some platforms this may also initialize - * the mutex used to serialize creation of more mutexes and thread - * local storage keys. + * and finalization of Tcl. On some platforms this may also initialize + * the mutex used to serialize creation of more mutexes and thread local + * storage keys. * * Results: * None. @@ -281,15 +283,16 @@ Tcl_GetCurrentThread() */ void -TclpInitLock() +TclpInitLock(void) { if (!init) { /* - * There is a fundamental race here that is solved by creating - * the first Tcl interpreter in a single threaded environment. - * Once the interpreter has been created, it is safe to create - * more threads that create interpreters in parallel. + * There is a fundamental race here that is solved by creating the + * first Tcl interpreter in a single threaded environment. Once the + * interpreter has been created, it is safe to create more threads + * that create interpreters in parallel. */ + init = 1; InitializeCriticalSection(&joinLock); InitializeCriticalSection(&initLock); @@ -303,8 +306,8 @@ TclpInitLock() * * TclpInitUnlock * - * This procedure is used to release a lock that serializes initialization - * and finalization of Tcl. + * This procedure is used to release a lock that serializes + * initialization and finalization of Tcl. * * Results: * None. @@ -316,7 +319,7 @@ TclpInitLock() */ void -TclpInitUnlock() +TclpInitUnlock(void) { LeaveCriticalSection(&initLock); } @@ -326,11 +329,11 @@ TclpInitUnlock() * * TclpMasterLock * - * This procedure is used to grab a lock that serializes creation - * of mutexes, condition variables, and thread local storage keys. + * This procedure is used to grab a lock that serializes creation of + * mutexes, condition variables, and thread local storage keys. * - * This lock must be different than the initLock because the - * initLock is held during creation of syncronization objects. + * This lock must be different than the initLock because the initLock is + * held during creation of syncronization objects. * * Results: * None. @@ -342,15 +345,16 @@ TclpInitUnlock() */ void -TclpMasterLock() +TclpMasterLock(void) { if (!init) { /* - * There is a fundamental race here that is solved by creating - * the first Tcl interpreter in a single threaded environment. - * Once the interpreter has been created, it is safe to create - * more threads that create interpreters in parallel. + * There is a fundamental race here that is solved by creating the + * first Tcl interpreter in a single threaded environment. Once the + * interpreter has been created, it is safe to create more threads + * that create interpreters in parallel. */ + init = 1; InitializeCriticalSection(&joinLock); InitializeCriticalSection(&initLock); @@ -364,8 +368,8 @@ TclpMasterLock() * * TclpMasterUnlock * - * This procedure is used to release a lock that serializes creation - * and deletion of synchronization objects. + * This procedure is used to release a lock that serializes creation and + * deletion of synchronization objects. * * Results: * None. @@ -377,7 +381,7 @@ TclpMasterLock() */ void -TclpMasterUnlock() +TclpMasterUnlock(void) { LeaveCriticalSection(&masterLock); } @@ -387,13 +391,13 @@ TclpMasterUnlock() * * Tcl_GetAllocMutex * - * This procedure returns a pointer to a statically initialized - * mutex for use by the memory allocator. The alloctor must - * use this lock, because all other locks are allocated... + * This procedure returns a pointer to a statically initialized mutex for + * use by the memory allocator. The alloctor must use this lock, because + * all other locks are allocated... * * Results: - * A pointer to a mutex that is suitable for passing to - * Tcl_MutexLock and Tcl_MutexUnlock. + * A pointer to a mutex that is suitable for passing to Tcl_MutexLock and + * Tcl_MutexUnlock. * * Side effects: * None. @@ -402,11 +406,11 @@ TclpMasterUnlock() */ Tcl_Mutex * -Tcl_GetAllocMutex() +Tcl_GetAllocMutex(void) { #ifdef TCL_THREADS if (!allocOnce) { - InitializeCriticalSection(&allocLock); + InitializeCriticalSection(&allocLock.crit); allocOnce = 1; } return &allocLockPtr; @@ -420,74 +424,85 @@ Tcl_GetAllocMutex() * * TclpFinalizeLock * - * This procedure is used to destroy all private resources used in - * this file. + * This procedure is used to destroy all private resources used in this + * file. * * Results: * None. * * Side effects: - * Destroys everything private. TclpInitLock must be held - * entering this function. + * Destroys everything private. TclpInitLock must be held entering this + * function. * *---------------------------------------------------------------------- */ void -TclFinalizeLock () +TclFinalizeLock(void) { MASTER_LOCK; DeleteCriticalSection(&joinLock); - /* Destroy the critical section that we are holding! */ + + /* + * Destroy the critical section that we are holding! + */ + DeleteCriticalSection(&masterLock); init = 0; + #ifdef TCL_THREADS - DeleteCriticalSection(&allocLock); - allocOnce = 0; + if (allocOnce) { + DeleteCriticalSection(&allocLock.crit); + allocOnce = 0; + } #endif - /* Destroy the critical section that we are holding! */ + + LeaveCriticalSection(&initLock); + + /* + * Destroy the critical section that we were holding. + */ + DeleteCriticalSection(&initLock); } #ifdef TCL_THREADS /* locally used prototype */ -static void FinalizeConditionEvent(ClientData data); - +static void FinalizeConditionEvent(ClientData data); /* *---------------------------------------------------------------------- * * Tcl_MutexLock -- * - * This procedure is invoked to lock a mutex. This is a self - * initializing mutex that is automatically finalized during - * Tcl_Finalize. + * This procedure is invoked to lock a mutex. This is a self initializing + * mutex that is automatically finalized during Tcl_Finalize. * * Results: * None. * * Side effects: - * May block the current thread. The mutex is aquired when - * this returns. + * May block the current thread. The mutex is aquired when this returns. * *---------------------------------------------------------------------- */ void -Tcl_MutexLock(mutexPtr) - Tcl_Mutex *mutexPtr; /* The lock */ +Tcl_MutexLock( + Tcl_Mutex *mutexPtr) /* The lock */ { CRITICAL_SECTION *csPtr; + if (*mutexPtr == NULL) { MASTER_LOCK; - /* + /* * Double inside master lock check to avoid a race. */ if (*mutexPtr == NULL) { - csPtr = (CRITICAL_SECTION *)ckalloc(sizeof(CRITICAL_SECTION)); + csPtr = (CRITICAL_SECTION *) ckalloc(sizeof(CRITICAL_SECTION)); InitializeCriticalSection(csPtr); *mutexPtr = (Tcl_Mutex)csPtr; TclRememberMutex(mutexPtr); @@ -515,10 +530,11 @@ Tcl_MutexLock(mutexPtr) */ void -Tcl_MutexUnlock(mutexPtr) - Tcl_Mutex *mutexPtr; /* The lock */ +Tcl_MutexUnlock( + Tcl_Mutex *mutexPtr) /* The lock */ { CRITICAL_SECTION *csPtr = *((CRITICAL_SECTION **)mutexPtr); + LeaveCriticalSection(csPtr); } @@ -527,8 +543,8 @@ Tcl_MutexUnlock(mutexPtr) * * TclpFinalizeMutex -- * - * This procedure is invoked to clean up one mutex. This is only - * safe to call at the end of time. + * This procedure is invoked to clean up one mutex. This is only safe to + * call at the end of time. * * Results: * None. @@ -540,13 +556,14 @@ Tcl_MutexUnlock(mutexPtr) */ void -TclpFinalizeMutex(mutexPtr) - Tcl_Mutex *mutexPtr; +TclpFinalizeMutex( + Tcl_Mutex *mutexPtr) { CRITICAL_SECTION *csPtr = *(CRITICAL_SECTION **)mutexPtr; + if (csPtr != NULL) { DeleteCriticalSection(csPtr); - ckfree((char *)csPtr); + ckfree((char *) csPtr); *mutexPtr = NULL; } } @@ -554,210 +571,11 @@ TclpFinalizeMutex(mutexPtr) /* *---------------------------------------------------------------------- * - * TclpThreadDataKeyInit -- - * - * This procedure initializes a thread specific data block key. - * Each thread has table of pointers to thread specific data. - * all threads agree on which table entry is used by each module. - * this is remembered in a "data key", that is just an index into - * this table. To allow self initialization, the interface - * passes a pointer to this key and the first thread to use - * the key fills in the pointer to the key. The key should be - * a process-wide static. - * - * Results: - * None. - * - * Side effects: - * Will allocate memory the first time this process calls for - * this key. In this case it modifies its argument - * to hold the pointer to information about the key. - * - *---------------------------------------------------------------------- - */ - -void -TclpThreadDataKeyInit(keyPtr) - Tcl_ThreadDataKey *keyPtr; /* Identifier for the data chunk, - * really (DWORD **) */ -{ - DWORD *indexPtr; - DWORD newKey; - - MASTER_LOCK; - if (*keyPtr == NULL) { - indexPtr = (DWORD *)ckalloc(sizeof(DWORD)); - newKey = TlsAlloc(); - if (newKey != TLS_OUT_OF_INDEXES) { - *indexPtr = newKey; - } else { - panic("TlsAlloc failed from TclpThreadDataKeyInit!"); /* this should be a fatal error */ - } - *keyPtr = (Tcl_ThreadDataKey)indexPtr; - TclRememberDataKey(keyPtr); - } - MASTER_UNLOCK; -} - -/* - *---------------------------------------------------------------------- - * - * TclpThreadDataKeyGet -- - * - * This procedure returns a pointer to a block of thread local storage. - * - * Results: - * A thread-specific pointer to the data structure, or NULL - * if the memory has not been assigned to this key for this thread. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -VOID * -TclpThreadDataKeyGet(keyPtr) - Tcl_ThreadDataKey *keyPtr; /* Identifier for the data chunk, - * really (DWORD **) */ -{ - DWORD *indexPtr = *(DWORD **)keyPtr; - LPVOID result; - if (indexPtr == NULL) { - return NULL; - } else { - result = TlsGetValue(*indexPtr); - if ((result == NULL) && (GetLastError() != NO_ERROR)) { - panic("TlsGetValue failed from TclpThreadDataKeyGet!"); - } - return result; - } -} - -/* - *---------------------------------------------------------------------- - * - * TclpThreadDataKeySet -- - * - * This procedure sets the pointer to a block of thread local storage. - * - * Results: - * None. - * - * Side effects: - * Sets up the thread so future calls to TclpThreadDataKeyGet with - * this key will return the data pointer. - * - *---------------------------------------------------------------------- - */ - -void -TclpThreadDataKeySet(keyPtr, data) - Tcl_ThreadDataKey *keyPtr; /* Identifier for the data chunk, - * really (pthread_key_t **) */ - VOID *data; /* Thread local storage */ -{ - DWORD *indexPtr = *(DWORD **)keyPtr; - BOOL success; - success = TlsSetValue(*indexPtr, (void *)data); - if (!success) { - panic("TlsSetValue failed from TclpThreadDataKeySet!"); - } -} - -/* - *---------------------------------------------------------------------- - * - * TclpFinalizeThreadData -- - * - * This procedure cleans up the thread-local storage. This is - * called once for each thread. - * - * Results: - * None. - * - * Side effects: - * Frees up the memory. - * - *---------------------------------------------------------------------- - */ - -void -TclpFinalizeThreadData(keyPtr) - Tcl_ThreadDataKey *keyPtr; -{ - VOID *result; - DWORD *indexPtr; - BOOL success; - - if (*keyPtr != NULL) { - indexPtr = *(DWORD **)keyPtr; - result = (VOID *)TlsGetValue(*indexPtr); - if (result != NULL) { -#if defined(USE_THREAD_ALLOC) && !defined(TCL_MEM_DEBUG) - if (indexPtr == &tlsKey) { - TclpFreeAllocCache(result); - return; - } -#endif - ckfree((char *)result); - success = TlsSetValue(*indexPtr, (void *)NULL); - if (!success) { - panic("TlsSetValue failed from TclpFinalizeThreadData!"); - } - } else { - if (GetLastError() != NO_ERROR) { - panic("TlsGetValue failed from TclpFinalizeThreadData!"); - } - } - } -} - -/* - *---------------------------------------------------------------------- - * - * TclpFinalizeThreadDataKey -- - * - * This procedure is invoked to clean up one key. This is a - * process-wide storage identifier. The thread finalization code - * cleans up the thread local storage itself. - * - * This assumes the master lock is held. - * - * Results: - * None. - * - * Side effects: - * The key is deallocated. - * - *---------------------------------------------------------------------- - */ - -void -TclpFinalizeThreadDataKey(keyPtr) - Tcl_ThreadDataKey *keyPtr; -{ - DWORD *indexPtr; - BOOL success; - if (*keyPtr != NULL) { - indexPtr = *(DWORD **)keyPtr; - success = TlsFree(*indexPtr); - if (!success) { - panic("TlsFree failed from TclpFinalizeThreadDataKey!"); - } - ckfree((char *)indexPtr); - *keyPtr = NULL; - } -} - -/* - *---------------------------------------------------------------------- - * * Tcl_ConditionWait -- * - * This procedure is invoked to wait on a condition variable. - * The mutex is atomically released as part of the wait, and - * automatically grabbed when the condition is signaled. + * This procedure is invoked to wait on a condition variable. The mutex + * is atomically released as part of the wait, and automatically grabbed + * when the condition is signaled. * * The mutex must be held when this procedure is called. * @@ -765,18 +583,18 @@ TclpFinalizeThreadDataKey(keyPtr) * None. * * Side effects: - * May block the current thread. The mutex is aquired when - * this returns. Will allocate memory for a HANDLE - * and initialize this the first time this Tcl_Condition is used. + * May block the current thread. The mutex is aquired when this returns. + * Will allocate memory for a HANDLE and initialize this the first time + * this Tcl_Condition is used. * *---------------------------------------------------------------------- */ void -Tcl_ConditionWait(condPtr, mutexPtr, timePtr) - Tcl_Condition *condPtr; /* Really (WinCondition **) */ - Tcl_Mutex *mutexPtr; /* Really (CRITICAL_SECTION **) */ - Tcl_Time *timePtr; /* Timeout on waiting period */ +Tcl_ConditionWait( + Tcl_Condition *condPtr, /* Really (WinCondition **) */ + Tcl_Mutex *mutexPtr, /* Really (CRITICAL_SECTION **) */ + Tcl_Time *timePtr) /* Timeout on waiting period */ { WinCondition *winCondPtr; /* Per-condition queue head */ CRITICAL_SECTION *csPtr; /* Caller's Mutex, after casting */ @@ -786,21 +604,20 @@ Tcl_ConditionWait(condPtr, mutexPtr, timePtr) ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); /* - * Self initialize the two parts of the condition. - * The per-condition and per-thread parts need to be - * handled independently. + * Self initialize the two parts of the condition. The per-condition and + * per-thread parts need to be handled independently. */ if (tsdPtr->flags == WIN_THREAD_UNINIT) { MASTER_LOCK; - /* + /* * Create the per-thread event and queue pointers. */ if (tsdPtr->flags == WIN_THREAD_UNINIT) { tsdPtr->condEvent = CreateEvent(NULL, TRUE /* manual reset */, - FALSE /* non signaled */, NULL); + FALSE /* non signaled */, NULL); tsdPtr->nextPtr = NULL; tsdPtr->prevPtr = NULL; tsdPtr->flags = WIN_THREAD_RUNNING; @@ -810,13 +627,12 @@ Tcl_ConditionWait(condPtr, mutexPtr, timePtr) if (doExit) { /* - * Create a per-thread exit handler to clean up the condEvent. - * We must be careful to do this outside the Master Lock - * because Tcl_CreateThreadExitHandler uses its own - * ThreadSpecificData, and initializing that may drop - * back into the Master Lock. + * Create a per-thread exit handler to clean up the condEvent. We + * must be careful to do this outside the Master Lock because + * Tcl_CreateThreadExitHandler uses its own ThreadSpecificData, + * and initializing that may drop back into the Master Lock. */ - + Tcl_CreateThreadExitHandler(FinalizeConditionEvent, (ClientData) tsdPtr); } @@ -830,11 +646,11 @@ Tcl_ConditionWait(condPtr, mutexPtr, timePtr) */ if (*condPtr == NULL) { - winCondPtr = (WinCondition *)ckalloc(sizeof(WinCondition)); + winCondPtr = (WinCondition *) ckalloc(sizeof(WinCondition)); InitializeCriticalSection(&winCondPtr->condLock); winCondPtr->firstPtr = NULL; winCondPtr->lastPtr = NULL; - *condPtr = (Tcl_Condition)winCondPtr; + *condPtr = (Tcl_Condition) winCondPtr; TclRememberCondition(condPtr); } MASTER_UNLOCK; @@ -848,8 +664,8 @@ Tcl_ConditionWait(condPtr, mutexPtr, timePtr) } /* - * Queue the thread on the condition, using - * the per-condition lock for serialization. + * Queue the thread on the condition, using the per-condition lock for + * serialization. */ tsdPtr->flags = WIN_THREAD_BLOCKED; @@ -858,22 +674,22 @@ Tcl_ConditionWait(condPtr, mutexPtr, timePtr) tsdPtr->prevPtr = winCondPtr->lastPtr; /* A: */ winCondPtr->lastPtr = tsdPtr; if (tsdPtr->prevPtr != NULL) { - tsdPtr->prevPtr->nextPtr = tsdPtr; + tsdPtr->prevPtr->nextPtr = tsdPtr; } if (winCondPtr->firstPtr == NULL) { - winCondPtr->firstPtr = tsdPtr; + winCondPtr->firstPtr = tsdPtr; } /* * Unlock the caller's mutex and wait for the condition, or a timeout. - * There is a minor issue here in that we don't count down the - * timeout if we get notified, but another thread grabs the condition - * before we do. In that race condition we'll wait again for the - * full timeout. Timed waits are dubious anyway. Either you have - * the locking protocol wrong and are masking a deadlock, - * or you are using conditions to pause your thread. + * There is a minor issue here in that we don't count down the timeout if + * we get notified, but another thread grabs the condition before we do. + * In that race condition we'll wait again for the full timeout. Timed + * waits are dubious anyway. Either you have the locking protocol wrong + * and are masking a deadlock, or you are using conditions to pause your + * thread. */ - + LeaveCriticalSection(csPtr); timeout = 0; while (!timeout && (tsdPtr->flags & WIN_THREAD_BLOCKED)) { @@ -886,32 +702,32 @@ Tcl_ConditionWait(condPtr, mutexPtr, timePtr) } /* - * Be careful on timeouts because the signal might arrive right around - * the time limit and someone else could have taken us off the queue. + * Be careful on timeouts because the signal might arrive right around the + * time limit and someone else could have taken us off the queue. */ - + if (timeout) { if (tsdPtr->flags & WIN_THREAD_RUNNING) { timeout = 0; } else { /* - * When dequeuing, we can leave the tsdPtr->nextPtr - * and tsdPtr->prevPtr with dangling pointers because - * they are reinitialilzed w/out reading them when the - * thread is enqueued later. + * When dequeuing, we can leave the tsdPtr->nextPtr and + * tsdPtr->prevPtr with dangling pointers because they are + * reinitialilzed w/out reading them when the thread is enqueued + * later. */ - if (winCondPtr->firstPtr == tsdPtr) { - winCondPtr->firstPtr = tsdPtr->nextPtr; - } else { - tsdPtr->prevPtr->nextPtr = tsdPtr->nextPtr; - } - if (winCondPtr->lastPtr == tsdPtr) { - winCondPtr->lastPtr = tsdPtr->prevPtr; - } else { - tsdPtr->nextPtr->prevPtr = tsdPtr->prevPtr; - } - tsdPtr->flags = WIN_THREAD_RUNNING; + if (winCondPtr->firstPtr == tsdPtr) { + winCondPtr->firstPtr = tsdPtr->nextPtr; + } else { + tsdPtr->prevPtr->nextPtr = tsdPtr->nextPtr; + } + if (winCondPtr->lastPtr == tsdPtr) { + winCondPtr->lastPtr = tsdPtr->prevPtr; + } else { + tsdPtr->nextPtr->prevPtr = tsdPtr->prevPtr; + } + tsdPtr->flags = WIN_THREAD_RUNNING; } } @@ -926,8 +742,8 @@ Tcl_ConditionWait(condPtr, mutexPtr, timePtr) * * This procedure is invoked to signal a condition variable. * - * The mutex must be held during this call to avoid races, - * but this interface does not enforce that. + * The mutex must be held during this call to avoid races, but this + * interface does not enforce that. * * Results: * None. @@ -939,13 +755,13 @@ Tcl_ConditionWait(condPtr, mutexPtr, timePtr) */ void -Tcl_ConditionNotify(condPtr) - Tcl_Condition *condPtr; +Tcl_ConditionNotify( + Tcl_Condition *condPtr) { WinCondition *winCondPtr; ThreadSpecificData *tsdPtr; - if (condPtr != NULL) { + if (*condPtr != NULL) { winCondPtr = *((WinCondition **)condPtr); if (winCondPtr == NULL) { @@ -953,9 +769,9 @@ Tcl_ConditionNotify(condPtr) } /* - * Loop through all the threads waiting on the condition - * and notify them (i.e., broadcast semantics). The queue - * manipulation is guarded by the per-condition coordinating mutex. + * Loop through all the threads waiting on the condition and notify + * them (i.e., broadcast semantics). The queue manipulation is guarded + * by the per-condition coordinating mutex. */ EnterCriticalSection(&winCondPtr->condLock); @@ -973,7 +789,7 @@ Tcl_ConditionNotify(condPtr) LeaveCriticalSection(&winCondPtr->condLock); } else { /* - * Noone has used the condition variable, so there are no waiters. + * No-one has used the condition variable, so there are no waiters. */ } } @@ -983,9 +799,9 @@ Tcl_ConditionNotify(condPtr) * * FinalizeConditionEvent -- * - * This procedure is invoked to clean up the per-thread - * event used to implement condition waiting. - * This is only safe to call at the end of time. + * This procedure is invoked to clean up the per-thread event used to + * implement condition waiting. This is only safe to call at the end of + * time. * * Results: * None. @@ -997,10 +813,11 @@ Tcl_ConditionNotify(condPtr) */ static void -FinalizeConditionEvent(data) - ClientData data; +FinalizeConditionEvent( + ClientData data) { - ThreadSpecificData *tsdPtr = (ThreadSpecificData *)data; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) data; + tsdPtr->flags = WIN_THREAD_UNINIT; CloseHandle(tsdPtr->condEvent); } @@ -1010,8 +827,8 @@ FinalizeConditionEvent(data) * * TclpFinalizeCondition -- * - * This procedure is invoked to clean up a condition variable. - * This is only safe to call at the end of time. + * This procedure is invoked to clean up a condition variable. This is + * only safe to call at the end of time. * * This assumes the Master Lock is held. * @@ -1025,30 +842,33 @@ FinalizeConditionEvent(data) */ void -TclpFinalizeCondition(condPtr) - Tcl_Condition *condPtr; +TclpFinalizeCondition( + Tcl_Condition *condPtr) { WinCondition *winCondPtr = *(WinCondition **)condPtr; /* - * Note - this is called long after the thread-local storage is - * reclaimed. The per-thread condition waiting event is - * reclaimed earlier in a per-thread exit handler, which is - * called before thread local storage is reclaimed. + * Note - this is called long after the thread-local storage is reclaimed. + * The per-thread condition waiting event is reclaimed earlier in a + * per-thread exit handler, which is called before thread local storage is + * reclaimed. */ if (winCondPtr != NULL) { DeleteCriticalSection(&winCondPtr->condLock); - ckfree((char *)winCondPtr); + ckfree((char *) winCondPtr); *condPtr = NULL; } } + + + /* * Additions by AOL for specialized thread memory allocator. */ +#ifdef USE_THREAD_ALLOC -#if defined(USE_THREAD_ALLOC) && !defined(TCL_MEM_DEBUG) Tcl_Mutex * TclpNewAllocMutex(void) { @@ -1056,7 +876,7 @@ TclpNewAllocMutex(void) lockPtr = malloc(sizeof(struct allocMutex)); if (lockPtr == NULL) { - panic("could not allocate lock"); + Tcl_Panic("could not allocate lock"); } lockPtr->tlock = (Tcl_Mutex) &lockPtr->wlock; InitializeCriticalSection(&lockPtr->wlock); @@ -1064,11 +884,14 @@ TclpNewAllocMutex(void) } void -TclpFreeAllocMutex(mutex) - Tcl_Mutex *mutex; /* The alloc mutex to free. */ +TclpFreeAllocMutex( + Tcl_Mutex *mutex) /* The alloc mutex to free. */ { - allocMutex* lockPtr = (allocMutex*) mutex; - if (!lockPtr) return; + allocMutex *lockPtr = (allocMutex *) mutex; + + if (!lockPtr) { + return; + } DeleteCriticalSection(&lockPtr->wlock); free(lockPtr); } @@ -1080,60 +903,73 @@ TclpGetAllocCache(void) if (!once) { /* - * We need to make sure that TclpFreeAllocCache is called - * on each thread that calls this, but only on threads that - * call this. + * We need to make sure that TclpFreeAllocCache is called on each + * thread that calls this, but only on threads that call this. */ - tlsKey = TlsAlloc(); + + tlsKey = TlsAlloc(); once = 1; if (tlsKey == TLS_OUT_OF_INDEXES) { - panic("could not allocate thread local storage"); + Tcl_Panic("could not allocate thread local storage"); } } result = TlsGetValue(tlsKey); if ((result == NULL) && (GetLastError() != NO_ERROR)) { - panic("TlsGetValue failed from TclpGetAllocCache!"); + Tcl_Panic("TlsGetValue failed from TclpGetAllocCache"); } return result; } void -TclpSetAllocCache(void *ptr) +TclpSetAllocCache( + void *ptr) { BOOL success; success = TlsSetValue(tlsKey, ptr); if (!success) { - panic("TlsSetValue failed from TclpSetAllocCache!"); + Tcl_Panic("TlsSetValue failed from TclpSetAllocCache"); } } void -TclpFreeAllocCache(void *ptr) +TclpFreeAllocCache( + void *ptr) { BOOL success; if (ptr != NULL) { - /* - * Called by the pthread lib when a thread exits - */ - TclFreeAllocCache(ptr); - success = TlsSetValue(tlsKey, NULL); - if (!success) { - panic("TlsSetValue failed from TclpFreeAllocCache!"); - } - } else if (once) { - /* - * Called by us in TclFinalizeThreadAlloc() during - * the library finalization initiated from Tcl_Finalize() - */ - success = TlsFree(tlsKey); - if (!success) { - Tcl_Panic("TlsFree failed from TclpFreeAllocCache!"); - } - once = 0; /* reset for next time. */ + /* + * Called by us in TclpFinalizeThreadData when a thread exits and + * destroys the tsd key which stores allocator caches. + */ + + TclFreeAllocCache(ptr); + success = TlsSetValue(tlsKey, NULL); + if (!success) { + Tcl_Panic("TlsSetValue failed from TclpFreeAllocCache"); + } + } else if (once) { + /* + * Called by us in TclFinalizeThreadAlloc() during the library + * finalization initiated from Tcl_Finalize() + */ + + success = TlsFree(tlsKey); + if (!success) { + Tcl_Panic("TlsFree failed from TclpFreeAllocCache"); + } + once = 0; /* reset for next time. */ } -} +} #endif /* USE_THREAD_ALLOC */ #endif /* TCL_THREADS */ + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ diff --git a/win/tclWinTime.c b/win/tclWinTime.c index dd5699e..3ae108b 100644 --- a/win/tclWinTime.c +++ b/win/tclWinTime.c @@ -1,29 +1,30 @@ -/* +/* * tclWinTime.c -- * - * Contains Windows specific versions of Tcl functions that - * obtain time values from the operating system. + * Contains Windows specific versions of Tcl functions that obtain time + * values from the operating system. * * Copyright 1995-1998 by Sun Microsystems, Inc. * - * See the file "license.terms" for information on usage and redistribution - * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ -#include "tclWinInt.h" +#include "tclInt.h" -#define SECSPERDAY (60L * 60L * 24L) -#define SECSPERYEAR (SECSPERDAY * 365L) -#define SECSPER4YEAR (SECSPERYEAR * 4L + SECSPERDAY) +#define SECSPERDAY (60L * 60L * 24L) +#define SECSPERYEAR (SECSPERDAY * 365L) +#define SECSPER4YEAR (SECSPERYEAR * 4L + SECSPERDAY) /* - * Number of samples over which to estimate the performance counter + * Number of samples over which to estimate the performance counter. */ -#define SAMPLES 64 + +#define SAMPLES 64 /* - * The following arrays contain the day of year for the last day of - * each month, where index 1 is January. + * The following arrays contain the day of year for the last day of each + * month, where index 1 is January. */ static int normalDays[] = { @@ -45,38 +46,29 @@ static Tcl_ThreadDataKey dataKey; */ typedef struct TimeInfo { - - CRITICAL_SECTION cs; /* Mutex guarding this structure */ - + CRITICAL_SECTION cs; /* Mutex guarding this structure. */ int initialized; /* Flag == 1 if this structure is * initialized. */ - - int perfCounterAvailable; /* Flag == 1 if the hardware has a - * performance counter */ - - HANDLE calibrationThread; /* Handle to the thread that keeps the - * virtual clock calibrated. */ - - HANDLE readyEvent; /* System event used to - * trigger the requesting thread - * when the clock calibration procedure - * is initialized for the first time */ - - HANDLE exitEvent; /* Event to signal out of an exit handler - * to tell the calibration loop to - * terminate */ - - LARGE_INTEGER nominalFreq; /* Nominal frequency of the system - * performance counter, that is, the value - * returned from QueryPerformanceFrequency. */ + int perfCounterAvailable; /* Flag == 1 if the hardware has a performance + * counter. */ + HANDLE calibrationThread; /* Handle to the thread that keeps the virtual + * clock calibrated. */ + HANDLE readyEvent; /* System event used to trigger the requesting + * thread when the clock calibration procedure + * is initialized for the first time. */ + HANDLE exitEvent; /* Event to signal out of an exit handler to + * tell the calibration loop to terminate. */ + LARGE_INTEGER nominalFreq; /* Nominal frequency of the system performance + * counter, that is, the value returned from + * QueryPerformanceFrequency. */ /* - * The following values are used for calculating virtual time. - * Virtual time is always equal to: - * lastFileTime + (current perf counter - lastCounter) + * The following values are used for calculating virtual time. Virtual + * time is always equal to: + * lastFileTime + (current perf counter - lastCounter) * * 10000000 / curCounterFreq - * and lastFileTime and lastCounter are updated any time that - * virtual time is returned to a caller. + * and lastFileTime and lastCounter are updated any time that virtual time + * is returned to a caller. */ ULARGE_INTEGER fileTimeLastCall; @@ -84,16 +76,14 @@ typedef struct TimeInfo { LARGE_INTEGER curCounterFreq; /* - * Data used in developing the estimate of performance counter - * frequency + * Data used in developing the estimate of performance counter frequency */ + Tcl_WideUInt fileTimeSample[SAMPLES]; - /* Last 64 samples of system time */ + /* Last 64 samples of system time. */ Tcl_WideInt perfCounterSample[SAMPLES]; - /* Last 64 samples of performance counter */ - int sampleNo; /* Current sample number */ - - + /* Last 64 samples of performance counter. */ + int sampleNo; /* Current sample number. */ } TimeInfo; static TimeInfo timeInfo = { @@ -119,33 +109,38 @@ static TimeInfo timeInfo = { 0 }; -static CONST FILETIME posixEpoch = { 0xD53E8000, 0x019DB1DE }; - /* * Declarations for functions defined later in this file. */ -static struct tm * ComputeGMT _ANSI_ARGS_((const time_t *tp)); -static void StopCalibration _ANSI_ARGS_(( ClientData )); -static DWORD WINAPI CalibrationThread _ANSI_ARGS_(( LPVOID arg )); -static void UpdateTimeEachSecond _ANSI_ARGS_(( void )); -static void ResetCounterSamples _ANSI_ARGS_(( - Tcl_WideUInt fileTime, - Tcl_WideInt perfCounter, - Tcl_WideInt perfFreq - )); -static Tcl_WideInt AccumulateSample _ANSI_ARGS_(( - Tcl_WideInt perfCounter, - Tcl_WideUInt fileTime - )); +static struct tm * ComputeGMT(const time_t *tp); +static void StopCalibration(ClientData clientData); +static DWORD WINAPI CalibrationThread(LPVOID arg); +static void UpdateTimeEachSecond(void); +static void ResetCounterSamples(Tcl_WideUInt fileTime, + Tcl_WideInt perfCounter, Tcl_WideInt perfFreq); +static Tcl_WideInt AccumulateSample(Tcl_WideInt perfCounter, + Tcl_WideUInt fileTime); +static void NativeScaleTime(Tcl_Time* timebuf, + ClientData clientData); +static void NativeGetTime(Tcl_Time* timebuf, + ClientData clientData); + +/* + * TIP #233 (Virtualized Time): Data for the time hooks, if any. + */ + +Tcl_GetTimeProc *tclGetTimeProcPtr = NativeGetTime; +Tcl_ScaleTimeProc *tclScaleTimeProcPtr = NativeScaleTime; +ClientData tclTimeClientData = NULL; /* *---------------------------------------------------------------------- * * TclpGetSeconds -- * - * This procedure returns the number of seconds from the epoch. - * On most Unix systems the epoch is Midnight Jan 1, 1970 GMT. + * This procedure returns the number of seconds from the epoch. On most + * Unix systems the epoch is Midnight Jan 1, 1970 GMT. * * Results: * Number of seconds from the epoch. @@ -157,10 +152,11 @@ static Tcl_WideInt AccumulateSample _ANSI_ARGS_(( */ unsigned long -TclpGetSeconds() +TclpGetSeconds(void) { Tcl_Time t; - Tcl_GetTime( &t ); + + (*tclGetTimeProcPtr) (&t, tclTimeClientData); /* Tcl_GetTime inlined. */ return t.sec; } @@ -169,11 +165,10 @@ TclpGetSeconds() * * TclpGetClicks -- * - * This procedure returns a value that represents the highest - * resolution clock available on the system. There are no - * guarantees on what the resolution will be. In Tcl we will - * call this value a "click". The start time is also system - * dependant. + * This procedure returns a value that represents the highest resolution + * clock available on the system. There are no guarantees on what the + * resolution will be. In Tcl we will call this value a "click". The + * start time is also system dependant. * * Results: * Number of clicks from some start time. @@ -185,18 +180,19 @@ TclpGetSeconds() */ unsigned long -TclpGetClicks() +TclpGetClicks(void) { /* - * Use the Tcl_GetTime abstraction to get the time in microseconds, - * as nearly as we can, and return it. + * Use the Tcl_GetTime abstraction to get the time in microseconds, as + * nearly as we can, and return it. */ Tcl_Time now; /* Current Tcl time */ unsigned long retval; /* Value to return */ - Tcl_GetTime( &now ); - retval = ( now.sec * 1000000 ) + now.usec; + (*tclGetTimeProcPtr) (&now, tclTimeClientData); /* Tcl_GetTime inlined */ + + retval = (now.sec * 1000000) + now.usec; return retval; } @@ -206,9 +202,8 @@ TclpGetClicks() * * TclpGetTimeZone -- * - * Determines the current timezone. The method varies wildly - * between different Platform implementations, so its hidden in - * this function. + * Determines the current timezone. The method varies wildly between + * different Platform implementations, so its hidden in this function. * * Results: * Minutes west of GMT. @@ -220,13 +215,13 @@ TclpGetClicks() */ int -TclpGetTimeZone (currentTime) - Tcl_WideInt currentTime; +TclpGetTimeZone( + unsigned long currentTime) { int timeZone; tzset(); - timeZone = _timezone / 60; + timeZone = timezone / 60; return timeZone; } @@ -236,79 +231,137 @@ TclpGetTimeZone (currentTime) * * Tcl_GetTime -- * - * Gets the current system time in seconds and microseconds - * since the beginning of the epoch: 00:00 UCT, January 1, 1970. + * Gets the current system time in seconds and microseconds since the + * beginning of the epoch: 00:00 UCT, January 1, 1970. * * Results: * Returns the current time in timePtr. * * Side effects: - * On the first call, initializes a set of static variables to - * keep track of the base value of the performance counter, the - * corresponding wall clock (obtained through ftime) and the - * frequency of the performance counter. Also spins a thread - * whose function is to wake up periodically and monitor these - * values, adjusting them as necessary to correct for drift - * in the performance counter's oscillator. + * On the first call, initializes a set of static variables to keep track + * of the base value of the performance counter, the corresponding wall + * clock (obtained through ftime) and the frequency of the performance + * counter. Also spins a thread whose function is to wake up periodically + * and monitor these values, adjusting them as necessary to correct for + * drift in the performance counter's oscillator. * *---------------------------------------------------------------------- */ void -Tcl_GetTime(timePtr) - Tcl_Time *timePtr; /* Location to store time information. */ +Tcl_GetTime( + Tcl_Time *timePtr) /* Location to store time information. */ { - struct timeb t; + (*tclGetTimeProcPtr) (timePtr, tclTimeClientData); +} + +/* + *---------------------------------------------------------------------- + * + * NativeScaleTime -- + * + * TIP #233: Scale from virtual time to the real-time. For native scaling + * the relationship is 1:1 and nothing has to be done. + * + * Results: + * Scales the time in timePtr. + * + * Side effects: + * See above. + * + *---------------------------------------------------------------------- + */ - int useFtime = 1; /* Flag == TRUE if we need to fall back - * on ftime rather than using the perf - * counter */ +static void +NativeScaleTime( + Tcl_Time *timePtr, + ClientData clientData) +{ + /* + * Native scale is 1:1. Nothing is done. + */ +} + +/* + *---------------------------------------------------------------------- + * + * NativeGetTime -- + * + * TIP #233: Gets the current system time in seconds and microseconds + * since the beginning of the epoch: 00:00 UCT, January 1, 1970. + * + * Results: + * Returns the current time in timePtr. + * + * Side effects: + * On the first call, initializes a set of static variables to keep track + * of the base value of the performance counter, the corresponding wall + * clock (obtained through ftime) and the frequency of the performance + * counter. Also spins a thread whose function is to wake up periodically + * and monitor these values, adjusting them as necessary to correct for + * drift in the performance counter's oscillator. + * + *---------------------------------------------------------------------- + */ - /* Initialize static storage on the first trip through. */ +static void +NativeGetTime( + Tcl_Time *timePtr, + ClientData clientData) +{ + struct timeb t; + int useFtime = 1; /* Flag == TRUE if we need to fall back on + * ftime rather than using the perf counter. */ /* - * Note: Outer check for 'initialized' is a performance win - * since it avoids an extra mutex lock in the common case. + * Initialize static storage on the first trip through. + * + * Note: Outer check for 'initialized' is a performance win since it + * avoids an extra mutex lock in the common case. */ - if ( !timeInfo.initialized ) { + if (!timeInfo.initialized) { TclpInitLock(); - if ( !timeInfo.initialized ) { - timeInfo.perfCounterAvailable - = QueryPerformanceFrequency( &timeInfo.nominalFreq ); + if (!timeInfo.initialized) { + timeInfo.perfCounterAvailable = + QueryPerformanceFrequency(&timeInfo.nominalFreq); /* - * Some hardware abstraction layers use the CPU clock - * in place of the real-time clock as a performance counter - * reference. This results in: + * Some hardware abstraction layers use the CPU clock in place of + * the real-time clock as a performance counter reference. This + * results in: * - inconsistent results among the processors on * multi-processor systems. - * - unpredictable changes in performance counter frequency - * on "gearshift" processors such as Transmeta and - * SpeedStep. + * - unpredictable changes in performance counter frequency on + * "gearshift" processors such as Transmeta and SpeedStep. * * There seems to be no way to test whether the performance - * counter is reliable, but a useful heuristic is that - * if its frequency is 1.193182 MHz or 3.579545 MHz, it's - * derived from a colorburst crystal and is therefore - * the RTC rather than the TSC. + * counter is reliable, but a useful heuristic is that if its + * frequency is 1.193182 MHz or 3.579545 MHz, it's derived from a + * colorburst crystal and is therefore the RTC rather than the + * TSC. + * + * A sloppier but serviceable heuristic is that the RTC crystal is + * normally less than 15 MHz while the TSC crystal is virtually + * assured to be greater than 100 MHz. Since Win98SE appears to + * fiddle with the definition of the perf counter frequency + * (perhaps in an attempt to calibrate the clock?), we use the + * latter rule rather than an exact match. * - * A sloppier but serviceable heuristic is that the RTC crystal - * is normally less than 15 MHz while the TSC crystal is - * virtually assured to be greater than 100 MHz. Since Win98SE - * appears to fiddle with the definition of the perf counter - * frequency (perhaps in an attempt to calibrate the clock?) - * we use the latter rule rather than an exact match. + * We also assume (perhaps questionably) that the vendors have + * gotten their act together on Win64, so bypass all this rubbish + * on that platform. */ - if ( timeInfo.perfCounterAvailable - /* The following lines would do an exact match on - * crystal frequency: - * && timeInfo.nominalFreq.QuadPart != (Tcl_WideInt) 1193182 - * && timeInfo.nominalFreq.QuadPart != (Tcl_WideInt) 3579545 - */ - && timeInfo.nominalFreq.QuadPart > (Tcl_WideInt) 15000000 ) { - +#if !defined(_WIN64) + if (timeInfo.perfCounterAvailable + /* + * The following lines would do an exact match on crystal + * frequency: + * && timeInfo.nominalFreq.QuadPart != (Tcl_WideInt)1193182 + * && timeInfo.nominalFreq.QuadPart != (Tcl_WideInt)3579545 + */ + && timeInfo.nominalFreq.QuadPart > (Tcl_WideInt) 15000000){ /* * As an exception, if every logical processor on the system * is on the same chip, we use the performance counter anyway, @@ -318,118 +371,109 @@ Tcl_GetTime(timePtr) SYSTEM_INFO systemInfo; unsigned int regs[4]; - GetSystemInfo( &systemInfo ); - if ( TclWinCPUID( 0, regs ) == TCL_OK - - && regs[1] == 0x756e6547 /* "Genu" */ - && regs[3] == 0x49656e69 /* "ineI" */ - && regs[2] == 0x6c65746e /* "ntel" */ - - && TclWinCPUID( 1, regs ) == TCL_OK - - && ( (regs[0] & 0x00000F00) == 0x00000F00 /* Pentium 4 */ - || ( (regs[0] & 0x00F00000) /* Extended family */ - && (regs[3] & 0x10000000) ) ) /* Hyperthread */ - && ( ( ( regs[1] & 0x00FF0000 ) >> 16 ) /* CPU count */ - == systemInfo.dwNumberOfProcessors ) - ) { + GetSystemInfo(&systemInfo); + if (TclWinCPUID(0, regs) == TCL_OK + && regs[1] == 0x756e6547 /* "Genu" */ + && regs[3] == 0x49656e69 /* "ineI" */ + && regs[2] == 0x6c65746e /* "ntel" */ + && TclWinCPUID(1, regs) == TCL_OK + && ((regs[0]&0x00000F00) == 0x00000F00 /* Pentium 4 */ + || ((regs[0] & 0x00F00000) /* Extended family */ + && (regs[3] & 0x10000000))) /* Hyperthread */ + && (((regs[1]&0x00FF0000) >> 16)/* CPU count */ + == systemInfo.dwNumberOfProcessors)) { timeInfo.perfCounterAvailable = TRUE; } else { - timeInfo.perfCounterAvailable = FALSE; - } - + timeInfo.perfCounterAvailable = FALSE; + } } +#endif /* above code is Win32 only */ /* * If the performance counter is available, start a thread to * calibrate it. */ - if ( timeInfo.perfCounterAvailable ) { + if (timeInfo.perfCounterAvailable) { DWORD id; - InitializeCriticalSection( &timeInfo.cs ); - timeInfo.readyEvent = CreateEvent( NULL, FALSE, FALSE, NULL ); - timeInfo.exitEvent = CreateEvent( NULL, FALSE, FALSE, NULL ); - timeInfo.calibrationThread = CreateThread( NULL, - 256, - CalibrationThread, - (LPVOID) NULL, - 0, - &id ); - SetThreadPriority( timeInfo.calibrationThread, - THREAD_PRIORITY_HIGHEST ); + + InitializeCriticalSection(&timeInfo.cs); + timeInfo.readyEvent = CreateEvent(NULL, FALSE, FALSE, NULL); + timeInfo.exitEvent = CreateEvent(NULL, FALSE, FALSE, NULL); + timeInfo.calibrationThread = CreateThread(NULL, 256, + CalibrationThread, (LPVOID) NULL, 0, &id); + SetThreadPriority(timeInfo.calibrationThread, + THREAD_PRIORITY_HIGHEST); /* - * Wait for the thread just launched to start running, - * and create an exit handler that kills it so that it - * doesn't outlive unloading tclXX.dll + * Wait for the thread just launched to start running, and + * create an exit handler that kills it so that it doesn't + * outlive unloading tclXX.dll */ - WaitForSingleObject( timeInfo.readyEvent, INFINITE ); - CloseHandle( timeInfo.readyEvent ); - Tcl_CreateExitHandler( StopCalibration, (ClientData) NULL ); + WaitForSingleObject(timeInfo.readyEvent, INFINITE); + CloseHandle(timeInfo.readyEvent); + Tcl_CreateExitHandler(StopCalibration, (ClientData) NULL); } timeInfo.initialized = TRUE; } TclpInitUnlock(); } - if ( timeInfo.perfCounterAvailable ) { + if (timeInfo.perfCounterAvailable && timeInfo.curCounterFreq.QuadPart!=0) { /* - * Query the performance counter and use it to calculate the - * current time. + * Query the performance counter and use it to calculate the current + * time. */ LARGE_INTEGER curCounter; - /* Current performance counter */ - - Tcl_WideInt curFileTime; - /* Current estimated time, expressed - * as 100-ns ticks since the Windows epoch */ - + /* Current performance counter. */ + Tcl_WideInt curFileTime;/* Current estimated time, expressed as 100-ns + * ticks since the Windows epoch. */ static LARGE_INTEGER posixEpoch; - /* Posix epoch expressed as 100-ns ticks - * since the windows epoch */ - + /* Posix epoch expressed as 100-ns ticks since + * the windows epoch. */ Tcl_WideInt usecSincePosixEpoch; - /* Current microseconds since Posix epoch */ + /* Current microseconds since Posix epoch. */ posixEpoch.LowPart = 0xD53E8000; posixEpoch.HighPart = 0x019DB1DE; - EnterCriticalSection( &timeInfo.cs ); + EnterCriticalSection(&timeInfo.cs); - QueryPerformanceCounter( &curCounter ); + QueryPerformanceCounter(&curCounter); - /* + /* * If it appears to be more than 1.1 seconds since the last trip - * through the calibration loop, the performance counter may - * have jumped forward. (See MSDN Knowledge Base article - * Q274323 for a description of the hardware problem that makes - * this test necessary.) If the counter jumps, we don't want - * to use it directly. Instead, we must return system time. - * Eventually, the calibration loop should recover. + * through the calibration loop, the performance counter may have + * jumped forward. (See MSDN Knowledge Base article Q274323 for a + * description of the hardware problem that makes this test + * necessary.) If the counter jumps, we don't want to use it directly. + * Instead, we must return system time. Eventually, the calibration + * loop should recover. */ - if ( curCounter.QuadPart - timeInfo.perfCounterLastCall.QuadPart - < 11 * timeInfo.curCounterFreq.QuadPart / 10 ) { - curFileTime = timeInfo.fileTimeLastCall.QuadPart - + ( ( curCounter.QuadPart - timeInfo.perfCounterLastCall.QuadPart ) - * 10000000 / timeInfo.curCounterFreq.QuadPart ); + if (curCounter.QuadPart - timeInfo.perfCounterLastCall.QuadPart < + 11 * timeInfo.curCounterFreq.QuadPart / 10) { + curFileTime = timeInfo.fileTimeLastCall.QuadPart + + ((curCounter.QuadPart - timeInfo.perfCounterLastCall.QuadPart) + * 10000000 / timeInfo.curCounterFreq.QuadPart); timeInfo.fileTimeLastCall.QuadPart = curFileTime; timeInfo.perfCounterLastCall.QuadPart = curCounter.QuadPart; - usecSincePosixEpoch = ( curFileTime - posixEpoch.QuadPart ) / 10; - timePtr->sec = (long) ( usecSincePosixEpoch / 1000000 ); - timePtr->usec = (unsigned long ) ( usecSincePosixEpoch % 1000000 ); + usecSincePosixEpoch = (curFileTime - posixEpoch.QuadPart) / 10; + timePtr->sec = (long) (usecSincePosixEpoch / 1000000); + timePtr->usec = (unsigned long) (usecSincePosixEpoch % 1000000); useFtime = 0; } - LeaveCriticalSection( &timeInfo.cs ); + LeaveCriticalSection(&timeInfo.cs); } - if ( useFtime ) { - /* High resolution timer is not available. Just use ftime */ + if (useFtime) { + /* + * High resolution timer is not available. Just use ftime. + */ ftime(&t); timePtr->sec = (long)t.time; @@ -449,20 +493,26 @@ Tcl_GetTime(timePtr) * None. * * Side effects: - * Sets the 'exitEvent' event in the 'timeInfo' structure to ask - * the thread in question to exit, and waits for it to do so. + * Sets the 'exitEvent' event in the 'timeInfo' structure to ask the + * thread in question to exit, and waits for it to do so. * *---------------------------------------------------------------------- */ static void -StopCalibration( ClientData unused ) - /* Client data is unused */ +StopCalibration( + ClientData unused) /* Client data is unused */ { - SetEvent( timeInfo.exitEvent ); - WaitForSingleObject( timeInfo.calibrationThread, INFINITE ); - CloseHandle( timeInfo.exitEvent ); - CloseHandle( timeInfo.calibrationThread ); + SetEvent(timeInfo.exitEvent); + + /* + * If Tcl_Finalize was called from DllMain, the calibration thread is in a + * paused state so we need to timeout and continue. + */ + + WaitForSingleObject(timeInfo.calibrationThread, 100); + CloseHandle(timeInfo.exitEvent); + CloseHandle(timeInfo.calibrationThread); } /* @@ -482,9 +532,10 @@ StopCalibration( ClientData unused ) */ char * -TclpGetTZName(int dst) +TclpGetTZName( + int dst) { - size_t len; + int len; char *zone, *p; TIME_ZONE_INFORMATION tz; Tcl_Encoding encoding; @@ -495,9 +546,9 @@ TclpGetTZName(int dst) * tzset() under Borland doesn't seem to set up tzname[] at all. * tzset() under MSVC has the following weird observed behavior: * First time we call "clock format [clock seconds] -format %Z -gmt 1" - * we get "GMT", but on all subsequent calls we get the current time - * zone string, even though env(TZ) is GMT and the variable _timezone - * is 0. + * we get "GMT", but on all subsequent calls we get the current time + * ezone string, even though env(TZ) is GMT and the variable _timezone + * is 0. */ name[0] = '\0'; @@ -505,11 +556,10 @@ TclpGetTZName(int dst) zone = getenv("TZ"); if (zone != NULL) { /* - * TZ is of form "NST-4:30NDT", where "NST" would be the - * name of the standard time zone for this area, "-4:30" is - * the offset from GMT in hours, and "NDT is the name of - * the daylight savings time zone in this area. The offset - * and DST strings are optional. + * TZ is of form "NST-4:30NDT", where "NST" would be the name of the + * standard time zone for this area, "-4:30" is the offset from GMT in + * hours, and "NDT is the name of the daylight savings time zone in + * this area. The offset and DST strings are optional. */ len = strlen(zone); @@ -531,23 +581,24 @@ TclpGetTZName(int dst) } } } - Tcl_ExternalToUtf(NULL, NULL, zone, (int)len, 0, NULL, name, + Tcl_ExternalToUtf(NULL, NULL, zone, len, 0, NULL, name, sizeof(tsdPtr->tzName), NULL, NULL, NULL); } if (name[0] == '\0') { if (GetTimeZoneInformation(&tz) == TIME_ZONE_ID_UNKNOWN) { /* - * MSDN: On NT this is returned if DST is not used in - * the current TZ + * MSDN: On NT this is returned if DST is not used in the current + * TZ */ + dst = 0; } encoding = Tcl_GetEncoding(NULL, "unicode"); - Tcl_ExternalToUtf(NULL, encoding, - (char *) ((dst) ? tz.DaylightName : tz.StandardName), -1, + Tcl_ExternalToUtf(NULL, encoding, + (char *) ((dst) ? tz.DaylightName : tz.StandardName), -1, 0, NULL, name, sizeof(tsdPtr->tzName), NULL, NULL, NULL); Tcl_FreeEncoding(encoding); - } + } return name; } @@ -556,9 +607,9 @@ TclpGetTZName(int dst) * * TclpGetDate -- * - * This function converts between seconds and struct tm. If - * useGMT is true, then the returned date will be in Greenwich - * Mean Time (GMT). Otherwise, it will be in the local time zone. + * This function converts between seconds and struct tm. If useGMT is + * true, then the returned date will be in Greenwich Mean Time (GMT). + * Otherwise, it will be in the local time zone. * * Results: * Returns a static tm structure. @@ -570,11 +621,10 @@ TclpGetTZName(int dst) */ struct tm * -TclpGetDate(t, useGMT) - TclpTime_t t; - int useGMT; +TclpGetDate( + CONST time_t *t, + int useGMT) { - const time_t *tp = (const time_t *) t; struct tm *tmPtr; time_t time; @@ -582,28 +632,44 @@ TclpGetDate(t, useGMT) tzset(); /* - * If we are in the valid range, let the C run-time library - * handle it. Otherwise we need to fake it. Note that this - * algorithm ignores daylight savings time before the epoch. + * If we are in the valid range, let the C run-time library handle it. + * Otherwise we need to fake it. Note that this algorithm ignores + * daylight savings time before the epoch. */ - if (*tp >= 0) { - return localtime(tp); + /* + * Hm, Borland's localtime manages to return NULL under certain + * circumstances (e.g. wintime.test, test 1.2). Nobody tests for this, + * since 'localtime' isn't supposed to do this, possibly leading to + * crashes. + * + * Patch: We only call this function if we are at least one day into + * the epoch, else we handle it ourselves (like we do for times < 0). + * H. Giese, June 2003 + */ + +#ifdef __BORLANDC__ +#define LOCALTIME_VALIDITY_BOUNDARY SECSPERDAY +#else +#define LOCALTIME_VALIDITY_BOUNDARY 0 +#endif + + if (*t >= LOCALTIME_VALIDITY_BOUNDARY) { + return TclpLocaltime(t); } - time = *tp - _timezone; + time = *t - timezone; /* * If we aren't near to overflowing the long, just add the bias and - * use the normal calculation. Otherwise we will need to adjust - * the result at the end. + * use the normal calculation. Otherwise we will need to adjust the + * result at the end. */ - if (*tp < (LONG_MAX - 2 * SECSPERDAY) - && *tp > (LONG_MIN + 2 * SECSPERDAY)) { + if (*t < (LONG_MAX - 2*SECSPERDAY) && *t > (LONG_MIN + 2*SECSPERDAY)) { tmPtr = ComputeGMT(&time); } else { - tmPtr = ComputeGMT(tp); + tmPtr = ComputeGMT(t); tzset(); @@ -612,7 +678,7 @@ TclpGetDate(t, useGMT) * Propagate seconds overflow into minutes, hours and days. */ - time = tmPtr->tm_sec - _timezone; + time = tmPtr->tm_sec - timezone; tmPtr->tm_sec = (int)(time % 60); if (tmPtr->tm_sec < 0) { tmPtr->tm_sec += 60; @@ -639,7 +705,7 @@ TclpGetDate(t, useGMT) tmPtr->tm_wday = (tmPtr->tm_wday + (int)time) % 7; } } else { - tmPtr = ComputeGMT(tp); + tmPtr = ComputeGMT(t); } return tmPtr; } @@ -649,8 +715,8 @@ TclpGetDate(t, useGMT) * * ComputeGMT -- * - * This function computes GMT given the number of seconds since - * the epoch (midnight Jan 1 1970). + * This function computes GMT given the number of seconds since the epoch + * (midnight Jan 1 1970). * * Results: * Returns a (per thread) statically allocated struct tm. @@ -662,8 +728,8 @@ TclpGetDate(t, useGMT) */ static struct tm * -ComputeGMT(tp) - const time_t *tp; +ComputeGMT( + const time_t *tp) { struct tm *tmPtr; long tmp, rem; @@ -678,7 +744,7 @@ ComputeGMT(tp) */ tmp = (long)(*tp / SECSPER4YEAR); - rem = (LONG)(*tp % SECSPER4YEAR); + rem = (long)(*tp % SECSPER4YEAR); /* * Correct for weird mod semantics so the remainder is always positive. @@ -690,9 +756,9 @@ ComputeGMT(tp) } /* - * Compute the year after 1900 by taking the 4 year span and adjusting - * for the remainder. This works because 2000 is a leap year, and - * 1900/2100 are out of the range. + * Compute the year after 1900 by taking the 4 year span and adjusting for + * the remainder. This works because 2000 is a leap year, and 1900/2100 + * are out of the range. */ tmp = (tmp * 4) + 70; @@ -714,13 +780,13 @@ ComputeGMT(tp) tmPtr->tm_year = tmp; /* - * Compute the day of year and leave the seconds in the current day in - * the remainder. + * Compute the day of year and leave the seconds in the current day in the + * remainder. */ tmPtr->tm_yday = rem / SECSPERDAY; rem %= SECSPERDAY; - + /* * Compute the time of day. */ @@ -736,6 +802,7 @@ ComputeGMT(tp) days = (isLeap) ? leapDays : normalDays; for (tmp = 1; days[tmp] < tmPtr->tm_yday; tmp++) { + /* empty body */ } tmPtr->tm_mon = --tmp; tmPtr->tm_mday = tmPtr->tm_yday - days[tmp]; @@ -761,60 +828,66 @@ ComputeGMT(tp) * * CalibrationThread -- * - * Thread that manages calibration of the hi-resolution time - * derived from the performance counter, to keep it synchronized - * with the system clock. + * Thread that manages calibration of the hi-resolution time derived from + * the performance counter, to keep it synchronized with the system + * clock. * * Parameters: - * arg -- Client data from the CreateThread call. This parameter - * points to the static TimeInfo structure. + * arg - Client data from the CreateThread call. This parameter points to + * the static TimeInfo structure. * * Return value: - * None. This thread embeds an infinite loop. + * None. This thread embeds an infinite loop. * * Side effects: - * At an interval of 1 s, this thread performs virtual time discipline. + * At an interval of 1s, this thread performs virtual time discipline. * - * Note: When this thread is entered, TclpInitLock has been called - * to safeguard the static storage. There is therefore no synchronization - * in the body of this procedure. + * Note: When this thread is entered, TclpInitLock has been called to + * safeguard the static storage. There is therefore no synchronization in the + * body of this procedure. * *---------------------------------------------------------------------- */ static DWORD WINAPI -CalibrationThread( LPVOID arg ) +CalibrationThread( + LPVOID arg) { FILETIME curFileTime; DWORD waitResult; - /* Get initial system time and performance counter */ + /* + * Get initial system time and performance counter. + */ - GetSystemTimeAsFileTime( &curFileTime ); - QueryPerformanceCounter( &timeInfo.perfCounterLastCall ); - QueryPerformanceFrequency( &timeInfo.curCounterFreq ); + GetSystemTimeAsFileTime(&curFileTime); + QueryPerformanceCounter(&timeInfo.perfCounterLastCall); + QueryPerformanceFrequency(&timeInfo.curCounterFreq); timeInfo.fileTimeLastCall.LowPart = curFileTime.dwLowDateTime; timeInfo.fileTimeLastCall.HighPart = curFileTime.dwHighDateTime; - ResetCounterSamples( timeInfo.fileTimeLastCall.QuadPart, - timeInfo.perfCounterLastCall.QuadPart, - timeInfo.curCounterFreq.QuadPart ); + ResetCounterSamples(timeInfo.fileTimeLastCall.QuadPart, + timeInfo.perfCounterLastCall.QuadPart, + timeInfo.curCounterFreq.QuadPart); /* - * Wake up the calling thread. When it wakes up, it will release the + * Wake up the calling thread. When it wakes up, it will release the * initialization lock. */ - SetEvent( timeInfo.readyEvent ); + SetEvent(timeInfo.readyEvent); - /* Run the calibration once a second */ - - for ( ; ; ) { + /* + * Run the calibration once a second. + */ - /* If the exitEvent is set, break out of the loop. */ + while (timeInfo.perfCounterAvailable) { + /* + * If the exitEvent is set, break out of the loop. + */ waitResult = WaitForSingleObjectEx(timeInfo.exitEvent, 1000, FALSE); - if ( waitResult == WAIT_OBJECT_0 ) { + if (waitResult == WAIT_OBJECT_0) { break; } UpdateTimeEachSecond(); @@ -829,11 +902,11 @@ CalibrationThread( LPVOID arg ) * * UpdateTimeEachSecond -- * - * Callback from the waitable timer in the clock calibration thread - * that updates system time. + * Callback from the waitable timer in the clock calibration thread that + * updates system time. * * Parameters: - * info -- Pointer to the static TimeInfo structure + * info - Pointer to the static TimeInfo structure * * Results: * None. @@ -845,113 +918,116 @@ CalibrationThread( LPVOID arg ) */ static void -UpdateTimeEachSecond() +UpdateTimeEachSecond(void) { - LARGE_INTEGER curPerfCounter; /* Current value returned from - * QueryPerformanceCounter */ - - FILETIME curSysTime; /* Current system time */ - - LARGE_INTEGER curFileTime; /* File time at the time this callback - * was scheduled. */ - - Tcl_WideInt estFreq; /* Estimated perf counter frequency */ - - Tcl_WideInt vt0; /* Tcl time right now */ - Tcl_WideInt vt1; /* Tcl time one second from now */ - - Tcl_WideInt tdiff; /* Difference between system clock and - * Tcl time. */ - - Tcl_WideInt driftFreq; /* Frequency needed to drift virtual time - * into step over 1 second */ + * QueryPerformanceCounter. */ + FILETIME curSysTime; /* Current system time. */ + LARGE_INTEGER curFileTime; /* File time at the time this callback was + * scheduled. */ + Tcl_WideInt estFreq; /* Estimated perf counter frequency. */ + Tcl_WideInt vt0; /* Tcl time right now. */ + Tcl_WideInt vt1; /* Tcl time one second from now. */ + Tcl_WideInt tdiff; /* Difference between system clock and Tcl + * time. */ + Tcl_WideInt driftFreq; /* Frequency needed to drift virtual time into + * step over 1 second. */ /* * Sample performance counter and system time. */ - QueryPerformanceCounter( &curPerfCounter ); - GetSystemTimeAsFileTime( &curSysTime ); + QueryPerformanceCounter(&curPerfCounter); + GetSystemTimeAsFileTime(&curSysTime); curFileTime.LowPart = curSysTime.dwLowDateTime; curFileTime.HighPart = curSysTime.dwHighDateTime; - EnterCriticalSection( &timeInfo.cs ); + EnterCriticalSection(&timeInfo.cs); /* - * Several things may have gone wrong here that have to - * be checked for. - * (1) The performance counter may have jumped. - * (2) The system clock may have been reset. - * - * In either case, we'll need to reinitialize the circular buffer - * with samples relative to the current system time and the NOMINAL - * performance frequency (not the actual, because the actual has - * probably run slow in the first case). Our estimated frequency - * will be the nominal frequency. + * We devide by timeInfo.curCounterFreq.QuadPart in several places. That + * value should always be positive on a correctly functioning system. But + * it is good to be defensive about such matters. So if something goes + * wrong and the value does goes to zero, we clear the + * timeInfo.perfCounterAvailable in order to cause the calibration thread + * to shut itself down, then return without additional processing. */ + if (timeInfo.curCounterFreq.QuadPart == 0){ + LeaveCriticalSection(&timeInfo.cs); + timeInfo.perfCounterAvailable = 0; + return; + } + /* - * Store the current sample into the circular buffer of samples, - * and estimate the performance counter frequency. + * Several things may have gone wrong here that have to be checked for. + * (1) The performance counter may have jumped. + * (2) The system clock may have been reset. + * + * In either case, we'll need to reinitialize the circular buffer with + * samples relative to the current system time and the NOMINAL performance + * frequency (not the actual, because the actual has probably run slow in + * the first case). Our estimated frequency will be the nominal frequency. + * + * Store the current sample into the circular buffer of samples, and + * estimate the performance counter frequency. */ - estFreq = AccumulateSample( curPerfCounter.QuadPart, - (Tcl_WideUInt) curFileTime.QuadPart ); + estFreq = AccumulateSample(curPerfCounter.QuadPart, + (Tcl_WideUInt) curFileTime.QuadPart); /* * We want to adjust things so that time appears to be continuous. - * Virtual file time, right now, is + * Virtual file time, right now, is * - * vt0 = 10000000 * ( curPerfCounter - perfCounterLastCall ) - * / curCounterFreq - * + fileTimeLastCall + * vt0 = 10000000 * (curPerfCounter - perfCounterLastCall) + * / curCounterFreq + * + fileTimeLastCall * - * Ideally, we would like to drift the clock into place over a - * period of 2 sec, so that virtual time 2 sec from now will be + * Ideally, we would like to drift the clock into place over a period of 2 + * sec, so that virtual time 2 sec from now will be * * vt1 = 20000000 + curFileTime - * - * The frequency that we need to use to drift the counter back into - * place is estFreq * 20000000 / ( vt1 - vt0 ) + * + * The frequency that we need to use to drift the counter back into place + * is estFreq * 20000000 / (vt1 - vt0) */ - - vt0 = 10000000 * ( curPerfCounter.QuadPart - - timeInfo.perfCounterLastCall.QuadPart ) - / timeInfo.curCounterFreq.QuadPart - + timeInfo.fileTimeLastCall.QuadPart; + + vt0 = 10000000 * (curPerfCounter.QuadPart + - timeInfo.perfCounterLastCall.QuadPart) + / timeInfo.curCounterFreq.QuadPart + + timeInfo.fileTimeLastCall.QuadPart; vt1 = 20000000 + curFileTime.QuadPart; /* - * If we've gotten more than a second away from system time, - * then drifting the clock is going to be pretty hopeless. - * Just let it jump. Otherwise, compute the drift frequency and - * fill in everything. + * If we've gotten more than a second away from system time, then drifting + * the clock is going to be pretty hopeless. Just let it jump. Otherwise, + * compute the drift frequency and fill in everything. */ tdiff = vt0 - curFileTime.QuadPart; - if ( tdiff > 10000000 || tdiff < -10000000 ) { + if (tdiff > 10000000 || tdiff < -10000000) { timeInfo.fileTimeLastCall.QuadPart = curFileTime.QuadPart; timeInfo.curCounterFreq.QuadPart = estFreq; } else { - driftFreq = estFreq * 20000000 / ( vt1 - vt0 ); - if ( driftFreq > 1003 * estFreq / 1000 ) { - driftFreq = 1003 * estFreq / 1000; - } - if ( driftFreq < 997 * estFreq / 1000 ) { - driftFreq = 997 * estFreq / 1000; + driftFreq = estFreq * 20000000 / (vt1 - vt0); + + if (driftFreq > 1003*estFreq/1000) { + driftFreq = 1003*estFreq/1000; + } else if (driftFreq < 997*estFreq/1000) { + driftFreq = 997*estFreq/1000; } + timeInfo.fileTimeLastCall.QuadPart = vt0; timeInfo.curCounterFreq.QuadPart = driftFreq; } timeInfo.perfCounterLastCall.QuadPart = curPerfCounter.QuadPart; - LeaveCriticalSection( &timeInfo.cs ); - + LeaveCriticalSection(&timeInfo.cs); } - + /* *---------------------------------------------------------------------- * @@ -964,23 +1040,21 @@ UpdateTimeEachSecond() * None. * * Side effects: - * The array of samples is filled in so that it appears that there - * are SAMPLES samples at one-second intervals, separated by precisely - * the given frequency. + * The array of samples is filled in so that it appears that there are + * SAMPLES samples at one-second intervals, separated by precisely the + * given frequency. * *---------------------------------------------------------------------- */ static void -ResetCounterSamples( Tcl_WideUInt fileTime, - /* Current file time */ - Tcl_WideInt perfCounter, - /* Current performance counter */ - Tcl_WideInt perfFreq ) - /* Target performance frequency */ +ResetCounterSamples( + Tcl_WideUInt fileTime, /* Current file time */ + Tcl_WideInt perfCounter, /* Current performance counter */ + Tcl_WideInt perfFreq) /* Target performance frequency */ { int i; - for ( i = SAMPLES-1; i >= 0; --i ) { + for (i=SAMPLES-1 ; i>=0 ; --i) { timeInfo.perfCounterSample[i] = perfCounter; timeInfo.fileTimeSample[i] = fileTime; perfCounter -= perfFreq; @@ -994,87 +1068,84 @@ ResetCounterSamples( Tcl_WideUInt fileTime, * * AccumulateSample -- * - * Updates the circular buffer of performance counter and system - * time samples with a new data point. + * Updates the circular buffer of performance counter and system time + * samples with a new data point. * * Results: * None. * * Side effects: - * The new data point replaces the oldest point in the circular - * buffer, and the descriptive statistics are updated to accumulate - * the new point. - * - * Several things may have gone wrong here that have to - * be checked for. - * (1) The performance counter may have jumped. - * (2) The system clock may have been reset. - * - * In either case, we'll need to reinitialize the circular buffer - * with samples relative to the current system time and the NOMINAL - * performance frequency (not the actual, because the actual has - * probably run slow in the first case). + * The new data point replaces the oldest point in the circular buffer, + * and the descriptive statistics are updated to accumulate the new + * point. + * + * Several things may have gone wrong here that have to be checked for. + * (1) The performance counter may have jumped. + * (2) The system clock may have been reset. + * + * In either case, we'll need to reinitialize the circular buffer with samples + * relative to the current system time and the NOMINAL performance frequency + * (not the actual, because the actual has probably run slow in the first + * case). */ static Tcl_WideInt -AccumulateSample( Tcl_WideInt perfCounter, - Tcl_WideUInt fileTime ) +AccumulateSample( + Tcl_WideInt perfCounter, + Tcl_WideUInt fileTime) { - Tcl_WideUInt workFTSample; /* File time sample being removed - * from or added to the circular buffer */ - - Tcl_WideInt workPCSample; /* Performance counter sample being - * removed from or added to the circular - * buffer */ - + Tcl_WideUInt workFTSample; /* File time sample being removed from or + * added to the circular buffer. */ + Tcl_WideInt workPCSample; /* Performance counter sample being removed + * from or added to the circular buffer. */ Tcl_WideUInt lastFTSample; /* Last file time sample recorded */ - Tcl_WideInt lastPCSample; /* Last performance counter sample recorded */ - Tcl_WideInt FTdiff; /* Difference between last FT and current */ - Tcl_WideInt PCdiff; /* Difference between last PC and current */ - Tcl_WideInt estFreq; /* Estimated performance counter frequency */ - /* Test for jumps and reset the samples if we have one. */ + /* + * Test for jumps and reset the samples if we have one. + */ - if ( timeInfo.sampleNo == 0 ) { - lastPCSample = timeInfo.perfCounterSample[ timeInfo.sampleNo - + SAMPLES - 1 ]; - lastFTSample = timeInfo.fileTimeSample[ timeInfo.sampleNo - + SAMPLES - 1 ]; + if (timeInfo.sampleNo == 0) { + lastPCSample = + timeInfo.perfCounterSample[timeInfo.sampleNo + SAMPLES - 1]; + lastFTSample = + timeInfo.fileTimeSample[timeInfo.sampleNo + SAMPLES - 1]; } else { - lastPCSample = timeInfo.perfCounterSample[ timeInfo.sampleNo - 1 ]; - lastFTSample = timeInfo.fileTimeSample[ timeInfo.sampleNo - 1 ]; + lastPCSample = timeInfo.perfCounterSample[timeInfo.sampleNo - 1]; + lastFTSample = timeInfo.fileTimeSample[timeInfo.sampleNo - 1]; } + PCdiff = perfCounter - lastPCSample; FTdiff = fileTime - lastFTSample; - if ( PCdiff < timeInfo.nominalFreq.QuadPart * 9 / 10 - || PCdiff > timeInfo.nominalFreq.QuadPart * 11 / 10 - || FTdiff < 9000000 - || FTdiff > 11000000 ) { - ResetCounterSamples( fileTime, perfCounter, - timeInfo.nominalFreq.QuadPart ); + if (PCdiff < timeInfo.nominalFreq.QuadPart * 9 / 10 + || PCdiff > timeInfo.nominalFreq.QuadPart * 11 / 10 + || FTdiff < 9000000 || FTdiff > 11000000) { + ResetCounterSamples(fileTime, perfCounter, + timeInfo.nominalFreq.QuadPart); return timeInfo.nominalFreq.QuadPart; - } else { - - /* Estimate the frequency */ - - workPCSample = timeInfo.perfCounterSample[ timeInfo.sampleNo ]; - workFTSample = timeInfo.fileTimeSample[ timeInfo.sampleNo ]; - estFreq = 10000000 * ( perfCounter - workPCSample ) - / ( fileTime - workFTSample ); - timeInfo.perfCounterSample[ timeInfo.sampleNo ] = perfCounter; - timeInfo.fileTimeSample[ timeInfo.sampleNo ] = (Tcl_WideInt) fileTime; - - /* Advance the sample number */ - - if ( ++timeInfo.sampleNo >= SAMPLES ) { + /* + * Estimate the frequency. + */ + + workPCSample = timeInfo.perfCounterSample[timeInfo.sampleNo]; + workFTSample = timeInfo.fileTimeSample[timeInfo.sampleNo]; + estFreq = 10000000 * (perfCounter - workPCSample) + / (fileTime - workFTSample); + timeInfo.perfCounterSample[timeInfo.sampleNo] = perfCounter; + timeInfo.fileTimeSample[timeInfo.sampleNo] = (Tcl_WideInt) fileTime; + + /* + * Advance the sample number. + */ + + if (++timeInfo.sampleNo >= SAMPLES) { timeInfo.sampleNo = 0; - } - + } + return estFreq; } } @@ -1084,8 +1155,7 @@ AccumulateSample( Tcl_WideInt perfCounter, * * TclpGmtime -- * - * Wrapper around the 'gmtime' library function to make it thread - * safe. + * Wrapper around the 'gmtime' library function to make it thread safe. * * Results: * Returns a pointer to a 'struct tm' in thread-specific data. @@ -1097,18 +1167,17 @@ AccumulateSample( Tcl_WideInt perfCounter, */ struct tm * -TclpGmtime( tt ) - TclpTime_t_CONST tt; +TclpGmtime( + CONST time_t *timePtr) /* Pointer to the number of seconds since the + * local system's epoch */ { - CONST time_t *timePtr = (CONST time_t *) tt; - /* Pointer to the number of seconds - * since the local system's epoch */ /* - * The MS implementation of gmtime is thread safe because - * it returns the time in a block of thread-local storage, - * and Windows does not provide a Posix gmtime_r function. + * The MS implementation of gmtime is thread safe because it returns the + * time in a block of thread-local storage, and Windows does not provide a + * Posix gmtime_r function. */ - return gmtime( timePtr ); + + return gmtime(timePtr); } /* @@ -1129,17 +1198,85 @@ TclpGmtime( tt ) */ struct tm * -TclpLocaltime( tt ) - TclpTime_t_CONST tt; -{ - CONST time_t *timePtr = (CONST time_t *) tt; - /* Pointer to the number of seconds - * since the local system's epoch */ +TclpLocaltime( + CONST time_t *timePtr) /* Pointer to the number of seconds since the + * local system's epoch */ +{ /* - * The MS implementation of localtime is thread safe because - * it returns the time in a block of thread-local storage, - * and Windows does not provide a Posix localtime_r function. + * The MS implementation of localtime is thread safe because it returns + * the time in a block of thread-local storage, and Windows does not + * provide a Posix localtime_r function. */ - return localtime( timePtr ); + + return localtime(timePtr); +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_SetTimeProc -- + * + * TIP #233 (Virtualized Time): Registers two handlers for the + * virtualization of Tcl's access to time information. + * + * Results: + * None. + * + * Side effects: + * Remembers the handlers, alters core behaviour. + * + *---------------------------------------------------------------------- + */ + +void +Tcl_SetTimeProc( + Tcl_GetTimeProc *getProc, + Tcl_ScaleTimeProc *scaleProc, + ClientData clientData) +{ + tclGetTimeProcPtr = getProc; + tclScaleTimeProcPtr = scaleProc; + tclTimeClientData = clientData; +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_QueryTimeProc -- + * + * TIP #233 (Virtualized Time): Query which time handlers are registered. + * + * Results: + * None. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +void +Tcl_QueryTimeProc( + Tcl_GetTimeProc **getProc, + Tcl_ScaleTimeProc **scaleProc, + ClientData *clientData) +{ + if (getProc) { + *getProc = tclGetTimeProcPtr; + } + if (scaleProc) { + *scaleProc = tclScaleTimeProcPtr; + } + if (clientData) { + *clientData = tclTimeClientData; + } } + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ diff --git a/win/tclsh.rc b/win/tclsh.rc index a1b0b76..16eaf83 100644 --- a/win/tclsh.rc +++ b/win/tclsh.rc @@ -7,20 +7,20 @@ // // build-up the name suffix that defines the type of build this is. // -#ifdef TCL_THREADS +#if TCL_THREADS #define SUFFIX_THREADS "t" #else #define SUFFIX_THREADS "" #endif -#ifdef STATIC_BUILD +#if STATIC_BUILD #define SUFFIX_STATIC "s" #else #define SUFFIX_STATIC "" #endif -#ifdef DEBUG -#define SUFFIX_DEBUG "d" +#if DEBUG && !UNCHECKED +#define SUFFIX_DEBUG "g" #else #define SUFFIX_DEBUG "" #endif @@ -48,7 +48,7 @@ BEGIN BLOCK "040904b0" BEGIN VALUE "FileDescription", "Tclsh Application\0" - VALUE "OriginalFilename", "tclsh" STRINGIFY(JOIN(TCL_MAJOR_VERSION,TCL_MINOR_VERSION)) SUFFIX ".exe\0" + VALUE "OriginalFilename", "tclsh" STRINGIFY(TCL_MAJOR_VERSION) STRINGIFY(TCL_MINOR_VERSION) SUFFIX ".exe\0" VALUE "CompanyName", "ActiveState Corporation\0" VALUE "FileVersion", TCL_PATCH_LEVEL VALUE "LegalCopyright", "Copyright \251 2000 by ActiveState Corporation, et al\0" |