diff options
Diffstat (limited to 'win')
43 files changed, 9012 insertions, 7446 deletions
diff --git a/win/.cvsignore b/win/.cvsignore deleted file mode 100644 index bcf3b41..0000000 --- a/win/.cvsignore +++ /dev/null @@ -1,17 +0,0 @@ -Debug -Release -*.opt -*.ncb -*.plg -*.00? -*.o -*.obj -*.i -*.asm -Makefile -tcl.hpj -tclConfig.sh -nmakehlp.exe -.#* -tcl.sln -tcl.suo diff --git a/win/Makefile.in b/win/Makefile.in index cbfe99e..fd80010 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -3,8 +3,6 @@ # 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. -# -# RCS: @(#) $Id: Makefile.in,v 1.114 2007/03/15 22:54:57 mdejong Exp $ VERSION = @TCL_VERSION@ @@ -82,7 +80,12 @@ CFLAGS_OPTIMIZE = @CFLAGS_OPTIMIZE@ #CFLAGS = $(CFLAGS_DEBUG) #CFLAGS = $(CFLAGS_OPTIMIZE) #CFLAGS = $(CFLAGS_DEBUG) $(CFLAGS_OPTIMIZE) -CFLAGS = @CFLAGS@ @CFLAGS_DEFAULT@ +CFLAGS = @CFLAGS@ @CFLAGS_DEFAULT@ -DUNICODE -D_UNICODE + +# To compile without backward compatibility and deprecated code uncomment the +# following +NO_DEPRECATED_FLAGS = +#NO_DEPRECATED_FLAGS = -DTCL_NO_DEPRECATED # To enable compilation debugging reverse the comment characters on one of the # following lines. @@ -90,15 +93,15 @@ COMPILE_DEBUG_FLAGS = #COMPILE_DEBUG_FLAGS = -DTCL_COMPILE_DEBUG #COMPILE_DEBUG_FLAGS = -DTCL_COMPILE_DEBUG -DTCL_COMPILE_STATS -# Special compiler flags to use when building man2tcl on Windows. -MAN2TCLFLAGS = @MAN2TCLFLAGS@ - SRC_DIR = @srcdir@ ROOT_DIR = @srcdir@/.. -GENERIC_DIR = @srcdir@/../generic -TOMMATH_DIR = @srcdir@/../libtommath -WIN_DIR = @srcdir@ -COMPAT_DIR = @srcdir@/../compat +TOP_DIR = $(shell cd @srcdir@/..; pwd -P) +GENERIC_DIR = $(TOP_DIR)/generic +TOMMATH_DIR = $(TOP_DIR)/libtommath +WIN_DIR = $(TOP_DIR)/win +COMPAT_DIR = $(TOP_DIR)/compat +PKGS_DIR = $(TOP_DIR)/pkgs +ZLIB_DIR = $(COMPAT_DIR)/zlib # Converts a POSIX path to a Windows native path. CYGPATH = @CYGPATH@ @@ -107,11 +110,15 @@ 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') +#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_DIR = $(shell cd '$(ROOT_DIR_NATIVE)/library' ; pwd) - +LIBRARY_DIR1 = $(shell cd '$(ROOT_DIR_NATIVE)/library' ; pwd -P) +LIBRARY_DIR = $(shell $(CYGPATH) '$(LIBRARY_DIR1)' | sed 's!\\!/!g') DLLSUFFIX = @DLLSUFFIX@ LIBSUFFIX = @LIBSUFFIX@ EXESUFFIX = @EXESUFFIX@ @@ -127,32 +134,33 @@ TCL_STUB_LIB_FILE = @TCL_STUB_LIB_FILE@ TCL_DLL_FILE = @TCL_DLL_FILE@ TCL_LIB_FILE = @TCL_LIB_FILE@ DDE_DLL_FILE = tcldde$(DDEVER)${DLLSUFFIX} -DDE_LIB_FILE = tcldde$(DDEVER)${LIBSUFFIX} +DDE_LIB_FILE = @LIBPREFIX@tcldde$(DDEVER)${LIBSUFFIX} REG_DLL_FILE = tclreg$(REGVER)${DLLSUFFIX} -REG_LIB_FILE = tclreg$(REGVER)${LIBSUFFIX} -PIPE_DLL_FILE = tclpip$(VER)${DLLSUFFIX} +REG_LIB_FILE = @LIBPREFIX@tclreg$(REGVER)${LIBSUFFIX} +TEST_DLL_FILE = tcltest$(VER)${DLLSUFFIX} +TEST_LIB_FILE = @LIBPREFIX@tcltest$(VER)${LIBSUFFIX} +ZLIB_DLL_FILE = zlib1.dll -SHARED_LIBRARIES = $(TCL_DLL_FILE) $(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 = tclsh +SHARED_LIBRARIES = $(TCL_DLL_FILE) @ZLIB_DLL_FILE@ +STATIC_LIBRARIES = $(TCL_LIB_FILE) TCLSH = tclsh$(VER)${EXESUFFIX} -TCLTEST = tcltest${EXEEXT} CAT32 = cat32$(EXEEXT) MAN2TCL = man2tcl$(EXEEXT) +# For cross-compiled builds, TCL_EXE is the name of a tclsh executable that is +# available *BEFORE* running make for the first time. Certain build targets +# (make genstubs, make install) need it to be available on the PATH. This +# executable should *NOT* be required just to do a normal build although +# it can be required to run make dist. +TCL_EXE = @TCL_EXE@ + @SET_MAKE@ # Setting the VPATH variable to a list of paths will cause the Makefile to # look into these paths when resolving .c to .obj dependencies. -VPATH = $(GENERIC_DIR):$(TOMMATH_DIR):$(WIN_DIR):$(COMPAT_DIR) +VPATH = $(GENERIC_DIR):$(TOMMATH_DIR):$(WIN_DIR):$(COMPAT_DIR):$(ZLIB_DIR) AR = @AR@ RANLIB = @RANLIB@ @@ -170,10 +178,10 @@ EXEEXT = @EXEEXT@ OBJEXT = @OBJEXT@ STLIB_LD = @STLIB_LD@ SHLIB_LD = @SHLIB_LD@ -SHLIB_LD_LIBS = @SHLIB_LD_LIBS@ $(LIBS) +SHLIB_LD_LIBS = @SHLIB_LD_LIBS@ SHLIB_CFLAGS = @SHLIB_CFLAGS@ SHLIB_SUFFIX = @SHLIB_SUFFIX@ -LIBS = @LIBS@ +LIBS = @LIBS@ @ZLIB_LIBS@ RMDIR = rm -rf MKDIR = mkdir -p @@ -181,10 +189,10 @@ SHELL = @SHELL@ RM = rm -f COPY = cp -CC_SWITCHES = ${CFLAGS} ${CFLAGS_WARNING} ${TCL_SHLIB_CFLAGS} \ +CC_SWITCHES = ${CFLAGS} ${CFLAGS_WARNING} ${TCL_SHLIB_CFLAGS} -I"${ZLIB_DIR}" \ -I"${GENERIC_DIR_NATIVE}" -DTCL_TOMMATH -DMP_PREC=4 -I"${TOMMATH_DIR_NATIVE}" \ -I"${WIN_DIR_NATIVE}" ${AC_FLAGS} \ -${COMPILE_DEBUG_FLAGS} +${COMPILE_DEBUG_FLAGS} ${NO_DEPRECATED_FLAGS} CC_OBJNAME = @CC_OBJNAME@ CC_EXENAME = @CC_EXENAME@ @@ -199,8 +207,7 @@ TCLTEST_OBJS = \ tclTestObj.$(OBJEXT) \ tclTestProcBodyObj.$(OBJEXT) \ tclThreadTest.$(OBJEXT) \ - tclWinTest.$(OBJEXT) \ - testMain.$(OBJEXT) + tclWinTest.$(OBJEXT) GENERIC_OBJS = \ regcomp.$(OBJEXT) \ @@ -208,6 +215,7 @@ GENERIC_OBJS = \ regfree.$(OBJEXT) \ regerror.$(OBJEXT) \ tclAlloc.$(OBJEXT) \ + tclAssembly.$(OBJEXT) \ tclAsync.$(OBJEXT) \ tclBasic.$(OBJEXT) \ tclBinary.$(OBJEXT) \ @@ -217,12 +225,15 @@ GENERIC_OBJS = \ tclCmdIL.$(OBJEXT) \ tclCmdMZ.$(OBJEXT) \ tclCompCmds.$(OBJEXT) \ + tclCompCmdsGR.$(OBJEXT) \ + tclCompCmdsSZ.$(OBJEXT) \ tclCompExpr.$(OBJEXT) \ tclCompile.$(OBJEXT) \ tclConfig.$(OBJEXT) \ tclDate.$(OBJEXT) \ tclDictObj.$(OBJEXT) \ tclEncoding.$(OBJEXT) \ + tclEnsemble.$(OBJEXT) \ tclEnv.$(OBJEXT) \ tclEvent.$(OBJEXT) \ tclExecute.$(OBJEXT) \ @@ -237,6 +248,7 @@ GENERIC_OBJS = \ tclIOCmd.$(OBJEXT) \ tclIOGT.$(OBJEXT) \ tclIORChan.$(OBJEXT) \ + tclIORTrans.$(OBJEXT) \ tclIOSock.$(OBJEXT) \ tclIOUtil.$(OBJEXT) \ tclLink.$(OBJEXT) \ @@ -244,10 +256,18 @@ GENERIC_OBJS = \ tclListObj.$(OBJEXT) \ tclLoad.$(OBJEXT) \ tclMain.$(OBJEXT) \ - tclMathOp.$(OBJEXT) \ + tclMain2.$(OBJEXT) \ tclNamesp.$(OBJEXT) \ tclNotify.$(OBJEXT) \ + tclOO.$(OBJEXT) \ + tclOOBasic.$(OBJEXT) \ + tclOOCall.$(OBJEXT) \ + tclOODefineCmds.$(OBJEXT) \ + tclOOInfo.$(OBJEXT) \ + tclOOMethod.$(OBJEXT) \ + tclOOStubInit.$(OBJEXT) \ tclObj.$(OBJEXT) \ + tclOptimize.$(OBJEXT) \ tclPanic.$(OBJEXT) \ tclParse.$(OBJEXT) \ tclPathObj.$(OBJEXT) \ @@ -264,7 +284,6 @@ GENERIC_OBJS = \ tclStringObj.$(OBJEXT) \ tclStrToD.$(OBJEXT) \ tclStubInit.$(OBJEXT) \ - tclStubLib.$(OBJEXT) \ tclThread.$(OBJEXT) \ tclThreadAlloc.$(OBJEXT) \ tclThreadJoin.$(OBJEXT) \ @@ -274,7 +293,8 @@ GENERIC_OBJS = \ tclTrace.$(OBJEXT) \ tclUtf.$(OBJEXT) \ tclUtil.$(OBJEXT) \ - tclVar.$(OBJEXT) + tclVar.$(OBJEXT) \ + tclZlib.$(OBJEXT) TOMMATH_OBJS = \ bncore.${OBJEXT} \ @@ -290,6 +310,7 @@ TOMMATH_OBJS = \ 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} \ @@ -304,6 +325,7 @@ TOMMATH_OBJS = \ 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) \ @@ -321,6 +343,7 @@ TOMMATH_OBJS = \ 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} \ @@ -356,48 +379,48 @@ WIN_OBJS = \ tclWinThrd.$(OBJEXT) \ tclWinTime.$(OBJEXT) -COMPAT_OBJS = \ - strtoll.$(OBJEXT) strtoull.$(OBJEXT) - -PIPE_OBJS = stub16.$(OBJEXT) - DDE_OBJS = tclWinDde.$(OBJEXT) REG_OBJS = tclWinReg.$(OBJEXT) -STUB_OBJS = tclStubLib.$(OBJEXT) +STUB_OBJS = \ + tclStubLib.$(OBJEXT) \ + tclTomMathStubLib.$(OBJEXT) \ + tclOOStubLib.$(OBJEXT) TCLSH_OBJS = tclAppInit.$(OBJEXT) -TCL_OBJS = ${GENERIC_OBJS} $(TOMMATH_OBJS) ${WIN_OBJS} ${COMPAT_OBJS} +ZLIB_OBJS = \ + adler32.$(OBJEXT) \ + compress.$(OBJEXT) \ + crc32.$(OBJEXT) \ + deflate.$(OBJEXT) \ + infback.$(OBJEXT) \ + inffast.$(OBJEXT) \ + inflate.$(OBJEXT) \ + inftrees.$(OBJEXT) \ + trees.$(OBJEXT) \ + uncompr.$(OBJEXT) \ + zutil.$(OBJEXT) + +TCL_OBJS = ${GENERIC_OBJS} $(TOMMATH_OBJS) ${WIN_OBJS} @ZLIB_OBJS@ TCL_DOCS = "$(ROOT_DIR_NATIVE)"/doc/*.[13n] -all: binaries libraries doc +all: binaries libraries doc packages -tcltest: $(TCLTEST) +tcltest: $(TCLSH) $(TEST_DLL_FILE) -binaries: @LIBRARIES@ $(TCLSH) +binaries: $(TCL_STUB_LIB_FILE) @LIBRARIES@ $(DDE_DLL_FILE) $(REG_DLL_FILE) $(TCLSH) libraries: doc: -winhelp: $(ROOT_DIR)/tools/man2help.tcl $(MAN2TCL) - TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \ - ./$(TCLSH) "$(ROOT_DIR_NATIVE)"/tools/man2help.tcl tcl "$(VER)" $(TCL_DOCS) - hcw /c /e tcl.hpj - -$(MAN2TCL): $(ROOT_DIR)/tools/man2tcl.c - $(CC) $(CFLAGS_OPTIMIZE) $(MAN2TCLFLAGS) -o $(MAN2TCL) "$(ROOT_DIR_NATIVE)"/tools/man2tcl.c - -$(TCLSH): $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE) $(TCLSH_OBJS) tclsh.$(RES) - $(CC) $(CFLAGS) $(TCLSH_OBJS) $(TCL_LIB_FILE) $(LIBS) \ - tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE) - -$(TCLTEST): $(TCL_LIB_FILE) $(TCLTEST_OBJS) $(CAT32) tclsh.$(RES) - $(CC) $(CFLAGS) $(TCLTEST_OBJS) $(TCL_LIB_FILE) $(LIBS) \ +$(TCLSH): $(TCLSH_OBJS) @LIBRARIES@ $(TCL_STUB_LIB_FILE) tclsh.$(RES) + $(CC) $(CFLAGS) $(TCLSH_OBJS) $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE) $(LIBS) \ tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE) + @VC_MANIFEST_EMBED_EXE@ cat32.$(OBJEXT): cat.c $(CC) -c $(CC_SWITCHES) @DEPARG@ $(CC_OBJNAME) @@ -410,39 +433,36 @@ $(CAT32): cat32.$(OBJEXT) ${TCL_STUB_LIB_FILE}: ${STUB_OBJS} @$(RM) ${TCL_STUB_LIB_FILE} - @MAKE_LIB@ ${STUB_OBJS} + @MAKE_STUB_LIB@ ${STUB_OBJS} @POST_MAKE_LIB@ -${TCL_DLL_FILE}: ${TCL_OBJS} tcl.$(RES) - @$(RM) ${TCL_DLL_FILE} +${TCL_DLL_FILE}: ${TCL_OBJS} tcl.$(RES) @ZLIB_DLL_FILE@ + @$(RM) ${TCL_DLL_FILE} $(TCL_LIB_FILE) @MAKE_DLL@ ${TCL_OBJS} tcl.$(RES) $(SHLIB_LD_LIBS) + @VC_MANIFEST_EMBED_DLL@ -${TCL_LIB_FILE}: ${TCL_OBJS} +${TCL_LIB_FILE}: ${TCL_OBJS} ${DDE_OBJS} ${REG_OBJS} @$(RM) ${TCL_LIB_FILE} - @MAKE_LIB@ ${TCL_OBJS} + @MAKE_LIB@ ${TCL_OBJS} ${DDE_OBJS} ${REG_OBJS} @POST_MAKE_LIB@ -${DDE_DLL_FILE}: ${DDE_OBJS} ${TCL_STUB_LIB_FILE} - @$(RM) ${DDE_DLL_FILE} +${DDE_DLL_FILE}: ${TCL_STUB_LIB_FILE} ${DDE_OBJS} @MAKE_DLL@ ${DDE_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS) -${DDE_LIB_FILE}: ${DDE_OBJS} ${TCL_LIB_FILE} - @$(RM) ${DDE_LIB_FILE} - @MAKE_LIB@ ${DDE_OBJS} ${TCL_LIB_FILE} - -${REG_DLL_FILE}: ${REG_OBJS} ${TCL_STUB_LIB_FILE} - @$(RM) ${REG_DLL_FILE} +${REG_DLL_FILE}: ${TCL_STUB_LIB_FILE} ${REG_OBJS} @MAKE_DLL@ ${REG_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS) -${REG_LIB_FILE}: ${REG_OBJS} ${TCL_LIB_FILE} - @$(RM) ${REG_LIB_FILE} - @MAKE_LIB@ ${REG_OBJS} ${TCL_LIB_FILE} +${TEST_DLL_FILE}: ${TCL_STUB_LIB_FILE} ${TCLTEST_OBJS} + @$(RM) ${TEST_DLL_FILE} ${TEST_LIB_FILE} + @MAKE_DLL@ ${TCLTEST_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS) -# 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) +# use pre-built zlib1.dll +${ZLIB_DLL_FILE}: ${TCL_STUB_LIB_FILE} + @if test "@ZLIB_LIBS@set" != "${ZLIB_DIR}/win32/zdll.libset" ; then \ + $(COPY) $(ZLIB_DIR)/win64/${ZLIB_DLL_FILE} ${ZLIB_DLL_FILE}; \ + else \ + $(COPY) $(ZLIB_DIR)/win32/${ZLIB_DLL_FILE} ${ZLIB_DLL_FILE}; \ + fi; # Add the object extension to the implicit rules. By default .obj is not # automatically added. @@ -457,31 +477,13 @@ tclWinInit.${OBJEXT}: tclWinInit.c $(CC) -c $(CC_SWITCHES) -DBUILD_tcl $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME) tclWinPipe.${OBJEXT}: tclWinPipe.c - $(CC) -c $(CC_SWITCHES) -DBUILD_tcl -DTCL_PIPE_DLL=\"$(PIPE_DLL_FILE)\" \ - $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME) + $(CC) -c $(CC_SWITCHES) -DBUILD_tcl $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME) testMain.${OBJEXT}: tclAppInit.c $(CC) -c $(CC_SWITCHES) -DTCL_TEST @DEPARG@ $(CC_OBJNAME) -tclTest.${OBJEXT}: tclTest.c - $(CC) -c $(CC_SWITCHES) @DEPARG@ $(CC_OBJNAME) - -tclTestObj.${OBJEXT}: tclTestObj.c - $(CC) -c $(CC_SWITCHES) @DEPARG@ $(CC_OBJNAME) - -tclWinTest.${OBJEXT}: tclWinTest.c - $(CC) -c $(CC_SWITCHES) @DEPARG@ $(CC_OBJNAME) - -tclAppInit.${OBJEXT} : tclAppInit.c - $(CC) -c $(CC_SWITCHES) @DEPARG@ $(CC_OBJNAME) - -# The following objects should be built using the stub interfaces - -tclWinReg.${OBJEXT} : tclWinReg.c - $(CC) -c $(CC_SWITCHES) -DUSE_TCL_STUBS @DEPARG@ $(CC_OBJNAME) - -tclWinDde.${OBJEXT} : tclWinDde.c - $(CC) -c $(CC_SWITCHES) -DUSE_TCL_STUBS @DEPARG@ $(CC_OBJNAME) +tclMain2.${OBJEXT}: tclMain.c + $(CC) -c $(CC_SWITCHES) -DBUILD_tcl -DTCL_ASCII_MAIN @DEPARG@ $(CC_OBJNAME) # TIP #59, embedding of configuration information into the binary library. # @@ -513,10 +515,15 @@ tclPkgConfig.${OBJEXT}: tclPkgConfig.c tclStubLib.${OBJEXT}: tclStubLib.c $(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD @DEPARG@ $(CC_OBJNAME) +tclTomMathStubLib.${OBJEXT}: tclTomMathStubLib.c + $(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD @DEPARG@ $(CC_OBJNAME) + +tclOOStubLib.${OBJEXT}: tclOOStubLib.c + $(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD @DEPARG@ $(CC_OBJNAME) # Implicit rule for all object files that will end up in the Tcl library -.c.${OBJEXT}: +%.${OBJEXT}: %.c $(CC) -c $(CC_SWITCHES) -DBUILD_tcl @DEPARG@ $(CC_OBJNAME) .rc.$(RES): @@ -538,11 +545,11 @@ gendate: # 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" + $(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: all install-binaries install-libraries install-doc install-packages install-binaries: binaries @for i in "$(LIB_INSTALL_DIR)" "$(BIN_INSTALL_DIR)" ; \ @@ -554,7 +561,7 @@ install-binaries: binaries else true; \ fi; \ done; - @for i in dde1.3 reg1.2; \ + @for i in dde${DDEDOTVER} reg${REGDOTVER}; \ do \ if [ ! -d $(LIB_INSTALL_DIR)/$$i ] ; then \ echo "Making directory $(LIB_INSTALL_DIR)/$$i"; \ @@ -562,14 +569,14 @@ install-binaries: binaries else true; \ fi; \ done; - @for i in $(TCL_DLL_FILE) $(TCLSH) $(PIPE_DLL_FILE); \ + @for i in $(TCL_DLL_FILE) $(ZLIB_DLL_FILE) $(TCLSH); \ do \ if [ -f $$i ]; then \ echo "Installing $$i to $(BIN_INSTALL_DIR)/"; \ $(COPY) $$i "$(BIN_INSTALL_DIR)"; \ fi; \ done - @for i in tclConfig.sh $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE); \ + @for i in tclConfig.sh tclooConfig.sh $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE); \ do \ if [ -f $$i ]; then \ echo "Installing $$i to $(LIB_INSTALL_DIR)/"; \ @@ -577,24 +584,24 @@ install-binaries: binaries fi; \ done @if [ -f $(DDE_DLL_FILE) ]; then \ - echo installing $(DDE_DLL_FILE); \ - $(COPY) $(DDE_DLL_FILE) $(LIB_INSTALL_DIR)/dde1.3; \ + echo Installing $(DDE_DLL_FILE); \ + $(COPY) $(DDE_DLL_FILE) $(LIB_INSTALL_DIR)/dde${DDEDOTVER}; \ $(COPY) $(ROOT_DIR)/library/dde/pkgIndex.tcl \ - $(LIB_INSTALL_DIR)/dde1.3; \ + $(LIB_INSTALL_DIR)/dde${DDEDOTVER}; \ fi @if [ -f $(DDE_LIB_FILE) ]; then \ - echo installing $(DDE_LIB_FILE); \ - $(COPY) $(DDE_LIB_FILE) $(LIB_INSTALL_DIR)/dde1.3; \ + echo Installing $(DDE_LIB_FILE); \ + $(COPY) $(DDE_LIB_FILE) $(LIB_INSTALL_DIR)/dde${DDEDOTVER}; \ fi @if [ -f $(REG_DLL_FILE) ]; then \ - echo installing $(REG_DLL_FILE); \ - $(COPY) $(REG_DLL_FILE) $(LIB_INSTALL_DIR)/reg1.2; \ + echo Installing $(REG_DLL_FILE); \ + $(COPY) $(REG_DLL_FILE) $(LIB_INSTALL_DIR)/reg${REGDOTVER}; \ $(COPY) $(ROOT_DIR)/library/reg/pkgIndex.tcl \ - $(LIB_INSTALL_DIR)/reg1.2; \ + $(LIB_INSTALL_DIR)/reg${REGDOTVER}; \ fi @if [ -f $(REG_LIB_FILE) ]; then \ - echo installing $(REG_LIB_FILE); \ - $(COPY) $(REG_LIB_FILE) $(LIB_INSTALL_DIR)/reg1.2; \ + echo Installing $(REG_LIB_FILE); \ + $(COPY) $(REG_LIB_FILE) $(LIB_INSTALL_DIR)/reg${REGDOTVER}; \ fi install-libraries: libraries install-tzdata install-msgs @@ -607,7 +614,7 @@ install-libraries: libraries install-tzdata install-msgs else true; \ fi; \ done; - @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; \ + @for i in http1.0 opt0.4 encoding ../tcl8 ../tcl8/8.4 ../tcl8/8.4/platform ../tcl8/8.5 ../tcl8/8.6; \ do \ if [ ! -d $(SCRIPT_INSTALL_DIR)/$$i ] ; then \ echo "Making directory $(SCRIPT_INSTALL_DIR)/$$i"; \ @@ -617,11 +624,10 @@ install-libraries: libraries install-tzdata install-msgs done; @echo "Installing header files"; @for i in "$(GENERIC_DIR)/tcl.h" "$(GENERIC_DIR)/tclDecls.h" \ + "$(GENERIC_DIR)/tclOO.h" "$(GENERIC_DIR)/tclOODecls.h" \ "$(GENERIC_DIR)/tclPlatDecls.h" \ "$(GENERIC_DIR)/tclTomMath.h" \ - "$(GENERIC_DIR)/tclTomMathDecls.h" \ - "$(TOMMATH_DIR)/tommath_class.h" \ - "$(TOMMATH_DIR)/tommath_superclass.h" ; \ + "$(GENERIC_DIR)/tclTomMathDecls.h"; \ do \ $(COPY) "$$i" "$(INCLUDE_INSTALL_DIR)"; \ done; @@ -635,21 +641,21 @@ install-libraries: libraries install-tzdata install-msgs do \ $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/http1.0"; \ done; - @echo "Installing package http 2.5.3 as a Tcl Module"; - @$(COPY) $(ROOT_DIR)/library/http/http.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/http-2.5.3.tm; + @echo "Installing package http 2.8.8 as a Tcl Module"; + @$(COPY) $(ROOT_DIR)/library/http/http.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.6/http-2.8.8.tm; @echo "Installing library opt0.4 directory"; @for j in $(ROOT_DIR)/library/opt/*.tcl; \ do \ $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/opt0.4"; \ done; - @echo "Installing package msgcat 1.4.2 as a Tcl Module"; - @$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/msgcat-1.4.2.tm; - @echo "Installing package tcltest 2.3a1 as a Tcl Module"; - @$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/tcltest-2.3a1.tm; - @echo "Installing package platform 1.0.2 as a Tcl Module"; - @$(COPY) $(ROOT_DIR)/library/platform/platform.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/platform-1.0.2.tm; - @echo "Installing package platform::shell 1.1.3 as a Tcl Module"; - @$(COPY) $(ROOT_DIR)/library/platform/shell.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/platform/shell-1.1.3.tm; + @echo "Installing package msgcat 1.5.2 as a Tcl Module"; + @$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/msgcat-1.5.2.tm; + @echo "Installing package tcltest 2.3.7 as a Tcl Module"; + @$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/tcltest-2.3.7.tm; + @echo "Installing package platform 1.0.12 as a Tcl Module"; + @$(COPY) $(ROOT_DIR)/library/platform/platform.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/platform-1.0.12.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"; \ @@ -657,14 +663,12 @@ install-libraries: libraries install-tzdata install-msgs install-tzdata: @echo "Installing time zone data" - @TCL_LIBRARY="${LIBRARY_DIR}"; export TCL_LIBRARY; \ - ./$(TCLSH) "$(ROOT_DIR)/tools/installData.tcl" \ + @$(TCL_EXE) "$(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" \ + @$(TCL_EXE) "$(ROOT_DIR)/tools/installData.tcl" \ "$(ROOT_DIR)/library/msgs" "$(SCRIPT_INSTALL_DIR)/msgs" install-doc: doc @@ -682,6 +686,7 @@ install-private-headers: libraries @echo "Installing private header files"; @for i in "$(GENERIC_DIR)/tclInt.h" "$(GENERIC_DIR)/tclIntDecls.h" \ "$(GENERIC_DIR)/tclIntPlatDecls.h" "$(GENERIC_DIR)/tclPort.h" \ + "$(GENERIC_DIR)/tclOOInt.h" "$(GENERIC_DIR)/tclOOIntDecls.h" \ "$(WIN_DIR)/tclWinPort.h" ; \ do \ $(COPY) "$$i" "$(PRIVATE_INCLUDE_INSTALL_DIR)"; \ @@ -691,17 +696,21 @@ install-private-headers: libraries # tcltest, i.e.: # % make test TESTFLAGS="-verbose bps -file fileName.test" -test: binaries $(TCLTEST) +test: test-tcl test-packages + +test-tcl: binaries $(TCLSH) $(CAT32) $(TEST_DLL_FILE) TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \ - ./$(TCLTEST) "$(ROOT_DIR_NATIVE)/tests/all.tcl" $(TESTFLAGS) \ - -load "set ::ddelib [file normalize ${DDE_DLL_FILE}]; \ - set ::reglib [file normalize ${REG_DLL_FILE}]" | ./$(CAT32) + ./$(TCLSH) "$(ROOT_DIR_NATIVE)/tests/all.tcl" $(TESTFLAGS) \ + -load "package ifneeded Tcltest ${VERSION}@TCL_PATCH_LEVEL@ [list load [file normalize ${TEST_DLL_FILE}] Tcltest]; \ + package ifneeded dde 1.4.0 [list load [file normalize ${DDE_DLL_FILE}] dde]; \ + package ifneeded registry 1.3.0 [list load [file normalize ${REG_DLL_FILE}] registry]" | ./$(CAT32) -# Useful target to launch a built tcltest with the proper path,... -runtest: binaries $(TCLTEST) +# Useful target to launch a built tclsh with the proper path,... +runtest: binaries $(TCLSH) $(TEST_DLL_FILE) @TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \ - ./$(TCLTEST) $(TESTFLAGS) -load "set ::ddelib [file normalize ${DDE_DLL_FILE}]; \ - set ::reglib [file normalize ${REG_DLL_FILE}]" $(SCRIPT) + ./$(TCLSH) $(TESTFLAGS) -load "package ifneeded Tcltest ${VERSION}@TCL_PATCH_LEVEL@ [list load [file normalize ${TEST_DLL_FILE}] Tcltest]; \ + package ifneeded dde 1.4.0 [list load [file normalize ${DDE_DLL_FILE}] dde]; \ + package ifneeded registry 1.3.0 [list load [file normalize ${REG_DLL_FILE}] registry]" $(SCRIPT) # This target can be used to run tclsh from the build directory via # `make shell SCRIPT=foo.tcl` @@ -723,16 +732,94 @@ Makefile: $(SRC_DIR)/Makefile.in cleanhelp: $(RM) *.hlp *.cnt *.GID *.rtf man2tcl.exe -clean: cleanhelp +clean: cleanhelp clean-packages $(RM) *.lib *.a *.exp *.dll *.$(RES) *.${OBJEXT} *~ \#* TAGS a.out - $(RM) $(TCLSH) $(TCLTEST) $(CAT32) + $(RM) $(TCLSH) $(CAT32) $(RM) *.pch *.ilk *.pdb -distclean: clean +distclean: distclean-packages clean $(RM) Makefile config.status config.cache config.log tclConfig.sh \ tcl.hpj config.status.lineno # +# Bundled package targets +# + +PKG_CFG_ARGS = @PKG_CFG_ARGS@ +PKG_DIR = ./pkgs + +packages: + @builddir=`pwd -P`; \ + for i in $(PKGS_DIR)/*; do \ + if [ -d $$i ] ; then \ + if [ -x $$i/configure ] ; then \ + pkg=`basename $$i`; \ + mkdir -p $(PKG_DIR)/$$pkg; \ + if [ ! -f $(PKG_DIR)/$$pkg/Makefile ]; then \ + ( cd $(PKG_DIR)/$$pkg; \ + echo "Configuring package '$$i' wd = `pwd -P`"; \ + $$i/configure --with-tcl=$$builddir --with-tclinclude=$(GENERIC_DIR) $(PKG_CFG_ARGS) --enable-shared --enable-threads; ) \ + fi ; \ + echo "Building package '$$pkg'"; \ + ( cd $(PKG_DIR)/$$pkg; $(MAKE); ) \ + fi; \ + fi; \ + done; \ + cd $$builddir + +install-packages: packages + @builddir=`pwd -P`; \ + for i in $(PKGS_DIR)/*; do \ + if [ -d $$i ]; then \ + pkg=`basename $$i`; \ + if [ -f $(PKG_DIR)/$$pkg/Makefile ]; then \ + echo "Installing package '$$pkg'"; \ + ( cd $(PKG_DIR)/$$pkg; $(MAKE) install "DESTDIR=$(INSTALL_ROOT)"; ) \ + fi; \ + fi; \ + done; \ + cd $$builddir + +test-packages: tcltest packages + @builddir=`pwd -P`; \ + for i in $(PKGS_DIR)/*; do \ + if [ -d $$i ]; then \ + pkg=`basename $$i`; \ + if [ -f $(PKG_DIR)/$$pkg/Makefile ]; then \ + echo "Testing package '$$pkg'"; \ + ( cd $(PKG_DIR)/$$pkg; $(MAKE) "LD_LIBRARY_PATH=$$builddir:${LD_LIBRARY_PATH}" "TCL_LIBRARY=${TCL_BUILDTIME_LIBRARY}" "TCLLIBPATH=$$builddir/pkgs" test "TCLSH_PROG=$$builddir/${TCLSH}"; ) \ + fi; \ + fi; \ + done; \ + cd $$builddir + +clean-packages: + @builddir=`pwd -P`; \ + for i in $(PKGS_DIR)/*; do \ + if [ -d $$i ]; then \ + pkg=`basename $$i`; \ + if [ -f $(PKG_DIR)/$$pkg/Makefile ]; then \ + ( cd $(PKG_DIR)/$$pkg; $(MAKE) clean; ) \ + fi; \ + fi; \ + done; \ + cd $$builddir + +distclean-packages: + @builddir=`pwd -P`; \ + for i in $(PKGS_DIR)/*; do \ + if [ -d $$i ]; then \ + pkg=`basename $$i`; \ + if [ -f $(PKG_DIR)/$$pkg/Makefile ]; then \ + ( cd $(PKG_DIR)/$$pkg; $(MAKE) distclean; ) \ + fi; \ + cd $$builddir; \ + rm -rf $(PKG_DIR)/$$pkg; \ + fi; \ + done; \ + rm -rf $(PKG_DIR) + +# # Regenerate the stubs files. # @@ -743,8 +830,41 @@ $(GENERIC_DIR)/tclStubInit.c: $(GENERIC_DIR)/tcl.decls \ @echo "This warning can be safely ignored, do not report as a bug!" genstubs: - $(TCL_EXE) "$(ROOT_DIR_NATIVE)\tools\genStubs.tcl" \ + $(TCL_EXE) "$(ROOT_DIR_NATIVE)/tools/genStubs.tcl" \ + "$(GENERIC_DIR_NATIVE)" \ + "$(GENERIC_DIR_NATIVE)/tcl.decls" \ + "$(GENERIC_DIR_NATIVE)/tclInt.decls" \ + "$(GENERIC_DIR_NATIVE)/tclTomMath.decls" + $(TCL_EXE) "$(ROOT_DIR_NATIVE)/tools/genStubs.tcl" \ "$(GENERIC_DIR_NATIVE)" \ - "$(GENERIC_DIR_NATIVE)\tcl.decls" \ - "$(GENERIC_DIR_NATIVE)\tclInt.decls" \ - "$(GENERIC_DIR_NATIVE)\tclTomMath.decls" + "$(GENERIC_DIR_NATIVE)/tclOO.decls" + +# +# This target creates the HTML folder for Tcl & Tk and places it in +# DISTDIR/html. It uses the tcltk-man2html.tcl tool from the Tcl group's tool +# workspace. It depends on the Tcl & Tk being in directories called tcl8.* & +# tk8.* up two directories from the TOOL_DIR. +# + +TOOL_DIR=$(ROOT_DIR)/tools +HTML_INSTALL_DIR=$(ROOT_DIR)/html +html: + $(MAKE) shell SCRIPT="$(TOOL_DIR)/tcltk-man2html.tcl --htmldir=$(HTML_INSTALL_DIR) --srcdir=$(ROOT_DIR)/.. $(BUILD_HTML_FLAGS)" +html-tcl: $(TCLSH) + $(MAKE) shell SCRIPT="$(TOOL_DIR)/tcltk-man2html.tcl --htmldir=$(HTML_INSTALL_DIR) --srcdir=$(ROOT_DIR)/.. $(BUILD_HTML_FLAGS) --tcl" +html-tk: $(TCLSH) + $(MAKE) shell SCRIPT="$(TOOL_DIR)/tcltk-man2html.tcl --htmldir=$(HTML_INSTALL_DIR) --srcdir=$(ROOT_DIR)/.. $(BUILD_HTML_FLAGS) --tk" + +# +# The list of all the targets that do not correspond to real files. This stops +# 'make' from getting confused when someone makes an error in a rule. +# + +.PHONY: all tcltest binaries libraries doc gendate gentommath_h install +.PHONY: install-binaries install-libraries install-tzdata install-msgs +.PHONY: install-doc install-private-headers test test-tcl runtest shell +.PHONY: gdb depend cleanhelp clean distclean packages install-packages +.PHONY: test-packages clean-packages distclean-packages genstubs html +.PHONY: html-tcl html-tk + +# DO NOT DELETE THIS LINE -- make depend depends on it. @@ -1,6 +1,4 @@ -Tcl 8.5 for Windows - -RCS: @(#) $Id: README,v 1.34 2005/07/29 03:47:36 mdejong Exp $ +Tcl 8.6 for Windows 1. Introduction --------------- @@ -10,84 +8,92 @@ version of Tcl. This directory also contains source files for Tcl that are specific to Microsoft Windows. The information in this file is maintained on the web at: - http://www.tcl.tk/doc/howto/compile.html#win -The above URL includes a lengthy discussion of compiler macros necessary -when compiling Tcl extensions that will be dynamically loaded. + http://www.tcl.tk/doc/howto/compile.html#win 2. Compiling Tcl ---------------- In order to compile Tcl for Windows, you need the following: - Tcl 8.5 Source Distribution (plus any patches) + Tcl 8.6 Source Distribution (plus any patches) and - Visual C++ 5 or newer + Visual C++ 6 or newer or - Msys + Mingw + Linux + MinGW-w64 [http://mingw-w64.sourceforge.net/] + (win32 or win64) + + or - http://prdownloads.sourceforge.net/tcl/msys_mingw8.zip + Cygwin + MinGW-w64 [http://cygwin.com/install.html] + (win32 or win64) + + or + + Darwin + MinGW-w64 [http://mingw-w64.sourceforge.net/] + (win32 or win64) + + or + + Msys + MinGW-w64 [http://mingw-w64.sourceforge.net/] + (win32 or win64) + + or + + Msys + MinGW [http://www.mingw.org/download.shtml] + (win32 only) - This Msys + Mingw download is the minimal environment - needed to build Tcl/Tk under Windows. It includes a - shell environment and gcc. The release is designed to - make it as easy a possible to build Tcl/Tk. To install, - you just download the zip file and extract the files - into a directory. The README.TXT file describes how - to launch the msys shell, you then run the configure - script in the tcl/win directory. In practice, this release is built with Visual C++ 6.0 and the TEA Makefile. If you are building with Visual C++, in the "win" subdirectory of the -source release, you will find "makefile.vc". This is the makefile for -the Visual C++ compiler and uses the stock NMAKE tool. Detailed -directions for using it, are in the comments of "makefile.vc". A quick -example would be: +source release, you will find "makefile.vc". This is the makefile for the +Visual C++ compiler and uses the stock NMAKE tool. Detailed directions for +using it, are in the comments of "makefile.vc". A quick example would be: + C:\tcl_source\win\>nmake -f makefile.vc There is also a Developer Studio workspace and project file, too, if you would like to use them. -If you are building with Msys or Cygwin, you can use the configure script -that lives in the win subdirectory. The Msys or Cygwin based configure/build -process works just like the UNIX one, so you will want to refer to -../unix/README for available configure options. An error will be -generated by the configure script if you try to compile Tcl with -the Cygwin version of gcc instead of the Mingw version. Check your -PATH if you get this error. Be aware that gcc will generate -lots of compile time warnings when building Tcl. Warnings are -not errors, so please don't file a bug report about them. +If you are building with Linux, Cygwin or Msys, you can use the configure +script that lives in the win subdirectory. The Linux/Cygwin/Msys based +configure/build process works just like the UNIX one, so you will want +to refer to ../unix/README for available configure options. -In order to use the binaries generated by these makefiles, you will -need to place the Tcl script library files someplace where Tcl can -find them. Tcl looks in one of following places for the library files: +If you want 64-bit executables (x86_64), you need to configure using +the --enable-64bit option. Make sure that the x86_64-w64-mingw32 +compiler is present. For Cygwin this compiler can be found in the +"mingw64-x86_64-gcc-core" package, which can be installed through +the normal Cygwin install process. If you only want 32-bit executables, +the "mingw64-i686-gcc-core" package is what you need. For Linux, Darwin +and Msys, you can download a suitable win32 or win64 compiler from +[https://sourceforge.net/projects/mingw-w64/files/] - 1) The path specified in the environment variable "TCL_LIBRARY". +Use the Makefile "install" target to install Tcl. It will install it +according to the prefix options you provided in the correct directory +structure. - 2) Relative to the directory containing the current .exe. - Tcl will look for a directory "..\lib\tcl8.5" relative to the - directory containing the currently running .exe. - -Note that in order to run tclsh85.exe, you must ensure that tcl85.dll -and tclpip85.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 +tclsh86.exe. Note: Tcl no longer provides support for Win32s. 3. Test suite ------------- -This distribution contains an extensive test suite for Tcl. Some of -the tests are timing dependent and will fail from time to time. If a -test is failing consistently, please send us a bug report with as much -detail as you can manage. Please use the online database at - http://tcl.sourceforge.net/ +This distribution contains an extensive test suite for Tcl. Some of the +tests are timing dependent and will fail from time to time. If a test is +failing consistently, please send us a bug report with as much detail as +you can manage to our tracker: + + http://core.tcl.tk/tcl/reportlist In order to run the test suite, you build the "test" target using the appropriate makefile for your compiler. diff --git a/win/buildall.vc.bat b/win/buildall.vc.bat index 1201bb2..e4f0a30 100755..100644 --- a/win/buildall.vc.bat +++ b/win/buildall.vc.bat @@ -1,9 +1,8 @@ @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 -:: -:: RCS: @(#) $Id: buildall.vc.bat,v 1.9 2005/10/14 12:31:39 patthoyts Exp $ set SYMBOLS= @@ -24,17 +23,25 @@ goto OPTIONS_DONE :: reset errorlevel cd > nul +:: You might have installed your developer studio to add itself to the +:: path or have already run vcvars32.bat. Testing these envars proves +:: cl.exe and friends are in your path. +:: +if defined VCINSTALLDIR (goto :startBuilding) +if defined MSDEVDIR (goto :startBuilding) +if defined MSVCDIR (goto :startBuilding) +if defined MSSDK (goto :startBuilding) +if defined WINDOWSSDKDIR (goto :startBuilding) + :: We need to run the development environment batch script that comes -:: with developer studio (v4,5,6,7,etc...) All have it. These paths -:: might not be correct. You may need to edit these. +:: with developer studio (v4,5,6,7,etc...) All have it. This path +:: might not be correct. You should call it yourself prior to running +:: this batchfile. :: -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 -) +call "C:\Program Files\Microsoft Developer Studio\vc98\bin\vcvars32.bat" +if errorlevel 1 (goto no_vcvars) +:startBuilding echo. echo Sit back and have a cup of coffee while this grinds through ;) @@ -54,45 +61,16 @@ if "%INSTALLDIR%" == "" set INSTALLDIR=C:\Program Files\Tcl :: set OPTS=none if not %SYMBOLS%.==. set OPTS=symbols -nmake -nologo -f makefile.vc release winhelp OPTS=%OPTS% %1 +nmake -nologo -f makefile.vc release htmlhelp OPTS=%OPTS% %1 if errorlevel 1 goto error -:: Build the static core, dlls and shell. -:: -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. +:: Build the static core and shell. :: 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. -:: -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 with a shell. -:: -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 that use the dynamic runtime, -:: but now with thread support. -:: -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 @@ -102,15 +80,15 @@ echo *** BOOM! *** goto end :no_vcvars -echo vcvars32.bat not found. You'll need to edit this batch script. +echo vcvars32.bat was not run prior to this batchfile, nor are the MS tools in your path. goto out :help title buildall.vc.bat help message echo usage: -echo %0 : builds Tcl for all build types (do this first) -echo %0 install : installs all the release builds (do this second) -echo %0 symbols : builds Tcl for all debugging build types +echo %0 : 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 @@ -7,20 +7,25 @@ * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. - * - * RCS: @(#) $Id: cat.c,v 1.3 2005/11/04 00:06:49 dkf Exp $ */ +#ifdef TCL_BROKEN_MAINARGS +/* On mingw32 and cygwin this doesn't work */ +# undef UNICODE +# undef _UNICODE +#endif + #include <stdio.h> #include <io.h> #include <string.h> +#include <tchar.h> int -main(void) +_tmain(void) { char buf[1024]; int n; - char *err; + const char *err; while (1) { n = read(0, buf, sizeof(buf)); diff --git a/win/coffbase.txt b/win/coffbase.txt index 44d7853..bdf5506 100644 --- a/win/coffbase.txt +++ b/win/coffbase.txt @@ -11,8 +11,6 @@ ; maximum size is too small a linker warning will occur. Modules can overlap when ; they're mutually exclusive. This info is placed in the DLL's PE header by the ; linker with the `-base:@$(TCLDIR)\win\coffbase.txt,<key>` option. -; -; RCS: @(#) $Id: coffbase.txt,v 1.8 2004/05/10 18:50:08 davygrvy Exp $ tcl 0x10000000 0x00200000 tcldde 0x10200000 0x00010000 @@ -25,3 +23,20 @@ bltlite 0x10600000 0x00080000 blt 0x10680000 0x00080000 iocpsock 0x10700000 0x00080000 tls 0x10780000 0x00100000 +winico 0x10880000 0x00010000 +sample 0x108B0000 0x00010000 +tile 0x10900000 0x00080000 +memchan 0x109D0000 0x00010000 +tdom 0x109E0000 0x00080000 +tclvfs 0x10A70000 0x00010000 +tkvideo 0x10B00000 0x00010000 +tclsdl 0x10B20000 0x00080000 +vqtcl 0x10C00000 0x00010000 +tdbc 0x10C40000 0x00010000 +thread 0x10C80000 0x00020000 +; +; insert new packages here +; +snack 0x1E000000 0x00400000 +sound 0x1E400000 0x00400000 +snackogg 0x1E800000 0x00200000 diff --git a/win/configure b/win/configure index ec1367a..2affd38 100755 --- a/win/configure +++ b/win/configure @@ -272,7 +272,44 @@ PACKAGE_STRING= PACKAGE_BUGREPORT= ac_unique_file="../generic/tcl.h" -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 AR RANLIB RC SET_MAKE TCL_THREADS CYGPATH CELIB_DIR DL_LIBS CFLAGS_DEBUG CFLAGS_OPTIMIZE CFLAGS_WARNING CFLAGS_DEFAULT LDFLAGS_DEFAULT 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' +# Factoring default headers for most tests. +ac_includes_default="\ +#include <stdio.h> +#if HAVE_SYS_TYPES_H +# include <sys/types.h> +#endif +#if HAVE_SYS_STAT_H +# include <sys/stat.h> +#endif +#if STDC_HEADERS +# include <stdlib.h> +# include <stddef.h> +#else +# if HAVE_STDLIB_H +# include <stdlib.h> +# endif +#endif +#if HAVE_STRING_H +# if !STDC_HEADERS && HAVE_MEMORY_H +# include <memory.h> +# endif +# include <string.h> +#endif +#if HAVE_STRINGS_H +# include <strings.h> +#endif +#if HAVE_INTTYPES_H +# include <inttypes.h> +#else +# if HAVE_STDINT_H +# include <stdint.h> +# endif +#endif +#if HAVE_UNISTD_H +# include <unistd.h> +#endif" + +ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT CPP EGREP AR ac_ct_AR RANLIB ac_ct_RANLIB RC ac_ct_RC SET_MAKE TCL_THREADS CYGPATH CELIB_DIR DL_LIBS CFLAGS_DEBUG CFLAGS_OPTIMIZE CFLAGS_WARNING ZLIB_DLL_FILE ZLIB_LIBS ZLIB_OBJS CFLAGS_DEFAULT LDFLAGS_DEFAULT VC_MANIFEST_EMBED_DLL VC_MANIFEST_EMBED_EXE TCL_WIN_VERSION MACHINE TCL_VERSION TCL_MAJOR_VERSION TCL_MINOR_VERSION TCL_PATCH_LEVEL PKG_CFG_ARGS TCL_EXE TCL_LIB_FILE TCL_LIB_FLAG TCL_STATIC_LIB_FILE TCL_STATIC_LIB_FLAG TCL_IMPORT_LIB_FILE TCL_IMPORT_LIB_FLAG TCL_LIB_SPEC TCL_STUB_LIB_FILE TCL_STUB_LIB_FLAG TCL_STUB_LIB_SPEC TCL_STUB_LIB_PATH TCL_INCLUDE_SPEC TCL_BUILD_STUB_LIB_SPEC TCL_BUILD_STUB_LIB_PATH TCL_DLL_FILE TCL_SRC_DIR TCL_BIN_DIR TCL_DBGX CFG_TCL_SHARED_LIB_SUFFIX CFG_TCL_UNSHARED_LIB_SUFFIX CFG_TCL_EXPORT_FILE_SUFFIX EXTRA_CFLAGS DEPARG CC_OBJNAME CC_EXENAME LDFLAGS_DEBUG LDFLAGS_OPTIMIZE LDFLAGS_CONSOLE LDFLAGS_WINDOW STLIB_LD SHLIB_LD SHLIB_LD_LIBS SHLIB_CFLAGS SHLIB_SUFFIX TCL_SHARED_BUILD LIBS_GUI DLLSUFFIX LIBPREFIX LIBSUFFIX EXESUFFIX LIBRARIES MAKE_LIB MAKE_STUB_LIB POST_MAKE_LIB MAKE_DLL MAKE_EXE TCL_BUILD_LIB_SPEC TCL_LD_SEARCH_FLAGS TCL_NEEDS_EXP_FILE TCL_BUILD_EXP_FILE TCL_EXP_FILE TCL_LIB_VERSIONS_OK TCL_PACKAGE_PATH TCL_DDE_VERSION TCL_DDE_MAJOR_VERSION TCL_DDE_MINOR_VERSION TCL_REG_VERSION TCL_REG_MAJOR_VERSION TCL_REG_MINOR_VERSION RC_OUT RC_TYPE RC_INCLUDE RC_DEFINE RC_DEFINES RES LIBOBJS LTLIBOBJS' ac_subst_files='' # Initialize some variables set by options. @@ -729,6 +766,10 @@ 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. @@ -799,16 +840,18 @@ if test -n "$ac_init_help"; then 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-threads build with threads (default: on) + --enable-shared build and link with shared libraries (default: on) --enable-64bit enable 64bit support (where applicable) --enable-wince enable Win/CE support (where applicable) - --enable-symbols build with debugging symbols --disable-symbols + --enable-symbols build with debugging symbols (default: off) + --enable-embedded-manifest + embed manifest if possible (default: yes) Optional Packages: --with-PACKAGE[=ARG] use PACKAGE [ARG=yes] --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no) - --with-encoding encoding for configuration values + --with-encoding encoding for configuration values --with-celib=DIR use Windows/CE support library from DIR Some influential environment variables: @@ -818,6 +861,7 @@ Some influential environment variables: 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. @@ -910,7 +954,7 @@ esac else echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2 fi - cd "$ac_popdir" + cd $ac_popdir done fi @@ -1264,24 +1308,29 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu # /bin/sh. The bash shell seems to suffer from some strange failures. SHELL=/bin/sh -TCL_VERSION=8.5 +TCL_VERSION=8.6 TCL_MAJOR_VERSION=8 -TCL_MINOR_VERSION=5 -TCL_PATCH_LEVEL="a6" +TCL_MINOR_VERSION=6 +TCL_PATCH_LEVEL=".1" VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION -TCL_DDE_VERSION=1.3 +TCL_DDE_VERSION=1.4 TCL_DDE_MAJOR_VERSION=1 -TCL_DDE_MINOR_VERSION=3 -TCL_DDE_PATCH_LEVEL="2" +TCL_DDE_MINOR_VERSION=4 DDEVER=$TCL_DDE_MAJOR_VERSION$TCL_DDE_MINOR_VERSION -TCL_REG_VERSION=1.2 +TCL_REG_VERSION=1.3 TCL_REG_MAJOR_VERSION=1 -TCL_REG_MINOR_VERSION=2 -TCL_REG_PATCH_LEVEL="" +TCL_REG_MINOR_VERSION=3 REGVER=$TCL_REG_MAJOR_VERSION$TCL_REG_MINOR_VERSION +PKG_CFG_ARGS=$@ + +#------------------------------------------------------------------------ +# Empty slate for bundled packages, to avoid stale configuration +#------------------------------------------------------------------------ +rm -Rf pkgs + #------------------------------------------------------------------------ # Handle the --prefix=... option #------------------------------------------------------------------------ @@ -1873,7 +1922,8 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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' + { 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=$? @@ -1931,7 +1981,8 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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' + { 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=$? @@ -2047,7 +2098,8 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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' + { 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=$? @@ -2101,7 +2153,8 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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' + { 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=$? @@ -2146,7 +2199,8 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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' + { 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=$? @@ -2190,7 +2244,8 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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' + { 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=$? @@ -2230,200 +2285,25 @@ ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $ ac_compiler_gnu=$ac_cv_c_compiler_gnu -# 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. - -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 "$as_me:$LINENO: checking for $ac_word" >&5 -echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 -if test "${ac_cv_prog_AR+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -else - if test -n "$AR"; then - ac_cv_prog_AR="$AR" # Let the user override the test. -else -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then - ac_cv_prog_AR="ar" - echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 - break 2 - fi -done -done - -fi -fi -AR=$ac_cv_prog_AR -if test -n "$AR"; then - echo "$as_me:$LINENO: result: $AR" >&5 -echo "${ECHO_T}$AR" >&6 -else - echo "$as_me:$LINENO: result: no" >&5 -echo "${ECHO_T}no" >&6 -fi - - # 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_RANLIB+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -else - if test -n "$RANLIB"; then - ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test. -else -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then - ac_cv_prog_RANLIB="ranlib" - echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 - break 2 - fi -done -done - -fi -fi -RANLIB=$ac_cv_prog_RANLIB -if test -n "$RANLIB"; then - echo "$as_me:$LINENO: result: $RANLIB" >&5 -echo "${ECHO_T}$RANLIB" >&6 -else - echo "$as_me:$LINENO: result: no" >&5 -echo "${ECHO_T}no" >&6 -fi - - # 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_RC+set}" = set; then +echo "$as_me:$LINENO: checking for inline" >&5 +echo $ECHO_N "checking for inline... $ECHO_C" >&6 +if test "${ac_cv_c_inline+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else - if test -n "$RC"; then - ac_cv_prog_RC="$RC" # Let the user override the test. -else -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then - ac_cv_prog_RC="windres" - echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 - break 2 - fi -done -done - -fi -fi -RC=$ac_cv_prog_RC -if test -n "$RC"; then - echo "$as_me:$LINENO: result: $RC" >&5 -echo "${ECHO_T}$RC" >&6 -else - echo "$as_me:$LINENO: result: no" >&5 -echo "${ECHO_T}no" >&6 -fi - - - if test "${AR}" = "" ; then - { { echo "$as_me:$LINENO: error: Required archive tool 'ar' not found on PATH." >&5 -echo "$as_me: error: Required archive tool 'ar' not found on PATH." >&2;} - { (exit 1); exit 1; }; } - fi - if test "${RANLIB}" = "" ; then - { { echo "$as_me:$LINENO: error: Required archive index tool 'ranlib' not found on PATH." >&5 -echo "$as_me: error: Required archive index tool 'ranlib' not found on PATH." >&2;} - { (exit 1); exit 1; }; } - fi - if test "${RC}" = "" ; then - { { echo "$as_me:$LINENO: error: Required resource tool 'windres' not found on PATH." >&5 -echo "$as_me: error: Required resource tool 'windres' not found on PATH." >&2;} - { (exit 1); exit 1; }; } - fi -fi - -#-------------------------------------------------------------------- -# Checks to see if the make progeam sets the $MAKE variable. -#-------------------------------------------------------------------- - -echo "$as_me:$LINENO: checking whether ${MAKE-make} sets \$(MAKE)" >&5 -echo $ECHO_N "checking whether ${MAKE-make} sets \$(MAKE)... $ECHO_C" >&6 -set dummy ${MAKE-make}; ac_make=`echo "$2" | sed 'y,:./+-,___p_,'` -if eval "test \"\${ac_cv_prog_make_${ac_make}_set+set}\" = set"; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -else - cat >conftest.make <<\_ACEOF -all: - @echo 'ac_maketemp="$(MAKE)"' -_ACEOF -# GNU make sometimes prints "make[1]: Entering...", which would confuse us. -eval `${MAKE-make} -f conftest.make 2>/dev/null | grep temp=` -if test -n "$ac_maketemp"; then - eval ac_cv_prog_make_${ac_make}_set=yes -else - eval ac_cv_prog_make_${ac_make}_set=no -fi -rm -f conftest.make -fi -if eval "test \"`echo '$ac_cv_prog_make_'${ac_make}_set`\" = yes"; then - echo "$as_me:$LINENO: result: yes" >&5 -echo "${ECHO_T}yes" >&6 - SET_MAKE= -else - echo "$as_me:$LINENO: result: no" >&5 -echo "${ECHO_T}no" >&6 - SET_MAKE="MAKE=${MAKE-make}" -fi - - -#-------------------------------------------------------------------- -# Perform additinal compiler tests. -#-------------------------------------------------------------------- - - -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 <<_ACEOF + 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. */ - -#ifdef __CYGWIN__ -#error cygwin +#ifndef __cplusplus +typedef int foo_t; +static $ac_kw foo_t static_foo () {return 0; } +$ac_kw foo_t foo () {return 0; } #endif -int -main () -{ - - ; - return 0; -} _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 @@ -2434,7 +2314,8 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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' + { 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=$? @@ -2446,326 +2327,288 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then - ac_cv_cygwin=no + ac_cv_c_inline=$ac_kw; break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 -ac_cv_cygwin=yes fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +done 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 "$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." >&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 "$as_me:$LINENO: result: $ac_cv_c_inline" >&5 +echo "${ECHO_T}$ac_cv_c_inline" >&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 +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 - if test "$cross_compiling" = yes; then - tcl_cv_seh=no -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. */ - -#define WIN32_LEAN_AND_MEAN -#include <windows.h> -#undef WIN32_LEAN_AND_MEAN - -int main(int argc, char** argv) { - int a, b = 0; - __try { - a = 666 / b; - } - __except (EXCEPTION_EXECUTE_HANDLER) { - return 0; - } - return 1; -} - +#ifdef __STDC__ +# include <limits.h> +#else +# include <assert.h> +#endif + Syntax error _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 +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); }; }; then - tcl_cv_seh=yes + (exit $ac_status); } >/dev/null; then + if test -s conftest.err; then + ac_cpp_err=$ac_c_preproc_warn_flag + ac_cpp_err=$ac_cpp_err$ac_c_werror_flag + else + ac_cpp_err= + fi else - echo "$as_me: program exited with status $ac_status" >&5 -echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -( exit $ac_status ) -tcl_cv_seh=no -fi -rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext + 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 -echo "$as_me:$LINENO: result: $tcl_cv_seh" >&5 -echo "${ECHO_T}$tcl_cv_seh" >&6 -if test "$tcl_cv_seh" = "no" ; then - -cat >>confdefs.h <<\_ACEOF -#define HAVE_NO_SEH 1 -_ACEOF - -fi +rm -f conftest.err conftest.$ac_ext -# -# Check to see if the excpt.h include file provided contains the -# definition for EXCEPTION_DISPOSITION; if not, which is the case -# with Cygwin's version as of 2002-04-10, define it to be int, -# sufficient for getting the current code to work. -# -echo "$as_me:$LINENO: checking for EXCEPTION_DISPOSITION support in include files" >&5 -echo $ECHO_N "checking for EXCEPTION_DISPOSITION support in include files... $ECHO_C" >&6 -if test "${tcl_cv_eh_disposition+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -else + # 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. */ - -#define WIN32_LEAN_AND_MEAN -#include <windows.h> -#undef WIN32_LEAN_AND_MEAN - -int -main () -{ - - EXCEPTION_DISPOSITION x; - - ; - return 0; -} +#include <ac_nonexistent.h> _ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 2>conftest.er1 +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); } && - { 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 + (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 -tcl_cv_eh_disposition=no + # Passes both tests. +ac_preproc_ok=: +break fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +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 -echo "$as_me:$LINENO: result: $tcl_cv_eh_disposition" >&5 -echo "${ECHO_T}$tcl_cv_eh_disposition" >&6 -if test "$tcl_cv_eh_disposition" = "no" ; then -cat >>confdefs.h <<\_ACEOF -#define EXCEPTION_DISPOSITION int -_ACEOF + done + ac_cv_prog_CPP=$CPP fi - - -# Check to see if the winsock2.h include file provided contains -# typedefs like LPFN_ACCEPT and friends. -# -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 + 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. */ - -#define WIN32_LEAN_AND_MEAN -#include <windows.h> -#undef WIN32_LEAN_AND_MEAN -#include <winsock2.h> - -int -main () -{ - - LPFN_ACCEPT accept; - - ; - return 0; -} +#ifdef __STDC__ +# include <limits.h> +#else +# include <assert.h> +#endif + Syntax error _ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 2>conftest.er1 +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); } && - { 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 + (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 -tcl_cv_lpfn_decls=no -fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext - -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 <<\_ACEOF -#define HAVE_NO_LPFN_DECLS 1 -_ACEOF - + # Broken: fails on valid input. +continue fi +rm -f conftest.err conftest.$ac_ext -# Check to see if winnt.h defines CHAR, SHORT, and LONG -# even if VOID has already been #defined. The win32api -# used by mingw and cygwin is known to do this. - -echo "$as_me:$LINENO: checking for winnt.h that ignores VOID define" >&5 -echo $ECHO_N "checking for winnt.h that ignores VOID define... $ECHO_C" >&6 -if test "${tcl_cv_winnt_ignore_void+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -else + # 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. */ - -#define VOID void -#define WIN32_LEAN_AND_MEAN -#include <windows.h> -#undef WIN32_LEAN_AND_MEAN - -int -main () -{ - - CHAR c; - SHORT s; - LONG l; - - ; - return 0; -} +#include <ac_nonexistent.h> _ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 2>conftest.er1 +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); } && - { 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 + (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 -tcl_cv_winnt_ignore_void=no + # Passes both tests. +ac_preproc_ok=: +break fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +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 -echo "$as_me:$LINENO: result: $tcl_cv_winnt_ignore_void" >&5 -echo "${ECHO_T}$tcl_cv_winnt_ignore_void" >&6 -if test "$tcl_cv_winnt_ignore_void" = "yes" ; then -cat >>confdefs.h <<\_ACEOF -#define HAVE_WINNT_IGNORE_VOID 1 -_ACEOF +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 -# Check to see if malloc.h is missing the alloca function -# declaration. This is known to be a problem with Mingw. -# If we compiled without the function declaration, it -# would work but we would get a warning message from gcc. -# If we add the function declaration ourselves, it -# would not compile correctly because the _alloca -# function expects the argument to be passed in a -# register and not on the stack. Instead, we just -# call it from inline asm code. -echo "$as_me:$LINENO: checking for 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 "$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 @@ -2774,18 +2617,15 @@ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ - -#include <malloc.h> +#include <stdlib.h> +#include <stdarg.h> +#include <string.h> +#include <float.h> int main () { - size_t arg = 0; - void* ptr; - ptr = alloca; - ptr = alloca(arg); - ; return 0; } @@ -2799,7 +2639,8 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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' + { 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=$? @@ -2811,35 +2652,61 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then - tcl_cv_malloc_decl_alloca=yes + ac_cv_header_stdc=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 -tcl_cv_malloc_decl_alloca=no +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 -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 +rm -f conftest* -cat >>confdefs.h <<\_ACEOF -#define HAVE_ALLOCA_GCC_INLINE 1 +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* -# See if the compiler supports casting to a union type. -# This is used to stop gcc from printing a compiler -# warning when initializing a union member. +fi -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 +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. */ @@ -2847,202 +2714,337 @@ _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 () { - - union foo { int i; double d; }; - union foo f = (union foo) (int) 0; - - ; - return 0; + 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_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 +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='test -s conftest.$ac_objext' + (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_cast_to_union=yes + : else - echo "$as_me: failed program was:" >&5 + echo "$as_me: program exited with status $ac_status" >&5 +echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 -tcl_cv_cast_to_union=no +( exit $ac_status ) +ac_cv_header_stdc=no fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext - +rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi -echo "$as_me:$LINENO: result: $tcl_cv_cast_to_union" >&5 -echo "${ECHO_T}$tcl_cv_cast_to_union" >&6 -if test "$tcl_cv_cast_to_union" = "yes"; then +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 HAVE_CAST_TO_UNION 1 +#define STDC_HEADERS 1 _ACEOF fi -# See if declarations like FINDEX_INFO_LEVELS are -# missing from winbase.h. This is known to be -# a problem with VC++ 5.2. - -echo "$as_me:$LINENO: checking for FINDEX_INFO_LEVELS in winbase.h" >&5 -echo $ECHO_N "checking for FINDEX_INFO_LEVELS in winbase.h... $ECHO_C" >&6 -if test "${tcl_cv_findex_enums+set}" = set; then +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 - 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 () -{ + if test -n "$AR"; then + ac_cv_prog_AR="$AR" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_AR="${ac_tool_prefix}ar" + echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done +done - FINDEX_INFO_LEVELS i; - FINDEX_SEARCH_OPS j; +fi +fi +AR=$ac_cv_prog_AR +if test -n "$AR"; then + echo "$as_me:$LINENO: result: $AR" >&5 +echo "${ECHO_T}$AR" >&6 +else + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 +fi - ; - 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 +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 - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 + 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 -tcl_cv_findex_enums=no fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +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 -echo "$as_me:$LINENO: result: $tcl_cv_findex_enums" >&5 -echo "${ECHO_T}$tcl_cv_findex_enums" >&6 -if test "$tcl_cv_findex_enums" = "no"; then -cat >>confdefs.h <<\_ACEOF -#define HAVE_NO_FINDEX_ENUMS 1 -_ACEOF +if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}ranlib", so it can be a program name with args. +set dummy ${ac_tool_prefix}ranlib; ac_word=$2 +echo "$as_me:$LINENO: checking for $ac_word" >&5 +echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 +if test "${ac_cv_prog_RANLIB+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + if test -n "$RANLIB"; then + ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_RANLIB="${ac_tool_prefix}ranlib" + echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done +done fi +fi +RANLIB=$ac_cv_prog_RANLIB +if test -n "$RANLIB"; then + echo "$as_me:$LINENO: result: $RANLIB" >&5 +echo "${ECHO_T}$RANLIB" >&6 +else + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 +fi -# See if MWMO_ALERTABLE is missing from winuser.h -# This is known to be a problem with Mingw. - -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 +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 - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ + 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 -#define WIN32_LEAN_AND_MEAN -#include <windows.h> -#undef WIN32_LEAN_AND_MEAN +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 -int -main () -{ + RANLIB=$ac_ct_RANLIB +else + RANLIB="$ac_cv_prog_RANLIB" +fi - int i = MWMO_ALERTABLE; +if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}windres", so it can be a program name with args. +set dummy ${ac_tool_prefix}windres; ac_word=$2 +echo "$as_me:$LINENO: checking for $ac_word" >&5 +echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 +if test "${ac_cv_prog_RC+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + if test -n "$RC"; then + ac_cv_prog_RC="$RC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_RC="${ac_tool_prefix}windres" + echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done +done - ; - 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 +fi +fi +RC=$ac_cv_prog_RC +if test -n "$RC"; then + echo "$as_me:$LINENO: result: $RC" >&5 +echo "${ECHO_T}$RC" >&6 else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 +fi -tcl_cv_mwmo_alertable=no fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +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 -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 +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 -cat >>confdefs.h <<\_ACEOF -#define HAVE_NO_MWMO_ALERTABLE 1 -_ACEOF + RC=$ac_ct_RC +else + RC="$ac_cv_prog_RC" +fi + + +#-------------------------------------------------------------------- +# Checks to see if the make program sets the $MAKE variable. +#-------------------------------------------------------------------- +echo "$as_me:$LINENO: checking whether ${MAKE-make} sets \$(MAKE)" >&5 +echo $ECHO_N "checking whether ${MAKE-make} sets \$(MAKE)... $ECHO_C" >&6 +set dummy ${MAKE-make}; ac_make=`echo "$2" | sed 'y,:./+-,___p_,'` +if eval "test \"\${ac_cv_prog_make_${ac_make}_set+set}\" = set"; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + cat >conftest.make <<\_ACEOF +all: + @echo 'ac_maketemp="$(MAKE)"' +_ACEOF +# GNU make sometimes prints "make[1]: Entering...", which would confuse us. +eval `${MAKE-make} -f conftest.make 2>/dev/null | grep temp=` +if test -n "$ac_maketemp"; then + eval ac_cv_prog_make_${ac_make}_set=yes +else + eval ac_cv_prog_make_${ac_make}_set=no +fi +rm -f conftest.make +fi +if eval "test \"`echo '$ac_cv_prog_make_'${ac_make}_set`\" = yes"; then + echo "$as_me:$LINENO: result: yes" >&5 +echo "${ECHO_T}yes" >&6 + SET_MAKE= +else + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 + SET_MAKE="MAKE=${MAKE-make}" fi + #-------------------------------------------------------------------- # Determines the correct binary file extension (.o, .obj, .exe etc.) #-------------------------------------------------------------------- @@ -3062,12 +3064,12 @@ if test "${enable_threads+set}" = set; then enableval="$enable_threads" tcl_ok=$enableval else - tcl_ok=no + tcl_ok=yes fi; if test "$tcl_ok" = "yes"; then - echo "$as_me:$LINENO: result: yes" >&5 -echo "${ECHO_T}yes" >&6 + echo "$as_me:$LINENO: result: yes (default)" >&5 +echo "${ECHO_T}yes (default)" >&6 TCL_THREADS=1 cat >>confdefs.h <<\_ACEOF #define TCL_THREADS 1 @@ -3081,8 +3083,8 @@ _ACEOF else TCL_THREADS=0 - echo "$as_me:$LINENO: result: no (default)" >&5 -echo "${ECHO_T}no (default)" >&6 + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 fi @@ -3144,7 +3146,8 @@ echo "${ECHO_T}shared" >&6 echo "$as_me:$LINENO: result: static" >&5 echo "${ECHO_T}static" >&6 SHARED_BUILD=0 - cat >>confdefs.h <<\_ACEOF + +cat >>confdefs.h <<\_ACEOF #define STATIC_BUILD 1 _ACEOF @@ -3157,6 +3160,78 @@ _ACEOF # 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? @@ -3203,6 +3278,11 @@ echo "${ECHO_T}$CELIB_DIR" >&6 # Set some defaults (may get changed below) EXTRA_CFLAGS="" +cat >>confdefs.h <<\_ACEOF +#define MODULE_SCOPE extern +_ACEOF + + # Extract the first word of "cygpath", so it can be a program name with args. set dummy cygpath; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 @@ -3242,6 +3322,91 @@ fi SHLIB_SUFFIX=".dll" + # MACHINE is IX86 for LINK, but this is used by the manifest, + # which requires x86|amd64|ia64. + MACHINE="X86" + + if test "$GCC" = "yes"; then + + echo "$as_me:$LINENO: checking for cross-compile version of gcc" >&5 +echo $ECHO_N "checking for cross-compile version of gcc... $ECHO_C" >&6 +if test "${ac_cv_cross+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ + + #ifndef _WIN32 + #error cross-compiler + #endif + +int +main () +{ + + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_cross=no +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_cv_cross=yes +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext + +fi +echo "$as_me:$LINENO: result: $ac_cv_cross" >&5 +echo "${ECHO_T}$ac_cv_cross" >&6 + + if test "$ac_cv_cross" = "yes"; then + case "$do64bit" in + amd64|x64|yes) + CC="x86_64-w64-mingw32-gcc" + LD="x86_64-w64-mingw32-ld" + AR="x86_64-w64-mingw32-ar" + RANLIB="x86_64-w64-mingw32-ranlib" + RC="x86_64-w64-mingw32-windres" + ;; + *) + CC="i686-w64-mingw32-gcc" + LD="i686-w64-mingw32-ld" + AR="i686-w64-mingw32-ar" + RANLIB="i686-w64-mingw32-ranlib" + RC="i686-w64-mingw32-windres" + ;; + esac + fi + fi + # Check for a bug in gcc's windres that causes the # compile to fail when a Windows native path is # passed into windres. The mingw toolchain requires @@ -3275,7 +3440,7 @@ echo "${ECHO_T}yes" >&6 cyg_conftest= fi - if test "$CYGPATH" = "echo" || test "$ac_cv_cygwin" = "yes"; then + if test "$CYGPATH" = "echo"; then DEPARG='"$<"' else DEPARG='"$(shell $(CYGPATH) $<)"' @@ -3283,17 +3448,148 @@ echo "${ECHO_T}yes" >&6 # set various compiler flags depending on whether we are using gcc or cl + if test "${GCC}" = "yes" ; then + extra_cflags="-pipe" + extra_ldflags="-pipe -static-libgcc" + echo "$as_me:$LINENO: checking for mingw32 version of gcc" >&5 +echo $ECHO_N "checking for mingw32 version of gcc... $ECHO_C" >&6 +if test "${ac_cv_win32+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ + + #ifdef _WIN32 + #error win32 + #endif + +int +main () +{ + + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_win32=no +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_cv_win32=yes +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext + +fi +echo "$as_me:$LINENO: result: $ac_cv_win32" >&5 +echo "${ECHO_T}$ac_cv_win32" >&6 + if test "$ac_cv_win32" != "yes"; then + { { echo "$as_me:$LINENO: error: ${CC} cannot produce win32 executables." >&5 +echo "$as_me: error: ${CC} cannot produce win32 executables." >&2;} + { (exit 1); exit 1; }; } + fi + + hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -mwindows -municode -Dmain=xxmain" + echo "$as_me:$LINENO: checking for working -municode linker flag" >&5 +echo $ECHO_N "checking for working -municode linker flag... $ECHO_C" >&6 +if test "${ac_cv_municode+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ + + #include <windows.h> + int APIENTRY wWinMain(HINSTANCE a, HINSTANCE b, LPWSTR c, int d) {return 0;} + +int +main () +{ + + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext conftest$ac_exeext +if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_municode=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_cv_municode=no +fi +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + +fi +echo "$as_me:$LINENO: result: $ac_cv_municode" >&5 +echo "${ECHO_T}$ac_cv_municode" >&6 + CFLAGS=$hold_cflags + if test "$ac_cv_municode" = "yes" ; then + extra_ldflags="$extra_ldflags -municode" + else + extra_cflags="$extra_cflags -DTCL_BROKEN_MAINARGS" + fi + fi + echo "$as_me:$LINENO: checking compiler flags" >&5 echo $ECHO_N "checking compiler flags... $ECHO_C" >&6 if test "${GCC}" = "yes" ; then - if test "$do64bit" != "no" ; then - { echo "$as_me:$LINENO: WARNING: 64bit mode not supported with GCC on Windows" >&5 -echo "$as_me: WARNING: 64bit mode not supported with GCC on Windows" >&2;} - fi SHLIB_LD="" - SHLIB_LD_LIBS="" - LIBS="" - LIBS_GUI="-lgdi32 -lcomdlg32 -limm32 -lcomctl32 -lshell32 -lole32 -loleaut32 -luuid" + SHLIB_LD_LIBS='${LIBS}' + LIBS="-lnetapi32 -lkernel32 -luser32 -ladvapi32 -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= @@ -3301,44 +3597,16 @@ echo "$as_me: WARNING: 64bit mode not supported with GCC on Windows" >&2;} RC_DEFINE=--define RES=res.o MAKE_LIB="\${STLIB_LD} \$@" + MAKE_STUB_LIB="\${STLIB_LD} \$@" POST_MAKE_LIB="\${RANLIB} \$@" MAKE_EXE="\${CC} -o \$@" LIBPREFIX="lib" - #if test "$ac_cv_cygwin" = "yes"; then - # extra_cflags="-mno-cygwin" - # extra_ldflags="-mno-cygwin" - #else - # extra_cflags="" - # extra_ldflags="" - #fi - - if test "$ac_cv_cygwin" = "yes"; then - touch ac$$.c - if ${CC} -c -mwin32 ac$$.c >/dev/null 2>&1; then - case "$extra_cflags" in - *-mwin32*) ;; - *) extra_cflags="-mwin32 $extra_cflags" ;; - esac - case "$extra_ldflags" in - *-mwin32*) ;; - *) extra_ldflags="-mwin32 $extra_ldflags" ;; - esac - fi - rm -f ac$$.o ac$$.c - else - extra_cflags='' - extra_ldflags='' - fi - if test "${SHARED_BUILD}" = "0" ; then # static echo "$as_me:$LINENO: result: using static flags" >&5 echo "${ECHO_T}using static flags" >&6 runtime= - MAKE_DLL="echo " - LIBSUFFIX="s\${DBGX}.a" - LIBFLAGSUFFIX="s\${DBGX}" LIBRARIES="\${STATIC_LIBRARIES}" EXESUFFIX="s\${DBGX}.exe" else @@ -3356,30 +3624,29 @@ echo "$as_me: error: ${CC} does not support the -shared option. fi runtime= - # Link with gcc since ld does not link to default libs like - # -luser32 and -lmsvcrt by default. Make sure CFLAGS is - # included so -mno-cygwin passed the correct libs to the linker. - SHLIB_LD='${CC} -shared ${CFLAGS}' - SHLIB_LD_LIBS='${LIBS}' # Add SHLIB_LD_LIBS to the Make rule, not here. - MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -o \$@ ${extra_ldflags} \ - -Wl,--out-implib,\$(patsubst %.dll,lib%.a,\$@)" - LIBSUFFIX="\${DBGX}.a" - LIBFLAGSUFFIX="\${DBGX}" EXESUFFIX="\${DBGX}.exe" LIBRARIES="\${SHARED_LIBRARIES}" fi + # Link with gcc since ld does not link to default libs like + # -luser32 and -lmsvcrt by default. + SHLIB_LD='${CC} -shared' + SHLIB_LD_LIBS='${LIBS}' + MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -o \$@ ${extra_ldflags} \ + -Wl,--out-implib,\$(patsubst %.dll,lib%.a,\$@)" # DLLSUFFIX is separate because it is the building block for # users of tclConfig.sh that may build shared or static. DLLSUFFIX="\${DBGX}.dll" + LIBSUFFIX="\${DBGX}.a" + LIBFLAGSUFFIX="\${DBGX}" SHLIB_SUFFIX=.dll EXTRA_CFLAGS="${extra_cflags}" CFLAGS_DEBUG=-g CFLAGS_OPTIMIZE="-O2 -fomit-frame-pointer" - CFLAGS_WARNING="-Wall" + CFLAGS_WARNING="-Wall -Wdeclaration-after-statement" LDFLAGS_DEBUG= LDFLAGS_OPTIMIZE= @@ -3404,43 +3671,103 @@ echo "$as_me: error: ${CC} does not support the -shared option. LDFLAGS_CONSOLE="-mconsole ${extra_ldflags}" LDFLAGS_WINDOW="-mwindows ${extra_ldflags}" - # gcc under Windows supports only 32bit builds - MACHINE="X86" + case "$do64bit" in + amd64|x64|yes) + MACHINE="AMD64" ; # assume AMD64 as default 64-bit build + echo "$as_me:$LINENO: result: Using 64-bit $MACHINE mode" >&5 +echo "${ECHO_T} Using 64-bit $MACHINE mode" >&6 + ;; + ia64) + MACHINE="IA64" + echo "$as_me:$LINENO: result: Using 64-bit $MACHINE mode" >&5 +echo "${ECHO_T} Using 64-bit $MACHINE mode" >&6 + ;; + *) + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ + + #ifndef _WIN64 + #error 32-bit + #endif + +int +main () +{ + + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + tcl_win_64bit=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +tcl_win_64bit=no + +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext + if test "$tcl_win_64bit" = "yes" ; then + do64bit=amd64 + MACHINE="AMD64" + echo "$as_me:$LINENO: result: Using 64-bit $MACHINE mode" >&5 +echo "${ECHO_T} Using 64-bit $MACHINE mode" >&6 + fi + ;; + esac else if test "${SHARED_BUILD}" = "0" ; then # static echo "$as_me:$LINENO: result: using static flags" >&5 echo "${ECHO_T}using static flags" >&6 runtime=-MT - MAKE_DLL="echo " - LIBSUFFIX="s\${DBGX}.lib" - LIBFLAGSUFFIX="s\${DBGX}" LIBRARIES="\${STATIC_LIBRARIES}" EXESUFFIX="s\${DBGX}.exe" - SHLIB_LD_LIBS="" else # dynamic echo "$as_me:$LINENO: result: using shared flags" >&5 echo "${ECHO_T}using shared flags" >&6 runtime=-MD # Add SHLIB_LD_LIBS to the Make rule, not here. - MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -out:\$@" - LIBSUFFIX="\${DBGX}.lib" - LIBFLAGSUFFIX="\${DBGX}" - EXESUFFIX="\${DBGX}.exe" LIBRARIES="\${SHARED_LIBRARIES}" - SHLIB_LD_LIBS='${LIBS}' + EXESUFFIX="\${DBGX}.exe" fi + MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -out:\$@" # DLLSUFFIX is separate because it is the building block for # users of tclConfig.sh that may build shared or static. DLLSUFFIX="\${DBGX}.dll" + LIBSUFFIX="\${DBGX}.lib" + LIBFLAGSUFFIX="\${DBGX}" - # This is a 2-stage check to make sure we have the 64-bit SDK - # We have to know where the SDK is installed. + # This is a 2-stage check to make sure we have the 64-bit SDK + # We have to know where the SDK is installed. # This magic is based on MS Platform SDK for Win2003 SP1 - hobbs - # MACHINE is IX86 for LINK, but this is used by the manifest, - # which requires x86|amd64|ia64. - MACHINE="X86" if test "$do64bit" != "no" ; then if test "x${MSSDK}x" = "xx" ; then MSSDK="C:/Progra~1/Microsoft Platform SDK" @@ -3448,14 +3775,14 @@ echo "${ECHO_T}using shared flags" >&6 MSSDK=`echo "$MSSDK" | sed -e 's!\\\!/!g'` PATH64="" case "$do64bit" in - amd64|x64|yes) - MACHINE="AMD64" ; # assume AMD64 as default 64-bit build - PATH64="${MSSDK}/Bin/Win64/x86/AMD64" - ;; - ia64) - MACHINE="IA64" - PATH64="${MSSDK}/Bin/Win64" - ;; + amd64|x64|yes) + MACHINE="AMD64" ; # assume AMD64 as default 64-bit build + PATH64="${MSSDK}/Bin/Win64/x86/AMD64" + ;; + ia64) + MACHINE="IA64" + PATH64="${MSSDK}/Bin/Win64" + ;; esac if test ! -d "${PATH64}" ; then { echo "$as_me:$LINENO: WARNING: Could not find 64-bit $MACHINE SDK to enable 64bit mode" >&5 @@ -3469,12 +3796,77 @@ echo "${ECHO_T} Using 64-bit $MACHINE mode" >&6 fi fi + LIBS="netapi32.lib kernel32.lib 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. @@ -3483,7 +3875,7 @@ echo "${ECHO_T} Using 64-bit $MACHINE mode" >&6 LINKBIN="\"${PATH64}/link.exe\"" # Avoid 'unresolved external symbol __security_cookie' errors. # c.f. http://support.microsoft.com/?id=894573 - LIBS="user32.lib advapi32.lib bufferoverflowU.lib" + LIBS="$LIBS bufferoverflowU.lib" else RC="rc" # -Od - no optimization @@ -3493,7 +3885,6 @@ echo "${ECHO_T} Using 64-bit $MACHINE mode" >&6 CFLAGS_OPTIMIZE="-nologo -O2 ${runtime}" lflags="-nologo" LINKBIN="link" - LIBS="user32.lib advapi32.lib" fi if test "$doWince" != "no" ; then @@ -3599,10 +3990,11 @@ _ACEOF 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 ole32.lib oleaut32.lib uuid.lib" + LIBS_GUI="gdi32.lib comdlg32.lib imm32.lib comctl32.lib shell32.lib uuid.lib" fi SHLIB_LD="${LINKBIN} -dll -incremental:no ${lflags}" + SHLIB_LD_LIBS='${LIBS}' # link -lib only works when -lib is the first arg STLIB_LD="${LINKBIN} -lib ${lflags}" RC_OUT=-fo @@ -3611,13 +4003,17 @@ _ACEOF RC_DEFINE=-d RES=res MAKE_LIB="\${STLIB_LD} -out:\$@" + MAKE_STUB_LIB="\${STLIB_LD} -nodefaultlib -out:\$@" POST_MAKE_LIB= MAKE_EXE="\${CC} -Fe\$@" LIBPREFIX="" + CFLAGS_DEBUG="${CFLAGS_DEBUG} -D_CRT_SECURE_NO_DEPRECATE -D_CRT_NONSTDC_NO_DEPRECATE" + CFLAGS_OPTIMIZE="${CFLAGS_OPTIMIZE} -D_CRT_SECURE_NO_DEPRECATE -D_CRT_NONSTDC_NO_DEPRECATE" + EXTRA_CFLAGS="" CFLAGS_WARNING="-W3" - LDFLAGS_DEBUG="-debug:full" + LDFLAGS_DEBUG="-debug" LDFLAGS_OPTIMIZE="-release" # Specify the CC output file names based on the target name @@ -3642,6 +4038,291 @@ _ACEOF fi + if test "${GCC}" = "yes" ; then + echo "$as_me:$LINENO: checking for SEH support in compiler" >&5 +echo $ECHO_N "checking for SEH support in compiler... $ECHO_C" >&6 +if test "${tcl_cv_seh+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + if test "$cross_compiling" = yes; then + tcl_cv_seh=no +else + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ + + #define WIN32_LEAN_AND_MEAN + #include <windows.h> + #undef WIN32_LEAN_AND_MEAN + + int main(int argc, char** argv) { + int a, b = 0; + __try { + a = 666 / b; + } + __except (EXCEPTION_EXECUTE_HANDLER) { + return 0; + } + return 1; + } + +_ACEOF +rm -f conftest$ac_exeext +if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && { ac_try='./conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + tcl_cv_seh=yes +else + echo "$as_me: program exited with status $ac_status" >&5 +echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +( exit $ac_status ) +tcl_cv_seh=no +fi +rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext +fi + +fi +echo "$as_me:$LINENO: result: $tcl_cv_seh" >&5 +echo "${ECHO_T}$tcl_cv_seh" >&6 + if test "$tcl_cv_seh" = "no" ; then + +cat >>confdefs.h <<\_ACEOF +#define HAVE_NO_SEH 1 +_ACEOF + + fi + + # + # Check to see if the excpt.h include file provided contains the + # definition for EXCEPTION_DISPOSITION; if not, which is the case + # with Cygwin's version as of 2002-04-10, define it to be int, + # sufficient for getting the current code to work. + # + echo "$as_me:$LINENO: checking for EXCEPTION_DISPOSITION support in include files" >&5 +echo $ECHO_N "checking for EXCEPTION_DISPOSITION support in include files... $ECHO_C" >&6 +if test "${tcl_cv_eh_disposition+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ + +# define WIN32_LEAN_AND_MEAN +# include <windows.h> +# undef WIN32_LEAN_AND_MEAN + +int +main () +{ + + EXCEPTION_DISPOSITION x; + + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + tcl_cv_eh_disposition=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +tcl_cv_eh_disposition=no +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext + +fi +echo "$as_me:$LINENO: result: $tcl_cv_eh_disposition" >&5 +echo "${ECHO_T}$tcl_cv_eh_disposition" >&6 + if test "$tcl_cv_eh_disposition" = "no" ; then + +cat >>confdefs.h <<\_ACEOF +#define EXCEPTION_DISPOSITION int +_ACEOF + + fi + + # Check to see if winnt.h defines CHAR, SHORT, and LONG + # even if VOID has already been #defined. The win32api + # used by mingw and cygwin is known to do this. + + echo "$as_me:$LINENO: checking for winnt.h that ignores VOID define" >&5 +echo $ECHO_N "checking for winnt.h that ignores VOID define... $ECHO_C" >&6 +if test "${tcl_cv_winnt_ignore_void+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ + + #define VOID void + #define WIN32_LEAN_AND_MEAN + #include <windows.h> + #undef WIN32_LEAN_AND_MEAN + +int +main () +{ + + CHAR c; + SHORT s; + LONG l; + + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + tcl_cv_winnt_ignore_void=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +tcl_cv_winnt_ignore_void=no +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext + +fi +echo "$as_me:$LINENO: result: $tcl_cv_winnt_ignore_void" >&5 +echo "${ECHO_T}$tcl_cv_winnt_ignore_void" >&6 + if test "$tcl_cv_winnt_ignore_void" = "yes" ; then + +cat >>confdefs.h <<\_ACEOF +#define HAVE_WINNT_IGNORE_VOID 1 +_ACEOF + + fi + + # See if the compiler supports casting to a union type. + # This is used to stop gcc from printing a compiler + # warning when initializing a union member. + + echo "$as_me:$LINENO: checking for cast to union support" >&5 +echo $ECHO_N "checking for cast to union support... $ECHO_C" >&6 +if test "${tcl_cv_cast_to_union+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ + +int +main () +{ + + union foo { int i; double d; }; + union foo f = (union foo) (int) 0; + + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + tcl_cv_cast_to_union=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +tcl_cv_cast_to_union=no +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext + +fi +echo "$as_me:$LINENO: result: $tcl_cv_cast_to_union" >&5 +echo "${ECHO_T}$tcl_cv_cast_to_union" >&6 + if test "$tcl_cv_cast_to_union" = "yes"; then + +cat >>confdefs.h <<\_ACEOF +#define HAVE_CAST_TO_UNION 1 +_ACEOF + + fi + fi + # DL_LIBS is empty, but then we match the Unix version @@ -3649,6 +4330,632 @@ _ACEOF +# Cross-compiling +case ${host_alias} in +*mingw32*) + TCL_EXE="tclsh" + ;; +*) + TCL_EXE="TCL_LIBRARY=\"\${LIBRARY_DIR}\"; export TCL_LIBRARY; ./\${TCLSH}" + ;; +esac + +#------------------------------------------------------------------------ +# Add stuff for zlib; note that this is mostly done in the makefile now +# as we just assume that the platform hasn't got a usable z.lib +#------------------------------------------------------------------------ + +if test "${enable_shared+set}" = "set"; then + + enableval="$enable_shared" + tcl_ok=$enableval + +else + + tcl_ok=yes + +fi + +if test "$tcl_ok" = "yes"; then + + ZLIB_DLL_FILE=\${ZLIB_DLL_FILE} + + if test "$do64bit" = "yes"; then + + if test "$GCC" == "yes"; then + + ZLIB_LIBS=\${ZLIB_DIR}/win64/libz.dll.a + + +else + + ZLIB_LIBS=\${ZLIB_DIR}/win64/zdll.lib + + +fi + + +else + + ZLIB_LIBS=\${ZLIB_DIR}/win32/zdll.lib + + +fi + + +else + + ZLIB_OBJS=\${ZLIB_OBJS} + + +fi + + +cat >>confdefs.h <<\_ACEOF +#define HAVE_ZLIB 1 +_ACEOF + + +echo "$as_me:$LINENO: checking for intptr_t" >&5 +echo $ECHO_N "checking for intptr_t... $ECHO_C" >&6 +if test "${ac_cv_type_intptr_t+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +$ac_includes_default +int +main () +{ +if ((intptr_t *) 0) + return 0; +if (sizeof (intptr_t)) + return 0; + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_type_intptr_t=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_cv_type_intptr_t=no +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +fi +echo "$as_me:$LINENO: result: $ac_cv_type_intptr_t" >&5 +echo "${ECHO_T}$ac_cv_type_intptr_t" >&6 +if test $ac_cv_type_intptr_t = yes; then + + +cat >>confdefs.h <<\_ACEOF +#define HAVE_INTPTR_T 1 +_ACEOF + +else + + echo "$as_me:$LINENO: checking for pointer-size signed integer type" >&5 +echo $ECHO_N "checking for pointer-size signed integer type... $ECHO_C" >&6 +if test "${tcl_cv_intptr_t+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + + for tcl_cv_intptr_t in "int" "long" "long long" none; do + if test "$tcl_cv_intptr_t" != none; then + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +$ac_includes_default +int +main () +{ +static int test_array [1 - 2 * !(sizeof (void *) <= sizeof ($tcl_cv_intptr_t))]; +test_array [0] = 0 + + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + tcl_ok=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +tcl_ok=no +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext + test "$tcl_ok" = yes && break; fi + done +fi +echo "$as_me:$LINENO: result: $tcl_cv_intptr_t" >&5 +echo "${ECHO_T}$tcl_cv_intptr_t" >&6 + if test "$tcl_cv_intptr_t" != none; then + +cat >>confdefs.h <<_ACEOF +#define intptr_t $tcl_cv_intptr_t +_ACEOF + + fi + +fi + +echo "$as_me:$LINENO: checking for uintptr_t" >&5 +echo $ECHO_N "checking for uintptr_t... $ECHO_C" >&6 +if test "${ac_cv_type_uintptr_t+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +$ac_includes_default +int +main () +{ +if ((uintptr_t *) 0) + return 0; +if (sizeof (uintptr_t)) + return 0; + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_type_uintptr_t=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_cv_type_uintptr_t=no +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +fi +echo "$as_me:$LINENO: result: $ac_cv_type_uintptr_t" >&5 +echo "${ECHO_T}$ac_cv_type_uintptr_t" >&6 +if test $ac_cv_type_uintptr_t = yes; then + + +cat >>confdefs.h <<\_ACEOF +#define HAVE_UINTPTR_T 1 +_ACEOF + +else + + echo "$as_me:$LINENO: checking for pointer-size unsigned integer type" >&5 +echo $ECHO_N "checking for pointer-size unsigned integer type... $ECHO_C" >&6 +if test "${tcl_cv_uintptr_t+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + + for tcl_cv_uintptr_t in "unsigned int" "unsigned long" "unsigned long long" \ + none; do + if test "$tcl_cv_uintptr_t" != none; then + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +$ac_includes_default +int +main () +{ +static int test_array [1 - 2 * !(sizeof (void *) <= sizeof ($tcl_cv_uintptr_t))]; +test_array [0] = 0 + + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + tcl_ok=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +tcl_ok=no +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext + test "$tcl_ok" = yes && break; fi + done +fi +echo "$as_me:$LINENO: result: $tcl_cv_uintptr_t" >&5 +echo "${ECHO_T}$tcl_cv_uintptr_t" >&6 + if test "$tcl_cv_uintptr_t" != none; then + +cat >>confdefs.h <<_ACEOF +#define uintptr_t $tcl_cv_uintptr_t +_ACEOF + + fi + +fi + + +#-------------------------------------------------------------------- +# Perform additinal compiler tests. +#-------------------------------------------------------------------- + +# See if declarations like FINDEX_INFO_LEVELS are +# missing from winbase.h. This is known to be +# a problem with VC++ 5.2. + +echo "$as_me:$LINENO: checking for FINDEX_INFO_LEVELS in winbase.h" >&5 +echo $ECHO_N "checking for FINDEX_INFO_LEVELS in winbase.h... $ECHO_C" >&6 +if test "${tcl_cv_findex_enums+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ + +#define WIN32_LEAN_AND_MEAN +#include <windows.h> +#undef WIN32_LEAN_AND_MEAN + +int +main () +{ + + FINDEX_INFO_LEVELS i; + FINDEX_SEARCH_OPS j; + + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + tcl_cv_findex_enums=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +tcl_cv_findex_enums=no +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext + +fi +echo "$as_me:$LINENO: result: $tcl_cv_findex_enums" >&5 +echo "${ECHO_T}$tcl_cv_findex_enums" >&6 +if test "$tcl_cv_findex_enums" = "no"; then + +cat >>confdefs.h <<\_ACEOF +#define HAVE_NO_FINDEX_ENUMS 1 +_ACEOF + +fi + +# See if the compiler supports intrinsics. + +echo "$as_me:$LINENO: checking for intrinsics support in compiler" >&5 +echo $ECHO_N "checking for intrinsics support in compiler... $ECHO_C" >&6 +if test "${tcl_cv_intrinsics+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ + +#define WIN32_LEAN_AND_MEAN +#include <windows.h> +#undef WIN32_LEAN_AND_MEAN +#include <intrin.h> + +int +main () +{ + + __cpuidex(0,0,0); + + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext conftest$ac_exeext +if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + tcl_cv_intrinsics=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +tcl_cv_intrinsics=no +fi +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + +fi +echo "$as_me:$LINENO: result: $tcl_cv_intrinsics" >&5 +echo "${ECHO_T}$tcl_cv_intrinsics" >&6 +if test "$tcl_cv_intrinsics" = "yes"; then + +cat >>confdefs.h <<\_ACEOF +#define HAVE_INTRIN_H 1 +_ACEOF + +fi + +# See if the <wspiapi.h> header file is present + +echo "$as_me:$LINENO: checking for wspiapi.h" >&5 +echo $ECHO_N "checking for wspiapi.h... $ECHO_C" >&6 +if test "${tcl_cv_wspiapi_h+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ + +#include <wspiapi.h> + +int +main () +{ + + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + tcl_cv_wspiapi_h=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +tcl_cv_wspiapi_h=no +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext + +fi +echo "$as_me:$LINENO: result: $tcl_cv_wspiapi_h" >&5 +echo "${ECHO_T}$tcl_cv_wspiapi_h" >&6 +if test "$tcl_cv_wspiapi_h" = "yes"; then + +cat >>confdefs.h <<\_ACEOF +#define HAVE_WSPIAPI_H 1 +_ACEOF + +fi + +# See if declarations like FINDEX_INFO_LEVELS are +# missing from winbase.h. This is known to be +# a problem with VC++ 5.2. + +echo "$as_me:$LINENO: checking for FINDEX_INFO_LEVELS in winbase.h" >&5 +echo $ECHO_N "checking for FINDEX_INFO_LEVELS in winbase.h... $ECHO_C" >&6 +if test "${tcl_cv_findex_enums+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ + +#define WIN32_LEAN_AND_MEAN +#include <windows.h> +#undef WIN32_LEAN_AND_MEAN + +int +main () +{ + + FINDEX_INFO_LEVELS i; + FINDEX_SEARCH_OPS j; + + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + tcl_cv_findex_enums=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +tcl_cv_findex_enums=no +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext + +fi +echo "$as_me:$LINENO: result: $tcl_cv_findex_enums" >&5 +echo "${ECHO_T}$tcl_cv_findex_enums" >&6 +if test "$tcl_cv_findex_enums" = "no"; then + +cat >>confdefs.h <<\_ACEOF +#define HAVE_NO_FINDEX_ENUMS 1 +_ACEOF + +fi + #-------------------------------------------------------------------- # Set the default compiler switches based on the --enable-symbols # option. This macro depends on C flags, and should be called @@ -3670,6 +4977,11 @@ fi; CFLAGS_DEFAULT='$(CFLAGS_OPTIMIZE)' LDFLAGS_DEFAULT='$(LDFLAGS_OPTIMIZE)' DBGX="" + +cat >>confdefs.h <<\_ACEOF +#define NDEBUG 1 +_ACEOF + echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 @@ -3688,24 +5000,23 @@ echo "${ECHO_T}yes (standard debugging)" >&6 fi - cat >>confdefs.h <<\_ACEOF -#define TCL_CFG_DEBUG 1 -_ACEOF - if test "$tcl_ok" = "mem" -o "$tcl_ok" = "all"; then - cat >>confdefs.h <<\_ACEOF + +cat >>confdefs.h <<\_ACEOF #define TCL_MEM_DEBUG 1 _ACEOF fi if test "$tcl_ok" = "compile" -o "$tcl_ok" = "all"; then - cat >>confdefs.h <<\_ACEOF + +cat >>confdefs.h <<\_ACEOF #define TCL_COMPILE_DEBUG 1 _ACEOF - cat >>confdefs.h <<\_ACEOF + +cat >>confdefs.h <<\_ACEOF #define TCL_COMPILE_STATS 1 _ACEOF @@ -3724,6 +5035,65 @@ echo "${ECHO_T}enabled $tcl_ok debugging" >&6 TCL_DBGX=${DBGX} +#-------------------------------------------------------------------- +# Embed the manifest if we can determine how +#-------------------------------------------------------------------- + + + echo "$as_me:$LINENO: checking whether to embed manifest" >&5 +echo $ECHO_N "checking whether to embed manifest... $ECHO_C" >&6 + # Check whether --enable-embedded-manifest or --disable-embedded-manifest was given. +if test "${enable_embedded_manifest+set}" = set; then + enableval="$enable_embedded_manifest" + embed_ok=$enableval +else + embed_ok=yes +fi; + + VC_MANIFEST_EMBED_DLL= + VC_MANIFEST_EMBED_EXE= + result=no + if test "$embed_ok" = "yes" -a "${SHARED_BUILD}" = "1" \ + -a "$GCC" != "yes" ; then + # Add the magic to embed the manifest into the dll/exe + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ + +#if defined(_MSC_VER) && _MSC_VER >= 1400 +print("manifest needed") +#endif + +_ACEOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + $EGREP "manifest needed" >/dev/null 2>&1; then + + # Could do a CHECK_PROG for mt, but should always be with MSVC8+ + # Could add 'if test -f' check, but manifest should be created + # in this compiler case + # Add in a manifest argument that may be specified + # XXX Needs improvement so that the test for existence accounts + # XXX for a provided (known) manifest + VC_MANIFEST_EMBED_DLL="if test -f \$@.manifest ; then mt.exe -nologo -manifest \$@.manifest -outputresource:\$@\;2 ; fi" + VC_MANIFEST_EMBED_EXE="if test -f \$@.manifest ; then mt.exe -nologo -manifest \$@.manifest -outputresource:\$@\;1 ; fi" + result=yes + if test "x" != x ; then + result="yes ()" + fi + +fi +rm -f conftest* + + fi + echo "$as_me:$LINENO: result: $result" >&5 +echo "${ECHO_T}$result" >&6 + + + + #------------------------------------------------------------------------ # tclConfig.sh refers to this by a different name #------------------------------------------------------------------------ @@ -3742,12 +5112,6 @@ eval "TCL_SRC_DIR=\"`cd $srcdir/..; pwd`\"" eval "TCL_DLL_FILE=tcl${VER}${DLLSUFFIX}" -eval "TCL_LIB_FILE=${LIBPREFIX}tcl$VER${LIBSUFFIX}" - -eval "TCL_LIB_FLAG=\"-ltcl${VER}${LIBFLAGSUFFIX}\"" -eval "TCL_BUILD_LIB_SPEC=\"-L`pwd` ${TCL_LIB_FLAG}\"" -eval "TCL_LIB_SPEC=\"-L${libdir} ${TCL_LIB_FLAG}\"" - eval "TCL_STUB_LIB_FILE=\"${LIBPREFIX}tclstub${VER}${LIBSUFFIX}\"" eval "TCL_STUB_LIB_FLAG=\"-ltclstub${VER}${LIBFLAGSUFFIX}\"" eval "TCL_BUILD_STUB_LIB_SPEC=\"-L`pwd` ${TCL_STUB_LIB_FLAG}\"" @@ -3755,6 +5119,10 @@ eval "TCL_STUB_LIB_SPEC=\"-L${libdir} ${TCL_STUB_LIB_FLAG}\"" eval "TCL_BUILD_STUB_LIB_PATH=\"`pwd`/${TCL_STUB_LIB_FILE}\"" eval "TCL_STUB_LIB_PATH=\"${libdir}/${TCL_STUB_LIB_FILE}\"" +eval "TCL_LIB_FILE=\"${LIBPREFIX}tcl${VER}${LIBSUFFIX}\"" +eval "TCL_BUILD_LIB_SPEC=\"-L`pwd` -ltcl${VER}${FLAGSUFFIX}\"" +eval "TCL_LIB_SPEC=\"-L${libdir} -ltcl${VER}${FLAGSUFFIX}\"" + # Install time header dir can be set via --includedir eval "TCL_INCLUDE_SPEC=\"-I${includedir}\"" @@ -3800,6 +5168,25 @@ else TCL_PACKAGE_PATH="${prefix}/lib" fi +# The tclsh.exe.manifest requires these +# TCL_WIN_VERSION is the 4 dotted pair Windows version format which needs +# the release level, and must account for interim release versioning +case "$TCL_PATCH_LEVEL" in + *a*) TCL_RELEASE_LEVEL=0 ;; + *b*) TCL_RELEASE_LEVEL=1 ;; + *) TCL_RELEASE_LEVEL=2 ;; +esac +TCL_WIN_VERSION="$TCL_VERSION.$TCL_RELEASE_LEVEL.`echo $TCL_PATCH_LEVEL | tr -d ab.`" + +# X86|AMD64|IA64 for manifest + + + + + + + + @@ -3861,6 +5248,7 @@ fi + # empty on win, but needs sub'ing @@ -3887,9 +5275,7 @@ fi - - - ac_config_files="$ac_config_files Makefile tclConfig.sh tcl.hpj" + ac_config_files="$ac_config_files Makefile tclConfig.sh tcl.hpj tclsh.exe.manifest" cat >confcache <<\_ACEOF # This file is a shell script that caches the results of configure # tests run on this system so they can be shared between configure @@ -4443,6 +5829,7 @@ do "Makefile" ) CONFIG_FILES="$CONFIG_FILES Makefile" ;; "tclConfig.sh" ) CONFIG_FILES="$CONFIG_FILES tclConfig.sh" ;; "tcl.hpj" ) CONFIG_FILES="$CONFIG_FILES tcl.hpj" ;; + "tclsh.exe.manifest" ) CONFIG_FILES="$CONFIG_FILES tclsh.exe.manifest" ;; *) { { echo "$as_me:$LINENO: error: invalid argument: $ac_config_target" >&5 echo "$as_me: error: invalid argument: $ac_config_target" >&2;} { (exit 1); exit 1; }; };; @@ -4533,9 +5920,14 @@ 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 @@ -4544,14 +5936,27 @@ s,@DL_LIBS@,$DL_LIBS,;t t s,@CFLAGS_DEBUG@,$CFLAGS_DEBUG,;t t s,@CFLAGS_OPTIMIZE@,$CFLAGS_OPTIMIZE,;t t s,@CFLAGS_WARNING@,$CFLAGS_WARNING,;t t +s,@ZLIB_DLL_FILE@,$ZLIB_DLL_FILE,;t t +s,@ZLIB_LIBS@,$ZLIB_LIBS,;t t +s,@ZLIB_OBJS@,$ZLIB_OBJS,;t t s,@CFLAGS_DEFAULT@,$CFLAGS_DEFAULT,;t t s,@LDFLAGS_DEFAULT@,$LDFLAGS_DEFAULT,;t t +s,@VC_MANIFEST_EMBED_DLL@,$VC_MANIFEST_EMBED_DLL,;t t +s,@VC_MANIFEST_EMBED_EXE@,$VC_MANIFEST_EMBED_EXE,;t t +s,@TCL_WIN_VERSION@,$TCL_WIN_VERSION,;t t +s,@MACHINE@,$MACHINE,;t t s,@TCL_VERSION@,$TCL_VERSION,;t t s,@TCL_MAJOR_VERSION@,$TCL_MAJOR_VERSION,;t t s,@TCL_MINOR_VERSION@,$TCL_MINOR_VERSION,;t t s,@TCL_PATCH_LEVEL@,$TCL_PATCH_LEVEL,;t t +s,@PKG_CFG_ARGS@,$PKG_CFG_ARGS,;t t +s,@TCL_EXE@,$TCL_EXE,;t t s,@TCL_LIB_FILE@,$TCL_LIB_FILE,;t t s,@TCL_LIB_FLAG@,$TCL_LIB_FLAG,;t t +s,@TCL_STATIC_LIB_FILE@,$TCL_STATIC_LIB_FILE,;t t +s,@TCL_STATIC_LIB_FLAG@,$TCL_STATIC_LIB_FLAG,;t t +s,@TCL_IMPORT_LIB_FILE@,$TCL_IMPORT_LIB_FILE,;t t +s,@TCL_IMPORT_LIB_FLAG@,$TCL_IMPORT_LIB_FLAG,;t t s,@TCL_LIB_SPEC@,$TCL_LIB_SPEC,;t t s,@TCL_STUB_LIB_FILE@,$TCL_STUB_LIB_FILE,;t t s,@TCL_STUB_LIB_FLAG@,$TCL_STUB_LIB_FLAG,;t t @@ -4588,6 +5993,7 @@ s,@LIBSUFFIX@,$LIBSUFFIX,;t t s,@EXESUFFIX@,$EXESUFFIX,;t t s,@LIBRARIES@,$LIBRARIES,;t t s,@MAKE_LIB@,$MAKE_LIB,;t t +s,@MAKE_STUB_LIB@,$MAKE_STUB_LIB,;t t s,@POST_MAKE_LIB@,$POST_MAKE_LIB,;t t s,@MAKE_DLL@,$MAKE_DLL,;t t s,@MAKE_EXE@,$MAKE_EXE,;t t @@ -4601,11 +6007,9 @@ 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 @@ -4776,6 +6180,11 @@ 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. */ @@ -4814,12 +6223,6 @@ echo "$as_me: error: cannot find input file: $f" >&2;} fi;; esac done` || { (exit 1); exit 1; } - - 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 _ACEOF cat >>$CONFIG_STATUS <<_ACEOF sed "$ac_vpsub @@ -4878,3 +6281,4 @@ if test "$no_create" != yes; then $ac_cs_success || { (exit 1); exit 1; } fi + diff --git a/win/configure.in b/win/configure.in index f27bf9f..77e0327 100644 --- a/win/configure.in +++ b/win/configure.in @@ -2,8 +2,6 @@ # This file is an input file used by the GNU "autoconf" program to # generate the file "configure", which is run during Tcl installation # to configure the system for the local environment. -# -# RCS: @(#) $Id: configure.in,v 1.90 2006/10/23 19:42:20 dgp Exp $ AC_INIT(../generic/tcl.h) AC_PREREQ(2.59) @@ -13,24 +11,29 @@ AC_PREREQ(2.59) # /bin/sh. The bash shell seems to suffer from some strange failures. SHELL=/bin/sh -TCL_VERSION=8.5 +TCL_VERSION=8.6 TCL_MAJOR_VERSION=8 -TCL_MINOR_VERSION=5 -TCL_PATCH_LEVEL="a6" +TCL_MINOR_VERSION=6 +TCL_PATCH_LEVEL=".1" VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION -TCL_DDE_VERSION=1.3 +TCL_DDE_VERSION=1.4 TCL_DDE_MAJOR_VERSION=1 -TCL_DDE_MINOR_VERSION=3 -TCL_DDE_PATCH_LEVEL="2" +TCL_DDE_MINOR_VERSION=4 DDEVER=$TCL_DDE_MAJOR_VERSION$TCL_DDE_MINOR_VERSION -TCL_REG_VERSION=1.2 +TCL_REG_VERSION=1.3 TCL_REG_MAJOR_VERSION=1 -TCL_REG_MINOR_VERSION=2 -TCL_REG_PATCH_LEVEL="" +TCL_REG_MINOR_VERSION=3 REGVER=$TCL_REG_MAJOR_VERSION$TCL_REG_MINOR_VERSION +PKG_CFG_ARGS=$@ + +#------------------------------------------------------------------------ +# Empty slate for bundled packages, to avoid stale configuration +#------------------------------------------------------------------------ +rm -Rf pkgs + #------------------------------------------------------------------------ # Handle the --prefix=... option #------------------------------------------------------------------------ @@ -55,215 +58,185 @@ 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 progeam sets the $MAKE variable. +# Checks to see if the make program sets the $MAKE variable. #-------------------------------------------------------------------- AC_PROG_MAKE_SET #-------------------------------------------------------------------- -# Perform additinal compiler tests. +# Determines the correct binary file extension (.o, .obj, .exe etc.) #-------------------------------------------------------------------- -dnl Currently AC_CYGWIN is disabled since it invokes AC_CANONICAL_HOST -dnl under autoconf 2.5X. -dnl -dnl AC_CYGWIN +AC_OBJEXT +AC_EXEEXT -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 -file for information about building with Mingw.]) -fi +#-------------------------------------------------------------------- +# Check whether --enable-threads or --disable-threads was given. +#-------------------------------------------------------------------- +SC_ENABLE_THREADS -AC_CACHE_CHECK(for SEH support in compiler, - tcl_cv_seh, -AC_TRY_RUN([ -#define WIN32_LEAN_AND_MEAN -#include <windows.h> -#undef WIN32_LEAN_AND_MEAN +#------------------------------------------------------------------------ +# Embedded configuration information, encoding to use for the values, TIP #59 +#------------------------------------------------------------------------ -int main(int argc, char** argv) { - int a, b = 0; - __try { - a = 666 / b; - } - __except (EXCEPTION_EXECUTE_HANDLER) { - return 0; - } - return 1; -} -], - tcl_cv_seh=yes, - tcl_cv_seh=no, - tcl_cv_seh=no) -) -if test "$tcl_cv_seh" = "no" ; then - AC_DEFINE(HAVE_NO_SEH, 1, - [Defined when mingw does not support SEH]) -fi +SC_TCL_CFG_ENCODING -# -# Check to see if the excpt.h include file provided contains the -# definition for EXCEPTION_DISPOSITION; if not, which is the case -# with Cygwin's version as of 2002-04-10, define it to be int, -# sufficient for getting the current code to work. -# -AC_CACHE_CHECK(for EXCEPTION_DISPOSITION support in include files, - tcl_cv_eh_disposition, -AC_TRY_COMPILE([ -#define WIN32_LEAN_AND_MEAN -#include <windows.h> -#undef WIN32_LEAN_AND_MEAN -], -[ - EXCEPTION_DISPOSITION x; -], - tcl_cv_eh_disposition=yes, - tcl_cv_eh_disposition=no) -) -if test "$tcl_cv_eh_disposition" = "no" ; then - AC_DEFINE(EXCEPTION_DISPOSITION, int, - [Defined when cygwin/mingw does not support EXCEPTION DISPOSITION]) -fi +#-------------------------------------------------------------------- +# The statements below define a collection of symbols related to +# building libtcl as a shared library instead of a static library. +#-------------------------------------------------------------------- + +SC_ENABLE_SHARED +#-------------------------------------------------------------------- +# The statements below define a collection of compile flags. This +# macro depends on the value of SHARED_BUILD, and should be called +# after SC_ENABLE_SHARED checks the configure switches. +#-------------------------------------------------------------------- -# Check to see if the winsock2.h include file provided contains -# typedefs like LPFN_ACCEPT and friends. -# -AC_CACHE_CHECK(for LPFN_ACCEPT support in winsock2.h, - tcl_cv_lpfn_decls, +SC_CONFIG_CFLAGS + +# Cross-compiling +case ${host_alias} in +*mingw32*) + TCL_EXE="tclsh" + ;; +*) + TCL_EXE="TCL_LIBRARY=\"\${LIBRARY_DIR}\"; export TCL_LIBRARY; ./\${TCLSH}" + ;; +esac + +#------------------------------------------------------------------------ +# Add stuff for zlib; note that this is mostly done in the makefile now +# as we just assume that the platform hasn't got a usable z.lib +#------------------------------------------------------------------------ + +AS_IF([test "${enable_shared+set}" = "set"], [ + enableval="$enable_shared" + tcl_ok=$enableval +], [ + tcl_ok=yes +]) +AS_IF([test "$tcl_ok" = "yes"], [ + AC_SUBST(ZLIB_DLL_FILE,[\${ZLIB_DLL_FILE}]) + AS_IF([test "$do64bit" = "yes"], [ + AS_IF([test "$GCC" == "yes"],[ + AC_SUBST(ZLIB_LIBS,[\${ZLIB_DIR}/win64/libz.dll.a]) + ], [ + AC_SUBST(ZLIB_LIBS,[\${ZLIB_DIR}/win64/zdll.lib]) + ]) + ], [ + AC_SUBST(ZLIB_LIBS,[\${ZLIB_DIR}/win32/zdll.lib]) + ]) +], [ + AC_SUBST(ZLIB_OBJS,[\${ZLIB_OBJS}]) +]) +AC_DEFINE(HAVE_ZLIB, 1, [Is there an installed zlib?]) + +AC_CHECK_TYPE([intptr_t], [ + AC_DEFINE([HAVE_INTPTR_T], 1, [Do we have the intptr_t type?])], [ + AC_CACHE_CHECK([for pointer-size signed integer type], tcl_cv_intptr_t, [ + for tcl_cv_intptr_t in "int" "long" "long long" none; do + if test "$tcl_cv_intptr_t" != none; then + AC_COMPILE_IFELSE([AC_LANG_BOOL_COMPILE_TRY([AC_INCLUDES_DEFAULT], + [[sizeof (void *) <= sizeof ($tcl_cv_intptr_t)]])], + [tcl_ok=yes], [tcl_ok=no]) + test "$tcl_ok" = yes && break; fi + done]) + if test "$tcl_cv_intptr_t" != none; then + AC_DEFINE_UNQUOTED([intptr_t], [$tcl_cv_intptr_t], [Signed integer + type wide enough to hold a pointer.]) + fi +]) +AC_CHECK_TYPE([uintptr_t], [ + AC_DEFINE([HAVE_UINTPTR_T], 1, [Do we have the uintptr_t type?])], [ + AC_CACHE_CHECK([for pointer-size unsigned integer type], tcl_cv_uintptr_t, [ + for tcl_cv_uintptr_t in "unsigned int" "unsigned long" "unsigned long long" \ + none; do + if test "$tcl_cv_uintptr_t" != none; then + AC_COMPILE_IFELSE([AC_LANG_BOOL_COMPILE_TRY([AC_INCLUDES_DEFAULT], + [[sizeof (void *) <= sizeof ($tcl_cv_uintptr_t)]])], + [tcl_ok=yes], [tcl_ok=no]) + test "$tcl_ok" = yes && break; fi + done]) + if test "$tcl_cv_uintptr_t" != none; then + AC_DEFINE_UNQUOTED([uintptr_t], [$tcl_cv_uintptr_t], [Unsigned integer + type wide enough to hold a pointer.]) + fi +]) + +#-------------------------------------------------------------------- +# Perform additinal compiler tests. +#-------------------------------------------------------------------- + +# See if declarations like FINDEX_INFO_LEVELS are +# missing from winbase.h. This is known to be +# a problem with VC++ 5.2. + +AC_CACHE_CHECK(for FINDEX_INFO_LEVELS in winbase.h, + tcl_cv_findex_enums, AC_TRY_COMPILE([ #define WIN32_LEAN_AND_MEAN #include <windows.h> #undef WIN32_LEAN_AND_MEAN -#include <winsock2.h> ], [ - LPFN_ACCEPT accept; + FINDEX_INFO_LEVELS i; + FINDEX_SEARCH_OPS j; ], - tcl_cv_lpfn_decls=yes, - tcl_cv_lpfn_decls=no) + tcl_cv_findex_enums=yes, + tcl_cv_findex_enums=no) ) -if test "$tcl_cv_lpfn_decls" = "no" ; then - AC_DEFINE(HAVE_NO_LPFN_DECLS, 1, - [Defined when cygwin/mingw does not support LPFN_ACCEPT and friends.]) +if test "$tcl_cv_findex_enums" = "no"; then + AC_DEFINE(HAVE_NO_FINDEX_ENUMS, 1, + [Defined when enums are missing from winbase.h]) fi -# Check to see if winnt.h defines CHAR, SHORT, and LONG -# even if VOID has already been #defined. The win32api -# used by mingw and cygwin is known to do this. +# See if the compiler supports intrinsics. -AC_CACHE_CHECK(for winnt.h that ignores VOID define, - tcl_cv_winnt_ignore_void, -AC_TRY_COMPILE([ -#define VOID void +AC_CACHE_CHECK(for intrinsics support in compiler, + tcl_cv_intrinsics, +AC_TRY_LINK([ #define WIN32_LEAN_AND_MEAN #include <windows.h> #undef WIN32_LEAN_AND_MEAN +#include <intrin.h> ], [ - CHAR c; - SHORT s; - LONG l; -], - tcl_cv_winnt_ignore_void=yes, - tcl_cv_winnt_ignore_void=no) -) -if test "$tcl_cv_winnt_ignore_void" = "yes" ; then - AC_DEFINE(HAVE_WINNT_IGNORE_VOID, 1, - [Defined when cygwin/mingw ignores VOID define in winnt.h]) -fi - -# Check to see if malloc.h is missing the alloca function -# declaration. This is known to be a problem with Mingw. -# If we compiled without the function declaration, it -# would work but we would get a warning message from gcc. -# If we add the function declaration ourselves, it -# would not compile correctly because the _alloca -# function expects the argument to be passed in a -# register and not on the stack. Instead, we just -# call it from inline asm code. - -AC_CACHE_CHECK(for alloca declaration in malloc.h, - tcl_cv_malloc_decl_alloca, -AC_TRY_COMPILE([ -#include <malloc.h> -], -[ - size_t arg = 0; - void* ptr; - ptr = alloca; - ptr = alloca(arg); + __cpuidex(0,0,0); ], - tcl_cv_malloc_decl_alloca=yes, - tcl_cv_malloc_decl_alloca=no) + tcl_cv_intrinsics=yes, + tcl_cv_intrinsics=no) ) -if test "$tcl_cv_malloc_decl_alloca" = "no" && - test "${GCC}" = "yes" ; then - AC_DEFINE(HAVE_ALLOCA_GCC_INLINE, 1, - [Defined when gcc should use inline ASM to call alloca.]) +if test "$tcl_cv_intrinsics" = "yes"; then + AC_DEFINE(HAVE_INTRIN_H, 1, + [Defined when the compilers supports intrinsics]) fi -# See if the compiler supports casting to a union type. -# This is used to stop gcc from printing a compiler -# warning when initializing a union member. +# See if the <wspiapi.h> header file is present -AC_CACHE_CHECK(for cast to union support, - tcl_cv_cast_to_union, -AC_TRY_COMPILE([], -[ - union foo { int i; double d; }; - union foo f = (union foo) (int) 0; -], - tcl_cv_cast_to_union=yes, - tcl_cv_cast_to_union=no) +AC_CACHE_CHECK(for wspiapi.h, + tcl_cv_wspiapi_h, +AC_TRY_COMPILE([ +#include <wspiapi.h> +], [], + tcl_cv_wspiapi_h=yes, + tcl_cv_wspiapi_h=no) ) -if test "$tcl_cv_cast_to_union" = "yes"; then - AC_DEFINE(HAVE_CAST_TO_UNION, 1, - [Defined when compiler supports casting to union type.]) +if test "$tcl_cv_wspiapi_h" = "yes"; then + AC_DEFINE(HAVE_WSPIAPI_H, 1, + [Defined when wspiapi.h exists]) fi - # See if declarations like FINDEX_INFO_LEVELS are # missing from winbase.h. This is known to be # a problem with VC++ 5.2. @@ -287,63 +260,8 @@ if test "$tcl_cv_findex_enums" = "no"; then [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.) -#-------------------------------------------------------------------- - -AC_OBJEXT -AC_EXEEXT - #-------------------------------------------------------------------- -# Check whether --enable-threads or --disable-threads was given. -#-------------------------------------------------------------------- - -SC_ENABLE_THREADS - -#------------------------------------------------------------------------ -# Embedded configuration information, encoding to use for the values, TIP #59 -#------------------------------------------------------------------------ - -SC_TCL_CFG_ENCODING - -#-------------------------------------------------------------------- -# The statements below define a collection of symbols related to -# building libtcl as a shared library instead of a static library. -#-------------------------------------------------------------------- - -SC_ENABLE_SHARED - -#-------------------------------------------------------------------- -# The statements below define a collection of compile flags. This -# macro depends on the value of SHARED_BUILD, and should be called -# after SC_ENABLE_SHARED checks the configure switches. -#-------------------------------------------------------------------- - -SC_CONFIG_CFLAGS - -#-------------------------------------------------------------------- -# Set the default compiler switches based on the --enable-symbols +# Set the default compiler switches based on the --enable-symbols # option. This macro depends on C flags, and should be called # after SC_CONFIG_CFLAGS macro is called. #-------------------------------------------------------------------- @@ -352,6 +270,12 @@ SC_ENABLE_SYMBOLS TCL_DBGX=${DBGX} +#-------------------------------------------------------------------- +# Embed the manifest if we can determine how +#-------------------------------------------------------------------- + +SC_EMBED_MANIFEST + #------------------------------------------------------------------------ # tclConfig.sh refers to this by a different name #------------------------------------------------------------------------ @@ -370,12 +294,6 @@ eval "TCL_SRC_DIR=\"`cd $srcdir/..; pwd`\"" eval "TCL_DLL_FILE=tcl${VER}${DLLSUFFIX}" -eval "TCL_LIB_FILE=${LIBPREFIX}tcl$VER${LIBSUFFIX}" - -eval "TCL_LIB_FLAG=\"-ltcl${VER}${LIBFLAGSUFFIX}\"" -eval "TCL_BUILD_LIB_SPEC=\"-L`pwd` ${TCL_LIB_FLAG}\"" -eval "TCL_LIB_SPEC=\"-L${libdir} ${TCL_LIB_FLAG}\"" - eval "TCL_STUB_LIB_FILE=\"${LIBPREFIX}tclstub${VER}${LIBSUFFIX}\"" eval "TCL_STUB_LIB_FLAG=\"-ltclstub${VER}${LIBFLAGSUFFIX}\"" eval "TCL_BUILD_STUB_LIB_SPEC=\"-L`pwd` ${TCL_STUB_LIB_FLAG}\"" @@ -383,6 +301,10 @@ eval "TCL_STUB_LIB_SPEC=\"-L${libdir} ${TCL_STUB_LIB_FLAG}\"" eval "TCL_BUILD_STUB_LIB_PATH=\"`pwd`/${TCL_STUB_LIB_FILE}\"" eval "TCL_STUB_LIB_PATH=\"${libdir}/${TCL_STUB_LIB_FILE}\"" +eval "TCL_LIB_FILE=\"${LIBPREFIX}tcl${VER}${LIBSUFFIX}\"" +eval "TCL_BUILD_LIB_SPEC=\"-L`pwd` -ltcl${VER}${FLAGSUFFIX}\"" +eval "TCL_LIB_SPEC=\"-L${libdir} -ltcl${VER}${FLAGSUFFIX}\"" + # Install time header dir can be set via --includedir eval "TCL_INCLUDE_SPEC=\"-I${includedir}\"" @@ -428,13 +350,32 @@ else TCL_PACKAGE_PATH="${prefix}/lib" fi +# The tclsh.exe.manifest requires these +# TCL_WIN_VERSION is the 4 dotted pair Windows version format which needs +# the release level, and must account for interim release versioning +case "$TCL_PATCH_LEVEL" in + *a*) TCL_RELEASE_LEVEL=0 ;; + *b*) TCL_RELEASE_LEVEL=1 ;; + *) TCL_RELEASE_LEVEL=2 ;; +esac +TCL_WIN_VERSION="$TCL_VERSION.$TCL_RELEASE_LEVEL.`echo $TCL_PATCH_LEVEL | tr -d ab.`" +AC_SUBST(TCL_WIN_VERSION) +# X86|AMD64|IA64 for manifest +AC_SUBST(MACHINE) + AC_SUBST(TCL_VERSION) AC_SUBST(TCL_MAJOR_VERSION) AC_SUBST(TCL_MINOR_VERSION) AC_SUBST(TCL_PATCH_LEVEL) +AC_SUBST(PKG_CFG_ARGS) +AC_SUBST(TCL_EXE) AC_SUBST(TCL_LIB_FILE) AC_SUBST(TCL_LIB_FLAG) +AC_SUBST(TCL_STATIC_LIB_FILE) +AC_SUBST(TCL_STATIC_LIB_FLAG) +AC_SUBST(TCL_IMPORT_LIB_FILE) +AC_SUBST(TCL_IMPORT_LIB_FLAG) # empty on win AC_SUBST(TCL_LIB_SPEC) AC_SUBST(TCL_STUB_LIB_FILE) @@ -485,6 +426,7 @@ AC_SUBST(LIBSUFFIX) AC_SUBST(EXESUFFIX) AC_SUBST(LIBRARIES) AC_SUBST(MAKE_LIB) +AC_SUBST(MAKE_STUB_LIB) AC_SUBST(POST_MAKE_LIB) AC_SUBST(MAKE_DLL) AC_SUBST(MAKE_EXE) @@ -503,11 +445,9 @@ 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) @@ -517,4 +457,8 @@ AC_SUBST(RC_DEFINE) AC_SUBST(RC_DEFINES) AC_SUBST(RES) -AC_OUTPUT(Makefile tclConfig.sh tcl.hpj) +AC_OUTPUT(Makefile tclConfig.sh tcl.hpj tclsh.exe.manifest) + +dnl Local Variables: +dnl mode: autoconf; +dnl End: diff --git a/win/makefile.bc b/win/makefile.bc index 36ae8c0..a962bc6 100644 --- a/win/makefile.bc +++ b/win/makefile.bc @@ -50,7 +50,6 @@ # # Not yet modified: # - The 'plug-in-DLL' and the associated shell. -# - The programs to create the windows help files. # # Suggestions and / or improvements are always welcome. # @@ -124,20 +123,20 @@ CFG_ENCODING = \"cp1252\" NAMEPREFIX = tcl STUBPREFIX = $(NAMEPREFIX)stub -DOTVERSION = 8.5 -VERSION = 85 +DOTVERSION = 8.6 +VERSION = 86 -DDEVERSION = 13 -DDEDOTVERSION = 1.3 +DDEVERSION = 14 +DDEDOTVERSION = 1.4 -REGVERSION = 11 -REGDOTVERSION = 1.1 +REGVERSION = 13 +REGDOTVERSION = 1.3 BINROOT = .. !IF "$(NODEBUG)" == "1" TMPDIRNAME = Release DBGX = -SYMDEFINES = +SYMDEFINES = -DNDEBUG !ELSE TMPDIRNAME = Debug #DBGX = d @@ -160,8 +159,6 @@ TCLPLUGINDLLNAME = $(NAMEPREFIX)$(VERSION)p$(DBGX).dll TCLPLUGINDLL = $(OUTDIR)\$(TCLPLUGINDLLNAME) TCLSH = $(OUTDIR)\$(NAMEPREFIX)sh$(VERSION)$(DBGX).exe TCLSHP = $(OUTDIR)\$(NAMEPREFIX)shp$(VERSION)$(DBGX).exe -TCLPIPEDLLNAME = $(NAMEPREFIX)pip$(VERSION)$(DBGX).dll -TCLPIPEDLL = $(OUTDIR)\$(TCLPIPEDLLNAME) TCLREGDLLNAME = $(NAMEPREFIX)reg$(REGVERSION)$(DBGX).dll TCLREGDLL = $(OUTDIR)\$(TCLREGDLLNAME) TCLDDEDLLNAME = $(NAMEPREFIX)dde$(DDEVERSION)$(DBGX).dll @@ -193,8 +190,6 @@ TCLOBJS = \ $(TMPDIR)\regexec.obj \ $(TMPDIR)\regfree.obj \ $(TMPDIR)\regerror.obj \ - $(TMPDIR)\strtoll.obj \ - $(TMPDIR)\strtoull.obj \ $(TMPDIR)\tclAlloc.obj \ $(TMPDIR)\tclAsync.obj \ $(TMPDIR)\tclBasic.obj \ @@ -205,12 +200,15 @@ TCLOBJS = \ $(TMPDIR)\tclCmdIL.obj \ $(TMPDIR)\tclCmdMZ.obj \ $(TMPDIR)\tclCompCmds.obj \ + $(TMPDIR)\tclCompCmdsGR.obj \ + $(TMPDIR)\tclCompCmdsSZ.obj \ $(TMPDIR)\tclCompExpr.obj \ $(TMPDIR)\tclCompile.obj \ $(TMPDIR)\tclConfig.obj \ $(TMPDIR)\tclDate.obj \ $(TMPDIR)\tclDictObj.obj \ $(TMPDIR)\tclEncoding.obj \ + $(TMPDIR)\tclEnsemble.obj \ $(TMPDIR)\tclEnv.obj \ $(TMPDIR)\tclEvent.obj \ $(TMPDIR)\tclExecute.obj \ @@ -231,10 +229,17 @@ TCLOBJS = \ $(TMPDIR)\tclListObj.obj \ $(TMPDIR)\tclLoad.obj \ $(TMPDIR)\tclMain.obj \ - $(TMPDIR)\tclMathOp.obj \ $(TMPDIR)\tclNamesp.obj \ $(TMPDIR)\tclNotify.obj \ + $(TMPDIR)\tclOO.obj \ + $(TMPDIR)\tclOOBasic.obj \ + $(TMPDIR)\tclOOCall.obj \ + $(TMPDIR)\tclOODefineCmds.obj \ + $(TMPDIR)\tclOOInfo.obj \ + $(TMPDIR)\tclOOMethod.obj \ + $(TMPDIR)\tclOOStubInit.obj \ $(TMPDIR)\tclObj.obj \ + $(TMPDIR)\tclOptimize.obj \ $(TMPDIR)\tclPanic.obj \ $(TMPDIR)\tclParse.obj \ $(TMPDIR)\tclPipe.obj \ @@ -249,7 +254,6 @@ TCLOBJS = \ $(TMPDIR)\tclScan.obj \ $(TMPDIR)\tclStringObj.obj \ $(TMPDIR)\tclStubInit.obj \ - $(TMPDIR)\tclStubLib.obj \ $(TMPDIR)\tclThread.obj \ $(TMPDIR)\tclThreadJoin.obj \ $(TMPDIR)\tclTimer.obj \ @@ -270,9 +274,13 @@ TCLOBJS = \ $(TMPDIR)\tclWinPipe.obj \ $(TMPDIR)\tclWinSock.obj \ $(TMPDIR)\tclWinThrd.obj \ - $(TMPDIR)\tclWinTime.obj + $(TMPDIR)\tclWinTime.obj \ + $(TMPDIR)\tclZlib.obj -TCLSTUBOBJS = $(TMPDIR)\tclStubLib.obj +TCLSTUBOBJS = \ + $(TMPDIR)\tclStubLib.obj \ + $(TMPDIR)\tclTomMathStubLib.obj \ + $(TMPDIR)\tclOOStubLib.obj WINDIR = $(ROOT)\win GENERICDIR = $(ROOT)\generic @@ -281,6 +289,7 @@ TCL_INCLUDES = -I"$(WINDIR)" -I"$(GENERICDIR)" TCL_DEFINES = $(DEBUGDEFINES) $(THREADDEFINES) $(SYMDEFINES) \ $(PROFDEFINES) $(OPTDEFINES) $(SIXFOURDEFINES) \ -DTCL_CFGVAL_ENCODING=${CFG_ENCODING} +### TODO: Add -DHAVE_ZLIB=1 ###################################################################### # Compiler flags @@ -333,7 +342,7 @@ LNLIBS = import32 cw32mt ###################################################################### release: setup $(TCLSH) dlls -dlls: setup $(TCLPIPEDLL) $(TCLREGDLL) $(TCLDDEDLL) +dlls: setup $(TCLREGDLL) $(TCLDDEDLL) all: setup $(TCLSH) dlls $(CAT32) tcltest: setup $(TCLTEST) dlls $(CAT32) plugin: setup $(TCLPLUGINDLL) $(TCLSHP) @@ -382,11 +391,6 @@ $(TCLTEST): $(TCLTESTOBJS) $(TCLLIB) $(TMPDIR)\$(NAMEPREFIX)sh.res $(TCLTESTOBJS), $@, -x, $(LNLIBS) $(TCLLIB),, $(TMPDIR)\$(NAMEPREFIX)sh.res ! -$(TCLPIPEDLL): $(WINDIR)\stub16.c - $(cc32) $(CFLAGS) -o$(TMPDIR)\stub16.obj $(WINDIR)\stub16.c - $(link32) $(ldebug) $(LNFLAGS) $(LNFLAGS_CONS) $(TOOLS32)\lib\c0x32 \ - $(TMPDIR)\stub16.obj, $@, -x, $(LNLIBS),, $(TMPDIR)\$(NAMEPREFIX).res - $(TCLDDEDLL): $(TMPDIR)\tclWinDde.obj $(TCLSTUBLIB) $(link32) $(ldebug) $(LNFLAGS) $(LNFLAGS_DLL) $(TOOLS32)\lib\c0d32 \ $(TMPDIR)\tclWinDde.obj, $@, -x, $(LNLIBS) $(TCLSTUBLIB),, \ @@ -405,59 +409,61 @@ $(CAT32): $(WINDIR)\cat.c install-binaries: $(TCLSH) $(MKDIR) "$(BIN_INSTALL_DIR)" $(MKDIR) "$(LIB_INSTALL_DIR)" - @echo installing $(TCLDLLNAME) + @echo Installing $(TCLDLLNAME) @copy "$(TCLDLL)" "$(BIN_INSTALL_DIR)" @copy "$(TCLLIB)" "$(LIB_INSTALL_DIR)" - @echo installing "$(TCLSH)" + @echo Installing "$(TCLSH)" @copy "$(TCLSH)" "$(BIN_INSTALL_DIR)" - @echo installing $(TCLPIPEDLLNAME) - @copy "$(TCLPIPEDLL)" "$(BIN_INSTALL_DIR)" - @echo installing $(TCLSTUBLIBNAME) + @echo Installing $(TCLSTUBLIBNAME) @copy "$(TCLSTUBLIB)" "$(LIB_INSTALL_DIR)" + @echo Installing $(WINDIR)\tclooConfig.sh + @copy "$(WINDIR)\tclooConfig.sh" "$(LIB_INSTALL_DIR)" install-libraries: -@$(MKDIR) "$(LIB_INSTALL_DIR)" -@$(MKDIR) "$(INCLUDE_INSTALL_DIR)" -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)" - @echo installing http1.0 + @echo Installing http1.0 -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\http1.0" -@copy "$(ROOT)\library\http1.0\http.tcl" "$(SCRIPT_INSTALL_DIR)\http1.0" -@copy "$(ROOT)\library\http1.0\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\http1.0" - @echo installing http2.4 - -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\http2.4" - -@copy "$(ROOT)\library\http\http.tcl" "$(SCRIPT_INSTALL_DIR)\http2.4" - -@copy "$(ROOT)\library\http\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\http2.4" - @echo installing opt0.4 + @echo Installing http2.8 + -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\http2.8" + -@copy "$(ROOT)\library\http\http.tcl" "$(SCRIPT_INSTALL_DIR)\http2.8" + -@copy "$(ROOT)\library\http\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\http2.8" + @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.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 + @echo Installing msgcat1.5 + -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\msgcat1.5" + -@copy "$(ROOT)\library\msgcat\msgcat.tcl" "$(SCRIPT_INSTALL_DIR)\msgcat1.5" + -@copy "$(ROOT)\library\msgcat\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\msgcat1.5" + @echo Installing tcltest2.3 -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\tcltest2.3" -@copy "$(ROOT)\library\tcltest\tcltest.tcl" "$(SCRIPT_INSTALL_DIR)\tcltest2.3" -@copy "$(ROOT)\library\tcltest\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\tcltest2.3" - @echo installing platform1.0 + @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) + @echo Installing $(TCLDDEDLLNAME) -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\dde1.3" -@copy "$(TCLDDEDLL)" "$(SCRIPT_INSTALL_DIR)\dde1.3" -@copy "$(ROOT)\library\dde\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\dde1.3" - @echo installing $(TCLREGDLLNAME) - -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\reg1.1" - -@copy "$(TCLREGDLL)" "$(SCRIPT_INSTALL_DIR)\reg1.1" - -@copy "$(ROOT)\library\reg\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\reg1.1" - @echo installing encoding files + @echo Installing $(TCLREGDLLNAME) + -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\reg1.2" + -@copy "$(TCLREGDLL)" "$(SCRIPT_INSTALL_DIR)\reg1.3" + -@copy "$(ROOT)\library\reg\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\reg1.2" + @echo Installing encoding files -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\encoding" -@copy "$(ROOT)\library\encoding\*.enc" "$(SCRIPT_INSTALL_DIR)\encoding" - @echo installing library files + @echo Installing library files -@copy "$(GENERICDIR)\tcl.h" "$(INCLUDE_INSTALL_DIR)" -@copy "$(GENERICDIR)\tclDecls.h" "$(INCLUDE_INSTALL_DIR)" + -@copy "$(GENERICDIR)\tclOO.h" "$(INCLUDE_INSTALL_DIR)" + -@copy "$(GENERICDIR)\tclOODecls.h" "$(INCLUDE_INSTALL_DIR)" -@copy "$(GENERICDIR)\tclPlatDecls.h" "$(INCLUDE_INSTALL_DIR)" -@copy "$(ROOT)\library\history.tcl" "$(SCRIPT_INSTALL_DIR)" -@copy "$(ROOT)\library\init.tcl" "$(SCRIPT_INSTALL_DIR)" @@ -477,29 +483,6 @@ genstubs: $(GENERICDIR)\tcl.decls $(GENERICDIR)\tclInt.decls # -# Regenerate the windows help files. -# - -TCLTOOLS = $(ROOT)/tools -MAN2TCL = $(TCLTOOLS)/man2tcl -TCLRTF = $(TCLTOOLS)/tcl.rtf -TCLHPJ = $(TCLTOOLS)/tcl.hpj -MAN2HELP = $(TCLTOOLS)/man2help.tcl -HCRTF = $(TOOLS32)/bin/hcrtf.exe - -winhelp: $(TCLRTF) - cd $(TCLTOOLS) - start /wait $(HCRTF) -xn $(TCLHPJ) - -$(MAN2TCL).exe: $(MAN2TCL).obj - cd $(TCLTOOLS) - $(cc32) /nologo /G4 /ML /O2 $(MAN2TCL).c - -$(TCLRTF): $(MAN2TCL).exe $(TCLSH) - cd $(TCLTOOLS) - ..\win\$(TCLSH) $(MAN2HELP) $(NAMEPREFIX) $(VERSION) $(ROOT)/doc ../../tk$(DOTVERSION)/doc - -# # Special case object file targets # $(TMPDIR)\tclWinInit.obj: $(WINDIR)\tclWinInit.c @@ -545,6 +528,12 @@ $(TMPDIR)\tclWinDde.obj : $(WINDIR)\tclWinDde.c $(TMPDIR)\tclStubLib.obj : $(GENERICDIR)\tclStubLib.c $(cc32) $(TCL_CFLAGS) -DSTATIC_BUILD -o$(TMPDIR)\$@ $? +$(TMPDIR)\tclTomMathStubLib.obj : $(GENERICDIR)\tclTomMathStubLib.c + $(cc32) $(TCL_CFLAGS) -DSTATIC_BUILD -o$(TMPDIR)\$@ $? + +$(TMPDIR)\tclOOStubLib.obj : $(GENERICDIR)\tclOOStubLib.c + $(cc32) $(TCL_CFLAGS) -DSTATIC_BUILD -o$(TMPDIR)\$@ $? + # Dedependency rules diff --git a/win/makefile.vc b/win/makefile.vc index 9f6830e..e5f6c9b 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -1,24 +1,21 @@ -#------------------------------------------------------------------------------ +#------------------------------------------------------------- -*- makefile -*- # makefile.vc -- # # Microsoft Visual C++ makefile for use with nmake.exe v1.62+ (VC++ 5.0+) # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# +# # Copyright (c) 1995-1996 Sun Microsystems, Inc. # Copyright (c) 1998-2000 Ajuba Solutions. # Copyright (c) 2001-2005 ActiveState Corporation. # Copyright (c) 2001-2004 David Gravereaux. -# -#------------------------------------------------------------------------------ -# RCS: @(#) $Id: makefile.vc,v 1.160 2007/02/09 06:43:00 mistachkin Exp $ +# Copyright (c) 2003-2008 Pat Thoyts. #------------------------------------------------------------------------------ -# Check to see we are configured to build with MSVC (MSDEVDIR or MSVCDIR) -# or with the MS Platform SDK (MSSDK). Visual Studio .NET 2003 and 2005 define -# VCINSTALLDIR instead. -!if !defined(MSDEVDIR) && !defined(MSVCDIR) && !defined(MSSDK) && !defined(VCINSTALLDIR) +# Check to see we are configured to build with MSVC (MSDEVDIR, MSVCDIR or +# VCINSTALLDIR) or with the MS Platform SDK (MSSDK or WindowsSDKDir) +!if !defined(MSDEVDIR) && !defined(MSVCDIR) && !defined(VCINSTALLDIR) && !defined(MSSDK) && !defined(WINDOWSSDKDIR) MSG = ^ You need to run vcvars32.bat from Developer Studio or setenv.bat from the^ Platform SDK first to setup the environment. Jump to this line to read^ @@ -46,8 +43,7 @@ the build instructions. # # 3) Targets are: # release -- Builds the core, the shell and the dlls. (default) -# dlls -- Just builds the windows extensions and the 16-bit DOS -# pipe/thunk helper app. +# dlls -- Just builds the windows extensions # shell -- Just builds the shell and the core. # core -- Only builds the core [tclXX.(dll|lib)]. # all -- Builds everything. @@ -61,66 +57,81 @@ the build instructions. # makefile. Helpful to avoid problems when the sources are # refreshed and you rebuild, but can "overbuild" when common # headers like tclInt.h just get small changes. -# winhelp -- Builds the windows .hlp file for Tcl from the troff man -# files found in $(ROOT)\doc . +# htmlhelp -- Builds a Windows .chm help file for Tcl and Tk from the +# troff manual pages found in $(ROOT)\doc. You need to +# have installed the HTML Help Compiler package from Microsoft +# to produce the .chm file. +# winhelp -- (deprecated) Builds the windows .hlp file for Tcl from +# the troff man files found in $(ROOT)\doc. This type of +# help file is deprecated by Microsoft in favour of html +# help files (.chm) # # 4) Macros usable on the commandline: # INSTALLDIR=<path> # Sets where to install Tcl from the built binaries. # C:\Progra~1\Tcl is assumed when not specified. # -# OPTS=static,msvcrt,staticpkg,threads,symbols,profile,loimpact,unchecked,none +# OPTS=loimpact,msvcrt,nothreads,pdbs,profile,static,staticpkg,symbols,thrdalloc,tclalloc,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 +# loimpact = Adds a flag for how NT treats the heap to keep memory +# in use, low. This is said to impact alloc performance. +# msvcrt = Affects the static option only to switch it from # using libcmt(d) as the C runtime [by default] to # msvcrt(d). This is useful for static embedding # support. -# staticpkg = Effects the static option only to switch +# nothreads= Turns off full multithreading support. +# pdbs = Build detached symbols for release builds. +# profile = Adds profiling hooks. Map file is assumed. +# static = Builds a static library of the core instead of a +# dll. The static library will contain the dde and reg +# extensions. External applications who want to use +# this, need to link with the stub library as well as +# the static Tcl library.The shell will be static (and +# large), as well. +# staticpkg = Affects the static option only to switch # tclshXX.exe to have the dde and reg extension linked # inside it. -# threads = Turns on full multithreading support. -# thrdalloc = Use the thread allocator (shared global free pool). -# 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 +# symbols = Debug build. Links to the debug C runtime, disables +# optimizations and creates pdb symbols files. +# thrdalloc = Use the thread allocator (shared global free pool) +# This is the default on threaded builds. +# tclalloc = Use the old non-thread allocator +# 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 +# STATS=compdbg,memdbg,none # Sets optional memory and bytecode compiler debugging code added # to the core. The default is for none. Any combination of the # above may be used (comma separated). 'none' will over-ride # everything to nothing. # -# memdbg = Enables the debugging memory allocator. # compdbg = Enables byte compilation logging. +# memdbg = Enables the debugging memory allocator. # -# CHECKS=nodep,fullwarn,none +# CHECKS=64bit,fullwarn,nodep,none # Sets special macros for checking compatability. # -# nodep = Turns off compatability macros to ensure the core -# isn't being built with deprecated functions. +# 64bit = Enable 64bit portability warnings (if available) # fullwarn = Builds with full compiler and link warnings enabled. # Very verbose. +# nodep = Turns off compatability macros to ensure the core +# isn't being built with deprecated functions. # -# MACHINE=(IX86|IA64|AMD64|ALPHA) +# MACHINE=(ALPHA|AMD64|IA64|IX86) # Set the machine type used for the compiler, linker, and # resource compiler. This hook is needed to tell the tools # when alternate platforms are requested. IX86 is the default -# when not specified. +# when not specified. If the CPU environment variable has been +# set (ie: recent Platform SDK) then MACHINE is set from CPU. # # TMP_DIR=<path> # OUT_DIR=<path> # Hooks to allow the intermediate and output directories to be -# changed. $(OUT_DIR) is assumed to be +# changed. $(OUT_DIR) is assumed to be # $(BINROOT)\(Release|Debug) based on if symbols are requested. # $(TMP_DIR) will de $(OUT_DIR)\<buildtype> by default. # @@ -172,32 +183,21 @@ Please `cd` to its location first. !error $(MSG) !endif -PROJECT = tcl +PROJECT = tcl !include "rules.vc" -STUBPREFIX = $(PROJECT)stub - -!if [nmakehlp -g ../generic/tcl.h TCL_VERSION] == 85 -DOTVERSION = 8.5 -!elseif [nmakehlp -g ../generic/tcl.h TCL_VERSION] == 86 -DOTVERSION = 8.6 -!elseif [nmakehlp -g ../generic/tcl.h TCL_VERSION] == 90 -DOTVERSION = 9.0 -!elseif [nmakehlp -g ../generic/tcl.h TCL_VERSION] == 0 -MSG =^ -Cannot get version string from ../generic/tcl.h -!error $(MSG) -!endif -VERSION = $(DOTVERSION:.=) +STUBPREFIX = $(PROJECT)stub +DOTVERSION = $(TCL_MAJOR_VERSION).$(TCL_MINOR_VERSION) +VERSION = $(TCL_MAJOR_VERSION)$(TCL_MINOR_VERSION) -DDEDOTVERSION = 1.3 +DDEDOTVERSION = 1.4 DDEVERSION = $(DDEDOTVERSION:.=) -REGDOTVERSION = 1.2 +REGDOTVERSION = 1.3 REGVERSION = $(REGDOTVERSION:.=) -BINROOT = . -ROOT = .. +BINROOT = $(MAKEDIR) # originally . +ROOT = $(MAKEDIR)\.. # originally .. TCLIMPLIB = $(OUT_DIR)\$(PROJECT)$(VERSION)$(SUFX).lib TCLLIBNAME = $(PROJECT)$(VERSION)$(SUFX).$(EXT) @@ -208,8 +208,6 @@ TCLSTUBLIB = $(OUT_DIR)\$(TCLSTUBLIBNAME) TCLSHNAME = $(PROJECT)sh$(VERSION)$(SUFX).exe TCLSH = $(OUT_DIR)\$(TCLSHNAME) -TCLPIPEDLLNAME = $(PROJECT)pip$(VERSION)$(SUFX:t=).dll -TCLPIPEDLL = $(OUT_DIR)\$(TCLPIPEDLLNAME) TCLREGLIBNAME = $(PROJECT)reg$(REGVERSION)$(SUFX:t=).$(EXT) TCLREGLIB = $(OUT_DIR)\$(TCLREGLIBNAME) @@ -220,6 +218,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 @@ -229,10 +236,12 @@ INCLUDE_INSTALL_DIR = $(_INSTALLDIR)\include TCLSHOBJS = \ $(TMP_DIR)\tclAppInit.obj \ +!if !$(STATIC_BUILD) !if $(TCL_USE_STATIC_PACKAGES) $(TMP_DIR)\tclWinReg.obj \ $(TMP_DIR)\tclWinDde.obj \ !endif +!endif $(TMP_DIR)\tclsh.res TCLTESTOBJS = \ @@ -241,20 +250,21 @@ TCLTESTOBJS = \ $(TMP_DIR)\tclTestProcBodyObj.obj \ $(TMP_DIR)\tclThreadTest.obj \ $(TMP_DIR)\tclWinTest.obj \ +!if !$(STATIC_BUILD) !if $(TCL_USE_STATIC_PACKAGES) $(TMP_DIR)\tclWinReg.obj \ $(TMP_DIR)\tclWinDde.obj \ !endif +!endif $(TMP_DIR)\testMain.obj -TCLOBJS = \ +COREOBJS = \ $(TMP_DIR)\regcomp.obj \ $(TMP_DIR)\regerror.obj \ $(TMP_DIR)\regexec.obj \ $(TMP_DIR)\regfree.obj \ - $(TMP_DIR)\strtoll.obj \ - $(TMP_DIR)\strtoull.obj \ $(TMP_DIR)\tclAlloc.obj \ + $(TMP_DIR)\tclAssembly.obj \ $(TMP_DIR)\tclAsync.obj \ $(TMP_DIR)\tclBasic.obj \ $(TMP_DIR)\tclBinary.obj \ @@ -264,12 +274,15 @@ TCLOBJS = \ $(TMP_DIR)\tclCmdIL.obj \ $(TMP_DIR)\tclCmdMZ.obj \ $(TMP_DIR)\tclCompCmds.obj \ + $(TMP_DIR)\tclCompCmdsGR.obj \ + $(TMP_DIR)\tclCompCmdsSZ.obj \ $(TMP_DIR)\tclCompExpr.obj \ $(TMP_DIR)\tclCompile.obj \ $(TMP_DIR)\tclConfig.obj \ $(TMP_DIR)\tclDate.obj \ $(TMP_DIR)\tclDictObj.obj \ $(TMP_DIR)\tclEncoding.obj \ + $(TMP_DIR)\tclEnsemble.obj \ $(TMP_DIR)\tclEnv.obj \ $(TMP_DIR)\tclEvent.obj \ $(TMP_DIR)\tclExecute.obj \ @@ -286,15 +299,24 @@ TCLOBJS = \ $(TMP_DIR)\tclIOSock.obj \ $(TMP_DIR)\tclIOUtil.obj \ $(TMP_DIR)\tclIORChan.obj \ + $(TMP_DIR)\tclIORTrans.obj \ $(TMP_DIR)\tclLink.obj \ $(TMP_DIR)\tclListObj.obj \ $(TMP_DIR)\tclLiteral.obj \ $(TMP_DIR)\tclLoad.obj \ $(TMP_DIR)\tclMain.obj \ - $(TMP_DIR)\tclMathOp.obj \ + $(TMP_DIR)\tclMain2.obj \ $(TMP_DIR)\tclNamesp.obj \ $(TMP_DIR)\tclNotify.obj \ + $(TMP_DIR)\tclOO.obj \ + $(TMP_DIR)\tclOOBasic.obj \ + $(TMP_DIR)\tclOOCall.obj \ + $(TMP_DIR)\tclOODefineCmds.obj \ + $(TMP_DIR)\tclOOInfo.obj \ + $(TMP_DIR)\tclOOMethod.obj \ + $(TMP_DIR)\tclOOStubInit.obj \ $(TMP_DIR)\tclObj.obj \ + $(TMP_DIR)\tclOptimize.obj \ $(TMP_DIR)\tclPanic.obj \ $(TMP_DIR)\tclParse.obj \ $(TMP_DIR)\tclPathObj.obj \ @@ -311,7 +333,6 @@ TCLOBJS = \ $(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 \ @@ -322,20 +343,22 @@ TCLOBJS = \ $(TMP_DIR)\tclUtf.obj \ $(TMP_DIR)\tclUtil.obj \ $(TMP_DIR)\tclVar.obj \ - $(TMP_DIR)\tclWin32Dll.obj \ - $(TMP_DIR)\tclWinChan.obj \ - $(TMP_DIR)\tclWinConsole.obj \ - $(TMP_DIR)\tclWinSerial.obj \ - $(TMP_DIR)\tclWinError.obj \ - $(TMP_DIR)\tclWinFCmd.obj \ - $(TMP_DIR)\tclWinFile.obj \ - $(TMP_DIR)\tclWinInit.obj \ - $(TMP_DIR)\tclWinLoad.obj \ - $(TMP_DIR)\tclWinNotify.obj \ - $(TMP_DIR)\tclWinPipe.obj \ - $(TMP_DIR)\tclWinSock.obj \ - $(TMP_DIR)\tclWinThrd.obj \ - $(TMP_DIR)\tclWinTime.obj \ + $(TMP_DIR)\tclZlib.obj + +ZLIBOBJS = \ + $(TMP_DIR)\adler32.obj \ + $(TMP_DIR)\compress.obj \ + $(TMP_DIR)\crc32.obj \ + $(TMP_DIR)\deflate.obj \ + $(TMP_DIR)\infback.obj \ + $(TMP_DIR)\inffast.obj \ + $(TMP_DIR)\inflate.obj \ + $(TMP_DIR)\inftrees.obj \ + $(TMP_DIR)\trees.obj \ + $(TMP_DIR)\uncompr.obj \ + $(TMP_DIR)\zutil.obj + +TOMMATHOBJS = \ $(TMP_DIR)\bncore.obj \ $(TMP_DIR)\bn_reverse.obj \ $(TMP_DIR)\bn_fast_s_mp_mul_digs.obj \ @@ -349,6 +372,7 @@ TCLOBJS = \ $(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 \ @@ -363,6 +387,7 @@ TCLOBJS = \ $(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 \ @@ -380,6 +405,7 @@ TCLOBJS = \ $(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 \ @@ -396,12 +422,36 @@ TCLOBJS = \ $(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)\bn_s_mp_sub.obj + +PLATFORMOBJS = \ + $(TMP_DIR)\tclWin32Dll.obj \ + $(TMP_DIR)\tclWinChan.obj \ + $(TMP_DIR)\tclWinConsole.obj \ + $(TMP_DIR)\tclWinError.obj \ + $(TMP_DIR)\tclWinFCmd.obj \ + $(TMP_DIR)\tclWinFile.obj \ + $(TMP_DIR)\tclWinInit.obj \ + $(TMP_DIR)\tclWinLoad.obj \ + $(TMP_DIR)\tclWinNotify.obj \ + $(TMP_DIR)\tclWinPipe.obj \ + $(TMP_DIR)\tclWinSerial.obj \ + $(TMP_DIR)\tclWinSock.obj \ + $(TMP_DIR)\tclWinThrd.obj \ + $(TMP_DIR)\tclWinTime.obj \ +!if $(STATIC_BUILD) + $(TMP_DIR)\tclWinReg.obj \ + $(TMP_DIR)\tclWinDde.obj \ +!else $(TMP_DIR)\tcl.res !endif -TCLSTUBOBJS = $(TMP_DIR)\tclStubLib.obj +TCLOBJS = $(COREOBJS) $(ZLIBOBJS) $(TOMMATHOBJS) $(PLATFORMOBJS) + +TCLSTUBOBJS = \ + $(TMP_DIR)\tclStubLib.obj \ + $(TMP_DIR)\tclTomMathStubLib.obj \ + $(TMP_DIR)\tclOOStubLib.obj ### The following paths CANNOT have spaces in them. COMPATDIR = $(ROOT)\compat @@ -410,7 +460,7 @@ GENERICDIR = $(ROOT)\generic TOMMATHDIR = $(ROOT)\libtommath TOOLSDIR = $(ROOT)\tools WINDIR = $(ROOT)\win - +PKGSDIR = $(ROOT)\pkgs #--------------------------------------------------------------------- # Compile flags @@ -423,23 +473,20 @@ cdebug = -O2 $(OPTIMIZATIONS) !else cdebug = !endif -!else if "$(MACHINE)" == "IA64" +!if $(SYMBOLS) +cdebug = $(cdebug) -Zi +!endif +!else if "$(MACHINE)" == "IA64" || "$(MACHINE)" == "AMD64" ### Warnings are too many, can't support warnings into errors. -cdebug = -Z7 -Od $(DEBUGFLAGS) +cdebug = -Zi -Od $(DEBUGFLAGS) !else -cdebug = -Z7 -WX $(DEBUGFLAGS) +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 $(DEBUG) && !$(UNCHECKED) crt = -MDd @@ -455,9 +502,8 @@ crt = -MT !endif TCL_INCLUDES = -I"$(WINDIR)" -I"$(GENERICDIR)" -I"$(TOMMATHDIR)" -BASE_CFLAGS = $(cflags) $(cdebug) $(crt) $(TCL_INCLUDES) \ - -DTCL_PIPE_DLL=\"$(TCLPIPEDLLNAME)\" -DTCL_TOMMATH \ - -DMP_PREC=4 +TCL_DEFINES = -DTCL_TOMMATH -DMP_PREC=4 -Dinline=__inline -DHAVE_ZLIB=1 +BASE_CFLAGS = $(cflags) $(cdebug) $(crt) $(TCL_INCLUDES) $(TCL_DEFINES) CON_CFLAGS = $(cflags) $(cdebug) $(crt) -DCONSOLE TCL_CFLAGS = $(BASE_CFLAGS) $(OPTDEFINES) STUB_CFLAGS = $(cflags) $(cdebug) $(OPTDEFINES) @@ -468,18 +514,17 @@ STUB_CFLAGS = $(cflags) $(cdebug) $(OPTDEFINES) #--------------------------------------------------------------------- !if $(DEBUG) -ldebug = -debug:full -debugtype:cv +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 @@ -500,12 +545,14 @@ dlllflags = $(lflags) -dll conlflags = $(lflags) -subsystem:console guilflags = $(lflags) -subsystem:windows -baselibs = kernel32.lib user32.lib +baselibs = netapi32.lib kernel32.lib user32.lib advapi32.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 @@ -520,34 +567,38 @@ TESTFLAGS = $(TESTFLAGS) -file $(TESTPAT) # Project specific targets #--------------------------------------------------------------------- -release: setup $(TCLSH) $(TCLSTUBLIB) dlls +release: setup $(TCLSH) $(TCLSTUBLIB) dlls pkgs core: setup $(TCLLIB) $(TCLSTUBLIB) shell: setup $(TCLSH) -dlls: setup $(TCLPIPEDLL) $(TCLREGLIB) $(TCLDDELIB) -all: setup $(TCLSH) $(TCLSTUBLIB) dlls $(CAT32) +dlls: setup $(TCLREGLIB) $(TCLDDELIB) +all: setup $(TCLSH) $(TCLSTUBLIB) dlls $(CAT32) pkgs tcltest: setup $(TCLTEST) dlls $(CAT32) -install: install-binaries install-libraries install-docs - +install: install-binaries install-libraries install-docs install-pkgs -test: setup $(TCLTEST) dlls $(CAT32) - set TCL_LIBRARY=$(ROOT)/library +test: test-core test-pkgs +test-core: setup $(TCLTEST) dlls $(CAT32) + set TCL_LIBRARY=$(ROOT:\=/)/library !if "$(OS)" == "Windows_NT" || "$(MSVCDIR)" == "IDE" - $(TCLTEST) "$(ROOT)/tests/all.tcl" $(TESTFLAGS) -loadfile << - set ::ddelib [file normalize $(TCLDDELIB:\=/)] - set ::reglib [file normalize $(TCLREGLIB:\=/)] + $(DEBUGGER) $(TCLTEST) "$(ROOT:\=/)/tests/all.tcl" $(TESTFLAGS) -loadfile << + package ifneeded dde 1.4.0 [list load "$(TCLDDELIB:\=/)" dde] + package ifneeded registry 1.3.0 [list load "$(TCLREGLIB:\=/)" registry] << !else @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:\=/)] + $(TCLTEST) "$(ROOT:\=/)/tests/all.tcl" $(TESTFLAGS) -loadfile << > tests.log + package ifneeded dde 1.4.0 "$(TCLDDELIB:\=/)" dde] + package ifneeded registry 1.3.0 "$(TCLREGLIB:\=/)" registry] << type tests.log | more !endif runtest: setup $(TCLTEST) dlls $(CAT32) - set TCL_LIBRARY=$(ROOT)/library - $(TCLTEST) + set TCL_LIBRARY=$(ROOT:\=/)/library + $(DEBUGGER) $(TCLTEST) $(SCRIPT) + +runshell: setup $(TCLSH) dlls + set TCL_LIBRARY=$(ROOT:\=/)/library + $(DEBUGGER) $(TCLSH) $(SCRIPT) setup: @if not exist $(OUT_DIR)\nul mkdir $(OUT_DIR) @@ -559,7 +610,7 @@ $(TCLIMPLIB): $(TCLLIB) $(TCLLIB): $(TCLOBJS) !if $(STATIC_BUILD) - $(lib32) -nologo -out:$@ @<< + $(lib32) -nologo $(LINKERFLAGS) -out:$@ @<< $** << !else @@ -568,53 +619,71 @@ $** $** << $(_VC_MANIFEST_EMBED_DLL) - -@del $*.exp !endif $(TCLSTUBLIB): $(TCLSTUBOBJS) - $(lib32) -nologo -out:$@ $(TCLSTUBOBJS) + $(lib32) -nologo $(LINKERFLAGS) -nodefaultlib -out:$@ $(TCLSTUBOBJS) -$(TCLSH): $(TCLSHOBJS) $(TCLIMPLIB) +$(TCLSH): $(TCLSHOBJS) $(TCLSTUBLIB) $(TCLIMPLIB) $(link32) $(conlflags) -stack:2300000 -out:$@ $(baselibs) $** $(_VC_MANIFEST_EMBED_EXE) -$(TCLTEST): $(TCLTESTOBJS) $(TCLIMPLIB) +$(TCLTEST): $(TCLTESTOBJS) $(TCLSTUBLIB) $(TCLIMPLIB) $(link32) $(conlflags) -stack:2300000 -out:$@ $(baselibs) $** $(_VC_MANIFEST_EMBED_EXE) -$(TCLPIPEDLL): $(WINDIR)\stub16.c - $(cc32) $(CON_CFLAGS) -Fo$(TMP_DIR)\ $(WINDIR)\stub16.c - $(link32) $(conlflags) -out:$@ $(TMP_DIR)\stub16.obj $(baselibs) - $(_VC_MANIFEST_EMBED_DLL) - !if $(STATIC_BUILD) -!if !$(TCL_USE_STATIC_PACKAGES) $(TCLDDELIB): $(TMP_DIR)\tclWinDde.obj - $(lib32) -nologo -out:$@ $(TMP_DIR)\tclWinDde.obj -!endif + $(lib32) -nologo $(LINKERFLAGS) -out:$@ $** !else $(TCLDDELIB): $(TMP_DIR)\tclWinDde.obj $(TCLSTUBLIB) $(link32) $(dlllflags) -base:@$(WINDIR)\coffbase.txt,tcldde -out:$@ \ $** $(baselibs) $(_VC_MANIFEST_EMBED_DLL) - -@del $*.exp - -@del $*.lib !endif !if $(STATIC_BUILD) -!if !$(TCL_USE_STATIC_PACKAGES) $(TCLREGLIB): $(TMP_DIR)\tclWinReg.obj - $(lib32) -nologo -out:$@ $(TMP_DIR)\tclWinReg.obj -!endif + $(lib32) -nologo $(LINKERFLAGS) -out:$@ $** !else $(TCLREGLIB): $(TMP_DIR)\tclWinReg.obj $(TCLSTUBLIB) $(link32) $(dlllflags) -base:@$(WINDIR)\coffbase.txt,tclreg -out:$@ \ $** $(baselibs) $(_VC_MANIFEST_EMBED_DLL) - -@del $*.exp - -@del $*.lib !endif +pkgs: + @for /d %d in ($(PKGSDIR)\*) do \ + @if exist "%~fd\win\makefile.vc" ( \ + pushd "%~fd\win" & \ + $(MAKE) -$(MAKEFLAGS) -f makefile.vc TCLDIR=$(ROOT) &\ + popd \ + ) + +test-pkgs: + @for /d %d in ($(PKGSDIR)\*) do \ + @if exist "%~fd\win\makefile.vc" ( \ + pushd "%~fd\win" & \ + $(MAKE) -$(MAKEFLAGS) -f makefile.vc TCLDIR=$(ROOT) test &\ + popd \ + ) + +install-pkgs: + @for /d %d in ($(PKGSDIR)\*) do \ + @if exist "%~fd\win\makefile.vc" ( \ + pushd "%~fd\win" & \ + $(MAKE) -$(MAKEFLAGS) -f makefile.vc TCLDIR=$(ROOT) install &\ + popd \ + ) + +clean-pkgs: + @for /d %d in ($(PKGSDIR)\*) do \ + @if exist "%~fd\win\makefile.vc" ( \ + pushd "%~fd\win" & \ + $(MAKE) -$(MAKEFLAGS) -f makefile.vc TCLDIR=$(ROOT) clean &\ + popd \ + ) + $(CAT32): $(WINDIR)\cat.c $(cc32) $(CON_CFLAGS) -Fo$(TMP_DIR)\ $? $(link32) $(conlflags) -out:$@ -stack:16384 $(TMP_DIR)\cat.obj \ @@ -632,6 +701,8 @@ genstubs: $(TCLSH) $(TOOLSDIR:\=/)/genStubs.tcl $(GENERICDIR:\=/) \ $(GENERICDIR:\=/)/tcl.decls $(GENERICDIR:\=/)/tclInt.decls \ $(GENERICDIR:\=/)/tclTomMath.decls + $(TCLSH) $(TOOLSDIR:\=/)/genStubs.tcl $(GENERICDIR:\=/) \ + $(GENERICDIR:\=/)/tclOO.decls !endif @@ -651,25 +722,48 @@ gentommath_h: !endif #--------------------------------------------------------------------- -# Generate the makefile depedancies. +# Build the Windows HTML help file. #--------------------------------------------------------------------- -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) \ - $(COMPATDIR) $(WINDIR) @<< -$(TCLOBJS) -<< +# NOTE: you can define HHC on the command-line to override this +!ifndef HHC +HHC=""%ProgramFiles%\HTML Help Workshop\hhc.exe"" !endif +HTMLDIR=$(ROOT)\html +HTMLBASE=TclTk$(VERSION) +HHPFILE=$(HTMLDIR)\$(HTMLBASE).hhp +CHMFILE=$(HTMLDIR)\$(HTMLBASE).chm -#" for emacs font-locking. +htmlhelp: chmsetup $(CHMFILE) -#--------------------------------------------------------------------- -# Build the windows help file. -#--------------------------------------------------------------------- +$(CHMFILE): $(DOCDIR)\* + @$(TCLSH) $(TOOLSDIR)\tcltk-man2html.tcl + @echo Compiling HTML help project + @$(HHC) <<$(HHPFILE) >NUL +[OPTIONS] +Compatibility=1.1 or later +Compiled file=$(HTMLBASE).chm +Display compile progress=no +Error log file=$(HTMLBASE).log +Language=0x409 English (United States) +Title=Tcl/Tk $(DOT_VERSION) Help +[FILES] +contents.htm +docs.css +Keywords +TclCmd +TclLib +TkCmd +TkLib +UserCmd +<< + +chmsetup: + @if not exist $(HTMLDIR)\nul mkdir $(HTMLDIR) + +#------------------------------------------------------------------------- +# Build the old-style Windows .hlp file +#------------------------------------------------------------------------- TCLHLPBASE = $(PROJECT)$(VERSION) HELPFILE = $(OUT_DIR)\$(TCLHLPBASE).hlp @@ -728,7 +822,12 @@ $(HELPRTF): $(MAN2TCL) $(MAN2HELP) $(MAN2HELP2) $(INDEX) $(DOCDIR)\* $(TCLSH) $(MAN2HELP) -bitmap $(BMP_NOPATH) $(PROJECT) $(VERSION) $(DOCDIR:\=/) install-docs: -!if exist($(HELPFILE)) +!if exist("$(CHMFILE)") + @echo Installing compiled HTML help + @$(CPY) "$(CHMFILE)" "$(DOC_INSTALL_DIR)\" +!endif +!if exist("$(HELPFILE)") + @echo Installing Windows help @$(CPY) "$(HELPFILE)" "$(DOC_INSTALL_DIR)\" @$(CPY) "$(HELPCNT)" "$(DOC_INSTALL_DIR)\" !endif @@ -737,83 +836,73 @@ install-docs: # Build tclConfig.sh for the TEA build system. #--------------------------------------------------------------------- -tclConfig: -!if !exist($(TCLSH)) - @echo Build tclsh first! -!else +tclConfig: $(OUT_DIR)\tclConfig.sh + +$(OUT_DIR)\tclConfig.sh: $(WINDIR)\tclConfig.sh.in @echo Creating tclConfig.sh - @set TCL_LIBRARY=$(ROOT)/library - @$(TCLSH) << - set debug $(DEBUG) - set thread $(TCL_THREADS) - set static $(STATIC_BUILD) - set config(@TCL_DLL_FILE@) {$(TCLLIBNAME)} - set config(@TCL_VERSION@) [info tcl] - set config(@TCL_MAJOR_VERSION@) [lindex [split [info tclversion] .] 0] - set config(@TCL_MINOR_VERSION@) [lindex [split [info tclversion] .] 1] - set config(@TCL_PATCH_LEVEL@) [string range [info patchlevel] [string length [info tclversion]] end] - set config(@CC@) {$(CC)} - set config(@DEFS@) {} - if {$$static} {lappend config(@DEFS@) "-DSTATIC_BUILD=1"} - if {$$thread} {lappend config(@DEFS@) "-DTHREAD=1"} - set config(@TCL_DBGX@) {$(DBGX)} - set config(@CFLAGS_DEBUG@) {-nologo -c -W3 -YX -Fp$(TMP_DIR)\ -MDd} - set config(@CFLAGS_OPTIMIZE@) {-nologo -c -W3 -YX -Fp$(TMP_DIR)\ -MD} - set config(@LDFLAGS_DEBUG@) {-nologo -machine:$(MACHINE) -debug:full -debugtype:cv} - set config(@LDFLAGS_OPTIMIZE@) {-nologo -machine:$(MACHINE) -release -opt:ref -opt:icf,3} - set config(@TCL_SHARED_BUILD@) [expr {$$static ? 0 : 1}] - set config(@TCL_LIB_FILE@) {$(PROJECT)$(VERSION)$(SUFX).lib} - set config(@TCL_NEEDS_EXP_FILE@) {} - set config(@CFG_TCL_EXPORT_FILE_SUFFIX@) {$${NODOT_VERSION}$${DBGX}.lib} - set config(@LIBS@) {$(baselibs)} - set config(@prefix@) {$(_INSTALLDIR)} - set config(@exec_prefix@) {$(BIN_INSTALL_DIR)} - set config(@SHLIB_CFLAGS@) {} - set config(@STLIB_CFLAGS@) {} - set config(@CFLAGS_WARNING@) {-W3} - set config(@EXTRA_CFLAGS@) {-YX} - set config(@SHLIB_LD@) {$(link32) $(dlllflags)} - set config(@STLIB_LD@) {$(lib32) -nologo} - set config(@SHLIB_LD_LIBS@) {$(baselibs)} - set config(@SHLIB_SUFFIX@) {.dll} - set config(@DL_LIBS@) {} - set config(@LDFLAGS@) {} - set config(@TCL_LD_SEARCH_FLAGS@) {} - set config(@LIBOBJS@) {} - set config(@RANLIB@) {} - set config(@TCL_LIB_FLAG@) {} - set config(@TCL_BUILD_LIB_SPEC@) {} - set config(@TCL_LIB_SPEC@) {$(LIB_INSTALL_DIR)\$(PROJECT)$(VERSION)$(SUFX).lib} - set config(@TCL_INCLUDE_SPEC@) {-I$(INCLUDE_INSTALL_DIR)} - set config(@TCL_LIB_VERSIONS_OK@) {} - set config(@CFG_TCL_SHARED_LIB_SUFFIX@) {$${NODOT_VERSION}$${DBGX}.dll} - set config(@CFG_TCL_UNSHARED_LIB_SUFFIX@) {$${NODOT_VERSION}$${DBGX}.lib} - set config(@TCL_SRC_DIR@) [file nativename [file normalize {$(ROOT)}]] - set config(@TCL_PACKAGE_PATH@) {} - set config(@TCL_STUB_LIB_FILE@) {$(TCLSTUBLIBNAME)} - set config(@TCL_STUB_LIB_FLAG@) {$(TCLSTUBLIBNAME)} - set config(@TCL_BUILD_STUB_LIB_SPEC@) "-L[file nativename [file normalize {$(OUT_DIR)}]] $(TCLSTUBLIBNAME)" - set config(@TCL_STUB_LIB_SPEC@) {-L$(LIB_INSTALL_DIR) $(TCLSTUBLIBNAME)} - set config(@TCL_BUILD_STUB_LIB_PATH@) [file nativename [file normalize {$(TCLSTUBLIB)}]] - set config(@TCL_STUB_LIB_PATH@) [file nativename [file normalize {$(LIB_INSTALL_DIR)\\$(TCLSTUBLIBNAME)}]] - set config(@TCL_THREADS@) {$(TCL_THREADS)} - set f [open tclConfig.sh.in r] - set data [read $$f] - close $$f - foreach {anchor subst} [array get config] { - regsub -all $$anchor $$data $$subst data - } - set f [open [file join [file normalize {$(OUT_DIR)}] tclConfig.sh] w] - puts $$f $$data - close $$f -<< + @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 + +#--------------------------------------------------------------------- +# 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 \ @@ -829,6 +918,10 @@ $(TMP_DIR)\testMain.obj: $(WINDIR)\tclAppInit.c -DTCL_USE_STATIC_PACKAGES=$(TCL_USE_STATIC_PACKAGES) \ -Fo$@ $? +$(TMP_DIR)\tclMain2.obj: $(GENERICDIR)\tclMain.c + $(cc32) $(TCL_CFLAGS) -DBUILD_tcl -DTCL_ASCII_MAIN \ + -Fo$@ $? + $(TMP_DIR)\tclTest.obj: $(GENERICDIR)\tclTest.c $(cc32) $(TCL_CFLAGS) -Fo$@ $? @@ -838,6 +931,9 @@ $(TMP_DIR)\tclTestObj.obj: $(GENERICDIR)\tclTestObj.c $(TMP_DIR)\tclWinTest.obj: $(WINDIR)\tclWinTest.c $(cc32) $(TCL_CFLAGS) -Fo$@ $? +$(TMP_DIR)\tclZlib.obj: $(GENERICDIR)\tclZlib.c + $(cc32) $(TCL_CFLAGS) -I$(COMPATDIR)\zlib -DBUILD_tcl -Fo$@ $? + $(TMP_DIR)\tclPkgConfig.obj: $(GENERICDIR)\tclPkgConfig.c $(cc32) -DBUILD_tcl $(TCL_CFLAGS) \ -DCFG_INSTALL_LIBDIR="\"$(LIB_INSTALL_DIR:\=\\)\"" \ @@ -877,39 +973,50 @@ $(TMP_DIR)\tclWinDde.obj: $(WINDIR)\tclWinDde.c ### 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) $(STUB_CFLAGS) -Zl -DSTATIC_BUILD $(TCL_INCLUDES) -Fo$@ $? +$(TMP_DIR)\tclTomMathStubLib.obj: $(GENERICDIR)\tclTomMathStubLib.c + $(cc32) $(STUB_CFLAGS) -Zl -DSTATIC_BUILD $(TCL_INCLUDES) -Fo$@ $? + +$(TMP_DIR)\tclOOStubLib.obj: $(GENERICDIR)\tclOOStubLib.c + $(cc32) $(STUB_CFLAGS) -Zl -DSTATIC_BUILD $(TCL_INCLUDES) -Fo$@ $? + +$(TMP_DIR)\tclsh.exe.manifest: $(WINDIR)\tclsh.exe.manifest.in + @nmakehlp -s << $** >$@ +@MACHINE@ $(MACHINE:IX86=X86) +@TCL_WIN_VERSION@ $(DOTVERSION).0.0 +<< #--------------------------------------------------------------------- -# 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 @@ -919,7 +1026,9 @@ $(GENERICDIR)\regguts.h: $(GENERICDIR)\regcustom.h #--------------------------------------------------------------------- -# Implicit rules +# Implicit rules. A limitation exists with nmake that requires that +# source directory can not contain spaces in the path. This an +# absolute. #--------------------------------------------------------------------- {$(WINDIR)}.c{$(TMP_DIR)}.obj:: @@ -942,13 +1051,20 @@ $< $< << +{$(COMPATDIR)\zlib}.c{$(TMP_DIR)}.obj:: + $(cc32) $(TCL_CFLAGS) -DBUILD_tcl -Fo$(TMP_DIR)\ @<< +$< +<< + {$(WINDIR)}.rc{$(TMP_DIR)}.res: - $(rc32) -fo $@ -r -i "$(GENERICDIR)" \ + $(rc32) -fo $@ -r -i "$(GENERICDIR)" -i "$(TMP_DIR)" \ -d DEBUG=$(DEBUG) -d UNCHECKED=$(UNCHECKED) \ -d TCL_THREADS=$(TCL_THREADS) \ -d STATIC_BUILD=$(STATIC_BUILD) \ $< +$(TMP_DIR)\tclsh.res: $(TMP_DIR)\tclsh.exe.manifest + .SUFFIXES: .SUFFIXES:.c .rc @@ -968,10 +1084,6 @@ install-binaries: @echo Installing $(TCLSHNAME) @$(CPY) "$(TCLSH)" "$(BIN_INSTALL_DIR)\" !endif -!if exist($(TCLPIPEDLL)) - @echo Installing $(TCLPIPEDLLNAME) - @$(CPY) "$(TCLPIPEDLL)" "$(BIN_INSTALL_DIR)\" -!endif @echo Installing $(TCLSTUBLIBNAME) @$(CPY) "$(TCLSTUBLIB)" "$(LIB_INSTALL_DIR)\" @@ -992,9 +1104,13 @@ install-libraries: tclConfig install-msgs install-tzdata $(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" + @if not exist "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.6$(NULL)" \ + $(MKDIR) "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.6" @echo Installing header files @$(CPY) "$(GENERICDIR)\tcl.h" "$(INCLUDE_INSTALL_DIR)\" @$(CPY) "$(GENERICDIR)\tclDecls.h" "$(INCLUDE_INSTALL_DIR)\" + @$(CPY) "$(GENERICDIR)\tclOO.h" "$(INCLUDE_INSTALL_DIR)\" + @$(CPY) "$(GENERICDIR)\tclOODecls.h" "$(INCLUDE_INSTALL_DIR)\" @$(CPY) "$(GENERICDIR)\tclPlatDecls.h" "$(INCLUDE_INSTALL_DIR)\" @$(CPY) "$(GENERICDIR)\tclTomMath.h" "$(INCLUDE_INSTALL_DIR)\" @$(CPY) "$(GENERICDIR)\tclTomMathDecls.h" "$(INCLUDE_INSTALL_DIR)\" @@ -1012,6 +1128,7 @@ install-libraries: tclConfig install-msgs install-tzdata @$(CPY) "$(ROOT)\library\word.tcl" "$(SCRIPT_INSTALL_DIR)\" @$(CPY) "$(ROOT)\library\auto.tcl" "$(SCRIPT_INSTALL_DIR)\" @$(CPY) "$(OUT_DIR)\tclConfig.sh" "$(LIB_INSTALL_DIR)\" + @$(CPY) "$(WINDIR)\tclooConfig.sh" "$(LIB_INSTALL_DIR)\" @echo Installing library http1.0 directory @$(CPY) "$(ROOT)\library\http1.0\*.tcl" \ "$(SCRIPT_INSTALL_DIR)\http1.0\" @@ -1020,7 +1137,7 @@ install-libraries: tclConfig install-msgs install-tzdata "$(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" + "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.6\http-$(PKG_HTTP_VER).tm" @echo Installing package msgcat $(PKG_MSGCAT_VER) as a Tcl Module @$(COPY) "$(ROOT)\library\msgcat\msgcat.tcl" \ "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.5\msgcat-$(PKG_MSGCAT_VER).tm" @@ -1035,7 +1152,9 @@ install-libraries: tclConfig install-msgs install-tzdata "$(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" \ @@ -1043,7 +1162,9 @@ install-libraries: tclConfig install-msgs install-tzdata !endif @echo Installing $(TCLREGLIBNAME) !if $(STATIC_BUILD) +!if !$(TCL_USE_STATIC_PACKAGES) @$(CPY) "$(TCLREGLIB)" "$(LIB_INSTALL_DIR)\" +!endif !else @$(CPY) "$(TCLREGLIB)" "$(LIB_INSTALL_DIR)\reg$(REGDOTVERSION)\" @$(CPY) "$(ROOT)\library\reg\pkgIndex.tcl" \ @@ -1053,17 +1174,19 @@ install-libraries: tclConfig install-msgs install-tzdata @$(CPY) "$(ROOT)\library\encoding\*.enc" \ "$(SCRIPT_INSTALL_DIR)\encoding\" +#" emacs fix + install-tzdata: @echo Installing time zone data - @set TCL_LIBRARY=$(ROOT)/library - @$(TCLSH) "$(ROOT)/tools/installData.tcl" \ - "$(ROOT)/library/tzdata" "$(SCRIPT_INSTALL_DIR)/tzdata" + @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) "$(ROOT)/tools/installData.tcl" \ - "$(ROOT)/library/msgs" "$(SCRIPT_INSTALL_DIR)/msgs" + @set TCL_LIBRARY=$(ROOT:\=/)/library + @$(TCLSH_NATIVE) "$(ROOT:\=/)/tools/installData.tcl" \ + "$(ROOT:\=/)/library/msgs" "$(SCRIPT_INSTALL_DIR)/msgs" #--------------------------------------------------------------------- # Clean up @@ -1085,7 +1208,7 @@ tidy: @echo Removing $(TCLREGLIB) ... @if exist $(TCLREGLIB) del $(TCLREGLIB) -clean: +clean: clean-pkgs @echo Cleaning $(TMP_DIR)\* ... @if exist $(TMP_DIR)\nul $(RMDIR) $(TMP_DIR) @echo Cleaning $(WINDIR)\nmakehlp.obj ... @@ -1101,6 +1224,8 @@ clean: @echo Cleaning $(WINDIR)\versions.vc ... @if exist $(WINDIR)\versions.vc del $(WINDIR)\versions.vc +realclean: hose + hose: @echo Hosing $(OUT_DIR)\* ... @if exist $(OUT_DIR)\nul $(RMDIR) $(OUT_DIR) diff --git a/win/nmakehlp.c b/win/nmakehlp.c index 044cc8f..b1a1517 100644 --- a/win/nmakehlp.c +++ b/win/nmakehlp.c @@ -5,24 +5,33 @@ * 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. - * - * ---------------------------------------------------------------------------- - * RCS: @(#) $Id: nmakehlp.c,v 1.15 2007/02/09 06:43:00 mistachkin Exp $ + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. * ---------------------------------------------------------------------------- */ #define _CRT_SECURE_NO_DEPRECATE #include <windows.h> +#define NO_SHLWAPI_GDI +#define NO_SHLWAPI_STREAM +#define NO_SHLWAPI_REG +#include <shlwapi.h> #pragma comment (lib, "user32.lib") #pragma comment (lib, "kernel32.lib") +#pragma comment (lib, "shlwapi.lib") #include <stdio.h> #include <math.h> + +/* + * This library is required for x64 builds with _some_ versions of MSVC + */ #if defined(_M_IA64) || defined(_M_AMD64) +#if _MSC_VER >= 1400 && _MSC_VER < 1500 #pragma comment(lib, "bufferoverflowU") #endif +#endif /* ISO hack for dumb VC++ */ #ifdef _MSC_VER @@ -33,12 +42,13 @@ /* protos */ -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); -const char * GetVersionFromFile(const char *filename, const char *match); -DWORD WINAPI ReadFromPipe(LPVOID args); +static int CheckForCompilerFeature(const char *option); +static int CheckForLinkerFeature(const char *option); +static int IsIn(const char *string, const char *substring); +static int SubstituteFile(const char *substs, const char *filename); +static int QualifyPath(const char *path); +static const char *GetVersionFromFile(const char *filename, const char *match, int numdots); +static DWORD WINAPI ReadFromPipe(LPVOID args); /* globals */ @@ -120,18 +130,18 @@ main( } else { return IsIn(argv[2], argv[3]); } - case 'g': + case 's': if (argc == 2) { chars = snprintf(msg, sizeof(msg) - 1, - "usage: %s -g <file> <string>\n" - "grep for a #define\n" - "exitcodes: integer of the found string (no decimals)\n", + "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 GrepForDefine(argv[2], argv[3]); + return SubstituteFile(argv[2], argv[3]); case 'V': if (argc != 4) { chars = snprintf(msg, sizeof(msg) - 1, @@ -143,12 +153,23 @@ main( &dwWritten, NULL); return 0; } - printf("%s\n", GetVersionFromFile(argv[2], argv[3])); + printf("%s\n", GetVersionFromFile(argv[2], argv[3], *(argv[1]+2) - '0')); return 0; + case 'Q': + if (argc != 3) { + chars = snprintf(msg, sizeof(msg) - 1, + "usage: %s -Q path\n" + "Emit the fully qualified path\n" + "exitcodes: 0 == no, 1 == yes, 2 == error\n", argv[0]); + WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars, + &dwWritten, NULL); + return 2; + } + return QualifyPath(argv[2]); } } chars = snprintf(msg, sizeof(msg) - 1, - "usage: %s -c|-l|-f|-g|-V ...\n" + "usage: %s -c|-f|-l|-Q|-s|-V ...\n" "This is a little helper app to equalize shell differences between WinNT and\n" "Win9x and get nmake.exe to accomplish its job.\n", argv[0]); @@ -156,7 +177,7 @@ main( return 2; } -int +static int CheckForCompilerFeature( const char *option) { @@ -285,10 +306,12 @@ 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 +static int CheckForLinkerFeature( const char *option) { @@ -408,12 +431,12 @@ 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 +static DWORD WINAPI ReadFromPipe( LPVOID args) { @@ -438,7 +461,7 @@ ReadFromPipe( return 0; /* makes the compiler happy */ } -int +static int IsIn( const char *string, const char *substring) @@ -447,93 +470,228 @@ IsIn( } /* - * Find a specified #define by name. - * - * If the line is '#define TCL_VERSION "8.5"', it returns 85 as the result. + * 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. */ -int -GrepForDefine( - const char *file, - const char *string) +static const char * +GetVersionFromFile( + const char *filename, + const char *match, + int numdots) { - FILE *f; - char s1[51], s2[51], s3[51]; - int r = 0; - double d1; - - f = fopen(file, "rt"); - if (f == NULL) { - return 0; - } + size_t cbBuffer = 100; + static char szBuffer[100]; + char *szResult = NULL; + FILE *fp = fopen(filename, "rt"); - do { - r = fscanf(f, "%50s", s1); - if (r == 1 && !strcmp(s1, "#define")) { - /* - * Get next two words. - */ + if (fp != NULL) { + /* + * Read data until we see our match string. + */ - r = fscanf(f, "%50s %50s", s2, s3); - if (r != 2) { - continue; - } + while (fgets(szBuffer, cbBuffer, fp) != NULL) { + LPSTR p, q; - /* - * Is the first word what we're looking for? - */ + p = strstr(szBuffer, match); + if (p != NULL) { + /* + * Skip to first digit after the match. + */ - if (!strcmp(s2, string)) { - fclose(f); + p += strlen(match); + while (*p && !isdigit(*p)) { + ++p; + } /* - * Add 1 past first double quote char. "8.5" + * Find ending whitespace. */ - d1 = atof(s3 + 1); /* 8.5 */ - while (floor(d1) != d1) { - d1 *= 10.0; + q = p; + while (*q && (strchr("0123456789.ab", *q)) && ((!strchr(".ab", *q) + && (!strchr("ab", q[-1])) || --numdots))) { + ++q; } - return ((int) d1); /* 85 */ + + memcpy(szBuffer, p, q - p); + szBuffer[q-p] = 0; + szResult = szBuffer; + break; } } - } while (!feof(f)); + fclose(fp); + } + return szResult; +} + +/* + * List helpers for the SubstituteFile function + */ - fclose(f); - return 0; +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); + } } /* - * 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. + * 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) + * << */ -const char * -GetVersionFromFile(const char *filename, const char *match) +static int +SubstituteFile( + const char *substitutions, + const char *filename) { - size_t cbBuffer = 100; - static char szBuffer[100]; + size_t cbBuffer = 1024; + static char szBuffer[1024], szCopy[1024]; char *szResult = NULL; - FILE *fp = fopen(filename, "r"); + list_item_t *substPtr = NULL; + FILE *fp, *sp; + + fp = fopen(filename, "rt"); if (fp != NULL) { - /* read data until we see our match string */ + + /* + * 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) { - LPSTR p, q; - if ((p = strstr(szBuffer, match)) != 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; + 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); } - fclose(fp); + + list_free(&substPtr); } - return szResult; + fclose(fp); + return 0; } + +/* + * QualifyPath -- + * + * This composes the current working directory with a provided path + * and returns the fully qualified and normalized path. + * Mostly needed to setup paths for testing. + */ + +static int +QualifyPath( + const char *szPath) +{ + char szCwd[MAX_PATH + 1]; + char szTmp[MAX_PATH + 1]; + char *p; + GetCurrentDirectory(MAX_PATH, szCwd); + while ((p = strchr(szPath, '/')) && *p) + *p = '\\'; + PathCombine(szTmp, szCwd, szPath); + PathCanonicalize(szCwd, szTmp); + printf("%s\n", szCwd); + return 0; +} + +/* + * 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 22208d2..1513198 100644 --- a/win/rules.vc +++ b/win/rules.vc @@ -6,12 +6,9 @@ # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# Copyright (c) 2001-2003 David Gravereaux. -# Copyright (c) 2003-2006 Patrick Thoyts # -#------------------------------------------------------------------------------ -# RCS: @(#) $Id: rules.vc,v 1.29 2007/02/04 00:01:54 mistachkin Exp $ +# Copyright (c) 2001-2003 David Gravereaux. +# Copyright (c) 2003-2008 Patrick Thoyts #------------------------------------------------------------------------------ !ifndef _RULES_VC @@ -30,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 @@ -67,6 +52,50 @@ ERRNULL = >NUL # Win9x shell cannot redirect stderr !endif MKDIR = mkdir +#------------------------------------------------------------------------------ +# 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 =============================================================================== #---------------------------------------------------------- @@ -88,7 +117,7 @@ MKDIR = mkdir !message *** Compiler has 'Optimizations' OPTIMIZING = 1 !else -!message *** Compiler doesn't have 'Optimizations' +!message *** Compiler does not have 'Optimizations' OPTIMIZING = 0 !endif @@ -130,7 +159,7 @@ DEBUGFLAGS = $(DEBUGFLAGS) -RTC1 DEBUGFLAGS = $(DEBUGFLAGS) -GZ !endif -COMPILERFLAGS =-W3 +COMPILERFLAGS =-W3 -DUNICODE -D_UNICODE # In v13 -GL and -YX are incompatible. !if [nmakehlp -c -YX] @@ -143,9 +172,9 @@ OPTIMIZATIONS = $(OPTIMIZATIONS) -YX ### test for pentium errata !if [nmakehlp -c -QI0f] !message *** Compiler has 'Pentium 0x0f fix' -COMPILERFLAGS = $(COMPILERFLAGSS) -QI0f +COMPILERFLAGS = $(COMPILERFLAGS) -QI0f !else -!message *** Compiler doesn't have 'Pentium 0x0f fix' +!message *** Compiler does not have 'Pentium 0x0f fix' !endif !endif @@ -165,7 +194,7 @@ COMPILERFLAGS = $(COMPILERFLAGS) -QIA64_Bx !message *** Linker has 'Win98 alignment problem' ALIGN98_HACK = 1 !else -!message *** Linker doesn't have 'Win98 alignment problem' +!message *** Linker does not have 'Win98 alignment problem' ALIGN98_HACK = 0 !endif !else @@ -179,40 +208,20 @@ 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) >= 1400 -VCVER=8 -_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 -!elseif $(VCVERSION) >= 1300 -VCVER=7 -!elseif $(VCVERSION) >= 1200 -VCVER=6 -!endif -!endif - -#---------------------------------------------------------- # Decode the options requested. #---------------------------------------------------------- !if "$(OPTS)" == "" || [nmakehlp -f "$(OPTS)" "none"] STATIC_BUILD = 0 -TCL_THREADS = 0 +TCL_THREADS = 1 DEBUG = 0 +SYMBOLS = 0 PROFILE = 0 -MSVCRT = 0 +PGO = 0 +MSVCRT = 1 LOIMPACT = 0 TCL_USE_STATIC_PACKAGES = 0 -USE_THREAD_ALLOC = 0 +USE_THREAD_ALLOC = 1 UNCHECKED = 0 !else !if [nmakehlp -f $(OPTS) "static"] @@ -225,19 +234,25 @@ STATIC_BUILD = 0 !message *** Doing msvcrt MSVCRT = 1 !else +!if !$(STATIC_BUILD) +MSVCRT = 1 +!else MSVCRT = 0 !endif -!if [nmakehlp -f $(OPTS) "staticpkg"] +!endif +!if [nmakehlp -f $(OPTS) "staticpkg"] && $(STATIC_BUILD) !message *** Doing staticpkg TCL_USE_STATIC_PACKAGES = 1 !else TCL_USE_STATIC_PACKAGES = 0 !endif -!if [nmakehlp -f $(OPTS) "threads"] -!message *** Doing threads -TCL_THREADS = 1 -!else +!if [nmakehlp -f $(OPTS) "nothreads"] +!message *** Compile explicitly for non-threaded tcl TCL_THREADS = 0 +USE_THREAD_ALLOC= 0 +!else +TCL_THREADS = 1 +USE_THREAD_ALLOC= 1 !endif !if [nmakehlp -f $(OPTS) "symbols"] !message *** Doing symbols @@ -245,12 +260,27 @@ DEBUG = 1 !else DEBUG = 0 !endif +!if [nmakehlp -f $(OPTS) "pdbs"] +!message *** Doing pdbs +SYMBOLS = 1 +!else +SYMBOLS = 0 +!endif !if [nmakehlp -f $(OPTS) "profile"] !message *** Doing profile PROFILE = 1 !else PROFILE = 0 !endif +!if [nmakehlp -f $(OPTS) "pgi"] +!message *** Doing profile guided optimization instrumentation +PGO = 1 +!elseif [nmakehlp -f $(OPTS) "pgo"] +!message *** Doing profile guided optimization +PGO = 2 +!else +PGO = 0 +!endif !if [nmakehlp -f $(OPTS) "loimpact"] !message *** Doing loimpact LOIMPACT = 1 @@ -260,7 +290,9 @@ LOIMPACT = 0 !if [nmakehlp -f $(OPTS) "thrdalloc"] !message *** Doing thrdalloc USE_THREAD_ALLOC = 1 -!else +!endif +!if [nmakehlp -f $(OPTS) "tclalloc"] +!message *** Doing tclalloc USE_THREAD_ALLOC = 0 !endif !if [nmakehlp -f $(OPTS) "unchecked"] @@ -271,15 +303,6 @@ UNCHECKED = 0 !endif !endif - -!if !$(STATIC_BUILD) -# Make sure we don't build overly fat DLLs. -MSVCRT = 1 -# We shouldn't statically put the extensions inside the shell when dynamic. -TCL_USE_STATIC_PACKAGES = 0 -!endif - - #---------------------------------------------------------- # Figure-out how to name our intermediate and output directories. # We wouldn't want different builds to use the same .obj files @@ -321,10 +344,8 @@ TMP_DIRFULL = .\$(BUILDDIRTOP)\$(PROJECT)_ThreadedDynamicStaticX TMP_DIRFULL = $(TMP_DIRFULL:Static=) SUFX = $(SUFX:s=) EXT = dll -!if $(MSVCRT) TMP_DIRFULL = $(TMP_DIRFULL:X=) SUFX = $(SUFX:x=) -!endif !else TMP_DIRFULL = $(TMP_DIRFULL:Dynamic=) EXT = lib @@ -380,7 +401,7 @@ TCL_COMPILE_DEBUG = 0 !if "$(CHECKS)" == "" || [nmakehlp -f "$(CHECKS)" "none"] TCL_NO_DEPRECATED = 0 -FULLWARNINGS = 0 +WARNINGS = -W3 !else !if [nmakehlp -f $(CHECKS) "nodep"] !message *** Doing nodep check @@ -390,18 +411,42 @@ 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 +!if $(PGO) > 1 +!if [nmakehlp -l -ltcg:pgoptimize] +LINKERFLAGS = $(LINKERFLAGS:-ltcg=) -ltcg:pgoptimize +!else +MSG=^ +This compiler does not support profile guided optimization. +!error $(MSG) +!endif +!elseif $(PGO) > 0 +!if [nmakehlp -l -ltcg:pginstrument] +LINKERFLAGS = $(LINKERFLAGS:-ltcg=) -ltcg:pginstrument +!else +MSG=^ +This compiler does not support profile guided optimization. +!error $(MSG) +!endif +!endif #---------------------------------------------------------- # Set our defines now armed with our options. #---------------------------------------------------------- -OPTDEFINES = -DTCL_CFGVAL_ENCODING=$(CFG_ENCODING) +OPTDEFINES = -DTCL_CFGVAL_ENCODING=$(CFG_ENCODING) -DSTDC_HEADERS !if $(TCL_MEM_DEBUG) OPTDEFINES = $(OPTDEFINES) -DTCL_MEM_DEBUG @@ -422,30 +467,43 @@ OPTDEFINES = $(OPTDEFINES) -DSTATIC_BUILD OPTDEFINES = $(OPTDEFINES) -DTCL_NO_DEPRECATED !endif -!if $(DEBUG) -OPTDEFINES = $(OPTDEFINES) -DTCL_CFG_DEBUG -!elseif $(OPTIMIZING) +!if !$(DEBUG) +OPTDEFINES = $(OPTDEFINES) -DNDEBUG +!if $(OPTIMIZING) OPTDEFINES = $(OPTDEFINES) -DTCL_CFG_OPTIMIZED !endif +!endif !if $(PROFILE) OPTDEFINES = $(OPTDEFINES) -DTCL_CFG_PROFILED !endif !if "$(MACHINE)" == "IA64" || "$(MACHINE)" == "AMD64" OPTDEFINES = $(OPTDEFINES) -DTCL_CFG_DO64BIT !endif - +!if $(VCVERSION) < 1300 +OPTDEFINES = $(OPTDEFINES) -DNO_STRTOI64 +!endif #---------------------------------------------------------- -# Get common info used when building extensions. +# Locate the Tcl headers to build against #---------------------------------------------------------- -!if "$(PROJECT)" != "tcl" +!if "$(PROJECT)" == "tcl" -!if !defined(TCLDIR) +_TCL_H = ..\generic\tcl.h + +!else + +# If INSTALLDIR set to tcl root dir then reset to the lib dir. !if exist("$(_INSTALLDIR)\include\tcl.h") -TCLH = "$(_INSTALLDIR)\include\tcl.h" +_INSTALLDIR=$(_INSTALLDIR)\lib +!endif + +!if !defined(TCLDIR) +!if exist("$(_INSTALLDIR)\..\include\tcl.h") TCLINSTALL = 1 -_TCLDIR = $(_INSTALLDIR) +_TCLDIR = $(_INSTALLDIR)\.. +_TCL_H = $(_INSTALLDIR)\..\include\tcl.h +TCLDIR = $(_INSTALLDIR)\.. !else MSG=^ Failed to find tcl.h. Set the TCLDIR macro. @@ -454,109 +512,174 @@ 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 -#---------------------------------------------------------- -# Get the version from the header file. Try all possibles -# even though some aren't fully valid. -#---------------------------------------------------------- +#-------------------------------------------------------------- +# Extract various version numbers from tcl headers +# The generated file is then included in the makefile. +#-------------------------------------------------------------- -!if [nmakehlp -g $(TCLH) TCL_VERSION] == 76 -TCL_DOTVERSION = 7.6 -!elseif [nmakehlp -g $(TCLH) TCL_VERSION] == 80 -TCL_DOTVERSION = 8.0 -!elseif [nmakehlp -g $(TCLH) TCL_VERSION] == 81 -TCL_DOTVERSION = 8.1 -!elseif [nmakehlp -g $(TCLH) TCL_VERSION] == 82 -TCL_DOTVERSION = 8.2 -!elseif [nmakehlp -g $(TCLH) TCL_VERSION] == 83 -TCL_DOTVERSION = 8.3 -!elseif [nmakehlp -g $(TCLH) TCL_VERSION] == 84 -TCL_DOTVERSION = 8.4 -!elseif [nmakehlp -g $(TCLH) TCL_VERSION] == 85 -TCL_DOTVERSION = 8.5 -!elseif [nmakehlp -g $(TCLH) TCL_VERSION] == 86 -TCL_DOTVERSION = 8.6 -!elseif [nmakehlp -g $(TCLH) TCL_VERSION] == 90 -TCL_DOTVERSION = 9.0 -!elseif [nmakehlp -g $(TCLH) TCL_VERSION] == 0 -MSG =^ -Can't get version string from $(TCLH) -!error $(MSG) +!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 -TCL_VERSION = $(TCL_DOTVERSION:.=) - -!if $(TCL_VERSION) < 81 -TCL_DOES_STUBS = 0 -!else -TCL_DOES_STUBS = 1 +# 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 + +#-------------------------------------------------------------- +# Setup tcl version dependent stuff headers +#-------------------------------------------------------------- + +!if "$(PROJECT)" != "tcl" + +TCL_VERSION = $(TCL_MAJOR_VERSION)$(TCL_MINOR_VERSION) !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\tclreg13$(SUFX:t=).lib" +TCLDDELIB = "$(_TCLDIR)\lib\tcldde14$(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)\tclreg13$(SUFX:t=).lib" +TCLDDELIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tcldde14$(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 +#------------------------------------------------------------------------- -#-------------------------------------------------------------- -# Extract various version numbers from tcl modules and headers -# The generated file is then included in the makefile. -#-------------------------------------------------------------- - -!if "$(PROJECT)" == "tcl" +!if "$(PROJECT)" == "tk" +_TK_H = ..\generic\tk.h +_INSTALLDIR = $(_INSTALLDIR)\.. +!endif -!if [echo REM = This file is generated from rules.vc > versions.vc] +!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 -# Note we can do the Tcl and/or Tk version extraction -#!if [echo TCL_DOTVERSION = \>> versions.vc] \ -# && [nmakehlp -V ..\generic\tcl.h TCL_VERSION >> versions.vc] -#!endif -!if [echo PKG_HTTP_VER = \>> versions.vc] \ - && [nmakehlp -V ..\library\http\pkgIndex.tcl http >> versions.vc] +!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 -!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] + +#------------------------------------------------------------------------- +# 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 PKG_SHELL_VER = \>> versions.vc] \ - && [nmakehlp -V ..\library\platform\pkgIndex.tcl "platform::shell" >> versions.vc] +!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 #---------------------------------------------------------- @@ -567,8 +690,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 deleted file mode 100644 index 737a53e..0000000 --- a/win/stub16.c +++ /dev/null @@ -1,197 +0,0 @@ -/* - * 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. - * - * RCS: @(#) $Id: stub16.c,v 1.5 2005/11/04 00:06:50 dkf Exp $ - */ - -#define STRICT - -#include <windows.h> -#include <stdio.h> - -static HANDLE CreateTempFile(void); - -/* - *--------------------------------------------------------------------------- - * - * main - * - * Entry point for the 32-bit console mode app used by Windows 95 to help - * run the 16-bit program specified on the command line. - * - * 1. EOF on a pipe that connects a detached 16-bit process and a 32-bit - * process is never seen. So, this process runs the 16-bit process - * _attached_, and then it is run detached from the calling 32-bit - * process. - * - * 2. If a 16-bit process blocks reading from or writing to a pipe, it - * never wakes up, and eventually brings the whole system down with it if - * you try to kill the process. This app simulates pipes. If any of the - * stdio handles is a pipe, this program accumulates information into - * temp files and forwards it to or from the DOS application as - * appropriate. This means that this program must receive EOF from a - * stdin pipe before it will actually start the DOS app, and the DOS app - * must finish generating stdout or stderr before the data will be sent - * to the next stage of the pipe. If the stdio handles are not pipes, no - * accumulation occurs and the data is passed straight through to and - * from the DOS application. - * - * Results: - * None. - * - * Side effects: - * The child process is created and this process waits for it to - * complete. - * - *--------------------------------------------------------------------------- - */ - -int -main(void) -{ - DWORD dwRead, dwWrite; - char *cmdLine; - HANDLE hStdInput, hStdOutput, hStdError; - HANDLE hFileInput, hFileOutput, hFileError; - STARTUPINFO si; - PROCESS_INFORMATION pi; - char buf[8192]; - DWORD result; - - hFileInput = INVALID_HANDLE_VALUE; - hFileOutput = INVALID_HANDLE_VALUE; - hFileError = INVALID_HANDLE_VALUE; - result = 1; - - /* - * Don't get command line from argc, argv, because the command line - * tokenizer will have stripped off all the escape sequences needed for - * quotes and backslashes, and then we'd have to put them all back in - * again. Get the raw command line and parse off what we want ourselves. - * The command line should be of the form: - * - * stub16.exe program arg1 arg2 ... - */ - - cmdLine = strchr(GetCommandLine(), ' '); - if (cmdLine == NULL) { - return 1; - } - cmdLine++; - - hStdInput = GetStdHandle(STD_INPUT_HANDLE); - hStdOutput = GetStdHandle(STD_OUTPUT_HANDLE); - hStdError = GetStdHandle(STD_ERROR_HANDLE); - - if (GetFileType(hStdInput) == FILE_TYPE_PIPE) { - hFileInput = CreateTempFile(); - if (hFileInput == INVALID_HANDLE_VALUE) { - goto cleanup; - } - while (ReadFile(hStdInput, buf, sizeof(buf), &dwRead, NULL) != FALSE) { - if (dwRead == 0) { - break; - } - if (WriteFile(hFileInput, buf, dwRead, &dwWrite, NULL) == FALSE) { - goto cleanup; - } - } - SetFilePointer(hFileInput, 0, 0, FILE_BEGIN); - SetStdHandle(STD_INPUT_HANDLE, hFileInput); - } - if (GetFileType(hStdOutput) == FILE_TYPE_PIPE) { - hFileOutput = CreateTempFile(); - if (hFileOutput == INVALID_HANDLE_VALUE) { - goto cleanup; - } - SetStdHandle(STD_OUTPUT_HANDLE, hFileOutput); - } - if (GetFileType(hStdError) == FILE_TYPE_PIPE) { - hFileError = CreateTempFile(); - if (hFileError == INVALID_HANDLE_VALUE) { - goto cleanup; - } - SetStdHandle(STD_ERROR_HANDLE, hFileError); - } - - ZeroMemory(&si, sizeof(si)); - si.cb = sizeof(si); - if (CreateProcess(NULL, cmdLine, NULL, NULL, TRUE, 0, NULL, NULL, &si, - &pi) == FALSE) { - goto cleanup; - } - - WaitForInputIdle(pi.hProcess, 5000); - WaitForSingleObject(pi.hProcess, INFINITE); - GetExitCodeProcess(pi.hProcess, &result); - CloseHandle(pi.hProcess); - CloseHandle(pi.hThread); - - if (hFileOutput != INVALID_HANDLE_VALUE) { - SetFilePointer(hFileOutput, 0, 0, FILE_BEGIN); - while (ReadFile(hFileOutput, buf, sizeof(buf), &dwRead, NULL) != FALSE) { - if (dwRead == 0) { - break; - } - if (WriteFile(hStdOutput, buf, dwRead, &dwWrite, NULL) == FALSE) { - break; - } - } - } - if (hFileError != INVALID_HANDLE_VALUE) { - SetFilePointer(hFileError, 0, 0, FILE_BEGIN); - while (ReadFile(hFileError, buf, sizeof(buf), &dwRead, NULL) != FALSE) { - if (dwRead == 0) { - break; - } - if (WriteFile(hStdError, buf, dwRead, &dwWrite, NULL) == FALSE) { - break; - } - } - } - - cleanup: - if (hFileInput != INVALID_HANDLE_VALUE) { - CloseHandle(hFileInput); - } - if (hFileOutput != INVALID_HANDLE_VALUE) { - CloseHandle(hFileOutput); - } - if (hFileError != INVALID_HANDLE_VALUE) { - CloseHandle(hFileError); - } - CloseHandle(hStdInput); - CloseHandle(hStdOutput); - CloseHandle(hStdError); - ExitProcess(result); - return 1; -} - -static HANDLE -CreateTempFile(void) -{ - char name[MAX_PATH]; - SECURITY_ATTRIBUTES sa; - - if (GetTempPath(sizeof(name), name) == 0) { - return INVALID_HANDLE_VALUE; - } - if (GetTempFileName(name, "tcl", 0, name) == 0) { - return INVALID_HANDLE_VALUE; - } - - sa.nLength = sizeof(sa); - sa.lpSecurityDescriptor = NULL; - sa.bInheritHandle = TRUE; - return CreateFile(name, GENERIC_READ | GENERIC_WRITE, 0, &sa, - CREATE_ALWAYS, FILE_ATTRIBUTE_TEMPORARY | FILE_FLAG_DELETE_ON_CLOSE, - NULL); -} diff --git a/win/tcl.dsp b/win/tcl.dsp index 193ef14..57ec6bf 100644 --- a/win/tcl.dsp +++ b/win/tcl.dsp @@ -43,9 +43,9 @@ CFG=tcl - Win32 Debug Static # 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\tclsh85.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 "" @@ -64,9 +64,9 @@ CFG=tcl - Win32 Debug Static # 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\tclsh85g.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 "" @@ -208,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 @@ -1304,6 +1300,14 @@ SOURCE=..\generic\tclStubLib.c # End Source File # Begin Source File +SOURCE=..\generic\tclOOStubLib.c +# End Source File +# Begin Source File + +SOURCE=..\generic\tclTomMathStubLib.c +# End Source File +# Begin Source File + SOURCE=..\generic\tclTest.c # End Source File # Begin Source File @@ -1456,10 +1460,6 @@ SOURCE=.\rules.vc # End Source File # Begin Source File -SOURCE=.\stub16.c -# End Source File -# Begin Source File - SOURCE=.\tcl.hpj.in # End Source File # Begin Source File @@ -1560,10 +1560,6 @@ SOURCE=.\tclWinThrd.c # End Source File # Begin Source File -SOURCE=.\tclWinThrd.h -# End Source File -# Begin Source File - SOURCE=.\tclWinTime.c # End Source File # End Group diff --git a/win/tcl.hpj.in b/win/tcl.hpj.in index 2a8c94a..3bdccbe 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=tcl86.cnt COPYRIGHT=Copyright © 2000 Ajuba Solutions -HLP=tcl84.hlp +HLP=tcl86.hlp [FILES] tcl.rtf @@ -3,47 +3,124 @@ # # Locate the tclConfig.sh file and perform a sanity check on # the Tcl compile flags -# Currently a no-op for Windows # # Arguments: -# PATCH_LEVEL The patch level for Tcl if any. +# none # # Results: # # Adds the following arguments to configure: # --with-tcl=... # -# Sets the following vars: -# TCL_BIN_DIR Full path to the tclConfig.sh file +# Defines the following vars: +# TCL_BIN_DIR Full path to the directory containing +# the tclConfig.sh file #------------------------------------------------------------------------ AC_DEFUN([SC_PATH_TCLCONFIG], [ - AC_MSG_CHECKING([the location of tclConfig.sh]) + # + # Ok, lets find the tcl configuration + # First, look for one uninstalled. + # the alternative search directory is invoked by --with-tcl + # - 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.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) - fi - if test ! -f $TCL_BIN_DIR/tclConfig.sh; then - AC_MSG_ERROR(There is no tclConfig.sh in $TCL_BIN_DIR: perhaps you did not specify the Tcl *build* directory (not the toplevel Tcl directory) or you forgot to configure Tcl?) + if test x"${no_tcl}" = x ; then + # we reset no_tcl in case something fails here + no_tcl=true + AC_ARG_WITH(tcl, + AC_HELP_STRING([--with-tcl], + [directory containing tcl configuration (tclConfig.sh)]), + with_tclconfig="${withval}") + AC_MSG_CHECKING([for Tcl configuration]) + AC_CACHE_VAL(ac_cv_c_tclconfig,[ + + # First check to see if --with-tcl was specified. + if test x"${with_tclconfig}" != x ; then + case "${with_tclconfig}" in + */tclConfig.sh ) + if test -f "${with_tclconfig}"; then + AC_MSG_WARN([--with-tcl argument should refer to directory containing tclConfig.sh, not to tclConfig.sh itself]) + with_tclconfig="`echo "${with_tclconfig}" | sed 's!/tclConfig\.sh$!!'`" + fi ;; + esac + if test -f "${with_tclconfig}/tclConfig.sh" ; then + ac_cv_c_tclconfig="`(cd "${with_tclconfig}"; pwd)`" + else + AC_MSG_ERROR([${with_tclconfig} directory doesn't contain tclConfig.sh]) + fi + fi + + # then check for a private Tcl installation + if test x"${ac_cv_c_tclconfig}" = x ; then + for i in \ + ../tcl \ + `ls -dr ../tcl[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \ + `ls -dr ../tcl[[8-9]].[[0-9]] 2>/dev/null` \ + `ls -dr ../tcl[[8-9]].[[0-9]]* 2>/dev/null` \ + ../../tcl \ + `ls -dr ../../tcl[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \ + `ls -dr ../../tcl[[8-9]].[[0-9]] 2>/dev/null` \ + `ls -dr ../../tcl[[8-9]].[[0-9]]* 2>/dev/null` \ + ../../../tcl \ + `ls -dr ../../../tcl[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \ + `ls -dr ../../../tcl[[8-9]].[[0-9]] 2>/dev/null` \ + `ls -dr ../../../tcl[[8-9]].[[0-9]]* 2>/dev/null` ; do + if test -f "$i/win/tclConfig.sh" ; then + ac_cv_c_tclconfig="`(cd $i/win; pwd)`" + break + fi + done + fi + + # check in a few common install locations + if test x"${ac_cv_c_tclconfig}" = x ; then + for i in `ls -d ${libdir} 2>/dev/null` \ + `ls -d ${exec_prefix}/lib 2>/dev/null` \ + `ls -d ${prefix}/lib 2>/dev/null` \ + `ls -d /cygdrive/c/Tcl/lib 2>/dev/null` \ + `ls -d /cygdrive/c/Progra~1/Tcl/lib 2>/dev/null` \ + `ls -d /c/Tcl/lib 2>/dev/null` \ + `ls -d /c/Progra~1/Tcl/lib 2>/dev/null` \ + `ls -d C:/Tcl/lib 2>/dev/null` \ + `ls -d C:/Progra~1/Tcl/lib 2>/dev/null` \ + ; do + if test -f "$i/tclConfig.sh" ; then + ac_cv_c_tclconfig="`(cd $i; pwd)`" + break + fi + done + fi + + # check in a few other private locations + if test x"${ac_cv_c_tclconfig}" = x ; then + for i in \ + ${srcdir}/../tcl \ + `ls -dr ${srcdir}/../tcl[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \ + `ls -dr ${srcdir}/../tcl[[8-9]].[[0-9]] 2>/dev/null` \ + `ls -dr ${srcdir}/../tcl[[8-9]].[[0-9]]* 2>/dev/null` ; do + if test -f "$i/win/tclConfig.sh" ; then + ac_cv_c_tclconfig="`(cd $i/win; pwd)`" + break + fi + done + fi + ]) + + if test x"${ac_cv_c_tclconfig}" = x ; then + TCL_BIN_DIR="# no Tcl configs found" + AC_MSG_ERROR([Can't find Tcl configuration definitions. Use --with-tcl to specify a directory containing tclConfig.sh]) + else + no_tcl= + TCL_BIN_DIR="${ac_cv_c_tclconfig}" + AC_MSG_RESULT([found ${TCL_BIN_DIR}/tclConfig.sh]) + fi fi - AC_MSG_RESULT($TCL_BIN_DIR/tclConfig.sh) ]) #------------------------------------------------------------------------ # SC_PATH_TKCONFIG -- # # Locate the tkConfig.sh file -# Currently a no-op for Windows # # Arguments: # none @@ -53,31 +130,109 @@ AC_DEFUN([SC_PATH_TCLCONFIG], [ # Adds the following arguments to configure: # --with-tk=... # -# Sets the following vars: -# TK_BIN_DIR Full path to the tkConfig.sh file +# Defines the following vars: +# TK_BIN_DIR Full path to the directory containing +# the tkConfig.sh file #------------------------------------------------------------------------ AC_DEFUN([SC_PATH_TKCONFIG], [ - AC_MSG_CHECKING([the location of tkConfig.sh]) + # + # Ok, lets find the tk configuration + # First, look for one uninstalled. + # the alternative search directory is invoked by --with-tk + # - 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.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) - fi - if test ! -f $TK_BIN_DIR/tkConfig.sh; then - AC_MSG_ERROR(There is no tkConfig.sh in $TK_BIN_DIR: perhaps you did not specify the Tk *build* directory (not the toplevel Tk directory) or you forgot to configure Tk?) - fi + if test x"${no_tk}" = x ; then + # we reset no_tk in case something fails here + no_tk=true + AC_ARG_WITH(tk, + AC_HELP_STRING([--with-tk], + [directory containing tk configuration (tkConfig.sh)]), + with_tkconfig="${withval}") + AC_MSG_CHECKING([for Tk configuration]) + AC_CACHE_VAL(ac_cv_c_tkconfig,[ + + # First check to see if --with-tkconfig was specified. + if test x"${with_tkconfig}" != x ; then + case "${with_tkconfig}" in + */tkConfig.sh ) + if test -f "${with_tkconfig}"; then + AC_MSG_WARN([--with-tk argument should refer to directory containing tkConfig.sh, not to tkConfig.sh itself]) + with_tkconfig="`echo "${with_tkconfig}" | sed 's!/tkConfig\.sh$!!'`" + fi ;; + esac + if test -f "${with_tkconfig}/tkConfig.sh" ; then + ac_cv_c_tkconfig="`(cd "${with_tkconfig}"; pwd)`" + else + AC_MSG_ERROR([${with_tkconfig} directory doesn't contain tkConfig.sh]) + fi + fi + + # then check for a private Tk library + if test x"${ac_cv_c_tkconfig}" = x ; then + for i in \ + ../tk \ + `ls -dr ../tk[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \ + `ls -dr ../tk[[8-9]].[[0-9]] 2>/dev/null` \ + `ls -dr ../tk[[8-9]].[[0-9]]* 2>/dev/null` \ + ../../tk \ + `ls -dr ../../tk[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \ + `ls -dr ../../tk[[8-9]].[[0-9]] 2>/dev/null` \ + `ls -dr ../../tk[[8-9]].[[0-9]]* 2>/dev/null` \ + ../../../tk \ + `ls -dr ../../../tk[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \ + `ls -dr ../../../tk[[8-9]].[[0-9]] 2>/dev/null` \ + `ls -dr ../../../tk[[8-9]].[[0-9]]* 2>/dev/null` ; do + if test -f "$i/win/tkConfig.sh" ; then + ac_cv_c_tkconfig="`(cd $i/win; pwd)`" + break + fi + done + fi + + # check in a few common install locations + if test x"${ac_cv_c_tkconfig}" = x ; then + for i in `ls -d ${libdir} 2>/dev/null` \ + `ls -d ${exec_prefix}/lib 2>/dev/null` \ + `ls -d ${prefix}/lib 2>/dev/null` \ + `ls -d /cygdrive/c/Tcl/lib 2>/dev/null` \ + `ls -d /cygdrive/c/Progra~1/Tcl/lib 2>/dev/null` \ + `ls -d /c/Tcl/lib 2>/dev/null` \ + `ls -d /c/Progra~1/Tcl/lib 2>/dev/null` \ + `ls -d C:/Tcl/lib 2>/dev/null` \ + `ls -d C:/Progra~1/Tcl/lib 2>/dev/null` \ + ; do + if test -f "$i/tkConfig.sh" ; then + ac_cv_c_tkconfig="`(cd $i; pwd)`" + break + fi + done + fi - AC_MSG_RESULT([$TK_BIN_DIR/tkConfig.sh]) + # check in a few other private locations + if test x"${ac_cv_c_tkconfig}" = x ; then + for i in \ + ${srcdir}/../tk \ + `ls -dr ${srcdir}/../tk[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \ + `ls -dr ${srcdir}/../tk[[8-9]].[[0-9]] 2>/dev/null` \ + `ls -dr ${srcdir}/../tk[[8-9]].[[0-9]]* 2>/dev/null` ; do + if test -f "$i/win/tkConfig.sh" ; then + ac_cv_c_tkconfig="`(cd $i/win; pwd)`" + break + fi + done + fi + ]) + + if test x"${ac_cv_c_tkconfig}" = x ; then + TK_BIN_DIR="# no Tk configs found" + AC_MSG_ERROR([Can't find Tk configuration definitions. Use --with-tk to specify a directory containing tkConfig.sh]) + else + no_tk= + TK_BIN_DIR="${ac_cv_c_tkconfig}" + AC_MSG_RESULT([found ${TK_BIN_DIR}/tkConfig.sh]) + fi + fi ]) #------------------------------------------------------------------------ @@ -86,13 +241,13 @@ AC_DEFUN([SC_PATH_TKCONFIG], [ # Load the tclConfig.sh file. # # Arguments: -# +# # Requires the following vars to be set: # TCL_BIN_DIR # # Results: # -# Subst the following vars: +# Substitutes the following vars: # TCL_BIN_DIR # TCL_SRC_DIR # TCL_LIB_FILE @@ -100,13 +255,13 @@ AC_DEFUN([SC_PATH_TKCONFIG], [ #------------------------------------------------------------------------ AC_DEFUN([SC_LOAD_TCLCONFIG], [ - AC_MSG_CHECKING([for existence of $TCL_BIN_DIR/tclConfig.sh]) + AC_MSG_CHECKING([for existence of ${TCL_BIN_DIR}/tclConfig.sh]) - if test -f "$TCL_BIN_DIR/tclConfig.sh" ; then + if test -f "${TCL_BIN_DIR}/tclConfig.sh" ; then AC_MSG_RESULT([loading]) - . $TCL_BIN_DIR/tclConfig.sh + . "${TCL_BIN_DIR}/tclConfig.sh" else - AC_MSG_RESULT([file not found]) + AC_MSG_RESULT([could not find ${TCL_BIN_DIR}/tclConfig.sh]) fi # @@ -155,10 +310,9 @@ AC_DEFUN([SC_LOAD_TCLCONFIG], [ # SC_LOAD_TKCONFIG -- # # Load the tkConfig.sh file -# Currently a no-op for Windows # # Arguments: -# +# # Requires the following vars to be set: # TK_BIN_DIR # @@ -169,13 +323,13 @@ AC_DEFUN([SC_LOAD_TCLCONFIG], [ #------------------------------------------------------------------------ AC_DEFUN([SC_LOAD_TKCONFIG], [ - AC_MSG_CHECKING([for existence of $TK_BIN_DIR/tkConfig.sh]) + AC_MSG_CHECKING([for existence of ${TK_BIN_DIR}/tkConfig.sh]) - if test -f "$TK_BIN_DIR/tkConfig.sh" ; then + if test -f "${TK_BIN_DIR}/tkConfig.sh" ; then AC_MSG_RESULT([loading]) - . $TK_BIN_DIR/tkConfig.sh + . "${TK_BIN_DIR}/tkConfig.sh" else - AC_MSG_RESULT([could not find $TK_BIN_DIR/tkConfig.sh]) + AC_MSG_RESULT([could not find ${TK_BIN_DIR}/tkConfig.sh]) fi @@ -191,7 +345,7 @@ AC_DEFUN([SC_LOAD_TKCONFIG], [ # # Arguments: # none -# +# # Results: # # Adds the following arguments to configure: @@ -208,8 +362,8 @@ AC_DEFUN([SC_LOAD_TKCONFIG], [ AC_DEFUN([SC_ENABLE_SHARED], [ AC_MSG_CHECKING([how to build libraries]) AC_ARG_ENABLE(shared, - [ --enable-shared build and link with shared libraries [--enable-shared]], - [tcl_ok=$enableval], [tcl_ok=yes]) + [ --enable-shared build and link with shared libraries (default: on)], + [tcl_ok=$enableval], [tcl_ok=yes]) if test "${enable_shared+set}" = set; then enableval="$enable_shared" @@ -224,7 +378,7 @@ AC_DEFUN([SC_ENABLE_SHARED], [ else AC_MSG_RESULT([static]) SHARED_BUILD=0 - AC_DEFINE(STATIC_BUILD) + AC_DEFINE(STATIC_BUILD, 1, [Is this a static build?]) fi ]) @@ -235,7 +389,7 @@ AC_DEFUN([SC_ENABLE_SHARED], [ # # Arguments: # none -# +# # Results: # # Adds the following arguments to configure: @@ -247,11 +401,11 @@ AC_DEFUN([SC_ENABLE_SHARED], [ AC_DEFUN([SC_ENABLE_THREADS], [ AC_MSG_CHECKING(for building with threads) - AC_ARG_ENABLE(threads, [ --enable-threads build with threads], - [tcl_ok=$enableval], [tcl_ok=no]) + AC_ARG_ENABLE(threads, [ --enable-threads build with threads (default: on)], + [tcl_ok=$enableval], [tcl_ok=yes]) if test "$tcl_ok" = "yes"; then - AC_MSG_RESULT(yes) + AC_MSG_RESULT([yes (default)]) TCL_THREADS=1 AC_DEFINE(TCL_THREADS) # USE_THREAD_ALLOC tells us to try the special thread-based @@ -259,7 +413,7 @@ AC_DEFUN([SC_ENABLE_THREADS], [ AC_DEFINE(USE_THREAD_ALLOC) else TCL_THREADS=0 - AC_MSG_RESULT([no (default)]) + AC_MSG_RESULT(no) fi AC_SUBST(TCL_THREADS) ]) @@ -267,17 +421,17 @@ AC_DEFUN([SC_ENABLE_THREADS], [ #------------------------------------------------------------------------ # SC_ENABLE_SYMBOLS -- # -# Specify if debugging symbols should be used +# Specify if debugging symbols should be used. # Memory (TCL_MEM_DEBUG) and compile (TCL_COMPILE_DEBUG) debugging # can also be enabled. # # Arguments: # none -# +# # Requires the following vars to be set in the Makefile: # CFLAGS_DEBUG # CFLAGS_OPTIMIZE -# +# # Results: # # Adds the following arguments to configure: @@ -294,12 +448,13 @@ AC_DEFUN([SC_ENABLE_THREADS], [ AC_DEFUN([SC_ENABLE_SYMBOLS], [ AC_MSG_CHECKING([for build with symbols]) - AC_ARG_ENABLE(symbols, [ --enable-symbols build with debugging symbols [--disable-symbols]], [tcl_ok=$enableval], [tcl_ok=no]) + AC_ARG_ENABLE(symbols, [ --enable-symbols build with debugging symbols (default: off)], [tcl_ok=$enableval], [tcl_ok=no]) # FIXME: Currently, LDFLAGS_DEFAULT is not used, it should work like CFLAGS_DEFAULT. if test "$tcl_ok" = "no"; then CFLAGS_DEFAULT='$(CFLAGS_OPTIMIZE)' LDFLAGS_DEFAULT='$(LDFLAGS_OPTIMIZE)' DBGX="" + AC_DEFINE(NDEBUG, 1, [Is no debugging enabled?]) AC_MSG_RESULT([no]) AC_DEFINE(TCL_CFG_OPTIMIZED) @@ -313,15 +468,14 @@ 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) + AC_DEFINE(TCL_MEM_DEBUG, 1, [Is memory debugging enabled?]) fi if test "$tcl_ok" = "compile" -o "$tcl_ok" = "all"; then - AC_DEFINE(TCL_COMPILE_DEBUG) - AC_DEFINE(TCL_COMPILE_STATS) + AC_DEFINE(TCL_COMPILE_DEBUG, 1, [Is bytecode debugging enabled?]) + AC_DEFINE(TCL_COMPILE_STATS, 1, [Are bytecode statistics enabled?]) fi if test "$tcl_ok" != "yes" -a "$tcl_ok" != "no"; then @@ -369,10 +523,12 @@ AC_DEFUN([SC_ENABLE_SYMBOLS], [ # RES # # MAKE_LIB +# MAKE_STUB_LIB # MAKE_EXE # MAKE_DLL # # LIBSUFFIX +# LIBFLAGSUFFIX # LIBPREFIX # LIBRARIES # EXESUFFIX @@ -401,11 +557,49 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ # Set some defaults (may get changed below) EXTRA_CFLAGS="" + AC_DEFINE(MODULE_SCOPE, [extern], [No need to mark inidividual symbols as hidden]) AC_CHECK_PROG(CYGPATH, cygpath, cygpath -w, echo) SHLIB_SUFFIX=".dll" + # MACHINE is IX86 for LINK, but this is used by the manifest, + # which requires x86|amd64|ia64. + MACHINE="X86" + + if test "$GCC" = "yes"; then + + AC_CACHE_CHECK(for cross-compile version of gcc, + ac_cv_cross, + AC_TRY_COMPILE([ + #ifndef _WIN32 + #error cross-compiler + #endif + ], [], + ac_cv_cross=no, + ac_cv_cross=yes) + ) + + if test "$ac_cv_cross" = "yes"; then + case "$do64bit" in + amd64|x64|yes) + CC="x86_64-w64-mingw32-gcc" + LD="x86_64-w64-mingw32-ld" + AR="x86_64-w64-mingw32-ar" + RANLIB="x86_64-w64-mingw32-ranlib" + RC="x86_64-w64-mingw32-windres" + ;; + *) + CC="i686-w64-mingw32-gcc" + LD="i686-w64-mingw32-ld" + AR="i686-w64-mingw32-ar" + RANLIB="i686-w64-mingw32-ranlib" + RC="i686-w64-mingw32-windres" + ;; + esac + fi + fi + # Check for a bug in gcc's windres that causes the # compile to fail when a Windows native path is # passed into windres. The mingw toolchain requires @@ -431,7 +625,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ cyg_conftest= fi - if test "$CYGPATH" = "echo" || test "$ac_cv_cygwin" = "yes"; then + if test "$CYGPATH" = "echo"; then DEPARG='"$<"' else DEPARG='"$(shell $(CYGPATH) $<)"' @@ -439,15 +633,49 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ # set various compiler flags depending on whether we are using gcc or cl - AC_MSG_CHECKING([compiler flags]) if test "${GCC}" = "yes" ; then - if test "$do64bit" != "no" ; then - AC_MSG_WARN([64bit mode not supported with GCC on Windows]) + extra_cflags="-pipe" + extra_ldflags="-pipe -static-libgcc" + AC_CACHE_CHECK(for mingw32 version of gcc, + ac_cv_win32, + AC_TRY_COMPILE([ + #ifdef _WIN32 + #error win32 + #endif + ], [], + ac_cv_win32=no, + ac_cv_win32=yes) + ) + if test "$ac_cv_win32" != "yes"; then + AC_MSG_ERROR([${CC} cannot produce win32 executables.]) + fi + + hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -mwindows -municode -Dmain=xxmain" + AC_CACHE_CHECK(for working -municode linker flag, + ac_cv_municode, + AC_TRY_LINK([ + #include <windows.h> + int APIENTRY wWinMain(HINSTANCE a, HINSTANCE b, LPWSTR c, int d) {return 0;} + ], + [], + ac_cv_municode=yes, + ac_cv_municode=no) + ) + CFLAGS=$hold_cflags + if test "$ac_cv_municode" = "yes" ; then + extra_ldflags="$extra_ldflags -municode" + else + extra_cflags="$extra_cflags -DTCL_BROKEN_MAINARGS" fi + fi + + AC_MSG_CHECKING([compiler flags]) + if test "${GCC}" = "yes" ; then SHLIB_LD="" - SHLIB_LD_LIBS="" - LIBS="" - LIBS_GUI="-lgdi32 -lcomdlg32 -limm32 -lcomctl32 -lshell32 -lole32 -loleaut32 -luuid" + SHLIB_LD_LIBS='${LIBS}' + LIBS="-lnetapi32 -lkernel32 -luser32 -ladvapi32 -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= @@ -455,43 +683,15 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ RC_DEFINE=--define RES=res.o MAKE_LIB="\${STLIB_LD} \[$]@" + MAKE_STUB_LIB="\${STLIB_LD} \[$]@" POST_MAKE_LIB="\${RANLIB} \[$]@" MAKE_EXE="\${CC} -o \[$]@" LIBPREFIX="lib" - #if test "$ac_cv_cygwin" = "yes"; then - # extra_cflags="-mno-cygwin" - # extra_ldflags="-mno-cygwin" - #else - # extra_cflags="" - # extra_ldflags="" - #fi - - if test "$ac_cv_cygwin" = "yes"; then - touch ac$$.c - if ${CC} -c -mwin32 ac$$.c >/dev/null 2>&1; then - case "$extra_cflags" in - *-mwin32*) ;; - *) extra_cflags="-mwin32 $extra_cflags" ;; - esac - case "$extra_ldflags" in - *-mwin32*) ;; - *) extra_ldflags="-mwin32 $extra_ldflags" ;; - esac - fi - rm -f ac$$.o ac$$.c - else - extra_cflags='' - extra_ldflags='' - fi - if test "${SHARED_BUILD}" = "0" ; then # static AC_MSG_RESULT([using static flags]) runtime= - MAKE_DLL="echo " - LIBSUFFIX="s\${DBGX}.a" - LIBFLAGSUFFIX="s\${DBGX}" LIBRARIES="\${STATIC_LIBRARIES}" EXESUFFIX="s\${DBGX}.exe" else @@ -505,30 +705,29 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ fi runtime= - # Link with gcc since ld does not link to default libs like - # -luser32 and -lmsvcrt by default. Make sure CFLAGS is - # included so -mno-cygwin passed the correct libs to the linker. - SHLIB_LD='${CC} -shared ${CFLAGS}' - SHLIB_LD_LIBS='${LIBS}' # Add SHLIB_LD_LIBS to the Make rule, not here. - MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -o \[$]@ ${extra_ldflags} \ - -Wl,--out-implib,\$(patsubst %.dll,lib%.a,\[$]@)" - LIBSUFFIX="\${DBGX}.a" - LIBFLAGSUFFIX="\${DBGX}" EXESUFFIX="\${DBGX}.exe" LIBRARIES="\${SHARED_LIBRARIES}" fi + # Link with gcc since ld does not link to default libs like + # -luser32 and -lmsvcrt by default. + SHLIB_LD='${CC} -shared' + SHLIB_LD_LIBS='${LIBS}' + MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -o \[$]@ ${extra_ldflags} \ + -Wl,--out-implib,\$(patsubst %.dll,lib%.a,\[$]@)" # DLLSUFFIX is separate because it is the building block for # users of tclConfig.sh that may build shared or static. DLLSUFFIX="\${DBGX}.dll" + LIBSUFFIX="\${DBGX}.a" + LIBFLAGSUFFIX="\${DBGX}" SHLIB_SUFFIX=.dll EXTRA_CFLAGS="${extra_cflags}" CFLAGS_DEBUG=-g CFLAGS_OPTIMIZE="-O2 -fomit-frame-pointer" - CFLAGS_WARNING="-Wall" + CFLAGS_WARNING="-Wall -Wdeclaration-after-statement" LDFLAGS_DEBUG= LDFLAGS_OPTIMIZE= @@ -536,7 +735,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ CC_OBJNAME="-o \[$]@" CC_EXENAME="-o \[$]@" - # Specify linker flags depending on the type of app being + # Specify linker flags depending on the type of app being # built -- Console vs. Window. # # ORIGINAL COMMENT: @@ -547,47 +746,62 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ # cross compiling. Remove this -e workaround once we # require a gcc that does not have this bug. # - # MK NOTE: Tk should use a different mechanism. This causes + # MK NOTE: Tk should use a different mechanism. This causes # interesting problems, such as wish dying at startup. #LDFLAGS_WINDOW="-mwindows -e _WinMain@16 ${extra_ldflags}" LDFLAGS_CONSOLE="-mconsole ${extra_ldflags}" LDFLAGS_WINDOW="-mwindows ${extra_ldflags}" - # gcc under Windows supports only 32bit builds - MACHINE="X86" + case "$do64bit" in + amd64|x64|yes) + MACHINE="AMD64" ; # assume AMD64 as default 64-bit build + AC_MSG_RESULT([ Using 64-bit $MACHINE mode]) + ;; + ia64) + MACHINE="IA64" + AC_MSG_RESULT([ Using 64-bit $MACHINE mode]) + ;; + *) + AC_TRY_COMPILE([ + #ifndef _WIN64 + #error 32-bit + #endif + ], [], + tcl_win_64bit=yes, + tcl_win_64bit=no + ) + if test "$tcl_win_64bit" = "yes" ; then + do64bit=amd64 + MACHINE="AMD64" + AC_MSG_RESULT([ Using 64-bit $MACHINE mode]) + fi + ;; + esac else if test "${SHARED_BUILD}" = "0" ; then # static AC_MSG_RESULT([using static flags]) runtime=-MT - MAKE_DLL="echo " - LIBSUFFIX="s\${DBGX}.lib" - LIBFLAGSUFFIX="s\${DBGX}" LIBRARIES="\${STATIC_LIBRARIES}" EXESUFFIX="s\${DBGX}.exe" - SHLIB_LD_LIBS="" else # dynamic AC_MSG_RESULT([using shared flags]) runtime=-MD # Add SHLIB_LD_LIBS to the Make rule, not here. - MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -out:\[$]@" - LIBSUFFIX="\${DBGX}.lib" - LIBFLAGSUFFIX="\${DBGX}" - EXESUFFIX="\${DBGX}.exe" LIBRARIES="\${SHARED_LIBRARIES}" - SHLIB_LD_LIBS='${LIBS}' + EXESUFFIX="\${DBGX}.exe" fi + MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -out:\[$]@" # DLLSUFFIX is separate because it is the building block for # users of tclConfig.sh that may build shared or static. DLLSUFFIX="\${DBGX}.dll" + LIBSUFFIX="\${DBGX}.lib" + LIBFLAGSUFFIX="\${DBGX}" - # This is a 2-stage check to make sure we have the 64-bit SDK - # We have to know where the SDK is installed. + # This is a 2-stage check to make sure we have the 64-bit SDK + # We have to know where the SDK is installed. # This magic is based on MS Platform SDK for Win2003 SP1 - hobbs - # MACHINE is IX86 for LINK, but this is used by the manifest, - # which requires x86|amd64|ia64. - MACHINE="X86" if test "$do64bit" != "no" ; then if test "x${MSSDK}x" = "xx" ; then MSSDK="C:/Progra~1/Microsoft Platform SDK" @@ -595,14 +809,14 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ MSSDK=`echo "$MSSDK" | sed -e 's!\\\!/!g'` PATH64="" case "$do64bit" in - amd64|x64|yes) - MACHINE="AMD64" ; # assume AMD64 as default 64-bit build - PATH64="${MSSDK}/Bin/Win64/x86/AMD64" - ;; - ia64) - MACHINE="IA64" - PATH64="${MSSDK}/Bin/Win64" - ;; + amd64|x64|yes) + MACHINE="AMD64" ; # assume AMD64 as default 64-bit build + PATH64="${MSSDK}/Bin/Win64/x86/AMD64" + ;; + ia64) + MACHINE="IA64" + PATH64="${MSSDK}/Bin/Win64" + ;; esac if test ! -d "${PATH64}" ; then AC_MSG_WARN([Could not find 64-bit $MACHINE SDK to enable 64bit mode]) @@ -613,12 +827,17 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ fi fi + LIBS="netapi32.lib kernel32.lib 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. @@ -627,7 +846,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ LINKBIN="\"${PATH64}/link.exe\"" # Avoid 'unresolved external symbol __security_cookie' errors. # c.f. http://support.microsoft.com/?id=894573 - LIBS="user32.lib advapi32.lib bufferoverflowU.lib" + LIBS="$LIBS bufferoverflowU.lib" else RC="rc" # -Od - no optimization @@ -637,7 +856,6 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ CFLAGS_OPTIMIZE="-nologo -O2 ${runtime}" lflags="-nologo" LINKBIN="link" - LIBS="user32.lib advapi32.lib" fi if test "$doWince" != "no" ; then @@ -730,10 +948,11 @@ 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 ole32.lib oleaut32.lib uuid.lib" + LIBS_GUI="gdi32.lib comdlg32.lib imm32.lib comctl32.lib shell32.lib uuid.lib" fi SHLIB_LD="${LINKBIN} -dll -incremental:no ${lflags}" + SHLIB_LD_LIBS='${LIBS}' # link -lib only works when -lib is the first arg STLIB_LD="${LINKBIN} -lib ${lflags}" RC_OUT=-fo @@ -742,20 +961,24 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ RC_DEFINE=-d RES=res MAKE_LIB="\${STLIB_LD} -out:\[$]@" + MAKE_STUB_LIB="\${STLIB_LD} -nodefaultlib -out:\[$]@" POST_MAKE_LIB= MAKE_EXE="\${CC} -Fe\[$]@" LIBPREFIX="" + CFLAGS_DEBUG="${CFLAGS_DEBUG} -D_CRT_SECURE_NO_DEPRECATE -D_CRT_NONSTDC_NO_DEPRECATE" + CFLAGS_OPTIMIZE="${CFLAGS_OPTIMIZE} -D_CRT_SECURE_NO_DEPRECATE -D_CRT_NONSTDC_NO_DEPRECATE" + EXTRA_CFLAGS="" CFLAGS_WARNING="-W3" - LDFLAGS_DEBUG="-debug:full" + LDFLAGS_DEBUG="-debug" LDFLAGS_OPTIMIZE="-release" - + # Specify the CC output file names based on the target name CC_OBJNAME="-Fo\[$]@" CC_EXENAME="-Fe\"\$(shell \$(CYGPATH) '\[$]@')\"" - # Specify linker flags depending on the type of app being + # Specify linker flags depending on the type of app being # built -- Console vs. Window. if test "$doWince" != "no" -a "${TARGETCPU}" != "X86"; then LDFLAGS_CONSOLE="-link ${lflags}" @@ -770,6 +993,101 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ AC_DEFINE(TCL_CFG_DO64BIT) fi + if test "${GCC}" = "yes" ; then + AC_CACHE_CHECK(for SEH support in compiler, + tcl_cv_seh, + AC_TRY_RUN([ + #define WIN32_LEAN_AND_MEAN + #include <windows.h> + #undef WIN32_LEAN_AND_MEAN + + int main(int argc, char** argv) { + int a, b = 0; + __try { + a = 666 / b; + } + __except (EXCEPTION_EXECUTE_HANDLER) { + return 0; + } + return 1; + } + ], + tcl_cv_seh=yes, + tcl_cv_seh=no, + tcl_cv_seh=no) + ) + if test "$tcl_cv_seh" = "no" ; then + AC_DEFINE(HAVE_NO_SEH, 1, + [Defined when mingw does not support SEH]) + fi + + # + # Check to see if the excpt.h include file provided contains the + # definition for EXCEPTION_DISPOSITION; if not, which is the case + # with Cygwin's version as of 2002-04-10, define it to be int, + # sufficient for getting the current code to work. + # + AC_CACHE_CHECK(for EXCEPTION_DISPOSITION support in include files, + tcl_cv_eh_disposition, + AC_TRY_COMPILE([ +# define WIN32_LEAN_AND_MEAN +# include <windows.h> +# undef WIN32_LEAN_AND_MEAN + ],[ + EXCEPTION_DISPOSITION x; + ], + tcl_cv_eh_disposition=yes, + tcl_cv_eh_disposition=no) + ) + if test "$tcl_cv_eh_disposition" = "no" ; then + AC_DEFINE(EXCEPTION_DISPOSITION, int, + [Defined when cygwin/mingw does not support EXCEPTION DISPOSITION]) + fi + + # Check to see if winnt.h defines CHAR, SHORT, and LONG + # even if VOID has already been #defined. The win32api + # used by mingw and cygwin is known to do this. + + AC_CACHE_CHECK(for winnt.h that ignores VOID define, + tcl_cv_winnt_ignore_void, + AC_TRY_COMPILE([ + #define VOID void + #define WIN32_LEAN_AND_MEAN + #include <windows.h> + #undef WIN32_LEAN_AND_MEAN + ], [ + CHAR c; + SHORT s; + LONG l; + ], + tcl_cv_winnt_ignore_void=yes, + tcl_cv_winnt_ignore_void=no) + ) + if test "$tcl_cv_winnt_ignore_void" = "yes" ; then + AC_DEFINE(HAVE_WINNT_IGNORE_VOID, 1, + [Defined when cygwin/mingw ignores VOID define in winnt.h]) + fi + + # See if the compiler supports casting to a union type. + # This is used to stop gcc from printing a compiler + # warning when initializing a union member. + + AC_CACHE_CHECK(for cast to union support, + tcl_cv_cast_to_union, + AC_TRY_COMPILE([], + [ + union foo { int i; double d; }; + union foo f = (union foo) (int) 0; + ], + tcl_cv_cast_to_union=yes, + tcl_cv_cast_to_union=no) + ) + if test "$tcl_cv_cast_to_union" = "yes"; then + AC_DEFINE(HAVE_CAST_TO_UNION, 1, + [Defined when compiler supports casting to union type.]) + fi + fi + # DL_LIBS is empty, but then we match the Unix version AC_SUBST(DL_LIBS) AC_SUBST(CFLAGS_DEBUG) @@ -795,13 +1113,13 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ #------------------------------------------------------------------------ AC_DEFUN([SC_WITH_TCL], [ - if test -d ../../tcl8.5$1/win; then - TCL_BIN_DEFAULT=../../tcl8.5$1/win + if test -d ../../tcl8.6$1/win; then + TCL_BIN_DEFAULT=../../tcl8.6$1/win else - TCL_BIN_DEFAULT=../../tcl8.5/win + TCL_BIN_DEFAULT=../../tcl8.6/win fi - - AC_ARG_WITH(tcl, [ --with-tcl=DIR use Tcl 8.5 binaries from DIR], + + AC_ARG_WITH(tcl, [ --with-tcl=DIR use Tcl 8.6 binaries from DIR], TCL_BIN_DIR=$withval, TCL_BIN_DIR=`cd $TCL_BIN_DEFAULT; pwd`) if test ! -d $TCL_BIN_DIR; then AC_MSG_ERROR(Tcl directory $TCL_BIN_DIR does not exist) @@ -905,7 +1223,7 @@ AC_DEFUN([SC_BUILD_TCLSH], [ #-------------------------------------------------------------------- AC_DEFUN([SC_TCL_CFG_ENCODING], [ - AC_ARG_WITH(encoding, [ --with-encoding encoding for configuration values], with_tcencoding=${withval}) + 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}") @@ -914,3 +1232,55 @@ AC_DEFUN([SC_TCL_CFG_ENCODING], [ AC_DEFINE(TCL_CFGVAL_ENCODING,"cp1252") fi ]) + +#-------------------------------------------------------------------- +# SC_EMBED_MANIFEST +# +# Figure out if we can embed the manifest where necessary +# +# Arguments: +# An optional manifest to merge into DLL/EXE. +# +# Results: +# Will define the following vars: +# VC_MANIFEST_EMBED_DLL +# VC_MANIFEST_EMBED_EXE +# +#-------------------------------------------------------------------- + +AC_DEFUN([SC_EMBED_MANIFEST], [ + AC_MSG_CHECKING(whether to embed manifest) + AC_ARG_ENABLE(embedded-manifest, + AC_HELP_STRING([--enable-embedded-manifest], + [embed manifest if possible (default: yes)]), + [embed_ok=$enableval], [embed_ok=yes]) + + VC_MANIFEST_EMBED_DLL= + VC_MANIFEST_EMBED_EXE= + result=no + if test "$embed_ok" = "yes" -a "${SHARED_BUILD}" = "1" \ + -a "$GCC" != "yes" ; then + # Add the magic to embed the manifest into the dll/exe + AC_EGREP_CPP([manifest needed], [ +#if defined(_MSC_VER) && _MSC_VER >= 1400 +print("manifest needed") +#endif + ], [ + # Could do a CHECK_PROG for mt, but should always be with MSVC8+ + # Could add 'if test -f' check, but manifest should be created + # in this compiler case + # Add in a manifest argument that may be specified + # XXX Needs improvement so that the test for existence accounts + # XXX for a provided (known) manifest + VC_MANIFEST_EMBED_DLL="if test -f \[$]@.manifest ; then mt.exe -nologo -manifest \[$]@.manifest $1 -outputresource:\[$]@\;2 ; fi" + VC_MANIFEST_EMBED_EXE="if test -f \[$]@.manifest ; then mt.exe -nologo -manifest \[$]@.manifest $1 -outputresource:\[$]@\;1 ; fi" + result=yes + if test "x$1" != x ; then + result="yes ($1)" + fi + ]) + fi + AC_MSG_RESULT([$result]) + AC_SUBST(VC_MANIFEST_EMBED_DLL) + AC_SUBST(VC_MANIFEST_EMBED_EXE) +]) @@ -1,5 +1,3 @@ -// RCS: @(#) $Id: tcl.rc,v 1.11 2004/02/07 21:47:19 davygrvy Exp $ -// // Version Resource Script // diff --git a/win/tclAppInit.c b/win/tclAppInit.c index 65318b6..a6c1a67 100644 --- a/win/tclAppInit.c +++ b/win/tclAppInit.c @@ -2,32 +2,65 @@ * tclAppInit.c -- * * Provides a default version of the main program and Tcl_AppInit - * function for Tcl applications (without Tk). Note that this program - * must be built in Win32 console mode to work properly. + * procedure for tclsh and other Tcl-based applications (without Tk). + * Note that this program must be built in Win32 console mode to work + * properly. * - * Copyright (c) 1996-1997 by Sun Microsystems, Inc. - * Copyright (c) 1998-1999 by Scriptics Corporation. + * Copyright (c) 1993 The Regents of the University of California. + * Copyright (c) 1994-1997 Sun Microsystems, Inc. + * Copyright (c) 1998-1999 Scriptics Corporation. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. - * - * RCS: @(#) $Id: tclAppInit.c,v 1.24 2007/03/19 16:59:09 dgp Exp $ */ #include "tcl.h" +#define WIN32_LEAN_AND_MEAN #include <windows.h> +#undef WIN32_LEAN_AND_MEAN #include <locale.h> +#include <stdlib.h> +#include <tchar.h> #ifdef TCL_TEST -extern Tcl_PackageInitProc Procbodytest_Init; -extern Tcl_PackageInitProc Procbodytest_SafeInit; -extern Tcl_PackageInitProc Tcltest_Init; -extern Tcl_PackageInitProc TclObjTest_Init; +extern Tcl_PackageInitProc Tcltest_Init; +extern Tcl_PackageInitProc Tcltest_SafeInit; #endif /* TCL_TEST */ -#if defined(__GNUC__) -static void setargv(int *argcPtr, char ***argvPtr); -#endif /* __GNUC__ */ +#if defined(STATIC_BUILD) && TCL_USE_STATIC_PACKAGES +extern Tcl_PackageInitProc Registry_Init; +extern Tcl_PackageInitProc Dde_Init; +extern Tcl_PackageInitProc Dde_SafeInit; +#endif + +#ifdef TCL_BROKEN_MAINARGS +int _CRT_glob = 0; +static void setargv(int *argcPtr, TCHAR ***argvPtr); +#endif /* TCL_BROKEN_MAINARGS */ + +/* + * The following #if block allows you to change the AppInit function by using + * a #define of TCL_LOCAL_APPINIT instead of rewriting this entire file. The + * #if checks for that #define and uses Tcl_AppInit if it does not exist. + */ + +#ifndef TCL_LOCAL_APPINIT +#define TCL_LOCAL_APPINIT Tcl_AppInit +#endif +#ifndef MODULE_SCOPE +# define MODULE_SCOPE extern +#endif +MODULE_SCOPE int TCL_LOCAL_APPINIT(Tcl_Interp *); + +/* + * The following #if block allows you to change how Tcl finds the startup + * script, prime the library or encoding paths, fiddle with the argv, etc., + * without needing to rewrite Tcl_Main() + */ + +#ifdef TCL_LOCAL_MAIN_HOOK +MODULE_SCOPE int TCL_LOCAL_MAIN_HOOK(int *argc, TCHAR ***argv); +#endif /* *---------------------------------------------------------------------- @@ -37,51 +70,45 @@ static void setargv(int *argcPtr, char ***argvPtr); * This is the main program for the application. * * Results: - * None: Tcl_Main never returns here, so this function never returns + * None: Tcl_Main never returns here, so this procedure never returns * either. * * Side effects: - * Whatever the application does. + * Just about anything, since from here we call arbitrary Tcl code. * *---------------------------------------------------------------------- */ +#ifdef TCL_BROKEN_MAINARGS int -main(int argc, char *argv[]) +main( + int argc, /* Number of command-line arguments. */ + char *dummy[]) /* Not used. */ +{ + TCHAR **argv; +#else +int +_tmain( + int argc, /* Number of command-line arguments. */ + TCHAR *argv[]) /* Values of command-line arguments. */ { - /* - * The following #if block allows you to change the AppInit function by - * using a #define of TCL_LOCAL_APPINIT instead of rewriting this entire - * file. The #if checks for that #define and uses Tcl_AppInit if it - * doesn't exist. - */ - -#ifndef TCL_LOCAL_APPINIT -#define TCL_LOCAL_APPINIT Tcl_AppInit #endif - extern int TCL_LOCAL_APPINIT _ANSI_ARGS_((Tcl_Interp *interp)); + TCHAR *p; /* - * The following #if block allows you to change how Tcl finds the startup - * script, prime the library or encoding paths, fiddle with the argv, - * etc., without needing to rewrite Tcl_Main() + * Set up the default locale to be standard "C" locale so parsing is + * performed correctly. */ -#ifdef TCL_LOCAL_MAIN_HOOK - extern int TCL_LOCAL_MAIN_HOOK _ANSI_ARGS_((int *argc, char ***argv)); -#endif - - char *p; + setlocale(LC_ALL, "C"); +#ifdef TCL_BROKEN_MAINARGS /* - * Set up the default locale to be standard "C" locale so parsing is - * performed correctly. + * Get our args from the c-runtime. Ignore command line. */ -#if defined(__GNUC__) - setargv( &argc, &argv ); + setargv(&argc, &argv); #endif - setlocale(LC_ALL, "C"); /* * Forward slashes substituted for backslashes. @@ -98,7 +125,6 @@ main(int argc, char *argv[]) #endif Tcl_Main(argc, argv, TCL_LOCAL_APPINIT); - return 0; /* Needed only to prevent compiler warning. */ } @@ -107,9 +133,9 @@ main(int argc, char *argv[]) * * Tcl_AppInit -- * - * This function performs application-specific initialization. Most + * This procedure performs application-specific initialization. Most * applications, especially those that incorporate additional packages, - * will have their own version of this function. + * will have their own version of this procedure. * * Results: * Returns a standard Tcl completion code, and leaves an error message in @@ -122,60 +148,47 @@ main(int argc, char *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) { + if ((Tcl_Init)(interp) == TCL_ERROR) { return TCL_ERROR; } -#ifdef TCL_TEST - if (Tcltest_Init(interp) == TCL_ERROR) { +#if defined(STATIC_BUILD) && TCL_USE_STATIC_PACKAGES + if (Registry_Init(interp) == TCL_ERROR) { return TCL_ERROR; } - Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init, NULL); - if (TclObjTest_Init(interp) == TCL_ERROR) { + Tcl_StaticPackage(interp, "registry", Registry_Init, NULL); + + if (Dde_Init(interp) == TCL_ERROR) { return TCL_ERROR; } - if (Procbodytest_Init(interp) == TCL_ERROR) { + Tcl_StaticPackage(interp, "dde", Dde_Init, Dde_SafeInit); +#endif + +#ifdef TCL_TEST + if (Tcltest_Init(interp) == TCL_ERROR) { return TCL_ERROR; } - Tcl_StaticPackage(interp, "procbodytest", Procbodytest_Init, - Procbodytest_SafeInit); + Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init, Tcltest_SafeInit); #endif /* TCL_TEST */ -#if defined(STATIC_BUILD) && TCL_USE_STATIC_PACKAGES - { - extern Tcl_PackageInitProc Registry_Init; - extern Tcl_PackageInitProc Dde_Init; - extern Tcl_PackageInitProc Dde_SafeInit; - - if (Registry_Init(interp) == TCL_ERROR) { - return TCL_ERROR; - } - Tcl_StaticPackage(interp, "registry", Registry_Init, NULL); - - if (Dde_Init(interp) == TCL_ERROR) { - return TCL_ERROR; - } - Tcl_StaticPackage(interp, "dde", Dde_Init, Dde_SafeInit); - } -#endif - /* - * Call the init functions for included packages. Each call should look + * Call the init procedures for included packages. Each call should look * like this: * * if (Mod_Init(interp) == TCL_ERROR) { * return TCL_ERROR; * } * - * where "Mod" is the name of the module. + * where "Mod" is the name of the module. (Dynamically-loadable packages + * should have the same entry-point name.) */ /* * Call Tcl_CreateCommand for application-specific commands, if they - * weren't already created by the init functions called above. + * weren't already created by the init procedures called above. */ /* @@ -185,7 +198,8 @@ Tcl_AppInit(interp) * user-specific startup file will be run under any conditions. */ - Tcl_SetVar(interp, "tcl_rcFileName", "~/tclshrc.tcl", TCL_GLOBAL_ONLY); + (Tcl_ObjSetVar2)(interp, Tcl_NewStringObj("tcl_rcFileName", -1), NULL, + Tcl_NewStringObj("~/tclshrc.tcl", -1), TCL_GLOBAL_ONLY); return TCL_OK; } @@ -216,17 +230,17 @@ Tcl_AppInit(interp) *-------------------------------------------------------------------------- */ -#if defined(__GNUC__) +#ifdef TCL_BROKEN_MAINARGS 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. */ + TCHAR ***argvPtr) /* Filled with argument strings (malloc'd). */ { - char *cmdLine, *p, *arg, *argSpace; - char **argv; + TCHAR *cmdLine, *p, *arg, *argSpace; + TCHAR **argv; int argc, size, inquote, copy, slashes; - cmdLine = GetCommandLine(); /* INTL: BUG */ + cmdLine = GetCommandLine(); /* * Precompute an overly pessimistic guess at the number of arguments in @@ -245,10 +259,15 @@ setargv(argcPtr, argvPtr) } } } - argSpace = (char *) ckalloc( - (unsigned) (size * sizeof(char *) + strlen(cmdLine) + 1)); - argv = (char **) argSpace; - argSpace += size * sizeof(char *); + + /* Make sure we don't call ckalloc through the (not yet initialized) stub table */ + #undef Tcl_Alloc + #undef Tcl_DbCkalloc + + argSpace = ckalloc(size * sizeof(char *) + + (_tcslen(cmdLine) * sizeof(TCHAR)) + sizeof(TCHAR)); + argv = (TCHAR **) argSpace; + argSpace += size * (sizeof(char *)/sizeof(TCHAR)); size--; p = cmdLine; @@ -306,7 +325,7 @@ setargv(argcPtr, argvPtr) *argcPtr = argc; *argvPtr = argv; } -#endif /* __GNUC__ */ +#endif /* TCL_BROKEN_MAINARGS */ /* * Local Variables: diff --git a/win/tclConfig.sh.in b/win/tclConfig.sh.in index 991fc09..00a8790 100644 --- a/win/tclConfig.sh.in +++ b/win/tclConfig.sh.in @@ -8,8 +8,6 @@ # out for themselves. # # The information in this file is specific to a single platform. -# -# RCS: @(#) $Id: tclConfig.sh.in,v 1.8 2001/11/08 03:07:22 mdejong Exp $ TCL_DLL_FILE="@TCL_DLL_FILE@" @@ -177,6 +175,6 @@ TCL_BUILD_STUB_LIB_PATH='@TCL_BUILD_STUB_LIB_PATH@' # Path to the Tcl stub library in the install directory. TCL_STUB_LIB_PATH='@TCL_STUB_LIB_PATH@' -# Flag, 1: we built Tcl with threads enables, 0 we didn't +# Flag, 1: we built Tcl with threads enabled, 0 we didn't TCL_THREADS=@TCL_THREADS@ diff --git a/win/tclWin32Dll.c b/win/tclWin32Dll.c index c196705..688fa8d 100644 --- a/win/tclWin32Dll.c +++ b/win/tclWin32Dll.c @@ -9,25 +9,12 @@ * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. - * - * RCS: @(#) $Id: tclWin32Dll.c,v 1.48 2005/11/04 00:06:50 dkf Exp $ */ #include "tclWinInt.h" - -/* - * The following data structures are used when loading the thunking library - * for execing child processes under Win32s. - */ - -typedef DWORD (WINAPI UT32PROC)(LPVOID lpBuff, DWORD dwUserDefined, - LPVOID *lpTranslationList); - -typedef BOOL (WINAPI UTREGISTER)(HANDLE hModule, LPCSTR SixteenBitDLL, - LPCSTR InitName, LPCSTR ProcName, UT32PROC **ThirtyTwoBitThunk, - FARPROC UT32Callback, LPVOID Buff); - -typedef VOID (WINAPI UTUNREGISTER)(HANDLE hModule); +#if defined(HAVE_INTRIN_H) +# include <intrin.h> +#endif /* * The following variables keep track of information about this DLL on a @@ -38,23 +25,6 @@ typedef VOID (WINAPI UTUNREGISTER)(HANDLE hModule); 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. - */ - -typedef struct EXCEPTION_REGISTRATION { - 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 */ @@ -63,148 +33,14 @@ typedef struct EXCEPTION_REGISTRATION { #define cpuid __asm __emit 0fh __asm __emit 0a2h #endif -/* - * The following function tables are used to dispatch to either the - * wide-character or multi-byte versions of the operating system calls, - * depending on whether the Unicode calls are available. - */ - -static TclWinProcs asciiProcs = { - 0, - - (BOOL (WINAPI *)(CONST TCHAR *, LPDCB)) BuildCommDCBA, - (TCHAR *(WINAPI *)(TCHAR *)) CharLowerA, - (BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR *, BOOL)) CopyFileA, - (BOOL (WINAPI *)(CONST TCHAR *, LPSECURITY_ATTRIBUTES)) CreateDirectoryA, - (HANDLE (WINAPI *)(CONST TCHAR *, DWORD, DWORD, SECURITY_ATTRIBUTES *, - DWORD, DWORD, HANDLE)) CreateFileA, - (BOOL (WINAPI *)(CONST TCHAR *, TCHAR *, LPSECURITY_ATTRIBUTES, - LPSECURITY_ATTRIBUTES, BOOL, DWORD, LPVOID, CONST TCHAR *, - LPSTARTUPINFOA, LPPROCESS_INFORMATION)) CreateProcessA, - (BOOL (WINAPI *)(CONST TCHAR *)) DeleteFileA, - (HANDLE (WINAPI *)(CONST TCHAR *, WIN32_FIND_DATAT *)) FindFirstFileA, - (BOOL (WINAPI *)(HANDLE, WIN32_FIND_DATAT *)) FindNextFileA, - (BOOL (WINAPI *)(WCHAR *, LPDWORD)) GetComputerNameA, - (DWORD (WINAPI *)(DWORD, WCHAR *)) GetCurrentDirectoryA, - (DWORD (WINAPI *)(CONST TCHAR *)) GetFileAttributesA, - (DWORD (WINAPI *)(CONST TCHAR *, DWORD nBufferLength, WCHAR *, - TCHAR **)) GetFullPathNameA, - (DWORD (WINAPI *)(HMODULE, WCHAR *, int)) GetModuleFileNameA, - (DWORD (WINAPI *)(CONST TCHAR *, WCHAR *, DWORD)) GetShortPathNameA, - (UINT (WINAPI *)(CONST TCHAR *, CONST TCHAR *, UINT uUnique, - WCHAR *)) GetTempFileNameA, - (DWORD (WINAPI *)(DWORD, WCHAR *)) GetTempPathA, - (BOOL (WINAPI *)(CONST TCHAR *, WCHAR *, DWORD, LPDWORD, LPDWORD, LPDWORD, - WCHAR *, DWORD)) GetVolumeInformationA, - (HINSTANCE (WINAPI *)(CONST TCHAR *)) LoadLibraryA, - (TCHAR (WINAPI *)(WCHAR *, CONST TCHAR *)) lstrcpyA, - (BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR *)) MoveFileA, - (BOOL (WINAPI *)(CONST TCHAR *)) RemoveDirectoryA, - (DWORD (WINAPI *)(CONST TCHAR *, CONST TCHAR *, CONST TCHAR *, DWORD, - WCHAR *, TCHAR **)) SearchPathA, - (BOOL (WINAPI *)(CONST TCHAR *)) SetCurrentDirectoryA, - (BOOL (WINAPI *)(CONST TCHAR *, DWORD)) SetFileAttributesA, - - /* - * The three NULL function pointers will only be set when - * Tcl_FindExecutable is called. If you don't ever call that function, the - * application will crash whenever WinTcl tries to call functions through - * these null pointers. That is not a bug in Tcl - Tcl_FindExecutable is - * mandatory in recent Tcl releases. - */ - - NULL, - NULL, - /* deleted (int (__cdecl*)(CONST TCHAR *, struct _utimbuf *)) _utime, */ - NULL, - NULL, - /* getLongPathNameProc */ - NULL, - /* Security SDK - not available on 95,98,ME */ - NULL, NULL, NULL, NULL, NULL, NULL, - /* ReadConsole and WriteConsole */ - (BOOL (WINAPI *)(HANDLE, LPVOID, DWORD, LPDWORD, LPVOID)) ReadConsoleA, - (BOOL (WINAPI *)(HANDLE, const VOID*, DWORD, LPDWORD, LPVOID)) WriteConsoleA -}; - -static TclWinProcs unicodeProcs = { - 1, - - (BOOL (WINAPI *)(CONST TCHAR *, LPDCB)) BuildCommDCBW, - (TCHAR *(WINAPI *)(TCHAR *)) CharLowerW, - (BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR *, BOOL)) CopyFileW, - (BOOL (WINAPI *)(CONST TCHAR *, LPSECURITY_ATTRIBUTES)) CreateDirectoryW, - (HANDLE (WINAPI *)(CONST TCHAR *, DWORD, DWORD, SECURITY_ATTRIBUTES *, - DWORD, DWORD, HANDLE)) CreateFileW, - (BOOL (WINAPI *)(CONST TCHAR *, TCHAR *, LPSECURITY_ATTRIBUTES, - LPSECURITY_ATTRIBUTES, BOOL, DWORD, LPVOID, CONST TCHAR *, - LPSTARTUPINFOA, LPPROCESS_INFORMATION)) CreateProcessW, - (BOOL (WINAPI *)(CONST TCHAR *)) DeleteFileW, - (HANDLE (WINAPI *)(CONST TCHAR *, WIN32_FIND_DATAT *)) FindFirstFileW, - (BOOL (WINAPI *)(HANDLE, WIN32_FIND_DATAT *)) FindNextFileW, - (BOOL (WINAPI *)(WCHAR *, LPDWORD)) GetComputerNameW, - (DWORD (WINAPI *)(DWORD, WCHAR *)) GetCurrentDirectoryW, - (DWORD (WINAPI *)(CONST TCHAR *)) GetFileAttributesW, - (DWORD (WINAPI *)(CONST TCHAR *, DWORD nBufferLength, WCHAR *, - TCHAR **)) GetFullPathNameW, - (DWORD (WINAPI *)(HMODULE, WCHAR *, int)) GetModuleFileNameW, - (DWORD (WINAPI *)(CONST TCHAR *, WCHAR *, DWORD)) GetShortPathNameW, - (UINT (WINAPI *)(CONST TCHAR *, CONST TCHAR *, UINT uUnique, - WCHAR *)) GetTempFileNameW, - (DWORD (WINAPI *)(DWORD, WCHAR *)) GetTempPathW, - (BOOL (WINAPI *)(CONST TCHAR *, WCHAR *, DWORD, LPDWORD, LPDWORD, LPDWORD, - WCHAR *, DWORD)) GetVolumeInformationW, - (HINSTANCE (WINAPI *)(CONST TCHAR *)) LoadLibraryW, - (TCHAR (WINAPI *)(WCHAR *, CONST TCHAR *)) lstrcpyW, - (BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR *)) MoveFileW, - (BOOL (WINAPI *)(CONST TCHAR *)) RemoveDirectoryW, - (DWORD (WINAPI *)(CONST TCHAR *, CONST TCHAR *, CONST TCHAR *, DWORD, - WCHAR *, TCHAR **)) SearchPathW, - (BOOL (WINAPI *)(CONST TCHAR *)) SetCurrentDirectoryW, - (BOOL (WINAPI *)(CONST TCHAR *, DWORD)) SetFileAttributesW, - - /* - * The three NULL function pointers will only be set when - * Tcl_FindExecutable is called. If you don't ever call that function, the - * application will crash whenever WinTcl tries to call functions through - * these null pointers. That is not a bug in Tcl - Tcl_FindExecutable is - * mandatory in recent Tcl releases. - */ - - NULL, - NULL, - /* deleted (int (__cdecl*)(CONST TCHAR *, struct _utimbuf *)) _wutime, */ - NULL, - NULL, - /* getLongPathNameProc */ - NULL, - /* Security SDK - will be filled in on NT,XP,2000,2003 */ - NULL, NULL, NULL, NULL, NULL, NULL, - /* ReadConsole and WriteConsole */ - (BOOL (WINAPI *)(HANDLE, LPVOID, DWORD, LPDWORD, LPVOID)) ReadConsoleW, - (BOOL (WINAPI *)(HANDLE, const VOID*, DWORD, LPDWORD, LPVOID)) WriteConsoleW -}; - -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. - */ +static Tcl_Encoding winTCharEncoding = NULL; -BOOL APIENTRY DllMain(HINSTANCE hInst, DWORD reason, - LPVOID reserved) __attribute__ ((noinline)); -#else /* * The following declaration is for the VC++ DLL entry point. */ BOOL APIENTRY DllMain(HINSTANCE hInst, DWORD reason, LPVOID reserved); -#endif /* HAVE_NO_SEH */ /* * The following structure and linked list is to allow us to map between @@ -213,8 +49,8 @@ BOOL APIENTRY DllMain(HINSTANCE hInst, DWORD reason, */ typedef struct MountPointMap { - CONST WCHAR *volumeName; /* Native wide string volume name. */ - char driveLetter; /* Drive letter corresponding to the volume + const TCHAR *volumeName; /* Native wide string volume name. */ + TCHAR driveLetter; /* Drive letter corresponding to the volume * name. */ struct MountPointMap *nextPtr; /* Pointer to next structure in list, or @@ -233,9 +69,7 @@ TCL_DECLARE_MUTEX(mountPointMap) * We will need this below. */ -extern Tcl_FSDupInternalRepProc TclNativeDupInternalRep; - -#ifdef __WIN32__ +#ifdef _WIN32 #ifndef STATIC_BUILD /* @@ -277,10 +111,7 @@ DllEntryPoint( * TRUE on sucess, FALSE on failure. * * Side effects: - * 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." + * Initializes most rudimentary Windows bits. * *---------------------------------------------------------------------- */ @@ -291,107 +122,22 @@ DllMain( DWORD reason, /* Reason this function is being called. */ LPVOID reserved) /* Not used. */ { -#ifdef HAVE_NO_SEH - EXCEPTION_REGISTRATION registration; -#endif - switch (reason) { case DLL_PROCESS_ATTACH: DisableThreadLibraryCalls(hInst); TclWinInit(hInst); return TRUE; - case DLL_PROCESS_DETACH: /* - * Protect the call to Tcl_Finalize. The OS could be unloading us from - * an exception handler and the state of the stack might be unstable. + * DLL_PROCESS_DETACH is unnecessary as the user should call + * Tcl_Finalize explicitly before unloading Tcl. */ - -#ifdef HAVE_NO_SEH - __asm__ __volatile__ ( - - /* - * Construct an EXCEPTION_REGISTRATION to protect the call to - * Tcl_Finalize - */ - - "leal %[registration], %%edx" "\n\t" - "movl %%fs:0, %%eax" "\n\t" - "movl %%eax, 0x0(%%edx)" "\n\t" /* link */ - "leal 1f, %%eax" "\n\t" - "movl %%eax, 0x4(%%edx)" "\n\t" /* handler */ - "movl %%ebp, 0x8(%%edx)" "\n\t" /* ebp */ - "movl %%esp, 0xc(%%edx)" "\n\t" /* esp */ - "movl %[error], 0x10(%%edx)" "\n\t" /* status */ - - /* - * Link the EXCEPTION_REGISTRATION on the chain - */ - - "movl %%edx, %%fs:0" "\n\t" - - /* - * Call Tcl_Finalize - */ - - "call _Tcl_Finalize" "\n\t" - - /* - * Come here on a normal exit. Recover the 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" - - - /* - * 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) - : - "%eax", "%ebx", "%ecx", "%edx", "%esi", "%edi", "memory" - ); - -#else /* HAVE_NO_SEH */ - __try { - Tcl_Finalize(); - } __except (EXCEPTION_EXECUTE_HANDLER) { - /* empty handler body. */ - } -#endif - - break; } return TRUE; } #endif /* !STATIC_BUILD */ -#endif /* __WIN32__ */ +#endif /* _WIN32 */ /* *---------------------------------------------------------------------- @@ -435,23 +181,26 @@ void TclWinInit( HINSTANCE hInst) /* Library instance handle. */ { - OSVERSIONINFO os; + OSVERSIONINFOW os; hInstance = hInst; - os.dwOSVersionInfoSize = sizeof(OSVERSIONINFO); - GetVersionEx(&os); + os.dwOSVersionInfoSize = sizeof(OSVERSIONINFOW); + GetVersionExW(&os); 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 or Win9x, so just in case someone manages + * to get a runtime there, make sure they know that. */ if (platformId == VER_PLATFORM_WIN32s) { Tcl_Panic("Win32s is not a supported platform"); } + if (platformId == VER_PLATFORM_WIN32_WINDOWS) { + Tcl_Panic("Windows 9x is not a supported platform"); + } - tclWinProcs = &asciiProcs; + TclWinResetInterfaces(); } /* @@ -464,9 +213,10 @@ TclWinInit( * * Results: * The return value is one of: - * VER_PLATFORM_WIN32s Win32s on Windows 3.1. (not supported) - * VER_PLATFORM_WIN32_WINDOWS Win32 on Windows 95, 98, ME. - * VER_PLATFORM_WIN32_NT Win32 on Windows NT, 2000, XP + * VER_PLATFORM_WIN32s Win32s on Windows 3.1 (not supported) + * VER_PLATFORM_WIN32_WINDOWS Win32 on Windows 95, 98, ME (not supported) + * VER_PLATFORM_WIN32_NT Win32 on Windows NT, 2000, XP + * VER_PLATFORM_WIN32_CE Win32 on Windows CE * * Side effects: * None. @@ -512,143 +262,11 @@ TclWinNoBackslash( } /* - *---------------------------------------------------------------------- - * - * TclpCheckStackSpace -- - * - * Detect if we are about to blow the stack. Called before an evaluation - * can happen when nesting depth is checked. - * - * Results: - * 1 if there is enough stack space to continue; 0 if not. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -int -TclpCheckStackSpace(void) -{ - -#ifdef HAVE_NO_SEH - 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. - */ - -#ifdef HAVE_NO_SEH - __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 /* !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 */ - - return retval; -} - -/* *--------------------------------------------------------------------------- * - * 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. + * TclpSetInterfaces -- * - * 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 initializes winTCharEncoding. * * Results: * None. @@ -660,115 +278,18 @@ TclpCheckStackSpace(void) */ void -TclWinSetInterfaces( - int wide) /* Non-zero to use wide interfaces, 0 - * otherwise. */ +TclpSetInterfaces(void) { - Tcl_FreeEncoding(tclWinTCharEncoding); - - if (wide) { - tclWinProcs = &unicodeProcs; - tclWinTCharEncoding = Tcl_GetEncoding(NULL, "unicode"); - if (tclWinProcs->getFileAttributesExProc == NULL) { - HINSTANCE hInstance = LoadLibraryA("kernel32"); - if (hInstance != NULL) { - tclWinProcs->getFileAttributesExProc = - (BOOL (WINAPI *)(CONST TCHAR *, GET_FILEEX_INFO_LEVELS, - LPVOID)) GetProcAddress(hInstance, - "GetFileAttributesExW"); - tclWinProcs->createHardLinkProc = - (BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR*, - LPSECURITY_ATTRIBUTES)) GetProcAddress(hInstance, - "CreateHardLinkW"); - tclWinProcs->findFirstFileExProc = - (HANDLE (WINAPI *)(CONST TCHAR*, UINT, LPVOID, UINT, - LPVOID, DWORD)) GetProcAddress(hInstance, - "FindFirstFileExW"); - tclWinProcs->getVolumeNameForVMPProc = - (BOOL (WINAPI *)(CONST TCHAR*, TCHAR*, - DWORD)) GetProcAddress(hInstance, - "GetVolumeNameForVolumeMountPointW"); - tclWinProcs->getLongPathNameProc = - (DWORD (WINAPI *)(CONST TCHAR*, TCHAR*, - DWORD)) GetProcAddress(hInstance, "GetLongPathNameW"); - FreeLibrary(hInstance); - } - hInstance = LoadLibraryA("advapi32"); - if (hInstance != NULL) { - tclWinProcs->getFileSecurityProc = (BOOL (WINAPI *)( - LPCTSTR lpFileName, - SECURITY_INFORMATION RequestedInformation, - PSECURITY_DESCRIPTOR pSecurityDescriptor, - DWORD nLength, LPDWORD lpnLengthNeeded)) - GetProcAddress(hInstance, "GetFileSecurityW"); - tclWinProcs->impersonateSelfProc = (BOOL (WINAPI *) ( - SECURITY_IMPERSONATION_LEVEL ImpersonationLevel)) - GetProcAddress(hInstance, "ImpersonateSelf"); - tclWinProcs->openThreadTokenProc = (BOOL (WINAPI *) ( - HANDLE ThreadHandle, DWORD DesiredAccess, - BOOL OpenAsSelf, PHANDLE TokenHandle)) - GetProcAddress(hInstance, "OpenThreadToken"); - tclWinProcs->revertToSelfProc = (BOOL (WINAPI *) (void)) - GetProcAddress(hInstance, "RevertToSelf"); - tclWinProcs->mapGenericMaskProc = (VOID (WINAPI *) ( - PDWORD AccessMask, PGENERIC_MAPPING GenericMapping)) - GetProcAddress(hInstance, "MapGenericMask"); - tclWinProcs->accessCheckProc = (BOOL (WINAPI *)( - PSECURITY_DESCRIPTOR pSecurityDescriptor, - HANDLE ClientToken, DWORD DesiredAccess, - PGENERIC_MAPPING GenericMapping, - PPRIVILEGE_SET PrivilegeSet, - LPDWORD PrivilegeSetLength, LPDWORD GrantedAccess, - LPBOOL AccessStatus)) GetProcAddress(hInstance, - "AccessCheck"); - FreeLibrary(hInstance); - } - } - } else { - tclWinProcs = &asciiProcs; - tclWinTCharEncoding = NULL; - if (tclWinProcs->getFileAttributesExProc == NULL) { - HINSTANCE hInstance = LoadLibraryA("kernel32"); - if (hInstance != NULL) { - tclWinProcs->getFileAttributesExProc = - (BOOL (WINAPI *)(CONST TCHAR *, GET_FILEEX_INFO_LEVELS, - LPVOID)) GetProcAddress(hInstance, - "GetFileAttributesExA"); - tclWinProcs->createHardLinkProc = - (BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR*, - LPSECURITY_ATTRIBUTES)) GetProcAddress(hInstance, - "CreateHardLinkA"); - tclWinProcs->findFirstFileExProc = NULL; - tclWinProcs->getLongPathNameProc = NULL; - /* - * The 'findFirstFileExProc' function exists on some of - * 95/98/ME, but it seems not to work as anticipated. - * Therefore we don't set this function pointer. The relevant - * code will fall back on a slower approach using the normal - * findFirstFileProc. - * - * (HANDLE (WINAPI *)(CONST TCHAR*, UINT, - * LPVOID, UINT, LPVOID, DWORD)) GetProcAddress(hInstance, - * "FindFirstFileExA"); - */ - tclWinProcs->getVolumeNameForVMPProc = - (BOOL (WINAPI *)(CONST TCHAR*, TCHAR*, - DWORD)) GetProcAddress(hInstance, - "GetVolumeNameForVolumeMountPointA"); - FreeLibrary(hInstance); - } - } - } + TclWinResetInterfaces(); + winTCharEncoding = Tcl_GetEncoding(NULL, "unicode"); } /* *--------------------------------------------------------------------------- * - * TclWinResetInterfaceEncodings -- + * TclWinEncodingsCleanup -- * - * 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. * * 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 @@ -784,13 +305,11 @@ TclWinSetInterfaces( */ void -TclWinResetInterfaceEncodings(void) +TclWinEncodingsCleanup(void) { MountPointMap *dlIter, *dlIter2; - if (tclWinTCharEncoding != NULL) { - Tcl_FreeEncoding(tclWinTCharEncoding); - tclWinTCharEncoding = NULL; - } + + TclWinResetInterfaces(); /* * Clean up the mount point map. @@ -800,8 +319,8 @@ TclWinResetInterfaceEncodings(void) dlIter = driveLetterLookup; while (dlIter != NULL) { dlIter2 = dlIter->nextPtr; - ckfree((char*)dlIter->volumeName); - ckfree((char*)dlIter); + ckfree(dlIter->volumeName); + ckfree(dlIter); dlIter = dlIter2; } Tcl_MutexUnlock(&mountPointMap); @@ -813,8 +332,6 @@ TclWinResetInterfaceEncodings(void) * TclWinResetInterfaces -- * * Called during finalization to reset us to a safe state for reuse. - * After this call, it is best not to use the tclWinProcs-> look up table - * since it is likely to be different to what is expected. * * Results: * None. @@ -827,7 +344,10 @@ TclWinResetInterfaceEncodings(void) void TclWinResetInterfaces(void) { - tclWinProcs = &asciiProcs; + if (winTCharEncoding != NULL) { + Tcl_FreeEncoding(winTCharEncoding); + winTCharEncoding = NULL; + } } /* @@ -854,11 +374,11 @@ TclWinResetInterfaces(void) char TclWinDriveLetterForVolMountPoint( - CONST WCHAR *mountPoint) + const TCHAR *mountPoint) { MountPointMap *dlIter, *dlPtr2; - WCHAR Target[55]; /* Target of mount at mount point */ - WCHAR drive[4] = { L'A', L':', L'\\', L'\0' }; + TCHAR Target[55]; /* Target of mount at mount point */ + TCHAR drive[4] = TEXT("A:\\"); /* * Detect the volume mounted there. Unfortunately, there is no simple way @@ -869,28 +389,28 @@ TclWinDriveLetterForVolMountPoint( Tcl_MutexLock(&mountPointMap); dlIter = driveLetterLookup; while (dlIter != NULL) { - if (wcscmp(dlIter->volumeName, mountPoint) == 0) { + if (_tcscmp(dlIter->volumeName, mountPoint) == 0) { /* * We need to check whether this information is still valid, since * either the user or various programs could have adjusted the * mount points on the fly. */ - drive[0] = L'A' + (dlIter->driveLetter - 'A'); + drive[0] = (TCHAR) dlIter->driveLetter; /* * 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) { + if (GetVolumeNameForVolumeMountPoint(drive, + Target, 55) != 0) { + if (_tcscmp(dlIter->volumeName, Target) == 0) { /* * Nothing has changed. */ Tcl_MutexUnlock(&mountPointMap); - return dlIter->driveLetter; + return (char) dlIter->driveLetter; } } @@ -917,8 +437,8 @@ TclWinDriveLetterForVolMountPoint( * Now dlPtr2 points to the structure to free. */ - ckfree((char*)dlPtr2->volumeName); - ckfree((char*)dlPtr2); + ckfree(dlPtr2->volumeName); + ckfree(dlPtr2); /* * Restart the loop - we could try to be clever and continue half @@ -941,23 +461,23 @@ TclWinDriveLetterForVolMountPoint( * Try to read the volume mount point and see where it points. */ - if ((*tclWinProcs->getVolumeNameForVMPProc)((TCHAR*)drive, - (TCHAR*)Target, 55) != 0) { + if (GetVolumeNameForVolumeMountPoint(drive, + Target, 55) != 0) { int alreadyStored = 0; for (dlIter = driveLetterLookup; dlIter != NULL; dlIter = dlIter->nextPtr) { - if (wcscmp((WCHAR*)dlIter->volumeName, Target) == 0) { + if (_tcscmp(dlIter->volumeName, Target) == 0) { alreadyStored = 1; break; } } if (!alreadyStored) { - dlPtr2 = (MountPointMap *) ckalloc(sizeof(MountPointMap)); + dlPtr2 = ckalloc(sizeof(MountPointMap)); dlPtr2->volumeName = TclNativeDupInternalRep(Target); - dlPtr2->driveLetter = 'A' + (drive[0] - L'A'); + dlPtr2->driveLetter = (char) drive[0]; dlPtr2->nextPtr = driveLetterLookup; - driveLetterLookup = dlPtr2; + driveLetterLookup = dlPtr2; } } } @@ -968,9 +488,9 @@ TclWinDriveLetterForVolMountPoint( for (dlIter = driveLetterLookup; dlIter != NULL; dlIter = dlIter->nextPtr) { - if (wcscmp(dlIter->volumeName, mountPoint) == 0) { + if (_tcscmp(dlIter->volumeName, mountPoint) == 0) { Tcl_MutexUnlock(&mountPointMap); - return dlIter->driveLetter; + return (char) dlIter->driveLetter; } } @@ -979,11 +499,11 @@ TclWinDriveLetterForVolMountPoint( * that fact and store '-1' so we don't have to look it up each time. */ - dlPtr2 = (MountPointMap*) ckalloc(sizeof(MountPointMap)); - dlPtr2->volumeName = TclNativeDupInternalRep((ClientData)mountPoint); + dlPtr2 = ckalloc(sizeof(MountPointMap)); + dlPtr2->volumeName = TclNativeDupInternalRep((ClientData) mountPoint); dlPtr2->driveLetter = -1; dlPtr2->nextPtr = driveLetterLookup; - driveLetterLookup = dlPtr2; + driveLetterLookup = dlPtr2; Tcl_MutexUnlock(&mountPointMap); return -1; } @@ -1040,27 +560,27 @@ TclWinDriveLetterForVolMountPoint( TCHAR * Tcl_WinUtfToTChar( - CONST char *string, /* Source string in UTF-8. */ + 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. */ { - return (TCHAR *) Tcl_UtfToExternalDString(tclWinTCharEncoding, + return (TCHAR *) Tcl_UtfToExternalDString(winTCharEncoding, string, len, dsPtr); } char * Tcl_WinTCharToUtf( - CONST TCHAR *string, /* Source string in Unicode when running NT, + 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. */ { - return Tcl_ExternalToUtfDString(tclWinTCharEncoding, - (CONST char *) string, len, dsPtr); + return Tcl_ExternalToUtfDString(winTCharEncoding, + (const char *) string, len, dsPtr); } /* @@ -1086,12 +606,15 @@ TclWinCPUID( unsigned int index, /* Which CPUID value to retrieve. */ unsigned int *regsPtr) /* Registers after the CPUID. */ { -#ifdef HAVE_NO_SEH - EXCEPTION_REGISTRATION registration; -#endif int status = TCL_ERROR; -#if defined(__GNUC__) && !defined(_WIN64) +#if defined(HAVE_INTRIN_H) && defined(_WIN64) + + __cpuid(regsPtr, index); + status = TCL_OK; + +#elif defined(__GNUC__) +# if defined(_WIN64) /* * Execute the CPUID instruction with the given index, and store results * off 'regPtr'. @@ -1099,7 +622,39 @@ TclWinCPUID( __asm__ __volatile__( /* - * Construct an EXCEPTION_REGISTRATION to protect the CPUID + * Do the CPUID instruction, and save the results in the 'regsPtr' + * area. + */ + + "movl %[rptr], %%edi" "\n\t" + "movl %[index], %%eax" "\n\t" + "cpuid" "\n\t" + "movl %%eax, 0x0(%%edi)" "\n\t" + "movl %%ebx, 0x4(%%edi)" "\n\t" + "movl %%ecx, 0x8(%%edi)" "\n\t" + "movl %%edx, 0xc(%%edi)" "\n\t" + + : + /* No outputs */ + : + [index] "m" (index), + [rptr] "m" (regsPtr) + : + "%eax", "%ebx", "%ecx", "%edx", "%esi", "%edi", "memory"); + status = TCL_OK; + +# else + + TCLEXCEPTION_REGISTRATION registration; + + /* + * Execute the CPUID instruction with the given index, and store results + * off 'regPtr'. + */ + + __asm__ __volatile__( + /* + * Construct an TCLEXCEPTION_REGISTRATION to protect the CPUID * instruction (early 486's don't have CPUID) */ @@ -1113,7 +668,7 @@ TclWinCPUID( "movl %[error], 0x10(%%edx)" "\n\t" /* status */ /* - * Link the EXCEPTION_REGISTRATION on the chain + * Link the TCLEXCEPTION_REGISTRATION on the chain */ "movl %%edx, %%fs:0" "\n\t" @@ -1132,7 +687,7 @@ TclWinCPUID( "movl %%edx, 0xc(%%edi)" "\n\t" /* - * Come here on a normal exit. Recover the EXCEPTION_REGISTRATION and + * Come here on a normal exit. Recover the TCLEXCEPTION_REGISTRATION and * store a TCL_OK status. */ @@ -1142,7 +697,7 @@ TclWinCPUID( "jmp 2f" "\n" /* - * Come here on an exception. Get the EXCEPTION_REGISTRATION that we + * Come here on an exception. Get the TCLEXCEPTION_REGISTRATION that we * previously put on the chain. */ @@ -1152,7 +707,7 @@ TclWinCPUID( /* * Come here however we exited. Restore context from the - * EXCEPTION_REGISTRATION in case the stack is unbalanced. + * TCLEXCEPTION_REGISTRATION in case the stack is unbalanced. */ "2:" "\t" @@ -1173,7 +728,14 @@ TclWinCPUID( "%eax", "%ebx", "%ecx", "%edx", "%esi", "%edi", "memory"); status = registration.status; -#elif defined(_MSC_VER) && !defined(_WIN64) +# endif /* !_WIN64 */ +#elif defined(_MSC_VER) +# if defined(_WIN64) + + __cpuid(regsPtr, index); + status = TCL_OK; + +# else /* * Define a structure in the stack frame to hold the registers. */ @@ -1220,6 +782,7 @@ TclWinCPUID( /* do nothing */ } +# endif #else /* * Don't know how to do assembly code for this compiler and/or diff --git a/win/tclWinChan.c b/win/tclWinChan.c index f07c192..48acacb 100644 --- a/win/tclWinChan.c +++ b/win/tclWinChan.c @@ -8,8 +8,6 @@ * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. - * - * RCS: @(#) $Id: tclWinChan.c,v 1.48 2006/08/30 19:30:25 hobbs Exp $ */ #include "tclWinInt.h" @@ -85,7 +83,7 @@ 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); + const char *buf, int toWrite, int *errorCode); static int FileSeekProc(ClientData instanceData, long offset, int mode, int *errorCode); static Tcl_WideInt FileWideSeekProc(ClientData instanceData, @@ -97,12 +95,12 @@ static void FileThreadActionProc(ClientData instanceData, static int FileTruncateProc(ClientData instanceData, Tcl_WideInt length); static DWORD FileGetType(HANDLE handle); - +static int NativeIsComPort(CONST TCHAR *nativeName); /* * This structure describes the channel type structure for file based IO. */ -static Tcl_ChannelType fileChannelType = { +static const Tcl_ChannelType fileChannelType = { "file", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ FileCloseProc, /* Close proc. */ @@ -119,25 +117,8 @@ static Tcl_ChannelType fileChannelType = { NULL, /* handler proc. */ FileWideSeekProc, /* Wide seek proc. */ FileThreadActionProc, /* Thread action proc. */ - FileTruncateProc, /* Truncate 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. - */ - -typedef struct EXCEPTION_REGISTRATION { - struct EXCEPTION_REGISTRATION* link; - EXCEPTION_DISPOSITION (*handler)( - struct _EXCEPTION_RECORD*, void*, struct _CONTEXT*, void*); - void* ebp; - void* esp; - int status; -} EXCEPTION_REGISTRATION; -#endif /* *---------------------------------------------------------------------- @@ -276,7 +257,7 @@ FileCheckProc( infoPtr = infoPtr->nextPtr) { if (infoPtr->watchMask && !(infoPtr->flags & FILE_PENDING)) { infoPtr->flags |= FILE_PENDING; - evPtr = (FileEvent *) ckalloc(sizeof(FileEvent)); + evPtr = ckalloc(sizeof(FileEvent)); evPtr->header.proc = FileEventProc; evPtr->infoPtr = infoPtr; Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL); @@ -359,7 +340,7 @@ FileBlockProc( int mode) /* TCL_MODE_BLOCKING or * TCL_MODE_NONBLOCKING. */ { - FileInfo *infoPtr = (FileInfo *) instanceData; + FileInfo *infoPtr = instanceData; /* * Files on Windows can not be switched between blocking and nonblocking, @@ -397,7 +378,7 @@ FileCloseProc( ClientData instanceData, /* Pointer to FileInfo structure. */ Tcl_Interp *interp) /* Not used. */ { - FileInfo *fileInfoPtr = (FileInfo *) instanceData; + FileInfo *fileInfoPtr = instanceData; FileInfo *infoPtr; ThreadSpecificData *tsdPtr; int errorCode = 0; @@ -443,7 +424,7 @@ FileCloseProc( break; } } - ckfree((char *)fileInfoPtr); + ckfree(fileInfoPtr); return errorCode; } @@ -472,7 +453,7 @@ FileSeekProc( int mode, /* Relative to where should we seek? */ int *errorCodePtr) /* To store error code. */ { - FileInfo *infoPtr = (FileInfo *) instanceData; + FileInfo *infoPtr = instanceData; LONG newPos, newPosHigh, oldPos, oldPosHigh; DWORD moveMethod; @@ -491,7 +472,7 @@ FileSeekProc( oldPosHigh = 0; oldPos = SetFilePointer(infoPtr->handle, 0, &oldPosHigh, FILE_CURRENT); - if (oldPos == INVALID_SET_FILE_POINTER) { + if (oldPos == (LONG)INVALID_SET_FILE_POINTER) { DWORD winError = GetLastError(); if (winError != NO_ERROR) { @@ -503,7 +484,7 @@ FileSeekProc( newPosHigh = (offset < 0 ? -1 : 0); newPos = SetFilePointer(infoPtr->handle, offset, &newPosHigh, moveMethod); - if (newPos == INVALID_SET_FILE_POINTER) { + if (newPos == (LONG)INVALID_SET_FILE_POINTER) { DWORD winError = GetLastError(); if (winError != NO_ERROR) { @@ -550,7 +531,7 @@ FileWideSeekProc( int mode, /* Relative to where should we seek? */ int *errorCodePtr) /* To store error code. */ { - FileInfo *infoPtr = (FileInfo *) instanceData; + FileInfo *infoPtr = instanceData; DWORD moveMethod; LONG newPos, newPosHigh; @@ -566,7 +547,7 @@ FileWideSeekProc( newPosHigh = Tcl_WideAsLong(offset >> 32); newPos = SetFilePointer(infoPtr->handle, Tcl_WideAsLong(offset), &newPosHigh, moveMethod); - if (newPos == INVALID_SET_FILE_POINTER) { + if (newPos == (LONG)INVALID_SET_FILE_POINTER) { DWORD winError = GetLastError(); if (winError != NO_ERROR) { @@ -575,7 +556,7 @@ FileWideSeekProc( return -1; } } - return (Tcl_LongAsWide(newPos) | (Tcl_LongAsWide(newPosHigh) << 32)); + return (((Tcl_WideInt)((unsigned)newPos)) | (Tcl_LongAsWide(newPosHigh) << 32)); } /* @@ -599,7 +580,7 @@ FileTruncateProc( ClientData instanceData, /* File state. */ Tcl_WideInt length) /* Length to truncate at. */ { - FileInfo *infoPtr = (FileInfo *) instanceData; + FileInfo *infoPtr = instanceData; LONG newPos, newPosHigh, oldPos, oldPosHigh; /* @@ -608,7 +589,7 @@ FileTruncateProc( oldPosHigh = 0; oldPos = SetFilePointer(infoPtr->handle, 0, &oldPosHigh, FILE_CURRENT); - if (oldPos == INVALID_SET_FILE_POINTER) { + if (oldPos == (LONG)INVALID_SET_FILE_POINTER) { DWORD winError = GetLastError(); if (winError != NO_ERROR) { TclWinConvertError(winError); @@ -623,7 +604,7 @@ FileTruncateProc( newPosHigh = Tcl_WideAsLong(length >> 32); newPos = SetFilePointer(infoPtr->handle, Tcl_WideAsLong(length), &newPosHigh, FILE_BEGIN); - if (newPos == INVALID_SET_FILE_POINTER) { + if (newPos == (LONG)INVALID_SET_FILE_POINTER) { DWORD winError = GetLastError(); if (winError != NO_ERROR) { TclWinConvertError(winError); @@ -675,13 +656,16 @@ FileInputProc( int bufSize, /* Num bytes available in buffer. */ int *errorCode) /* Where to store error code. */ { - FileInfo *infoPtr; + FileInfo *infoPtr = instanceData; DWORD bytesRead; *errorCode = 0; - infoPtr = (FileInfo *) instanceData; /* + * TODO: This comment appears to be out of date. We *do* have a + * console driver, over in tclWinConsole.c. After some Windows + * developer confirms, this comment should be revised. + * * Note that we will block on reads from a console buffer until a full * line has been entered. The only way I know of to get around this is to * write a console driver. We should probably do this at some point, but @@ -723,11 +707,11 @@ FileInputProc( static int FileOutputProc( ClientData instanceData, /* File state. */ - CONST char *buf, /* The data buffer. */ + const char *buf, /* The data buffer. */ int toWrite, /* How many bytes to write? */ int *errorCode) /* Where to store error code. */ { - FileInfo *infoPtr = (FileInfo *) instanceData; + FileInfo *infoPtr = instanceData; DWORD bytesWritten; *errorCode = 0; @@ -774,7 +758,7 @@ FileWatchProc( * of TCL_READABLE, TCL_WRITABLE and * TCL_EXCEPTION. */ { - FileInfo *infoPtr = (FileInfo *) instanceData; + FileInfo *infoPtr = instanceData; Tcl_Time blockTime = { 0, 0 }; /* @@ -812,7 +796,7 @@ FileGetHandleProc( int direction, /* TCL_READABLE or TCL_WRITABLE */ ClientData *handlePtr) /* Where to store the handle. */ { - FileInfo *infoPtr = (FileInfo *) instanceData; + FileInfo *infoPtr = instanceData; if (direction & infoPtr->validMask) { *handlePtr = (ClientData) infoPtr->handle; @@ -852,12 +836,12 @@ TclpOpenFileChannel( Tcl_Channel channel = 0; int channelPermissions = 0; DWORD accessMode = 0, createMode, shareMode, flags; - CONST TCHAR *nativeName; + const TCHAR *nativeName; HANDLE handle; char channelName[16 + TCL_INTEGER_SPACE]; TclFile readFile = NULL, writeFile = NULL; - nativeName = (TCHAR*) Tcl_FSGetNativePath(pathPtr); + nativeName = Tcl_FSGetNativePath(pathPtr); if (nativeName == NULL) { return NULL; } @@ -905,6 +889,33 @@ TclpOpenFileChannel( } /* + * [2413550] Avoid double-open of serial ports on Windows + * Special handling for Windows serial ports by a "name-hint" + * to directly open it with the OVERLAPPED flag set. + */ + + if( NativeIsComPort(nativeName) ) { + + handle = TclWinSerialOpen(INVALID_HANDLE_VALUE, nativeName, accessMode); + if (handle == INVALID_HANDLE_VALUE) { + TclWinConvertError(GetLastError()); + if (interp != (Tcl_Interp *) NULL) { + Tcl_AppendResult(interp, "couldn't open serial \"", + TclGetString(pathPtr), "\": ", + Tcl_PosixError(interp), NULL); + } + return NULL; + } + + /* + * For natively named Windows serial ports we are done. + */ + channel = TclWinOpenSerialChannel(handle, channelName, + channelPermissions); + + return channel; + } + /* * If the file is being created, get the file attributes from the * permissions argument, else use the existing file attributes. */ @@ -916,7 +927,7 @@ TclpOpenFileChannel( flags = FILE_ATTRIBUTE_READONLY; } } else { - flags = (*tclWinProcs->getFileAttributesProc)(nativeName); + flags = GetFileAttributes(nativeName); if (flags == 0xFFFFFFFF) { flags = 0; } @@ -932,8 +943,8 @@ TclpOpenFileChannel( * Now we get to create the file. */ - handle = (*tclWinProcs->createFileProc)(nativeName, accessMode, - shareMode, NULL, createMode, flags, (HANDLE) NULL); + handle = CreateFile(nativeName, accessMode, shareMode, + NULL, createMode, flags, (HANDLE) NULL); if (handle == INVALID_HANDLE_VALUE) { DWORD err = GetLastError(); @@ -943,8 +954,9 @@ TclpOpenFileChannel( } TclWinConvertError(err); if (interp != (Tcl_Interp *) NULL) { - Tcl_AppendResult(interp, "couldn't open \"", TclGetString(pathPtr), - "\": ", Tcl_PosixError(interp), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "couldn't open \"%s\": %s", + TclGetString(pathPtr), Tcl_PosixError(interp))); } return NULL; } @@ -954,17 +966,21 @@ TclpOpenFileChannel( switch (FileGetType(handle)) { case FILE_TYPE_SERIAL: /* + * Natively named serial ports "com1-9", "\\\\.\\comXX" are + * already done with the code above. + * Here we handle all other serial port names. + * * Reopen channel for OVERLAPPED operation. Normally this shouldn't * fail, because the channel exists. */ - handle = TclWinSerialReopen(handle, nativeName, accessMode); + handle = TclWinSerialOpen(handle, nativeName, accessMode); if (handle == INVALID_HANDLE_VALUE) { TclWinConvertError(GetLastError()); if (interp != (Tcl_Interp *) NULL) { - Tcl_AppendResult(interp, "couldn't reopen serial \"", - TclGetString(pathPtr), "\": ", - Tcl_PosixError(interp), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "couldn't reopen serial \"%s\": %s", + TclGetString(pathPtr), Tcl_PosixError(interp))); } return NULL; } @@ -998,8 +1014,11 @@ TclpOpenFileChannel( */ channel = NULL; - Tcl_AppendResult(interp, "couldn't open \"", TclGetString(pathPtr), - "\": bad file type", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "couldn't open \"%s\": bad file type", + TclGetString(pathPtr))); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "CHANNEL", "BAD_TYPE", + NULL); break; } @@ -1028,8 +1047,8 @@ Tcl_MakeFileChannel( int mode) /* ORed combination of TCL_READABLE and * TCL_WRITABLE to indicate file mode. */ { -#ifdef HAVE_NO_SEH - EXCEPTION_REGISTRATION registration; +#if defined(HAVE_NO_SEH) && !defined(_WIN64) + TCLEXCEPTION_REGISTRATION registration; #endif char channelName[16 + TCL_INTEGER_SPACE]; Tcl_Channel channel = NULL; @@ -1094,12 +1113,7 @@ Tcl_MakeFileChannel( */ result = 0; -#ifndef HAVE_NO_SEH - __try { - CloseHandle(dupedHandle); - result = 1; - } __except (EXCEPTION_EXECUTE_HANDLER) {} -#else +#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 @@ -1115,7 +1129,7 @@ Tcl_MakeFileChannel( "movl %[dupedHandle], %%ebx" "\n\t" /* - * Construct an EXCEPTION_REGISTRATION to protect the call to + * Construct an TCLEXCEPTION_REGISTRATION to protect the call to * CloseHandle. */ @@ -1129,7 +1143,7 @@ Tcl_MakeFileChannel( "movl $0, 0x10(%%edx)" "\n\t" /* status */ /* - * Link the EXCEPTION_REGISTRATION on the chain. + * Link the TCLEXCEPTION_REGISTRATION on the chain. */ "movl %%edx, %%fs:0" "\n\t" @@ -1142,7 +1156,7 @@ Tcl_MakeFileChannel( "call _CloseHandle@4" "\n\t" /* - * Come here on normal exit. Recover the EXCEPTION_REGISTRATION + * Come here on normal exit. Recover the TCLEXCEPTION_REGISTRATION * and put a TRUE status return into it. */ @@ -1152,7 +1166,7 @@ Tcl_MakeFileChannel( "jmp 2f" "\n" /* - * Come here on an exception. Recover the EXCEPTION_REGISTRATION + * Come here on an exception. Recover the TCLEXCEPTION_REGISTRATION */ "1:" "\t" @@ -1161,7 +1175,7 @@ Tcl_MakeFileChannel( /* * Come here however we exited. Restore context from the - * EXCEPTION_REGISTRATION in case the stack is unbalanced. + * TCLEXCEPTION_REGISTRATION in case the stack is unbalanced. */ "2:" "\t" @@ -1179,7 +1193,15 @@ Tcl_MakeFileChannel( "%eax", "%ebx", "%ecx", "%edx", "%esi", "%edi", "memory" ); result = registration.status; - +#else +#ifndef HAVE_NO_SEH + __try { +#endif + CloseHandle(dupedHandle); + result = 1; +#ifndef HAVE_NO_SEH + } __except (EXCEPTION_EXECUTE_HANDLER) {} +#endif #endif if (result == FALSE) { return NULL; @@ -1222,8 +1244,8 @@ TclpGetDefaultStdChannel( Tcl_Channel channel; HANDLE handle; int mode = -1; - char *bufMode = NULL; - DWORD handleId = (DWORD)INVALID_HANDLE_VALUE; + const char *bufMode = NULL; + DWORD handleId = (DWORD) -1; /* Standard handle to retrieve. */ switch (type) { @@ -1322,7 +1344,7 @@ TclWinOpenFileChannel( } } - infoPtr = (FileInfo *) ckalloc((unsigned) sizeof(FileInfo)); + infoPtr = ckalloc(sizeof(FileInfo)); /* * TIP #218. Removed the code inserting the new structure into the global @@ -1336,10 +1358,10 @@ TclWinOpenFileChannel( infoPtr->flags = appendMode; infoPtr->handle = handle; infoPtr->dirty = 0; - wsprintfA(channelName, "file%lx", (int) infoPtr); + sprintf(channelName, "file%" TCL_I_MODIFIER "x", (size_t) infoPtr); infoPtr->channel = Tcl_CreateChannel(&fileChannelType, channelName, - (ClientData) infoPtr, permissions); + infoPtr, permissions); /* * Files have default translation of AUTO and ^Z eof char, which means @@ -1413,7 +1435,7 @@ FileThreadActionProc( int action) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - FileInfo *infoPtr = (FileInfo *) instanceData; + FileInfo *infoPtr = instanceData; if (action == TCL_CHANNEL_THREAD_INSERT) { infoPtr->nextPtr = tsdPtr->firstFilePtr; @@ -1460,26 +1482,28 @@ FileThreadActionProc( */ DWORD -FileGetType(handle) - HANDLE handle; /* Opened file handle */ +FileGetType( + HANDLE handle) /* Opened file handle */ { DWORD type; type = GetFileType(handle); /* - * If the file is a character device, we need to try to figure out - * whether it is a serial port, a console, or something else. We - * test for the console case first because this is more common. + * If the file is a character device, we need to try to figure out whether + * it is a serial port, a console, or something else. We test for the + * console case first because this is more common. */ if ((type == FILE_TYPE_CHAR) || ((type == FILE_TYPE_UNKNOWN) && !GetLastError())) { DWORD consoleParams; + if (GetConsoleMode(handle, &consoleParams)) { type = FILE_TYPE_CONSOLE; } else { DCB dcb; + dcb.DCBlength = sizeof(DCB); if (GetCommState(handle, &dcb)) { type = FILE_TYPE_SERIAL; @@ -1490,6 +1514,74 @@ FileGetType(handle) return type; } + /* + *---------------------------------------------------------------------- + * + * NativeIsComPort -- + * + * Determines if a path refers to a Windows serial port. + * A simple and efficient solution is to use a "name hint" to detect + * COM ports by their filename instead of resorting to a syscall + * to detect serialness after the fact. + * The following patterns cover common serial port names: + * COM[1-9]:? + * //./COM[0-9]+ + * \\.\COM[0-9]+ + * + * Results: + * 1 = serial port, 0 = not. + * + *---------------------------------------------------------------------- + */ + +static int +NativeIsComPort( + const TCHAR *nativePath) /* Path of file to access, native encoding. */ +{ + const WCHAR *p = (const WCHAR *) nativePath; + int i, len = wcslen(p); + + /* + * 1. Look for com[1-9]:? + */ + + if ( (len >= 4) && (len <= 5) + && (_wcsnicmp(p, L"com", 3) == 0) ) { + /* + * The 4th character must be a digit 1..9 optionally followed by a ":" + */ + + if ( (p[3] < L'1') || (p[3] > L'9') ) { + return 0; + } + if ( (len == 5) && (p[4] != L':') ) { + return 0; + } + return 1; + } + + /* + * 2. Look for //./com[0-9]+ or \\.\com[0-9]+ + */ + + if ( (len >= 8) && ( + (_wcsnicmp(p, L"//./com", 7) == 0) + || (_wcsnicmp(p, L"\\\\.\\com", 7) == 0) ) ) + { + /* + * Charaters 8..end must be a digits 0..9 + */ + + for ( i=7; i<len; i++ ) { + if ( (p[i] < '0') || (p[i] > '9') ) { + return 0; + } + } + return 1; + } + return 0; +} + /* * Local Variables: * mode: c diff --git a/win/tclWinConsole.c b/win/tclWinConsole.c index 1480199..6630083 100644 --- a/win/tclWinConsole.c +++ b/win/tclWinConsole.c @@ -8,16 +8,10 @@ * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. - * - * RCS: @(#) $Id: tclWinConsole.c,v 1.19 2006/03/27 18:08:51 andreas_kupries Exp $ */ #include "tclWinInt.h" -#include <fcntl.h> -#include <io.h> -#include <sys/stat.h> - /* * The following variable is used to tell whether this module has been * initialized. @@ -51,6 +45,23 @@ TCL_DECLARE_MUTEX(consoleMutex) #define CONSOLE_BUFFER_SIZE (8*1024) /* + * Structure containing handles associated with one of the special console + * threads. + */ + +typedef struct ConsoleThreadInfo { + HANDLE thread; /* Handle to reader or writer thread. */ + HANDLE readyEvent; /* Manual-reset event to signal _to_ the main + * thread when the worker thread has finished + * waiting for its normal work to happen. */ + HANDLE startEvent; /* Auto-reset event used by the main thread to + * signal when the thread should attempt to do + * its normal work. */ + HANDLE stopEvent; /* Auto-reset event used by the main thread to + * signal when the thread should exit. */ +} ConsoleThreadInfo; + +/* * This structure describes per-instance data for a console based channel. */ @@ -69,24 +80,18 @@ typedef struct ConsoleInfo { Tcl_ThreadId threadId; /* Thread to which events should be reported. * This value is used by the reader/writer * threads. */ - HANDLE writeThread; /* Handle to writer thread. */ - HANDLE readThread; /* Handle to reader thread. */ - HANDLE writable; /* Manual-reset event to signal when the - * writer thread has finished waiting for the - * current buffer to be written. */ - HANDLE readable; /* Manual-reset event to signal when the - * reader thread has finished waiting for - * input. */ - HANDLE startWriter; /* Auto-reset event used by the main thread to - * signal when the writer thread should - * attempt to write to the console. */ - HANDLE stopWriter; /* Auto-reset event used by the main thread to - * signal when the writer thread should exit */ - HANDLE startReader; /* Auto-reset event used by the main thread to - * signal when the reader thread should - * attempt to read from the console. */ - HANDLE stopReader; /* Auto-reset event used by the main thread to - * signal when the reader thread should exit */ + ConsoleThreadInfo writer; /* A specialized thread for handling + * asynchronous writes to the console; the + * waiting starts when a start event is sent, + * and a reset event is sent back to the main + * thread when the write is done. A stop event + * is used to terminate the thread. */ + ConsoleThreadInfo reader; /* A specialized thread for handling + * asynchronous reads from the console; the + * waiting starts when a start event is sent, + * and a reset event is sent back to the main + * thread when input is available. A stop + * event is used to terminate the thread. */ 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 @@ -101,8 +106,8 @@ typedef struct ConsoleInfo { 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 */ + int bytesRead; /* Number of bytes in the buffer. */ + int offset; /* Number of bytes read out of the buffer. */ char buffer[CONSOLE_BUFFER_SIZE]; /* Data consumed by reader thread. */ } ConsoleInfo; @@ -136,7 +141,8 @@ 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); @@ -148,7 +154,7 @@ static void ConsoleInit(void); static int ConsoleInputProc(ClientData instanceData, char *buf, int toRead, int *errorCode); static int ConsoleOutputProc(ClientData instanceData, - CONST char *buf, int toWrite, int *errorCode); + const char *buf, int toWrite, int *errorCode); static DWORD WINAPI ConsoleReaderThread(LPVOID arg); static void ConsoleSetupProc(ClientData clientData, int flags); static void ConsoleWatchProc(ClientData instanceData, int mask); @@ -157,13 +163,22 @@ static void ProcExitHandler(ClientData clientData); static int WaitForRead(ConsoleInfo *infoPtr, int blocking); static void ConsoleThreadActionProc(ClientData instanceData, int action); +static BOOL ReadConsoleBytes(HANDLE hConsole, LPVOID lpBuffer, + DWORD nbytes, LPDWORD nbytesread); +static BOOL WriteConsoleBytes(HANDLE hConsole, + const void *lpBuffer, DWORD nbytes, + LPDWORD nbyteswritten); +static void StartChannelThread(ConsoleInfo *infoPtr, + ConsoleThreadInfo *threadInfoPtr, + LPTHREAD_START_ROUTINE threadProc); +static void StopChannelThread(ConsoleThreadInfo *threadInfoPtr); /* * This structure describes the channel type structure for command console * based IO. */ -static Tcl_ChannelType consoleChannelType = { +static const Tcl_ChannelType consoleChannelType = { "console", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ ConsoleCloseProc, /* Close proc. */ @@ -175,23 +190,27 @@ static Tcl_ChannelType consoleChannelType = { ConsoleWatchProc, /* Set up notifier to watch the channel. */ ConsoleGetHandleProc, /* Get an OS handle from channel. */ NULL, /* close2proc. */ - ConsoleBlockModeProc, /* Set blocking or non-blocking mode.*/ - NULL, /* flush proc. */ - NULL, /* handler proc. */ - NULL, /* wide seek proc */ - ConsoleThreadActionProc, /* thread action proc */ - NULL, /* truncation */ + ConsoleBlockModeProc, /* Set blocking or non-blocking mode. */ + NULL, /* Flush proc. */ + NULL, /* Handler proc. */ + NULL, /* Wide seek proc. */ + ConsoleThreadActionProc, /* Thread action proc. */ + NULL /* Truncation proc. */ }; /* *---------------------------------------------------------------------- * - * readConsoleBytes, writeConsoleBytes -- - * Wrapper for ReadConsole{A,W}, that takes and returns number of bytes - * instead of number of TCHARS + * ReadConsoleBytes, WriteConsoleBytes -- + * + * Wrapper for ReadConsole{A,W}, that takes and returns number of bytes + * instead of number of TCHARS. + * + *---------------------------------------------------------------------- */ + static BOOL -readConsoleBytes( +ReadConsoleBytes( HANDLE hConsole, LPVOID lpBuffer, DWORD nbytes, @@ -199,30 +218,32 @@ readConsoleBytes( { 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); + int tcharsize = sizeof(TCHAR); + + result = ReadConsole(hConsole, lpBuffer, nbytes / tcharsize, &ntchars, + NULL); + if (nbytesread != NULL) { + *nbytesread = ntchars * tcharsize; + } return result; } static BOOL -writeConsoleBytes( +WriteConsoleBytes( HANDLE hConsole, - const VOID *lpBuffer, + 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); + int tcharsize = sizeof(TCHAR); + + result = WriteConsole(hConsole, lpBuffer, nbytes / tcharsize, &ntchars, + NULL); + if (nbyteswritten != NULL) { + *nbyteswritten = ntchars * tcharsize; + } return result; } @@ -245,8 +266,6 @@ writeConsoleBytes( static void ConsoleInit(void) { - ThreadSpecificData *tsdPtr; - /* * Check the initialized flag first, then check again in the mutex. This * is a speed enhancement. @@ -261,9 +280,9 @@ ConsoleInit(void) Tcl_MutexUnlock(&consoleMutex); } - tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); - if (tsdPtr == NULL) { - tsdPtr = TCL_TSD_INIT(&dataKey); + if (TclThreadDataKeyGet(&dataKey) == NULL) { + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + tsdPtr->firstConsolePtr = NULL; Tcl_CreateEventSource(ConsoleSetupProc, ConsoleCheckProc, NULL); Tcl_CreateThreadExitHandler(ConsoleExitHandler, NULL); @@ -289,7 +308,7 @@ ConsoleInit(void) static void ConsoleExitHandler( - ClientData clientData) /* Old window proc */ + ClientData clientData) /* Old window proc. */ { Tcl_DeleteEventSource(ConsoleSetupProc, ConsoleCheckProc, NULL); } @@ -313,7 +332,7 @@ ConsoleExitHandler( static void ProcExitHandler( - ClientData clientData) /* Old window proc */ + ClientData clientData) /* Old window proc. */ { Tcl_MutexLock(&consoleMutex); initialized = 0; @@ -358,7 +377,8 @@ ConsoleSetupProc( for (infoPtr = tsdPtr->firstConsolePtr; infoPtr != NULL; infoPtr = infoPtr->nextPtr) { if (infoPtr->watchMask & TCL_WRITABLE) { - if (WaitForSingleObject(infoPtr->writable, 0) != WAIT_TIMEOUT) { + if (WaitForSingleObject(infoPtr->writer.readyEvent, + 0) != WAIT_TIMEOUT) { block = 0; } } @@ -396,7 +416,6 @@ ConsoleCheckProc( int flags) /* Event flags as passed to Tcl_DoOneEvent. */ { ConsoleInfo *infoPtr; - ConsoleEvent *evPtr; int needEvent; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -421,7 +440,8 @@ ConsoleCheckProc( needEvent = 0; if (infoPtr->watchMask & TCL_WRITABLE) { - if (WaitForSingleObject(infoPtr->writable, 0) != WAIT_TIMEOUT) { + if (WaitForSingleObject(infoPtr->writer.readyEvent, + 0) != WAIT_TIMEOUT) { needEvent = 1; } } @@ -433,8 +453,9 @@ ConsoleCheckProc( } if (needEvent) { + ConsoleEvent *evPtr = ckalloc(sizeof(ConsoleEvent)); + infoPtr->flags |= CONSOLE_PENDING; - evPtr = (ConsoleEvent *) ckalloc(sizeof(ConsoleEvent)); evPtr->header.proc = ConsoleEventProc; evPtr->infoPtr = infoPtr; Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL); @@ -442,7 +463,6 @@ ConsoleCheckProc( } } - /* *---------------------------------------------------------------------- * @@ -465,7 +485,7 @@ ConsoleBlockModeProc( int mode) /* TCL_MODE_BLOCKING or * TCL_MODE_NONBLOCKING. */ { - ConsoleInfo *infoPtr = (ConsoleInfo *) instanceData; + ConsoleInfo *infoPtr = instanceData; /* * Consoles on Windows can not be switched between blocking and @@ -478,7 +498,7 @@ ConsoleBlockModeProc( if (mode == TCL_MODE_NONBLOCKING) { infoPtr->flags |= CONSOLE_ASYNC; } else { - infoPtr->flags &= ~(CONSOLE_ASYNC); + infoPtr->flags &= ~CONSOLE_ASYNC; } return 0; } @@ -486,6 +506,84 @@ ConsoleBlockModeProc( /* *---------------------------------------------------------------------- * + * StartChannelThread, StopChannelThread -- + * + * Helpers that codify how to ask one of the console service threads to + * start and stop. + * + *---------------------------------------------------------------------- + */ + +static void +StartChannelThread( + ConsoleInfo *infoPtr, + ConsoleThreadInfo *threadInfoPtr, + LPTHREAD_START_ROUTINE threadProc) +{ + DWORD id; + + threadInfoPtr->readyEvent = CreateEvent(NULL, TRUE, TRUE, NULL); + threadInfoPtr->startEvent = CreateEvent(NULL, FALSE, FALSE, NULL); + threadInfoPtr->stopEvent = CreateEvent(NULL, FALSE, FALSE, NULL); + threadInfoPtr->thread = CreateThread(NULL, 256, threadProc, infoPtr, 0, + &id); + SetThreadPriority(threadInfoPtr->thread, THREAD_PRIORITY_HIGHEST); +} + +static void +StopChannelThread( + ConsoleThreadInfo *threadInfoPtr) +{ + DWORD exitCode = 0; + + /* + * The thread may already have closed on it's own. Check it's exit + * code. + */ + + GetExitCodeThread(threadInfoPtr->thread, &exitCode); + if (exitCode == STILL_ACTIVE) { + /* + * Set the stop event so that if the reader thread is blocked in + * ConsoleReaderThread on WaitForMultipleEvents, it will exit cleanly. + */ + + SetEvent(threadInfoPtr->stopEvent); + + /* + * Wait at most 20 milliseconds for the reader thread to close. + */ + + if (WaitForSingleObject(threadInfoPtr->thread, 20) == WAIT_TIMEOUT) { + /* + * Forcibly terminate the background thread as a last resort. + * Note that we need to guard against terminating the thread while + * it is in the middle of Tcl_ThreadAlert because it won't be able + * to release the notifier lock. + */ + + Tcl_MutexLock(&consoleMutex); + /* BUG: this leaks memory. */ + TerminateThread(threadInfoPtr->thread, 0); + Tcl_MutexUnlock(&consoleMutex); + } + } + + /* + * Close all the handles associated with the thread, and set the thread + * handle field to NULL to mark that the thread has been cleaned up. + */ + + CloseHandle(threadInfoPtr->thread); + CloseHandle(threadInfoPtr->readyEvent); + CloseHandle(threadInfoPtr->startEvent); + CloseHandle(threadInfoPtr->stopEvent); + threadInfoPtr->thread = NULL; +} + +/* + *---------------------------------------------------------------------- + * * ConsoleCloseProc -- * * Closes a console based IO channel. @@ -504,13 +602,10 @@ ConsoleCloseProc( ClientData instanceData, /* Pointer to ConsoleInfo structure. */ Tcl_Interp *interp) /* For error reporting. */ { - ConsoleInfo *consolePtr = (ConsoleInfo *) instanceData; - int errorCode; + ConsoleInfo *consolePtr = instanceData; + int errorCode = 0; ConsoleInfo *infoPtr, **nextPtrPtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - DWORD exitCode; - - errorCode = 0; /* * Clean up the background thread if necessary. Note that this must be @@ -518,49 +613,8 @@ ConsoleCloseProc( * trying to read from the console. */ - if (consolePtr->readThread) { - /* - * 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 - * cleanly. - */ - - SetEvent(consolePtr->stopReader); - - /* - * Wait at most 20 milliseconds for the reader thread to close. - */ - - if (WaitForSingleObject(consolePtr->readThread, 20) - == WAIT_TIMEOUT) { - /* - * Forcibly terminate the background thread as a last resort. - * Note that we need to guard against terminating the thread - * while it is in the middle of Tcl_ThreadAlert because it - * won't be able to release the notifier lock. - */ - - Tcl_MutexLock(&consoleMutex); - - /* BUG: this leaks memory. */ - TerminateThread(consolePtr->readThread, 0); - Tcl_MutexUnlock(&consoleMutex); - } - } - - CloseHandle(consolePtr->readThread); - CloseHandle(consolePtr->readable); - CloseHandle(consolePtr->startReader); - CloseHandle(consolePtr->stopReader); - consolePtr->readThread = NULL; + if (consolePtr->reader.thread) { + StopChannelThread(&consolePtr->reader); } consolePtr->validMask &= ~TCL_READABLE; @@ -570,62 +624,20 @@ ConsoleCloseProc( * should be no pending write operations. */ - if (consolePtr->writeThread) { + if (consolePtr->writer.thread) { if (consolePtr->toWrite) { /* * We only need to wait if there is something to write. This may - * prevent infinite wait on exit. [python bug 216289] - */ - - WaitForSingleObject(consolePtr->writable, INFINITE); - } - - /* - * 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. + * prevent infinite wait on exit. [Python Bug 216289] */ - SetEvent(consolePtr->stopWriter); - - /* - * Wait at most 20 milliseconds for the writer thread to close. - */ - - if (WaitForSingleObject(consolePtr->writeThread, 20) - == WAIT_TIMEOUT) { - /* - * Forcibly terminate the background thread as a last resort. - * Note that we need to guard against terminating the thread - * while it is in the middle of Tcl_ThreadAlert because it - * won't be able to release the notifier lock. - */ - - Tcl_MutexLock(&consoleMutex); - - /* BUG: this leaks memory. */ - TerminateThread(consolePtr->writeThread, 0); - Tcl_MutexUnlock(&consoleMutex); - } + WaitForSingleObject(consolePtr->writer.readyEvent, INFINITE); } - CloseHandle(consolePtr->writeThread); - CloseHandle(consolePtr->writable); - CloseHandle(consolePtr->startWriter); - CloseHandle(consolePtr->stopWriter); - consolePtr->writeThread = NULL; + StopChannelThread(&consolePtr->writer); } consolePtr->validMask &= ~TCL_WRITABLE; - /* * Don't close the Win32 handle if the handle is a standard channel during * the thread exit process. Otherwise, one thread may kill the stdio of @@ -651,7 +663,7 @@ ConsoleCloseProc( for (nextPtrPtr = &(tsdPtr->firstConsolePtr), infoPtr = *nextPtrPtr; infoPtr != NULL; nextPtrPtr = &infoPtr->nextPtr, infoPtr = *nextPtrPtr) { - if (infoPtr == (ConsoleInfo *)consolePtr) { + if (infoPtr == (ConsoleInfo *) consolePtr) { *nextPtrPtr = infoPtr->nextPtr; break; } @@ -660,7 +672,7 @@ ConsoleCloseProc( ckfree(consolePtr->writeBuf); consolePtr->writeBuf = 0; } - ckfree((char*) consolePtr); + ckfree(consolePtr); return errorCode; } @@ -691,7 +703,7 @@ ConsoleInputProc( * buffer? */ int *errorCode) /* Where to store error code. */ { - ConsoleInfo *infoPtr = (ConsoleInfo *) instanceData; + ConsoleInfo *infoPtr = instanceData; DWORD count, bytesRead = 0; int result; @@ -726,7 +738,7 @@ ConsoleInputProc( bytesRead = infoPtr->bytesRead - infoPtr->offset; /* - * Reset the buffer + * Reset the buffer. */ infoPtr->readFlags &= ~CONSOLE_BUFFERED; @@ -742,8 +754,15 @@ ConsoleInputProc( * byte is available or an EOF occurs. */ - if (readConsoleBytes(infoPtr->handle, (LPVOID) buf, (DWORD) bufSize, &count) - == TRUE) { + if (ReadConsoleBytes(infoPtr->handle, (LPVOID) buf, (DWORD) bufSize, + &count) == TRUE) { + /* + * TODO: This potentially writes beyond the limits specified + * by the caller. In practice this is harmless, since all writes + * are into ChannelBuffers, and those have padding, but still + * ought to remove this, unless some Windows wizard can give + * a reason not to. + */ buf[count] = '\0'; return count; } @@ -772,22 +791,23 @@ ConsoleInputProc( static int ConsoleOutputProc( ClientData instanceData, /* Console state. */ - CONST char *buf, /* The data buffer. */ + const char *buf, /* The data buffer. */ int toWrite, /* How many bytes to write? */ int *errorCode) /* Where to store error code. */ { - ConsoleInfo *infoPtr = (ConsoleInfo *) instanceData; + ConsoleInfo *infoPtr = instanceData; + ConsoleThreadInfo *threadInfo = &infoPtr->reader; DWORD bytesWritten, timeout; *errorCode = 0; timeout = (infoPtr->flags & CONSOLE_ASYNC) ? 0 : INFINITE; - if (WaitForSingleObject(infoPtr->writable, timeout) == WAIT_TIMEOUT) { + if (WaitForSingleObject(threadInfo->readyEvent,timeout) == WAIT_TIMEOUT) { /* * The writer thread is blocked waiting for a write to complete and * the channel is in non-blocking mode. */ - errno = EAGAIN; + errno = EWOULDBLOCK; goto error; } @@ -816,12 +836,12 @@ ConsoleOutputProc( ckfree(infoPtr->writeBuf); } infoPtr->writeBufLen = toWrite; - infoPtr->writeBuf = ckalloc((size_t)toWrite); + infoPtr->writeBuf = ckalloc(toWrite); } - memcpy(infoPtr->writeBuf, buf, (size_t)toWrite); + memcpy(infoPtr->writeBuf, buf, (size_t) toWrite); infoPtr->toWrite = toWrite; - ResetEvent(infoPtr->writable); - SetEvent(infoPtr->startWriter); + ResetEvent(threadInfo->readyEvent); + SetEvent(threadInfo->startEvent); bytesWritten = toWrite; } else { /* @@ -829,9 +849,8 @@ ConsoleOutputProc( * avoids an unnecessary copy. */ - if (writeConsoleBytes(infoPtr->handle, buf, (DWORD)toWrite, - &bytesWritten) - == FALSE) { + if (WriteConsoleBytes(infoPtr->handle, buf, (DWORD) toWrite, + &bytesWritten) == FALSE) { TclWinConvertError(GetLastError()); goto error; } @@ -870,7 +889,7 @@ ConsoleEventProc( int flags) /* Flags that indicate what events to handle, * such as TCL_FILE_EVENTS. */ { - ConsoleEvent *consoleEvPtr = (ConsoleEvent *)evPtr; + ConsoleEvent *consoleEvPtr = (ConsoleEvent *) evPtr; ConsoleInfo *infoPtr; int mask; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -889,7 +908,7 @@ ConsoleEventProc( for (infoPtr = tsdPtr->firstConsolePtr; infoPtr != NULL; infoPtr = infoPtr->nextPtr) { if (consoleEvPtr->infoPtr == infoPtr) { - infoPtr->flags &= ~(CONSOLE_PENDING); + infoPtr->flags &= ~CONSOLE_PENDING; break; } } @@ -910,7 +929,8 @@ ConsoleEventProc( mask = 0; if (infoPtr->watchMask & TCL_WRITABLE) { - if (WaitForSingleObject(infoPtr->writable, 0) != WAIT_TIMEOUT) { + if (WaitForSingleObject(infoPtr->writer.readyEvent, + 0) != WAIT_TIMEOUT) { mask = TCL_WRITABLE; } } @@ -957,7 +977,7 @@ ConsoleWatchProc( * TCL_EXCEPTION. */ { ConsoleInfo **nextPtrPtr, *ptr; - ConsoleInfo *infoPtr = (ConsoleInfo *) instanceData; + ConsoleInfo *infoPtr = instanceData; int oldMask = infoPtr->watchMask; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -969,6 +989,7 @@ ConsoleWatchProc( infoPtr->watchMask = mask & infoPtr->validMask; if (infoPtr->watchMask) { Tcl_Time blockTime = { 0, 0 }; + if (!oldMask) { infoPtr->nextPtr = tsdPtr->firstConsolePtr; tsdPtr->firstConsolePtr = infoPtr; @@ -1011,12 +1032,12 @@ ConsoleWatchProc( static int ConsoleGetHandleProc( ClientData instanceData, /* The console state. */ - int direction, /* TCL_READABLE or TCL_WRITABLE */ + int direction, /* TCL_READABLE or TCL_WRITABLE. */ ClientData *handlePtr) /* Where to store the handle. */ { - ConsoleInfo *infoPtr = (ConsoleInfo *) instanceData; + ConsoleInfo *infoPtr = instanceData; - *handlePtr = (ClientData) infoPtr->handle; + *handlePtr = infoPtr->handle; return TCL_OK; } @@ -1049,6 +1070,7 @@ WaitForRead( { DWORD timeout, count; HANDLE *handle = infoPtr->handle; + ConsoleThreadInfo *threadInfo = &infoPtr->reader; INPUT_RECORD input; while (1) { @@ -1057,13 +1079,14 @@ WaitForRead( */ timeout = blocking ? INFINITE : 0; - if (WaitForSingleObject(infoPtr->readable, timeout) == WAIT_TIMEOUT) { + if (WaitForSingleObject(threadInfo->readyEvent, + timeout) == WAIT_TIMEOUT) { /* * The reader thread is blocked waiting for data and the channel * is in non-blocking mode. */ - errno = EAGAIN; + errno = EWOULDBLOCK; return -1; } @@ -1116,8 +1139,8 @@ WaitForRead( * There wasn't any data available, so reset the thread and try again. */ - ResetEvent(infoPtr->readable); - SetEvent(infoPtr->startReader); + ResetEvent(threadInfo->readyEvent); + SetEvent(threadInfo->startEvent); } } @@ -1144,14 +1167,18 @@ static DWORD WINAPI ConsoleReaderThread( LPVOID arg) { - ConsoleInfo *infoPtr = (ConsoleInfo *)arg; + ConsoleInfo *infoPtr = arg; HANDLE *handle = infoPtr->handle; - DWORD count, waitResult; + ConsoleThreadInfo *threadInfo = &infoPtr->reader; + DWORD waitResult; HANDLE wEvents[2]; - /* The first event takes precedence. */ - wEvents[0] = infoPtr->stopReader; - wEvents[1] = infoPtr->startReader; + /* + * The first event takes precedence. + */ + + wEvents[0] = threadInfo->stopEvent; + wEvents[1] = threadInfo->startEvent; for (;;) { /* @@ -1169,14 +1196,12 @@ ConsoleReaderThread( break; } - count = 0; - /* * Look for data on the console, but first ignore any events that are * not KEY_EVENTs. */ - if (readConsoleBytes(handle, infoPtr->buffer, CONSOLE_BUFFER_SIZE, + if (ReadConsoleBytes(handle, infoPtr->buffer, CONSOLE_BUFFER_SIZE, (LPDWORD) &infoPtr->bytesRead) != FALSE) { /* * Data was stored in the buffer. @@ -1184,10 +1209,9 @@ ConsoleReaderThread( infoPtr->readFlags |= CONSOLE_BUFFERED; } else { - DWORD err; - err = GetLastError(); + DWORD err = GetLastError(); - if (err == EOF) { + if (err == (DWORD) EOF) { infoPtr->readFlags = CONSOLE_EOF; } } @@ -1197,7 +1221,7 @@ ConsoleReaderThread( * waking up the notifier thread. */ - SetEvent(infoPtr->readable); + SetEvent(threadInfo->readyEvent); /* * Alert the foreground thread. Note that we need to treat this like a @@ -1211,6 +1235,7 @@ ConsoleReaderThread( * TIP #218. When in flight ignore the event, no one will receive * it anyway. */ + Tcl_ThreadAlert(infoPtr->threadId); } Tcl_MutexUnlock(&consoleMutex); @@ -1242,16 +1267,19 @@ static DWORD WINAPI ConsoleWriterThread( LPVOID arg) { - - ConsoleInfo *infoPtr = (ConsoleInfo *)arg; + ConsoleInfo *infoPtr = arg; HANDLE *handle = infoPtr->handle; + ConsoleThreadInfo *threadInfo = &infoPtr->writer; DWORD count, toWrite, waitResult; char *buf; HANDLE wEvents[2]; - /* The first event takes precedence. */ - wEvents[0] = infoPtr->stopWriter; - wEvents[1] = infoPtr->startWriter; + /* + * The first event takes precedence. + */ + + wEvents[0] = threadInfo->stopEvent; + wEvents[1] = threadInfo->startEvent; for (;;) { /* @@ -1277,14 +1305,13 @@ ConsoleWriterThread( */ while (toWrite > 0) { - if (writeConsoleBytes(handle, buf, (DWORD)toWrite, - &count) == FALSE) { + if (WriteConsoleBytes(handle, buf, (DWORD) toWrite, + &count) == FALSE) { infoPtr->writeError = GetLastError(); break; - } else { - toWrite -= count; - buf += count; } + toWrite -= count; + buf += count; } /* @@ -1292,7 +1319,7 @@ ConsoleWriterThread( * waking up the notifier thread. */ - SetEvent(infoPtr->writable); + SetEvent(threadInfo->readyEvent); /* * Alert the foreground thread. Note that we need to treat this like a @@ -1328,7 +1355,7 @@ ConsoleWriterThread( * Returns the new channel, or NULL. * * Side effects: - * May open the channel + * May open the channel. * *---------------------------------------------------------------------- */ @@ -1341,7 +1368,7 @@ TclWinOpenConsoleChannel( { char encoding[4 + TCL_INTEGER_SPACE]; ConsoleInfo *infoPtr; - DWORD id, modes; + DWORD modes; ConsoleInit(); @@ -1349,7 +1376,7 @@ TclWinOpenConsoleChannel( * See if a channel with this handle already exists. */ - infoPtr = (ConsoleInfo *) ckalloc((unsigned) sizeof(ConsoleInfo)); + infoPtr = ckalloc(sizeof(ConsoleInfo)); memset(infoPtr, 0, sizeof(ConsoleInfo)); infoPtr->validMask = permissions; @@ -1366,10 +1393,10 @@ TclWinOpenConsoleChannel( * for instance). */ - wsprintfA(channelName, "file%lx", (int) infoPtr); + sprintf(channelName, "file%" TCL_I_MODIFIER "x", (size_t) infoPtr); infoPtr->channel = Tcl_CreateChannel(&consoleChannelType, channelName, - (ClientData) infoPtr, permissions); + infoPtr, permissions); if (permissions & TCL_READABLE) { /* @@ -1382,22 +1409,11 @@ TclWinOpenConsoleChannel( modes &= ~(ENABLE_WINDOW_INPUT | ENABLE_MOUSE_INPUT); modes |= ENABLE_LINE_INPUT; SetConsoleMode(infoPtr->handle, modes); - - infoPtr->readable = CreateEvent(NULL, TRUE, TRUE, NULL); - infoPtr->startReader = CreateEvent(NULL, FALSE, FALSE, NULL); - infoPtr->stopReader = CreateEvent(NULL, FALSE, FALSE, NULL); - infoPtr->readThread = CreateThread(NULL, 256, ConsoleReaderThread, - infoPtr, 0, &id); - SetThreadPriority(infoPtr->readThread, THREAD_PRIORITY_HIGHEST); + StartChannelThread(infoPtr, &infoPtr->reader, ConsoleReaderThread); } if (permissions & TCL_WRITABLE) { - infoPtr->writable = CreateEvent(NULL, TRUE, TRUE, NULL); - infoPtr->startWriter = CreateEvent(NULL, FALSE, FALSE, NULL); - infoPtr->stopWriter = CreateEvent(NULL, FALSE, FALSE, NULL); - infoPtr->writeThread = CreateThread(NULL, 256, ConsoleWriterThread, - infoPtr, 0, &id); - SetThreadPriority(infoPtr->writeThread, THREAD_PRIORITY_HIGHEST); + StartChannelThread(infoPtr, &infoPtr->writer, ConsoleWriterThread); } /* @@ -1407,11 +1423,11 @@ TclWinOpenConsoleChannel( Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto"); Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "\032 {}"); - if (tclWinProcs->useWide) - Tcl_SetChannelOption(NULL, infoPtr->channel, "-encoding", "unicode"); - else - Tcl_SetChannelOption(NULL, infoPtr->channel, "-encoding", encoding); - +#ifdef UNICODE + Tcl_SetChannelOption(NULL, infoPtr->channel, "-encoding", "unicode"); +#else + Tcl_SetChannelOption(NULL, infoPtr->channel, "-encoding", encoding); +#endif return infoPtr->channel; } @@ -1436,9 +1452,10 @@ ConsoleThreadActionProc( ClientData instanceData, int action) { - ConsoleInfo *infoPtr = (ConsoleInfo *) instanceData; + ConsoleInfo *infoPtr = instanceData; - /* We do not access firstConsolePtr in the thread structures. This is not + /* + * 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. diff --git a/win/tclWinDde.c b/win/tclWinDde.c index bcd086e..ce0b413 100644 --- a/win/tclWinDde.c +++ b/win/tclWinDde.c @@ -8,14 +8,30 @@ * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. - * - * RCS: @(#) $Id: tclWinDde.c,v 1.31 2006/09/26 00:05:03 patthoyts Exp $ */ +#undef STATIC_BUILD +#ifndef USE_TCL_STUBS +# define USE_TCL_STUBS +#endif #include "tclInt.h" #include <dde.h> #include <ddeml.h> -#include <tchar.h> + +#ifndef UNICODE +# undef CP_WINUNICODE +# define CP_WINUNICODE CP_WINANSI +# undef Tcl_WinTCharToUtf +# define Tcl_WinTCharToUtf(a,b,c) Tcl_ExternalToUtfDString(NULL,a,b,c) +# undef Tcl_WinUtfToTChar +# define Tcl_WinUtfToTChar(a,b,c) Tcl_UtfToExternalDString(NULL,a,b,c) +#endif + +#if !defined(NDEBUG) + /* test POKE server Implemented for debug mode only */ +# undef CBF_FAIL_POKES +# define CBF_FAIL_POKES 0 +#endif /* * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the Dde_Init @@ -36,7 +52,7 @@ typedef struct RegisteredInterp { struct RegisteredInterp *nextPtr; /* The next interp this application knows * about. */ - char *name; /* Interpreter's name (malloc-ed). */ + TCHAR *name; /* Interpreter's name (malloc-ed). */ Tcl_Obj *handlerPtr; /* The server handler command */ Tcl_Interp *interp; /* The interpreter attached to this name. */ } RegisteredInterp; @@ -81,10 +97,14 @@ static DWORD ddeInstance; /* The application instance handle given to us * by DdeInitialize. */ static int ddeIsServer = 0; -#define TCL_DDE_VERSION "1.3.2" +#define TCL_DDE_VERSION "1.4.0" #define TCL_DDE_PACKAGE_NAME "dde" -#define TCL_DDE_SERVICE_NAME "TclEval" -#define TCL_DDE_EXECUTE_RESULT "$TCLEVAL$EXECUTE$RESULT" +#define TCL_DDE_SERVICE_NAME TEXT("TclEval") +#define TCL_DDE_EXECUTE_RESULT TEXT("$TCLEVAL$EXECUTE$RESULT") + +#define DDE_FLAG_ASYNC 1 +#define DDE_FLAG_BINARY 2 +#define DDE_FLAG_FORCE 4 TCL_DECLARE_MUTEX(ddeMutex) @@ -95,10 +115,11 @@ TCL_DECLARE_MUTEX(ddeMutex) 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 BOOL CALLBACK DdeEnumWindowsCallback(HWND hwndTarget, + LPARAM lParam); static void DdeExitProc(ClientData clientData); static int DdeGetServicesList(Tcl_Interp *interp, - char *serviceName, char *topicName); + const TCHAR *serviceName, const TCHAR *topicName); static HDDEDATA CALLBACK DdeServerProc(UINT uType, UINT uFmt, HCONV hConv, HSZ ddeTopic, HSZ ddeItem, HDDEDATA hData, DWORD dwData1, DWORD dwData2); @@ -107,13 +128,12 @@ static LRESULT DdeServicesOnAck(HWND hwnd, WPARAM wParam, 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 int MakeDdeConnection(Tcl_Interp *interp, + const TCHAR *name, HCONV *ddeConvPtr); static void SetDdeError(Tcl_Interp *interp); - -int Tcl_DdeObjCmd(ClientData clientData, +static int DdeObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); EXTERN int Dde_Init(Tcl_Interp *interp); EXTERN int Dde_SafeInit(Tcl_Interp *interp); @@ -138,14 +158,18 @@ int Dde_Init( Tcl_Interp *interp) { - ThreadSpecificData *tsdPtr; - - if (!Tcl_InitStubs(interp, "8.0", 0)) { + if (!Tcl_InitStubs(interp, "8.1", 0)) { return TCL_ERROR; } - Tcl_CreateObjCommand(interp, "dde", Tcl_DdeObjCmd, NULL, NULL); - tsdPtr = TCL_TSD_INIT(&dataKey); +#ifdef UNICODE + if (TclWinGetPlatformId() < VER_PLATFORM_WIN32_NT) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "Win32s and Windows 9x are not supported platforms", -1)); + return TCL_ERROR; + } +#endif + Tcl_CreateObjCommand(interp, "dde", DdeObjCmd, NULL, NULL); Tcl_CreateExitHandler(DdeExitProc, NULL); return Tcl_PkgProvide(interp, TCL_DDE_PACKAGE_NAME, TCL_DDE_VERSION); } @@ -217,7 +241,7 @@ Initialize(void) if (ddeInstance == 0) { Tcl_MutexLock(&ddeMutex); if (ddeInstance == 0) { - if (DdeInitialize(&ddeInstance, DdeServerProc, + if (DdeInitialize(&ddeInstance, (PFNCALLBACK) DdeServerProc, CBF_SKIP_REGISTRATIONS | CBF_SKIP_UNREGISTRATIONS | CBF_FAIL_POKES, 0) != DMLERR_NO_ERROR) { ddeInstance = 0; @@ -231,7 +255,7 @@ Initialize(void) ddeIsServer = 1; Tcl_CreateExitHandler(DdeExitProc, NULL); ddeServiceGlobal = DdeCreateStringHandle(ddeInstance, - TCL_DDE_SERVICE_NAME, 0); + TCL_DDE_SERVICE_NAME, CP_WINUNICODE); DdeNameService(ddeInstance, ddeServiceGlobal, 0L, DNS_REGISTER); } else { ddeIsServer = 0; @@ -265,20 +289,20 @@ Initialize(void) *---------------------------------------------------------------------- */ -static char * +static const TCHAR * DdeSetServerName( Tcl_Interp *interp, - char *name, /* The name that will be used to refer to the + const TCHAR *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 */ + int flags, /* DDE_FLAG_FORCE or 0 */ Tcl_Obj *handlerPtr) /* Name of the optional proc/command to handle * incoming Dde eval's */ { int suffix, offset; RegisteredInterp *riPtr, *prevPtr; Tcl_DString dString; - char *actualName; + const TCHAR *actualName; Tcl_Obj *srvListPtr = NULL, **srvPtrPtr = NULL; int n, srvCount = 0, lastSuffix, r = TCL_OK; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -316,7 +340,7 @@ DdeSetServerName( * current interp, but it doesn't have a name. */ - return ""; + return TEXT(""); } /* @@ -327,7 +351,7 @@ DdeSetServerName( Tcl_DStringInit(&dString); actualName = name; - if (!exactName) { + if (!(flags & DDE_FLAG_FORCE)) { r = DdeGetServicesList(interp, TCL_DDE_SERVICE_NAME, NULL); if (r == TCL_OK) { srvListPtr = Tcl_GetObjResult(interp); @@ -337,7 +361,9 @@ DdeSetServerName( &srvPtrPtr); } if (r != TCL_OK) { - OutputDebugString(Tcl_GetStringResult(interp)); + Tcl_WinUtfToTChar(Tcl_GetStringResult(interp), -1, &dString); + OutputDebugString((TCHAR *) Tcl_DStringValue(&dString)); + Tcl_DStringFree(&dString); return NULL; } @@ -354,13 +380,14 @@ DdeSetServerName( lastSuffix = suffix; if (suffix > 1) { if (suffix == 2) { - Tcl_DStringAppend(&dString, name, -1); - Tcl_DStringAppend(&dString, " #", 2); + Tcl_DStringAppend(&dString, (char *)name, _tcslen(name) * sizeof(TCHAR)); + Tcl_DStringAppend(&dString, (char *)TEXT(" #"), 2 * sizeof(TCHAR)); offset = Tcl_DStringLength(&dString); - Tcl_DStringSetLength(&dString, offset + TCL_INTEGER_SPACE); - actualName = Tcl_DStringValue(&dString); + Tcl_DStringSetLength(&dString, offset + sizeof(TCHAR) * TCL_INTEGER_SPACE); + actualName = (TCHAR *) Tcl_DStringValue(&dString); } - sprintf(Tcl_DStringValue(&dString) + offset, "%d", suffix); + _sntprintf((TCHAR *) (Tcl_DStringValue(&dString) + offset), + TCL_INTEGER_SPACE, TEXT("%d"), suffix); } /* @@ -369,39 +396,41 @@ DdeSetServerName( for (n = 0; n < srvCount; ++n) { Tcl_Obj* namePtr; + Tcl_DString ds; Tcl_ListObjIndex(interp, srvPtrPtr[n], 1, &namePtr); - if (strcmp(actualName, Tcl_GetString(namePtr)) == 0) { + Tcl_WinUtfToTChar(Tcl_GetString(namePtr), -1, &ds); + if (_tcscmp(actualName, (TCHAR *)Tcl_DStringValue(&ds)) == 0) { suffix++; + Tcl_DStringFree(&ds); break; } + Tcl_DStringFree(&ds); } } - Tcl_DStringSetLength(&dString, - offset + (int)strlen(Tcl_DStringValue(&dString)+offset)); } /* * We have found a unique name. Now add it to the registry. */ - riPtr = (RegisteredInterp *) ckalloc(sizeof(RegisteredInterp)); + riPtr = ckalloc(sizeof(RegisteredInterp)); riPtr->interp = interp; - riPtr->name = ckalloc((unsigned int) strlen(actualName) + 1); + riPtr->name = ckalloc((_tcslen(actualName) + 1) * sizeof(TCHAR)); riPtr->nextPtr = tsdPtr->interpListPtr; riPtr->handlerPtr = handlerPtr; if (riPtr->handlerPtr != NULL) { Tcl_IncrRefCount(riPtr->handlerPtr); } tsdPtr->interpListPtr = riPtr; - strcpy(riPtr->name, actualName); + _tcscpy(riPtr->name, actualName); if (Tcl_IsSafe(interp)) { Tcl_ExposeCommand(interp, "dde", "dde"); } - Tcl_CreateObjCommand(interp, "dde", Tcl_DdeObjCmd, - (ClientData) riPtr, DeleteProc); + Tcl_CreateObjCommand(interp, "dde", DdeObjCmd, + riPtr, DeleteProc); if (Tcl_IsSafe(interp)) { Tcl_HideCommand(interp, "dde", "dde"); } @@ -474,7 +503,7 @@ DeleteProc( 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. @@ -530,6 +559,7 @@ ExecuteRemoteObject( Tcl_SetObjResult(riPtr->interp, Tcl_NewStringObj("permission denied: " "a handler procedure must be defined for use in a safe " "interp", -1)); + Tcl_SetErrorCode(riPtr->interp, "TCL", "DDE", "SECURITY_CHECK", NULL); result = TCL_ERROR; } @@ -540,7 +570,8 @@ ExecuteRemoteObject( Tcl_Obj *cmdPtr = Tcl_DuplicateObj(riPtr->handlerPtr); - result = Tcl_ListObjAppendElement(riPtr->interp, cmdPtr, ddeObjectPtr); + result = Tcl_ListObjAppendElement(riPtr->interp, cmdPtr, + ddeObjectPtr); if (result == TCL_OK) { ddeObjectPtr = cmdPtr; } @@ -552,7 +583,8 @@ ExecuteRemoteObject( returnPackagePtr = Tcl_NewListObj(0, NULL); - Tcl_ListObjAppendElement(NULL, returnPackagePtr, Tcl_NewIntObj(result)); + Tcl_ListObjAppendElement(NULL, returnPackagePtr, + Tcl_NewIntObj(result)); Tcl_ListObjAppendElement(NULL, returnPackagePtr, Tcl_GetObjResult(riPtr->interp)); @@ -595,7 +627,7 @@ static HDDEDATA CALLBACK DdeServerProc( UINT uType, /* The type of DDE transaction we are * performing. */ - UINT uFmt, /* The format that data is sent or received. */ + UINT uFmt, /* The format that data is sent or received */ HCONV hConv, /* The conversation associated with the * current transaction. */ HSZ ddeTopic, HSZ ddeItem, /* String handles. Transaction-type @@ -607,7 +639,7 @@ DdeServerProc( Tcl_DString dString; int len; DWORD dlen; - char *utilString; + TCHAR *utilString; Tcl_Obj *ddeObjectPtr; HDDEDATA ddeReturn = NULL; RegisteredInterp *riPtr; @@ -621,16 +653,16 @@ DdeServerProc( * sure we have a valid topic. */ - len = DdeQueryString(ddeInstance, ddeTopic, NULL, 0, 0); + len = DdeQueryString(ddeInstance, ddeTopic, NULL, 0, CP_WINUNICODE); Tcl_DStringInit(&dString); - Tcl_DStringSetLength(&dString, len); - utilString = Tcl_DStringValue(&dString); + Tcl_DStringSetLength(&dString, (len + 1) * sizeof(TCHAR) - 1); + utilString = (TCHAR *) Tcl_DStringValue(&dString); DdeQueryString(ddeInstance, ddeTopic, utilString, (DWORD) len + 1, - CP_WINANSI); + CP_WINUNICODE); for (riPtr = tsdPtr->interpListPtr; riPtr != NULL; riPtr = riPtr->nextPtr) { - if (stricmp(utilString, riPtr->name) == 0) { + if (_tcsicmp(utilString, riPtr->name) == 0) { Tcl_DStringFree(&dString); return (HDDEDATA) TRUE; } @@ -646,16 +678,16 @@ DdeServerProc( * result to return in an XTYP_REQUEST. */ - len = DdeQueryString(ddeInstance, ddeTopic, NULL, 0, 0); + len = DdeQueryString(ddeInstance, ddeTopic, NULL, 0, CP_WINUNICODE); Tcl_DStringInit(&dString); - Tcl_DStringSetLength(&dString, len); - utilString = Tcl_DStringValue(&dString); + Tcl_DStringSetLength(&dString, (len + 1) * sizeof(TCHAR) - 1); + utilString = (TCHAR *) Tcl_DStringValue(&dString); DdeQueryString(ddeInstance, ddeTopic, utilString, (DWORD) len + 1, - CP_WINANSI); + CP_WINUNICODE); for (riPtr = tsdPtr->interpListPtr; riPtr != NULL; riPtr = riPtr->nextPtr) { - if (stricmp(riPtr->name, utilString) == 0) { - convPtr = (Conversation *) ckalloc(sizeof(Conversation)); + if (_tcsicmp(riPtr->name, utilString) == 0) { + convPtr = ckalloc(sizeof(Conversation)); convPtr->nextPtr = tsdPtr->currentConversations; convPtr->returnPackagePtr = NULL; convPtr->hConv = hConv; @@ -685,7 +717,7 @@ DdeServerProc( if (convPtr->returnPackagePtr != NULL) { Tcl_DecrRefCount(convPtr->returnPackagePtr); } - ckfree((char *) convPtr); + ckfree(convPtr); break; } } @@ -698,7 +730,7 @@ DdeServerProc( * execute. */ - if (uFmt != CF_TEXT) { + if ((uFmt != CF_TEXT) && (uFmt != CF_UNICODETEXT)) { return (HDDEDATA) FALSE; } @@ -713,39 +745,102 @@ DdeServerProc( if (convPtr != NULL) { char *returnString; - len = DdeQueryString(ddeInstance, ddeItem, NULL, 0, CP_WINANSI); + len = DdeQueryString(ddeInstance, ddeItem, NULL, 0, CP_WINUNICODE); Tcl_DStringInit(&dString); - Tcl_DStringSetLength(&dString, len); - utilString = Tcl_DStringValue(&dString); + Tcl_DStringSetLength(&dString, (len + 1) * sizeof(TCHAR) - 1); + utilString = (TCHAR *) Tcl_DStringValue(&dString); DdeQueryString(ddeInstance, ddeItem, utilString, (DWORD) len + 1, - CP_WINANSI); - if (stricmp(utilString, TCL_DDE_EXECUTE_RESULT) == 0) { - returnString = - Tcl_GetStringFromObj(convPtr->returnPackagePtr, &len); - ddeReturn = DdeCreateDataHandle(ddeInstance, returnString, - (DWORD) len+1, 0, ddeItem, CF_TEXT, 0); + CP_WINUNICODE); + if (_tcsicmp(utilString, TCL_DDE_EXECUTE_RESULT) == 0) { + if (uFmt == CF_TEXT) { + returnString = + Tcl_GetStringFromObj(convPtr->returnPackagePtr, &len); + } else { + returnString = (char *) + Tcl_GetUnicodeFromObj(convPtr->returnPackagePtr, &len); + len = sizeof(TCHAR) * len + 1; + } + ddeReturn = DdeCreateDataHandle(ddeInstance, (BYTE *)returnString, + (DWORD) len+1, 0, ddeItem, uFmt, 0); } else { if (Tcl_IsSafe(convPtr->riPtr->interp)) { ddeReturn = NULL; } else { - Tcl_Obj *variableObjPtr = Tcl_GetVar2Ex( - convPtr->riPtr->interp, utilString, NULL, + Tcl_DString ds; + Tcl_Obj *variableObjPtr; + Tcl_WinTCharToUtf(utilString, -1, &ds); + variableObjPtr = Tcl_GetVar2Ex( + convPtr->riPtr->interp, Tcl_DStringValue(&ds), NULL, TCL_GLOBAL_ONLY); if (variableObjPtr != NULL) { - returnString = Tcl_GetStringFromObj(variableObjPtr, - &len); + if (uFmt == CF_TEXT) { + returnString = Tcl_GetStringFromObj( + variableObjPtr, &len); + } else { + returnString = (char *) Tcl_GetUnicodeFromObj( + variableObjPtr, &len); + len = sizeof(TCHAR) * len + 1; + } ddeReturn = DdeCreateDataHandle(ddeInstance, - returnString, (DWORD) len+1, 0, ddeItem, - CF_TEXT, 0); + (BYTE *)returnString, (DWORD) len+1, 0, ddeItem, + uFmt, 0); } else { ddeReturn = NULL; } + Tcl_DStringFree(&ds); } } Tcl_DStringFree(&dString); } return ddeReturn; +#if !CBF_FAIL_POKES + case XTYP_POKE: + /* + * This is a poke for a Tcl variable, only implemented in + * debug/UNICODE mode. + */ + ddeReturn = DDE_FNOTPROCESSED; + + if ((uFmt != CF_TEXT) && (uFmt != CF_UNICODETEXT)) { + return ddeReturn; + } + + for (convPtr = tsdPtr->currentConversations; (convPtr != NULL) + && (convPtr->hConv != hConv); convPtr = convPtr->nextPtr) { + /* + * Empty loop body. + */ + } + + if (convPtr && !Tcl_IsSafe(convPtr->riPtr->interp)) { + Tcl_DString ds; + Tcl_Obj *variableObjPtr; + + len = DdeQueryString(ddeInstance, ddeItem, NULL, 0, CP_WINUNICODE); + Tcl_DStringInit(&dString); + Tcl_DStringSetLength(&dString, (len + 1) * sizeof(TCHAR) - 1); + utilString = (TCHAR *) Tcl_DStringValue(&dString); + DdeQueryString(ddeInstance, ddeItem, utilString, (DWORD) len + 1, + CP_WINUNICODE); + Tcl_WinTCharToUtf(utilString, -1, &ds); + utilString = (TCHAR *) DdeAccessData(hData, &dlen); + if (uFmt == CF_TEXT) { + variableObjPtr = Tcl_NewStringObj((char *)utilString, -1); + } else { + variableObjPtr = Tcl_NewUnicodeObj(utilString, -1); + } + + Tcl_SetVar2Ex(convPtr->riPtr->interp, Tcl_DStringValue(&ds), NULL, + variableObjPtr, TCL_GLOBAL_ONLY); + + Tcl_DStringFree(&ds); + Tcl_DStringFree(&dString); + ddeReturn = (HDDEDATA) DDE_FACK; + } + return ddeReturn; + +#endif case XTYP_EXECUTE: { /* * Execute this script. The results will be saved into a list object @@ -753,6 +848,7 @@ DdeServerProc( */ Tcl_Obj *returnPackagePtr; + char *string; for (convPtr = tsdPtr->currentConversations; (convPtr != NULL) && (convPtr->hConv != hConv); convPtr = convPtr->nextPtr) { @@ -765,9 +861,22 @@ DdeServerProc( return (HDDEDATA) DDE_FNOTPROCESSED; } - utilString = (char *) DdeAccessData(hData, &dlen); - len = dlen; - ddeObjectPtr = Tcl_NewStringObj(utilString, -1); + utilString = (TCHAR *) DdeAccessData(hData, &dlen); + string = (char *) utilString; + if (!dlen) { + /* Empty binary array. */ + ddeObjectPtr = Tcl_NewObj(); + } else if ((dlen & 1) || utilString[(dlen>>1)-1]) { + /* Cannot be unicode, so assume utf-8 */ + if (!string[dlen-1]) { + dlen--; + } + ddeObjectPtr = Tcl_NewStringObj(string, dlen); + } else { + /* unicode */ + dlen >>= 1; + ddeObjectPtr = Tcl_NewUnicodeObj((Tcl_UniChar *)utilString, dlen - 1); + } Tcl_IncrRefCount(ddeObjectPtr); DdeUnaccessData(hData); if (convPtr->returnPackagePtr != NULL) { @@ -819,9 +928,9 @@ DdeServerProc( for (i = 0, riPtr = tsdPtr->interpListPtr; i < numItems; i++, riPtr = riPtr->nextPtr) { returnPtr[i].hszSvc = DdeCreateStringHandle(ddeInstance, - TCL_DDE_SERVICE_NAME, CP_WINANSI); + TCL_DDE_SERVICE_NAME, CP_WINUNICODE); returnPtr[i].hszTopic = DdeCreateStringHandle(ddeInstance, - riPtr->name, CP_WINANSI); + riPtr->name, CP_WINUNICODE); } returnPtr[i].hszSvc = NULL; returnPtr[i].hszTopic = NULL; @@ -879,14 +988,14 @@ DdeExitProc( static int MakeDdeConnection( Tcl_Interp *interp, /* Used to report errors. */ - char *name, /* The connection to use. */ + const TCHAR *name, /* The connection to use. */ HCONV *ddeConvPtr) { HSZ ddeTopic, ddeService; HCONV ddeConv; - ddeService = DdeCreateStringHandle(ddeInstance, TCL_DDE_SERVICE_NAME, 0); - ddeTopic = DdeCreateStringHandle(ddeInstance, name, 0); + ddeService = DdeCreateStringHandle(ddeInstance, TCL_DDE_SERVICE_NAME, CP_WINUNICODE); + ddeTopic = DdeCreateStringHandle(ddeInstance, name, CP_WINUNICODE); ddeConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL); DdeFreeStringHandle(ddeInstance, ddeService); @@ -894,8 +1003,13 @@ MakeDdeConnection( if (ddeConv == (HCONV) NULL) { if (interp != NULL) { - Tcl_AppendResult(interp, "no registered server named \"", - name, "\"", NULL); + Tcl_DString dString; + + Tcl_WinTCharToUtf(name, -1, &dString); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "no registered server named \"%s\"", Tcl_DStringValue(&dString))); + Tcl_DStringFree(&dString); + Tcl_SetErrorCode(interp, "TCL", "DDE", "NO_SERVER", NULL); } return TCL_ERROR; } @@ -929,8 +1043,8 @@ DdeCreateClient( struct DdeEnumServices *es) { WNDCLASSEX wc; - static const char *szDdeClientClassName = "TclEval client class"; - static const char *szDdeClientWindowName = "TclEval client window"; + static const TCHAR *szDdeClientClassName = TEXT("TclEval client class"); + static const TCHAR *szDdeClientWindowName = TEXT("TclEval client window"); memset(&wc, 0, sizeof(wc)); wc.cbSize = sizeof(wc); @@ -955,7 +1069,6 @@ DdeClientWindowProc( WPARAM wParam, LPARAM lParam) /* (Potentially) our local handle */ { - switch (uMsg) { case WM_CREATE: { LPCREATESTRUCT lpcs = (LPCREATESTRUCT) lParam; @@ -963,15 +1076,14 @@ DdeClientWindowProc( (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 return (LRESULT) 0L; } case WM_DDE_ACK: return DdeServicesOnAck(hwnd, wParam, lParam); - break; default: return DefWindowProc(hwnd, uMsg, wParam, lParam); } @@ -988,6 +1100,7 @@ DdeServicesOnAck( ATOM topic = (ATOM)HIWORD(lParam); struct DdeEnumServices *es; TCHAR sz[255]; + Tcl_DString dString; #ifdef _WIN64 es = (struct DdeEnumServices *) GetWindowLongPtr(hwnd, GWLP_USERDATA); @@ -995,15 +1108,19 @@ DdeServicesOnAck( es = (struct DdeEnumServices *) GetWindowLong(hwnd, GWL_USERDATA); #endif - if ((es->service == (ATOM)NULL || es->service == service) - && (es->topic == (ATOM)NULL || es->topic == topic)) { + if ((es->service == (ATOM)0 || es->service == service) + && (es->topic == (ATOM)0 || es->topic == topic)) { Tcl_Obj *matchPtr = Tcl_NewListObj(0, NULL); Tcl_Obj *resultPtr = Tcl_GetObjResult(es->interp); GlobalGetAtomName(service, sz, 255); - Tcl_ListObjAppendElement(NULL, matchPtr, Tcl_NewStringObj(sz, -1)); + Tcl_WinTCharToUtf(sz, -1, &dString); + Tcl_ListObjAppendElement(NULL, matchPtr, Tcl_NewStringObj(Tcl_DStringValue(&dString), -1)); + Tcl_DStringFree(&dString); GlobalGetAtomName(topic, sz, 255); - Tcl_ListObjAppendElement(NULL, matchPtr, Tcl_NewStringObj(sz, -1)); + Tcl_WinTCharToUtf(sz, -1, &dString); + Tcl_ListObjAppendElement(NULL, matchPtr, Tcl_NewStringObj(Tcl_DStringValue(&dString), -1)); + Tcl_DStringFree(&dString); /* * Adding the hwnd as a third list element provides a unique @@ -1038,7 +1155,7 @@ DdeEnumWindowsCallback( HWND hwndTarget, LPARAM lParam) { - LRESULT dwResult = 0; + DWORD_PTR dwResult = 0; struct DdeEnumServices *es = (struct DdeEnumServices *) lParam; SendMessageTimeout(hwndTarget, WM_DDE_INITIATE, (WPARAM)es->hwnd, @@ -1050,16 +1167,16 @@ DdeEnumWindowsCallback( static int DdeGetServicesList( Tcl_Interp *interp, - char *serviceName, - char *topicName) + const TCHAR *serviceName, + const TCHAR *topicName) { struct DdeEnumServices es; es.interp = interp; es.result = TCL_OK; es.service = (serviceName == NULL) - ? (ATOM)NULL : GlobalAddAtom(serviceName); - es.topic = (topicName == NULL) ? (ATOM)NULL : 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); @@ -1068,10 +1185,10 @@ DdeGetServicesList( if (IsWindow(es.hwnd)) { DestroyWindow(es.hwnd); } - if (es.service != (ATOM)NULL) { + if (es.service != (ATOM)0) { GlobalDeleteAtom(es.service); } - if (es.topic != (ATOM)NULL) { + if (es.topic != (ATOM)0) { GlobalDeleteAtom(es.topic); } return es.result; @@ -1098,31 +1215,36 @@ static void SetDdeError( Tcl_Interp *interp) /* The interp to put the message in. */ { - char *errorMessage; + const char *errorMessage, *errorCode; switch (DdeGetLastError(ddeInstance)) { case DMLERR_DATAACKTIMEOUT: case DMLERR_EXECACKTIMEOUT: case DMLERR_POKEACKTIMEOUT: errorMessage = "remote interpreter did not respond"; + errorCode = "TIMEOUT"; break; case DMLERR_BUSY: errorMessage = "remote server is busy"; + errorCode = "BUSY"; break; case DMLERR_NOTPROCESSED: errorMessage = "remote server cannot handle this command"; + errorCode = "NOCANDO"; break; default: errorMessage = "dde command failed"; + errorCode = "FAILED"; } Tcl_SetObjResult(interp, Tcl_NewStringObj(errorMessage, -1)); + Tcl_SetErrorCode(interp, "TCL", "DDE", errorCode, NULL); } /* *---------------------------------------------------------------------- * - * Tcl_DdeObjCmd -- + * DdeObjCmd -- * * This function is invoked to process the "dde" Tcl command. See the * user documentation for details on what it does. @@ -1136,41 +1258,46 @@ SetDdeError( *---------------------------------------------------------------------- */ -int -Tcl_DdeObjCmd( +static int +DdeObjCmd( ClientData clientData, /* Used only for deletion */ Tcl_Interp *interp, /* The interp we are sending from */ int objc, /* Number of arguments */ - Tcl_Obj *CONST * objv) /* The arguments */ + Tcl_Obj *const *objv) /* The arguments */ { - static CONST char *ddeCommands[] = { + static const char *const ddeCommands[] = { "servername", "execute", "poke", "request", "services", "eval", - (char *) NULL - }; + (char *) NULL}; enum DdeSubcommands { DDE_SERVERNAME, DDE_EXECUTE, DDE_POKE, DDE_REQUEST, DDE_SERVICES, DDE_EVAL }; - static CONST char *ddeSrvOptions[] = { + static const char *const ddeSrvOptions[] = { "-force", "-handler", "--", NULL }; enum DdeSrvOptions { DDE_SERVERNAME_EXACT, DDE_SERVERNAME_HANDLER, DDE_SERVERNAME_LAST, }; - static CONST char *ddeExecOptions[] = { + static const char *const ddeExecOptions[] = { + "-async", "-binary", NULL + }; + enum DdeExecOptions { + DDE_EXEC_ASYNC, DDE_EXEC_BINARY + }; + static const char *const ddeEvalOptions[] = { "-async", NULL }; - static CONST char *ddeReqOptions[] = { + static const char *const ddeReqOptions[] = { "-binary", NULL }; - int index, i, length; - int async = 0, binary = 0, exact = 0; - int result = TCL_OK, firstArg = 0; + int index, i, length, argIndex; + int flags = 0, result = TCL_OK, firstArg = 0; HSZ ddeService = NULL, ddeTopic = NULL, ddeItem = NULL, ddeCookie = NULL; HDDEDATA ddeData = NULL, ddeItemData = NULL, ddeReturn; HCONV hConv = NULL; - char *serviceName = NULL, *topicName = NULL, *string; + const TCHAR *serviceName = NULL, *topicName = NULL; + const char *string; DWORD ddeResult; Tcl_Obj *objPtr, *handlerPtr = NULL; @@ -1191,7 +1318,6 @@ Tcl_DdeObjCmd( 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) { /* @@ -1206,7 +1332,7 @@ Tcl_DdeObjCmd( break; } if (argIndex == DDE_SERVERNAME_EXACT) { - exact = 1; + flags |= DDE_FLAG_FORCE; } else if (argIndex == DDE_SERVERNAME_HANDLER) { if ((objc - i) == 1) { /* return current handler */ RegisteredInterp *riPtr = DdeGetRegistrationPtr(interp); @@ -1238,39 +1364,53 @@ Tcl_DdeObjCmd( if (objc == 5) { firstArg = 2; break; - } else if (objc == 6) { - int dummy; - if (Tcl_GetIndexFromObj(NULL, objv[2], ddeExecOptions, "option", 0, - &dummy) == TCL_OK) { - async = 1; - firstArg = 3; - break; + } else if (objc >= 6 && objc <= 7) { + firstArg = objc - 3; + for (i = 2; i < firstArg; i++) { + if (Tcl_GetIndexFromObj(interp, objv[i], ddeExecOptions, + "option", 0, &argIndex) != TCL_OK) { + goto wrongDdeExecuteArgs; + } + if (argIndex == DDE_EXEC_ASYNC) { + flags |= DDE_FLAG_ASYNC; + } else { + flags |= DDE_FLAG_BINARY; + } } + break; } /* otherwise... */ + wrongDdeExecuteArgs: Tcl_WrongNumArgs(interp, 2, objv, - "?-async? serviceName topicName value"); + "?-async? ?-binary? serviceName topicName value"); return TCL_ERROR; case DDE_POKE: - if (objc != 6) { - Tcl_WrongNumArgs(interp, 2, objv, - "serviceName topicName item value"); - return TCL_ERROR; + if (objc == 6) { + firstArg = 2; + break; + } else if ((objc == 7) && (Tcl_GetIndexFromObj(NULL, objv[2], + ddeReqOptions, "option", 0, &argIndex) == TCL_OK)) { + flags |= DDE_FLAG_BINARY; + firstArg = 3; + break; } - firstArg = 2; - break; + + /* + * Otherwise... + */ + + Tcl_WrongNumArgs(interp, 2, objv, + "?-binary? serviceName topicName item value"); + return TCL_ERROR; case DDE_REQUEST: if (objc == 5) { firstArg = 2; break; - } else if (objc == 6) { - int dummy; - if (Tcl_GetIndexFromObj(NULL, objv[2], ddeReqOptions, "option", 0, - &dummy) == TCL_OK) { - binary = 1; - firstArg = 3; - break; - } + } else if ((objc == 6) && (Tcl_GetIndexFromObj(NULL, objv[2], + ddeReqOptions, "option", 0, &argIndex) == TCL_OK)) { + flags |= DDE_FLAG_BINARY; + firstArg = 3; + break; } /* @@ -1293,15 +1433,13 @@ Tcl_DdeObjCmd( Tcl_WrongNumArgs(interp, 2, objv, "?-async? serviceName args"); return TCL_ERROR; } else { - int dummy; - firstArg = 2; - if (Tcl_GetIndexFromObj(NULL, objv[2], ddeExecOptions, "option", 0, - &dummy) == TCL_OK) { + if (Tcl_GetIndexFromObj(NULL, objv[2], ddeEvalOptions, "option", + 0, &argIndex) == TCL_OK) { if (objc < 5) { goto wrongDdeEvalArgs; } - async = 1; + flags |= DDE_FLAG_ASYNC; firstArg++; } break; @@ -1311,7 +1449,11 @@ Tcl_DdeObjCmd( Initialize(); if (firstArg != 1) { +#ifdef UNICODE + serviceName = Tcl_GetUnicodeFromObj(objv[firstArg], &length); +#else serviceName = Tcl_GetStringFromObj(objv[firstArg], &length); +#endif } else { length = 0; } @@ -1319,25 +1461,34 @@ Tcl_DdeObjCmd( if (length == 0) { serviceName = NULL; } else if ((index != DDE_SERVERNAME) && (index != DDE_EVAL)) { - ddeService = DdeCreateStringHandle(ddeInstance, serviceName, - CP_WINANSI); + ddeService = DdeCreateStringHandle(ddeInstance, (void *) serviceName, + CP_WINUNICODE); } if ((index != DDE_SERVERNAME) && (index != DDE_EVAL)) { +#ifdef UNICODE + topicName = (TCHAR *) Tcl_GetUnicodeFromObj(objv[firstArg + 1], &length); +#else topicName = Tcl_GetStringFromObj(objv[firstArg + 1], &length); +#endif if (length == 0) { topicName = NULL; } else { - ddeTopic = DdeCreateStringHandle(ddeInstance, topicName, - CP_WINANSI); + ddeTopic = DdeCreateStringHandle(ddeInstance, (void *) topicName, + CP_WINUNICODE); } } switch ((enum DdeSubcommands) index) { case DDE_SERVERNAME: - serviceName = DdeSetServerName(interp, serviceName, exact, handlerPtr); + serviceName = DdeSetServerName(interp, serviceName, flags, + handlerPtr); if (serviceName != NULL) { +#ifdef UNICODE + Tcl_SetObjResult(interp, Tcl_NewUnicodeObj((Tcl_UniChar *) serviceName, -1)); +#else Tcl_SetObjResult(interp, Tcl_NewStringObj(serviceName, -1)); +#endif } else { Tcl_ResetResult(interp); } @@ -1345,12 +1496,21 @@ Tcl_DdeObjCmd( case DDE_EXECUTE: { int dataLength; - char *dataString = Tcl_GetStringFromObj(objv[firstArg + 2], - &dataLength); + const Tcl_UniChar *dataString; - if (dataLength == 0) { + if (flags & DDE_FLAG_BINARY) { + dataString = (const Tcl_UniChar *) + Tcl_GetByteArrayFromObj(objv[firstArg + 2], &dataLength); + } else { + dataString = + Tcl_GetUnicodeFromObj(objv[firstArg + 2], &dataLength); + dataLength = (dataLength + 1) * sizeof(Tcl_UniChar); + } + + if (dataLength <= 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj("cannot execute null data", -1)); + Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", NULL); result = TCL_ERROR; break; } @@ -1364,16 +1524,16 @@ Tcl_DdeObjCmd( break; } - ddeData = DdeCreateDataHandle(ddeInstance, dataString, - (DWORD) dataLength+1, 0, 0, CF_TEXT, 0); + ddeData = DdeCreateDataHandle(ddeInstance, (BYTE *) dataString, + (DWORD) dataLength, 0, 0, (flags & DDE_FLAG_BINARY) ? CF_TEXT : CF_UNICODETEXT, 0); if (ddeData != NULL) { - if (async) { + if (flags & DDE_FLAG_ASYNC) { DdeClientTransaction((LPBYTE) ddeData, 0xFFFFFFFF, hConv, 0, - CF_TEXT, XTYP_EXECUTE, TIMEOUT_ASYNC, &ddeResult); + (flags & DDE_FLAG_BINARY) ? CF_TEXT : CF_UNICODETEXT, XTYP_EXECUTE, TIMEOUT_ASYNC, &ddeResult); DdeAbandonTransaction(ddeInstance, hConv, ddeResult); } else { ddeReturn = DdeClientTransaction((LPBYTE) ddeData, 0xFFFFFFFF, - hConv, 0, CF_TEXT, XTYP_EXECUTE, 30000, NULL); + hConv, 0, (flags & DDE_FLAG_BINARY) ? CF_TEXT : CF_UNICODETEXT, XTYP_EXECUTE, 30000, NULL); if (ddeReturn == 0) { SetDdeError(interp); result = TCL_ERROR; @@ -1387,11 +1547,18 @@ Tcl_DdeObjCmd( break; } case DDE_REQUEST: { - char *itemString = Tcl_GetStringFromObj(objv[firstArg + 2], &length); +#ifdef UNICODE + const TCHAR *itemString = (TCHAR *) Tcl_GetUnicodeFromObj(objv[firstArg + 2], + &length); +#else + const TCHAR *itemString = Tcl_GetStringFromObj(objv[firstArg + 2], + &length); +#endif if (length == 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj("cannot request value of null data", -1)); + Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", NULL); result = TCL_ERROR; goto cleanup; } @@ -1404,23 +1571,28 @@ Tcl_DdeObjCmd( result = TCL_ERROR; } else { Tcl_Obj *returnObjPtr; - ddeItem = DdeCreateStringHandle(ddeInstance, itemString, - CP_WINANSI); + ddeItem = DdeCreateStringHandle(ddeInstance, (void *) itemString, + CP_WINUNICODE); if (ddeItem != NULL) { ddeData = DdeClientTransaction(NULL, 0, hConv, ddeItem, - CF_TEXT, XTYP_REQUEST, 5000, NULL); + (flags & DDE_FLAG_BINARY) ? CF_TEXT : CF_UNICODETEXT, XTYP_REQUEST, 5000, NULL); if (ddeData == NULL) { SetDdeError(interp); result = TCL_ERROR; } else { DWORD tmp; - char *dataString = DdeAccessData(ddeData, &tmp); + const Tcl_UniChar *dataString = (const Tcl_UniChar *) DdeAccessData(ddeData, &tmp); - if (binary) { - returnObjPtr = Tcl_NewByteArrayObj(dataString, - (int) tmp); + if (flags & DDE_FLAG_BINARY) { + returnObjPtr = + Tcl_NewByteArrayObj((BYTE *) dataString, (int) tmp); } else { - returnObjPtr = Tcl_NewStringObj(dataString, -1); + tmp >>= 1; + if (tmp && !dataString[(tmp-1)]) { + --tmp; + } + returnObjPtr = Tcl_NewUnicodeObj(dataString, + (int) tmp); } DdeUnaccessData(ddeData); DdeFreeDataHandle(ddeData); @@ -1435,16 +1607,30 @@ Tcl_DdeObjCmd( break; } case DDE_POKE: { - char *itemString = Tcl_GetStringFromObj(objv[firstArg + 2], &length); - char *dataString; +#ifdef UNICODE + const TCHAR *itemString = (TCHAR *) Tcl_GetUnicodeFromObj(objv[firstArg + 2], + &length); +#else + const TCHAR *itemString = Tcl_GetStringFromObj(objv[firstArg + 2], + &length); +#endif + BYTE *dataString; if (length == 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj("cannot have a null item", -1)); + Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", NULL); result = TCL_ERROR; goto cleanup; } - dataString = Tcl_GetStringFromObj(objv[firstArg + 3], &length); + if (flags & DDE_FLAG_BINARY) { + dataString = (BYTE *) + Tcl_GetByteArrayFromObj(objv[firstArg + 3], &length); + } else { + dataString = (BYTE *) + Tcl_GetUnicodeFromObj(objv[firstArg + 3], &length); + length = 2 * length + 1; + } hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL); DdeFreeStringHandle(ddeInstance, ddeService); @@ -1454,11 +1640,11 @@ Tcl_DdeObjCmd( SetDdeError(interp); result = TCL_ERROR; } else { - ddeItem = DdeCreateStringHandle(ddeInstance, itemString, - CP_WINANSI); + ddeItem = DdeCreateStringHandle(ddeInstance, (void *) itemString, + CP_WINUNICODE); if (ddeItem != NULL) { - ddeData = DdeClientTransaction(dataString, (DWORD) length+1, - hConv, ddeItem, CF_TEXT, XTYP_POKE, 5000, NULL); + ddeData = DdeClientTransaction(dataString, (DWORD) length, + hConv, ddeItem, (flags & DDE_FLAG_BINARY) ? CF_TEXT : CF_UNICODETEXT, XTYP_POKE, 5000, NULL); if (ddeData == NULL) { SetDdeError(interp); result = TCL_ERROR; @@ -1482,12 +1668,13 @@ Tcl_DdeObjCmd( if (serviceName == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj("invalid service name \"\"", -1)); + Tcl_SetErrorCode(interp, "TCL", "DDE", "NO_SERVER", NULL); result = TCL_ERROR; goto cleanup; } - objc -= (async + 3); - objv += (async + 3); + objc -= firstArg + 1; + objv += firstArg + 1; /* * See if the target interpreter is local. If so, execute the command @@ -1500,7 +1687,7 @@ Tcl_DdeObjCmd( for (riPtr = tsdPtr->interpListPtr; riPtr != NULL; riPtr = riPtr->nextPtr) { - if (stricmp(serviceName, riPtr->name) == 0) { + if (_tcsicmp(serviceName, riPtr->name) == 0) { break; } } @@ -1513,9 +1700,9 @@ Tcl_DdeObjCmd( * server. */ - Tcl_Preserve((ClientData) riPtr); + Tcl_Preserve(riPtr); sendInterp = riPtr->interp; - Tcl_Preserve((ClientData) sendInterp); + Tcl_Preserve(sendInterp); /* * Don't exchange objects between interps. The target interp would @@ -1526,9 +1713,11 @@ Tcl_DdeObjCmd( */ 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); + Tcl_SetObjResult(riPtr->interp, Tcl_NewStringObj( + "permission denied: a handler procedure must be" + " defined for use in a safe interp", -1)); + Tcl_SetErrorCode(interp, "TCL", "DDE", "SECURITY_CHECK", + NULL); result = TCL_ERROR; } @@ -1580,8 +1769,8 @@ Tcl_DdeObjCmd( } Tcl_SetObjResult(interp, Tcl_GetObjResult(sendInterp)); } - Tcl_Release((ClientData) riPtr); - Tcl_Release((ClientData) sendInterp); + Tcl_Release(riPtr); + Tcl_Release(sendInterp); } else { /* * This is a non-local request. Send the script to the server and @@ -1591,31 +1780,31 @@ Tcl_DdeObjCmd( if (MakeDdeConnection(interp, serviceName, &hConv) != TCL_OK) { invalidServerResponse: Tcl_SetObjResult(interp, - Tcl_NewStringObj("invalid data returned from server", - -1)); + Tcl_NewStringObj("invalid data returned from server", -1)); + Tcl_SetErrorCode(interp, "TCL", "DDE", "BAD_RESPONSE", NULL); result = TCL_ERROR; goto cleanup; } objPtr = Tcl_ConcatObj(objc, objv); - string = Tcl_GetStringFromObj(objPtr, &length); - ddeItemData = DdeCreateDataHandle(ddeInstance, string, - (DWORD) length+1, 0, 0, CF_TEXT, 0); + string = (const char *) Tcl_GetUnicodeFromObj(objPtr, &length); + ddeItemData = DdeCreateDataHandle(ddeInstance, + (BYTE *) string, (DWORD) 2*length+2, 0, 0, CF_UNICODETEXT, 0); - if (async) { + if (flags & DDE_FLAG_ASYNC) { ddeData = DdeClientTransaction((LPBYTE) ddeItemData, 0xFFFFFFFF, hConv, 0, - CF_TEXT, XTYP_EXECUTE, TIMEOUT_ASYNC, &ddeResult); + CF_UNICODETEXT, XTYP_EXECUTE, TIMEOUT_ASYNC, &ddeResult); DdeAbandonTransaction(ddeInstance, hConv, ddeResult); } else { ddeData = DdeClientTransaction((LPBYTE) ddeItemData, 0xFFFFFFFF, hConv, 0, - CF_TEXT, XTYP_EXECUTE, 30000, NULL); + CF_UNICODETEXT, XTYP_EXECUTE, 30000, NULL); if (ddeData != 0) { ddeCookie = DdeCreateStringHandle(ddeInstance, - TCL_DDE_EXECUTE_RESULT, CP_WINANSI); + TCL_DDE_EXECUTE_RESULT, CP_WINUNICODE); ddeData = DdeClientTransaction(NULL, 0, hConv, ddeCookie, - CF_TEXT, XTYP_REQUEST, 30000, NULL); + CF_UNICODETEXT, XTYP_REQUEST, 30000, NULL); } } @@ -1624,10 +1813,12 @@ Tcl_DdeObjCmd( if (ddeData == 0) { SetDdeError(interp); result = TCL_ERROR; + goto cleanup; } - if (async == 0) { + if (!(flags & DDE_FLAG_ASYNC)) { Tcl_Obj *resultPtr; + Tcl_UniChar *ddeDataString; /* * The return handle has a two or four element list in it. The @@ -1640,10 +1831,11 @@ Tcl_DdeObjCmd( resultPtr = Tcl_NewObj(); length = DdeGetData(ddeData, NULL, 0, 0); - Tcl_SetObjLength(resultPtr, length); - string = Tcl_GetString(resultPtr); - DdeGetData(ddeData, string, (DWORD) length, 0); - Tcl_SetObjLength(resultPtr, (int) strlen(string)); + ddeDataString = ckalloc(length); + DdeGetData(ddeData, (BYTE *) ddeDataString, (DWORD) length, 0); + length = (length >> 1) - 1; + resultPtr = Tcl_NewUnicodeObj(ddeDataString, length); + ckfree(ddeDataString); if (Tcl_ListObjIndex(NULL, resultPtr, 0, &objPtr) != TCL_OK) { Tcl_DecrRefCount(resultPtr); diff --git a/win/tclWinError.c b/win/tclWinError.c index 05661a2..4d3250d 100644 --- a/win/tclWinError.c +++ b/win/tclWinError.c @@ -8,17 +8,14 @@ * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. - * - * RCS: @(#) $Id: tclWinError.c,v 1.7 2005/11/04 00:06:50 dkf Exp $ */ #include "tclInt.h" - /* * The following table contains the mapping from Win32 errors to errno errors. */ -static char errorTable[] = { +static const unsigned char errorTable[] = { 0, EINVAL, /* ERROR_INVALID_FUNCTION 1 */ ENOENT, /* ERROR_FILE_NOT_FOUND 2 */ @@ -286,17 +283,15 @@ static char errorTable[] = { EINVAL, /* 264 */ EINVAL, /* 265 */ EINVAL, /* 266 */ - ENOTDIR, /* ERROR_DIRECTORY 267 */ + ENOTDIR /* ERROR_DIRECTORY 267 */ }; -static const unsigned int tableLen = sizeof(errorTable); - /* * The following table contains the mapping from WinSock errors to * errno errors. */ -static int wsaErrorTable[] = { +static const unsigned char wsaErrorTable[] = { EWOULDBLOCK, /* WSAEWOULDBLOCK */ EINPROGRESS, /* WSAEINPROGRESS */ EALREADY, /* WSAEALREADY */ @@ -333,7 +328,7 @@ static int wsaErrorTable[] = { EUSERS, /* WSAEUSERS */ EDQUOT, /* WSAEDQUOT */ ESTALE, /* WSAESTALE */ - EREMOTE, /* WSAEREMOTE */ + EREMOTE /* WSAEREMOTE */ }; /* @@ -356,36 +351,78 @@ void TclWinConvertError( DWORD errCode) /* Win32 error code. */ { - if (errCode >= tableLen) { - Tcl_SetErrno(EINVAL); + if (errCode >= sizeof(errorTable)/sizeof(errorTable[0])) { + errCode -= WSAEWOULDBLOCK; + if (errCode >= sizeof(wsaErrorTable)/sizeof(wsaErrorTable[0])) { + Tcl_SetErrno(errorTable[1]); + } else { + Tcl_SetErrno(wsaErrorTable[errCode]); + } } else { Tcl_SetErrno(errorTable[errCode]); } } - + +#ifdef __CYGWIN__ /* *---------------------------------------------------------------------- * - * TclWinConvertWSAError -- + * tclWinDebugPanic -- * - * This routine converts a WinSock error into an errno value. + * Display a message. If a debugger is present, present it directly to + * the debugger, otherwise send it to stderr. * * Results: * None. * * Side effects: - * Sets the errno global variable. + * None. * *---------------------------------------------------------------------- */ void -TclWinConvertWSAError( - DWORD errCode) /* Win32 error code. */ +tclWinDebugPanic( + const char *format, ...) { - if ((errCode >= WSAEWOULDBLOCK) && (errCode <= WSAEREMOTE)) { - Tcl_SetErrno(wsaErrorTable[errCode - WSAEWOULDBLOCK]); +#define TCL_MAX_WARN_LEN 1024 + va_list argList; + va_start(argList, format); + + if (IsDebuggerPresent()) { + WCHAR msgString[TCL_MAX_WARN_LEN]; + char buf[TCL_MAX_WARN_LEN * TCL_UTF_MAX]; + + vsnprintf(buf, sizeof(buf), format, argList); + msgString[TCL_MAX_WARN_LEN-1] = L'\0'; + MultiByteToWideChar(CP_UTF8, 0, buf, -1, msgString, TCL_MAX_WARN_LEN); + + /* + * Truncate MessageBox string if it is too long to not overflow the buffer. + */ + + if (msgString[TCL_MAX_WARN_LEN-1] != L'\0') { + memcpy(msgString + (TCL_MAX_WARN_LEN - 5), L" ...", 5 * sizeof(WCHAR)); + } + OutputDebugStringW(msgString); } else { - Tcl_SetErrno(EINVAL); + vfprintf(stderr, format, argList); + fprintf(stderr, "\n"); + fflush(stderr); } +# if defined(__GNUC__) + __builtin_trap(); +# else + DebugBreak(); +# endif + abort(); } +#endif +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * tab-width: 8 + * End: + */ diff --git a/win/tclWinFCmd.c b/win/tclWinFCmd.c index c940620..52ea8c6 100644 --- a/win/tclWinFCmd.c +++ b/win/tclWinFCmd.c @@ -8,8 +8,6 @@ * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. - * - * RCS: @(#) $Id: tclWinFCmd.c,v 1.52 2006/08/29 00:36:57 coldstore Exp $ */ #include "tclWinInt.h" @@ -52,16 +50,16 @@ enum { WIN_SYSTEM_ATTRIBUTE }; -static int attributeArray[] = {FILE_ATTRIBUTE_ARCHIVE, FILE_ATTRIBUTE_HIDDEN, +static const int attributeArray[] = {FILE_ATTRIBUTE_ARCHIVE, FILE_ATTRIBUTE_HIDDEN, 0, FILE_ATTRIBUTE_READONLY, 0, FILE_ATTRIBUTE_SYSTEM}; -CONST char *tclpFileAttrStrings[] = { +const char *const tclpFileAttrStrings[] = { "-archive", "-hidden", "-longname", "-readonly", "-shortname", "-system", (char *) NULL }; -CONST TclFileAttrProcs tclpFileAttrProcs[] = { +const TclFileAttrProcs tclpFileAttrProcs[] = { {GetWinFileAttributes, SetWinFileAttributes}, {GetWinFileAttributes, SetWinFileAttributes}, {GetWinFileLongName, CannotSetAttribute}, @@ -69,30 +67,11 @@ CONST TclFileAttrProcs tclpFileAttrProcs[] = { {GetWinFileShortName, CannotSetAttribute}, {GetWinFileAttributes, SetWinFileAttributes}}; -#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. - */ - -typedef struct EXCEPTION_REGISTRATION { - struct EXCEPTION_REGISTRATION *link; - EXCEPTION_DISPOSITION (*handler)( - struct _EXCEPTION_RECORD *, void *, struct _CONTEXT *, void *); - void *ebp; - void *esp; - int status; -} EXCEPTION_REGISTRATION; - -#endif - /* * 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); /* @@ -103,18 +82,18 @@ static void StatError(Tcl_Interp *interp, Tcl_Obj *fileName); static int ConvertFileNameFormat(Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, int longShort, Tcl_Obj **attributePtrPtr); -static int DoCopyFile(CONST TCHAR *srcPtr, CONST TCHAR *dstPtr); -static int DoCreateDirectory(CONST TCHAR *pathPtr); -static int DoRemoveJustDirectory(CONST TCHAR *nativeSrc, +static int DoCopyFile(const TCHAR *srcPtr, const TCHAR *dstPtr); +static int DoCreateDirectory(const TCHAR *pathPtr); +static int DoRemoveJustDirectory(const TCHAR *nativeSrc, int ignoreError, Tcl_DString *errorPtr); static int DoRemoveDirectory(Tcl_DString *pathPtr, int recursive, Tcl_DString *errorPtr); -static int DoRenameFile(CONST TCHAR *nativeSrc, - CONST TCHAR *dstPtr); -static int TraversalCopy(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, +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, @@ -172,13 +151,13 @@ TclpObjRenameFile( static int DoRenameFile( - CONST TCHAR *nativeSrc, /* Pathname of file or dir to be renamed + const TCHAR *nativeSrc, /* Pathname of file or dir to be renamed * (native). */ - CONST TCHAR *nativeDst) /* New pathname for file or directory + const TCHAR *nativeDst) /* New pathname for file or directory * (native). */ { -#ifdef HAVE_NO_SEH - EXCEPTION_REGISTRATION registration; +#if defined(HAVE_NO_SEH) && !defined(_WIN64) + TCLEXCEPTION_REGISTRATION registration; #endif DWORD srcAttr, dstAttr; int retval = -1; @@ -199,14 +178,7 @@ DoRenameFile( * arguments is a char block device. */ -#ifndef HAVE_NO_SEH - __try { - if ((*tclWinProcs->moveFileProc)(nativeSrc, nativeDst) != FALSE) { - retval = TCL_OK; - } - } __except (EXCEPTION_EXECUTE_HANDLER) {} -#else - +#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 @@ -222,7 +194,7 @@ DoRenameFile( "movl %[nativeSrc], %%ecx" "\n\t" /* - * Construct an EXCEPTION_REGISTRATION to protect the call to + * Construct an TCLEXCEPTION_REGISTRATION to protect the call to * MoveFile. */ @@ -236,7 +208,7 @@ DoRenameFile( "movl $0, 0x10(%%edx)" "\n\t" /* status */ /* - * Link the EXCEPTION_REGISTRATION on the chain. + * Link the TCLEXCEPTION_REGISTRATION on the chain. */ "movl %%edx, %%fs:0" "\n\t" @@ -251,7 +223,7 @@ DoRenameFile( "call *%%eax" "\n\t" /* - * Come here on normal exit. Recover the EXCEPTION_REGISTRATION and + * Come here on normal exit. Recover the TCLEXCEPTION_REGISTRATION and * put the status return from MoveFile into it. */ @@ -260,7 +232,7 @@ DoRenameFile( "jmp 2f" "\n" /* - * Come here on an exception. Recover the EXCEPTION_REGISTRATION + * Come here on an exception. Recover the TCLEXCEPTION_REGISTRATION */ "1:" "\t" @@ -269,7 +241,7 @@ DoRenameFile( /* * Come here however we exited. Restore context from the - * EXCEPTION_REGISTRATION in case the stack is unbalanced. + * TCLEXCEPTION_REGISTRATION in case the stack is unbalanced. */ "2:" "\t" @@ -284,13 +256,23 @@ DoRenameFile( [registration] "m" (registration), [nativeDst] "m" (nativeDst), [nativeSrc] "m" (nativeSrc), - [moveFile] "r" (tclWinProcs->moveFileProc) + [moveFile] "r" (MoveFile) : "%eax", "%ebx", "%ecx", "%edx", "memory" ); if (registration.status != FALSE) { retval = TCL_OK; } +#else +#ifndef HAVE_NO_SEH + __try { +#endif + if ((*MoveFile)(nativeSrc, nativeDst) != FALSE) { + retval = TCL_OK; + } +#ifndef HAVE_NO_SEH + } __except (EXCEPTION_EXECUTE_HANDLER) {} +#endif #endif if (retval != -1) { @@ -299,10 +281,10 @@ DoRenameFile( TclWinConvertError(GetLastError()); - srcAttr = (*tclWinProcs->getFileAttributesProc)(nativeSrc); - dstAttr = (*tclWinProcs->getFileAttributesProc)(nativeDst); + srcAttr = GetFileAttributes(nativeSrc); + dstAttr = GetFileAttributes(nativeDst); if (srcAttr == 0xffffffff) { - if ((*tclWinProcs->getFullPathNameProc)(nativeSrc, 0, NULL, + if (GetFullPathName(nativeSrc, 0, NULL, NULL) >= MAX_PATH) { errno = ENAMETOOLONG; return TCL_ERROR; @@ -310,7 +292,7 @@ DoRenameFile( srcAttr = 0; } if (dstAttr == 0xffffffff) { - if ((*tclWinProcs->getFullPathNameProc)(nativeDst, 0, NULL, + if (GetFullPathName(nativeDst, 0, NULL, NULL) >= MAX_PATH) { errno = ENAMETOOLONG; return TCL_ERROR; @@ -326,28 +308,28 @@ DoRenameFile( decode: if (srcAttr & FILE_ATTRIBUTE_DIRECTORY) { TCHAR *nativeSrcRest, *nativeDstRest; - CONST char **srcArgv, **dstArgv; + const char **srcArgv, **dstArgv; int size, srcArgc, dstArgc; - WCHAR nativeSrcPath[MAX_PATH]; - WCHAR nativeDstPath[MAX_PATH]; + TCHAR nativeSrcPath[MAX_PATH]; + TCHAR nativeDstPath[MAX_PATH]; Tcl_DString srcString, dstString; - CONST char *src, *dst; + const char *src, *dst; - size = (*tclWinProcs->getFullPathNameProc)(nativeSrc, MAX_PATH, + size = GetFullPathName(nativeSrc, MAX_PATH, nativeSrcPath, &nativeSrcRest); if ((size == 0) || (size > MAX_PATH)) { return TCL_ERROR; } - size = (*tclWinProcs->getFullPathNameProc)(nativeDst, MAX_PATH, + size = GetFullPathName(nativeDst, MAX_PATH, nativeDstPath, &nativeDstRest); if ((size == 0) || (size > MAX_PATH)) { return TCL_ERROR; } - (*tclWinProcs->charLowerProc)((TCHAR *) nativeSrcPath); - (*tclWinProcs->charLowerProc)((TCHAR *) nativeDstPath); + CharLower(nativeSrcPath); + CharLower(nativeDstPath); - src = Tcl_WinTCharToUtf((TCHAR *) nativeSrcPath, -1, &srcString); - dst = Tcl_WinTCharToUtf((TCHAR *) nativeDstPath, -1, &dstString); + src = Tcl_WinTCharToUtf(nativeSrcPath, -1, &srcString); + dst = Tcl_WinTCharToUtf(nativeDstPath, -1, &dstString); /* * Check whether the destination path is actually inside the @@ -394,8 +376,8 @@ DoRenameFile( Tcl_SetErrno(EXDEV); } - ckfree((char *) srcArgv); - ckfree((char *) dstArgv); + ckfree(srcArgv); + ckfree(dstArgv); } /* @@ -426,7 +408,7 @@ DoRenameFile( * directory back, for completeness. */ - if ((*tclWinProcs->moveFileProc)(nativeSrc, + if (MoveFile(nativeSrc, nativeDst) != FALSE) { return TCL_OK; } @@ -437,8 +419,8 @@ DoRenameFile( */ TclWinConvertError(GetLastError()); - (*tclWinProcs->createDirectoryProc)(nativeDst, NULL); - (*tclWinProcs->setFileAttributesProc)(nativeDst, dstAttr); + CreateDirectory(nativeDst, NULL); + SetFileAttributes(nativeDst, dstAttr); if (Tcl_GetErrno() == EACCES) { /* * Decode the EACCES to a more meaningful error. @@ -465,22 +447,20 @@ DoRenameFile( TCHAR *nativeRest, *nativeTmp, *nativePrefix; int result, size; - WCHAR tempBuf[MAX_PATH]; + TCHAR tempBuf[MAX_PATH]; - size = (*tclWinProcs->getFullPathNameProc)(nativeDst, MAX_PATH, + size = GetFullPathName(nativeDst, MAX_PATH, tempBuf, &nativeRest); if ((size == 0) || (size > MAX_PATH) || (nativeRest == NULL)) { return TCL_ERROR; } nativeTmp = (TCHAR *) tempBuf; - ((char *) nativeRest)[0] = '\0'; - ((char *) nativeRest)[1] = '\0'; /* In case it's Unicode. */ + nativeRest[0] = L'\0'; result = TCL_ERROR; - nativePrefix = (tclWinProcs->useWide) - ? (TCHAR *) L"tclr" : (TCHAR *) "tclr"; - if ((*tclWinProcs->getTempFileNameProc)(nativeTmp, - nativePrefix, 0, tempBuf) != 0) { + nativePrefix = (TCHAR *) L"tclr"; + if (GetTempFileName(nativeTmp, nativePrefix, + 0, tempBuf) != 0) { /* * Strictly speaking, need the following DeleteFile and * MoveFile to be joined as an atomic operation so no @@ -488,19 +468,16 @@ DoRenameFile( * same temp file. */ - nativeTmp = (TCHAR *) tempBuf; - (*tclWinProcs->deleteFileProc)(nativeTmp); - if ((*tclWinProcs->moveFileProc)(nativeDst, - nativeTmp) != FALSE) { - if ((*tclWinProcs->moveFileProc)(nativeSrc, - nativeDst) != FALSE) { - (*tclWinProcs->setFileAttributesProc)(nativeTmp, - FILE_ATTRIBUTE_NORMAL); - (*tclWinProcs->deleteFileProc)(nativeTmp); + nativeTmp = tempBuf; + DeleteFile(nativeTmp); + if (MoveFile(nativeDst, nativeTmp) != FALSE) { + if (MoveFile(nativeSrc, nativeDst) != FALSE) { + SetFileAttributes(nativeTmp, FILE_ATTRIBUTE_NORMAL); + DeleteFile(nativeTmp); return TCL_OK; } else { - (*tclWinProcs->deleteFileProc)(nativeDst); - (*tclWinProcs->moveFileProc)(nativeTmp, nativeDst); + DeleteFile(nativeDst); + MoveFile(nativeTmp, nativeDst); } } @@ -563,11 +540,11 @@ TclpObjCopyFile( 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). */ { -#ifdef HAVE_NO_SEH - EXCEPTION_REGISTRATION registration; +#if defined(HAVE_NO_SEH) && !defined(_WIN64) + TCLEXCEPTION_REGISTRATION registration; #endif int retval = -1; @@ -587,14 +564,7 @@ DoCopyFile( * arguments is a char block device. */ -#ifndef HAVE_NO_SEH - __try { - if ((*tclWinProcs->copyFileProc)(nativeSrc, nativeDst, 0) != FALSE) { - retval = TCL_OK; - } - } __except (EXCEPTION_EXECUTE_HANDLER) {} -#else - +#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 @@ -611,7 +581,7 @@ DoCopyFile( "movl %[nativeSrc], %%ecx" "\n\t" /* - * Construct an EXCEPTION_REGISTRATION to protect the call to + * Construct an TCLEXCEPTION_REGISTRATION to protect the call to * CopyFile. */ @@ -625,7 +595,7 @@ DoCopyFile( "movl $0, 0x10(%%edx)" "\n\t" /* status */ /* - * Link the EXCEPTION_REGISTRATION on the chain. + * Link the TCLEXCEPTION_REGISTRATION on the chain. */ "movl %%edx, %%fs:0" "\n\t" @@ -641,7 +611,7 @@ DoCopyFile( "call *%%eax" "\n\t" /* - * Come here on normal exit. Recover the EXCEPTION_REGISTRATION and + * Come here on normal exit. Recover the TCLEXCEPTION_REGISTRATION and * put the status return from CopyFile into it. */ @@ -650,7 +620,7 @@ DoCopyFile( "jmp 2f" "\n" /* - * Come here on an exception. Recover the EXCEPTION_REGISTRATION + * Come here on an exception. Recover the TCLEXCEPTION_REGISTRATION */ "1:" "\t" @@ -659,7 +629,7 @@ DoCopyFile( /* * Come here however we exited. Restore context from the - * EXCEPTION_REGISTRATION in case the stack is unbalanced. + * TCLEXCEPTION_REGISTRATION in case the stack is unbalanced. */ "2:" "\t" @@ -674,13 +644,23 @@ DoCopyFile( [registration] "m" (registration), [nativeDst] "m" (nativeDst), [nativeSrc] "m" (nativeSrc), - [copyFile] "r" (tclWinProcs->copyFileProc) + [copyFile] "r" (CopyFile) : "%eax", "%ebx", "%ecx", "%edx", "memory" ); if (registration.status != FALSE) { retval = TCL_OK; } +#else +#ifndef HAVE_NO_SEH + __try { +#endif + if (CopyFile(nativeSrc, nativeDst, 0) != FALSE) { + retval = TCL_OK; + } +#ifndef HAVE_NO_SEH + } __except (EXCEPTION_EXECUTE_HANDLER) {} +#endif #endif if (retval != -1) { @@ -695,8 +675,8 @@ DoCopyFile( if (Tcl_GetErrno() == EACCES) { DWORD srcAttr, dstAttr; - srcAttr = (*tclWinProcs->getFileAttributesProc)(nativeSrc); - dstAttr = (*tclWinProcs->getFileAttributesProc)(nativeDst); + srcAttr = GetFileAttributes(nativeSrc); + dstAttr = GetFileAttributes(nativeDst); if (srcAttr != 0xffffffff) { if (dstAttr == 0xffffffff) { dstAttr = 0; @@ -712,9 +692,9 @@ DoCopyFile( Tcl_SetErrno(EISDIR); } if (dstAttr & FILE_ATTRIBUTE_READONLY) { - (*tclWinProcs->setFileAttributesProc)(nativeDst, + SetFileAttributes(nativeDst, dstAttr & ~((DWORD)FILE_ATTRIBUTE_READONLY)); - if ((*tclWinProcs->copyFileProc)(nativeSrc, nativeDst, + if (CopyFile(nativeSrc, nativeDst, 0) != FALSE) { return TCL_OK; } @@ -725,7 +705,7 @@ DoCopyFile( */ TclWinConvertError(GetLastError()); - (*tclWinProcs->setFileAttributesProc)(nativeDst, dstAttr); + SetFileAttributes(nativeDst, dstAttr); } } } @@ -766,34 +746,35 @@ TclpObjDeleteFile( int TclpDeleteFile( - CONST TCHAR *nativePath) /* Pathname of file to be removed (native). */ + const void *nativePath) /* Pathname of file to be removed (native). */ { DWORD attr; + const TCHAR *path = nativePath; /* * The DeleteFile API acts differently under Win95/98 and NT WRT NULL and * "". Avoid passing these values. */ - if (nativePath == NULL || nativePath[0] == '\0') { + if (path == NULL || path[0] == '\0') { Tcl_SetErrno(ENOENT); return TCL_ERROR; } - if ((*tclWinProcs->deleteFileProc)(nativePath) != FALSE) { + if (DeleteFile(path) != FALSE) { return TCL_OK; } TclWinConvertError(GetLastError()); if (Tcl_GetErrno() == EACCES) { - attr = (*tclWinProcs->getFileAttributesProc)(nativePath); + attr = GetFileAttributes(path); if (attr != 0xffffffff) { if (attr & FILE_ATTRIBUTE_DIRECTORY) { if (attr & FILE_ATTRIBUTE_REPARSE_POINT) { /* * It is a symbolic link - remove it. */ - if (TclWinSymLinkDelete(nativePath, 0) == 0) { + if (TclWinSymLinkDelete(path, 0) == 0) { return TCL_OK; } } @@ -807,21 +788,21 @@ TclpDeleteFile( Tcl_SetErrno(EISDIR); } else if (attr & FILE_ATTRIBUTE_READONLY) { - int res = (*tclWinProcs->setFileAttributesProc)(nativePath, - attr & ~((DWORD)FILE_ATTRIBUTE_READONLY)); + int res = SetFileAttributes(path, + attr & ~((DWORD) FILE_ATTRIBUTE_READONLY)); - if ((res != 0) && ((*tclWinProcs->deleteFileProc)(nativePath) - != FALSE)) { + if ((res != 0) && + (DeleteFile(path) != FALSE)) { return TCL_OK; } TclWinConvertError(GetLastError()); if (res != 0) { - (*tclWinProcs->setFileAttributesProc)(nativePath, attr); + SetFileAttributes(path, attr); } } } } else if (Tcl_GetErrno() == ENOENT) { - attr = (*tclWinProcs->getFileAttributesProc)(nativePath); + attr = GetFileAttributes(path); if (attr != 0xffffffff) { if (attr & FILE_ATTRIBUTE_DIRECTORY) { /* @@ -878,11 +859,11 @@ TclpObjCreateDirectory( static int DoCreateDirectory( - CONST TCHAR *nativePath) /* Pathname of directory to create (native). */ + const TCHAR *nativePath) /* Pathname of directory to create (native). */ { - DWORD error; - if ((*tclWinProcs->createDirectoryProc)(nativePath, NULL) == 0) { - error = GetLastError(); + if (CreateDirectory(nativePath, NULL) == 0) { + DWORD error = GetLastError(); + TclWinConvertError(error); return TCL_ERROR; } @@ -1011,13 +992,12 @@ TclpObjRemoveDirectory( } if (ret != TCL_OK) { - int len = Tcl_DStringLength(&ds); - if (len > 0) { + if (Tcl_DStringLength(&ds) > 0) { if (normPtr != NULL && !strcmp(Tcl_DStringValue(&ds), TclGetString(normPtr))) { *errorPtr = pathPtr; } else { - *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1); + *errorPtr = TclDStringToObj(&ds); } Tcl_IncrRefCount(*errorPtr); } @@ -1029,7 +1009,7 @@ TclpObjRemoveDirectory( static int DoRemoveJustDirectory( - CONST TCHAR *nativePath, /* Pathname of directory to be removed + const TCHAR *nativePath, /* Pathname of directory to be removed * (native). */ int ignoreError, /* If non-zero, don't initialize the errorPtr * under some circumstances on return. */ @@ -1049,7 +1029,7 @@ DoRemoveJustDirectory( goto end; } - attr = (*tclWinProcs->getFileAttributesProc)(nativePath); + attr = GetFileAttributes(nativePath); if (attr & FILE_ATTRIBUTE_REPARSE_POINT) { /* @@ -1063,7 +1043,7 @@ DoRemoveJustDirectory( * Ordinary directory. */ - if ((*tclWinProcs->removeDirectoryProc)(nativePath) != FALSE) { + if (RemoveDirectory(nativePath) != FALSE) { return TCL_OK; } } @@ -1071,7 +1051,7 @@ DoRemoveJustDirectory( TclWinConvertError(GetLastError()); if (Tcl_GetErrno() == EACCES) { - attr = (*tclWinProcs->getFileAttributesProc)(nativePath); + attr = GetFileAttributes(nativePath); if (attr != 0xffffffff) { if ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0) { /* @@ -1095,60 +1075,17 @@ DoRemoveJustDirectory( if (attr & FILE_ATTRIBUTE_READONLY) { attr &= ~FILE_ATTRIBUTE_READONLY; - if ((*tclWinProcs->setFileAttributesProc)(nativePath, + if (SetFileAttributes(nativePath, attr) == FALSE) { goto end; } - if ((*tclWinProcs->removeDirectoryProc)(nativePath) != FALSE) { + if (RemoveDirectory(nativePath) != FALSE) { return TCL_OK; } TclWinConvertError(GetLastError()); - (*tclWinProcs->setFileAttributesProc)(nativePath, + SetFileAttributes(nativePath, attr | FILE_ATTRIBUTE_READONLY); } - - /* - * Windows 95 and Win32s report removing a non-empty directory as - * EACCES, not EEXIST. If the directory is not empty, change errno - * so caller knows what's going on. - */ - - if (TclWinGetPlatformId() != VER_PLATFORM_WIN32_NT) { - CONST char *path, *find; - HANDLE handle; - WIN32_FIND_DATAA data; - Tcl_DString buffer; - int len; - - path = (CONST char *) nativePath; - - Tcl_DStringInit(&buffer); - len = strlen(path); - find = Tcl_DStringAppend(&buffer, path, len); - if ((len > 0) && (find[len - 1] != '\\')) { - Tcl_DStringAppend(&buffer, "\\", 1); - } - find = Tcl_DStringAppend(&buffer, "*.*", 3); - handle = FindFirstFileA(find, &data); - if (handle != INVALID_HANDLE_VALUE) { - while (1) { - if ((strcmp(data.cFileName, ".") != 0) - && (strcmp(data.cFileName, "..") != 0)) { - /* - * Found something in this directory. - */ - - Tcl_SetErrno(EEXIST); - break; - } - if (FindNextFileA(handle, &data) == FALSE) { - break; - } - } - FindClose(handle); - } - Tcl_DStringFree(&buffer); - } } } @@ -1171,7 +1108,12 @@ DoRemoveJustDirectory( end: if (errorPtr != NULL) { + char *p; Tcl_WinTCharToUtf(nativePath, -1, errorPtr); + p = Tcl_DStringValue(errorPtr); + for (; *p; ++p) { + if (*p == '\\') *p = '/'; + } } return TCL_ERROR; @@ -1188,7 +1130,7 @@ DoRemoveDirectory( * filled with UTF-8 name of file causing * error. */ { - int res = DoRemoveJustDirectory(Tcl_DStringValue(pathPtr), recursive, + int res = DoRemoveJustDirectory((const TCHAR *)Tcl_DStringValue(pathPtr), recursive, errorPtr); if ((res == TCL_ERROR) && (recursive != 0) && (Tcl_GetErrno() == EEXIST)) { @@ -1242,7 +1184,7 @@ TraverseWinTree( TCHAR *nativeSource, *nativeTarget, *nativeErrfile; int result, found, sourceLen, targetLen = 0, oldSourceLen, oldTargetLen; HANDLE handle; - WIN32_FIND_DATAT data; + WIN32_FIND_DATA data; nativeErrfile = NULL; result = TCL_OK; @@ -1253,7 +1195,7 @@ TraverseWinTree( (targetPtr == NULL ? NULL : Tcl_DStringValue(targetPtr)); oldSourceLen = Tcl_DStringLength(sourcePtr); - sourceAttr = (*tclWinProcs->getFileAttributesProc)(nativeSource); + sourceAttr = GetFileAttributes(nativeSource); if (sourceAttr == 0xffffffff) { nativeErrfile = nativeSource; goto end; @@ -1264,7 +1206,7 @@ TraverseWinTree( * Process the symbolic link */ - return (*traverseProc)(nativeSource, nativeTarget, DOTREE_LINK, + return traverseProc(nativeSource, nativeTarget, DOTREE_LINK, errorPtr); } @@ -1273,18 +1215,14 @@ TraverseWinTree( * Process the regular file */ - return (*traverseProc)(nativeSource, nativeTarget, DOTREE_F, errorPtr); + return traverseProc(nativeSource, nativeTarget, DOTREE_F, errorPtr); } - if (tclWinProcs->useWide) { - Tcl_DStringAppend(sourcePtr, (char *) L"\\*.*", 4 * sizeof(WCHAR) + 1); - Tcl_DStringSetLength(sourcePtr, Tcl_DStringLength(sourcePtr) - 1); - } else { - Tcl_DStringAppend(sourcePtr, "\\*.*", 4); - } + Tcl_DStringAppend(sourcePtr, (char *) TEXT("\\*.*"), 4 * sizeof(TCHAR) + 1); + Tcl_DStringSetLength(sourcePtr, Tcl_DStringLength(sourcePtr) - 1); nativeSource = (TCHAR *) Tcl_DStringValue(sourcePtr); - handle = (*tclWinProcs->findFirstFileProc)(nativeSource, &data); + handle = FindFirstFile(nativeSource, &data); if (handle == INVALID_HANDLE_VALUE) { /* * Can't read directory. @@ -1295,67 +1233,44 @@ TraverseWinTree( goto end; } - nativeSource[oldSourceLen + 1] = '\0'; + Tcl_DStringSetLength(sourcePtr, oldSourceLen + 1); Tcl_DStringSetLength(sourcePtr, oldSourceLen); - result = (*traverseProc)(nativeSource, nativeTarget, DOTREE_PRED, + result = traverseProc(nativeSource, nativeTarget, DOTREE_PRED, errorPtr); if (result != TCL_OK) { FindClose(handle); return result; } - sourceLen = oldSourceLen; - - if (tclWinProcs->useWide) { - sourceLen += sizeof(WCHAR); - Tcl_DStringAppend(sourcePtr, (char *) L"\\", sizeof(WCHAR) + 1); - Tcl_DStringSetLength(sourcePtr, sourceLen); - } else { - sourceLen += 1; - Tcl_DStringAppend(sourcePtr, "\\", 1); - } + sourceLen = oldSourceLen + sizeof(TCHAR); + Tcl_DStringAppend(sourcePtr, (char *) TEXT("\\"), sizeof(TCHAR) + 1); + Tcl_DStringSetLength(sourcePtr, sourceLen); if (targetPtr != NULL) { oldTargetLen = Tcl_DStringLength(targetPtr); targetLen = oldTargetLen; - if (tclWinProcs->useWide) { - targetLen += sizeof(WCHAR); - Tcl_DStringAppend(targetPtr, (char *) L"\\", sizeof(WCHAR) + 1); - Tcl_DStringSetLength(targetPtr, targetLen); - } else { - targetLen += 1; - Tcl_DStringAppend(targetPtr, "\\", 1); - } + targetLen += sizeof(TCHAR); + Tcl_DStringAppend(targetPtr, (char *) TEXT("\\"), sizeof(TCHAR) + 1); + Tcl_DStringSetLength(targetPtr, targetLen); } found = 1; - for (; found; found = (*tclWinProcs->findNextFileProc)(handle, &data)) { + for (; found; found = FindNextFile(handle, &data)) { TCHAR *nativeName; int len; - if (tclWinProcs->useWide) { - WCHAR *wp; - - wp = data.w.cFileName; + TCHAR *wp = data.cFileName; + if (*wp == '.') { + wp++; if (*wp == '.') { wp++; - if (*wp == '.') { - wp++; - } - if (*wp == '\0') { - continue; - } } - nativeName = (TCHAR *) data.w.cFileName; - len = wcslen(data.w.cFileName) * sizeof(WCHAR); - } else { - if ((strcmp(data.a.cFileName, ".") == 0) - || (strcmp(data.a.cFileName, "..") == 0)) { + if (*wp == '\0') { continue; } - nativeName = (TCHAR *) data.a.cFileName; - len = strlen(data.a.cFileName); } + nativeName = (TCHAR *) data.cFileName; + len = _tcslen(data.cFileName) * sizeof(TCHAR); /* * Append name after slash, and recurse on the file. @@ -1400,8 +1315,8 @@ TraverseWinTree( * files in that directory. */ - result = (*traverseProc)(Tcl_DStringValue(sourcePtr), - (targetPtr == NULL ? NULL : Tcl_DStringValue(targetPtr)), + result = traverseProc((const TCHAR *)Tcl_DStringValue(sourcePtr), + (const TCHAR *)(targetPtr == NULL ? NULL : Tcl_DStringValue(targetPtr)), DOTREE_POSTD, errorPtr); } @@ -1436,8 +1351,8 @@ TraverseWinTree( static int TraversalCopy( - CONST TCHAR *nativeSrc, /* Source pathname to copy. */ - CONST TCHAR *nativeDst, /* Destination pathname of copy. */ + const TCHAR *nativeSrc, /* Source pathname to copy. */ + const TCHAR *nativeDst, /* Destination pathname of copy. */ int type, /* Reason for call - see TraverseWinTree() */ Tcl_DString *errorPtr) /* If non-NULL, initialized DString filled * with UTF-8 name of file causing error. */ @@ -1455,9 +1370,9 @@ TraversalCopy( break; case DOTREE_PRED: if (DoCreateDirectory(nativeDst) == TCL_OK) { - DWORD attr = (tclWinProcs->getFileAttributesProc)(nativeSrc); + DWORD attr = GetFileAttributes(nativeSrc); - if ((tclWinProcs->setFileAttributesProc)(nativeDst, + if (SetFileAttributes(nativeDst, attr) != FALSE) { return TCL_OK; } @@ -1502,8 +1417,8 @@ TraversalCopy( static int TraversalDelete( - CONST TCHAR *nativeSrc, /* Source pathname to delete. */ - CONST TCHAR *dstPtr, /* Not used. */ + const TCHAR *nativeSrc, /* Source pathname to delete. */ + const TCHAR *dstPtr, /* Not used. */ int type, /* Reason for call - see TraverseWinTree() */ Tcl_DString *errorPtr) /* If non-NULL, initialized DString filled * with UTF-8 name of file causing error. */ @@ -1558,8 +1473,8 @@ StatError( * error. */ { TclWinConvertError(GetLastError()); - Tcl_AppendResult(interp, "could not read \"", TclGetString(fileName), - "\": ", Tcl_PosixError(interp), (char *) NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf("could not read \"%s\": %s", + TclGetString(fileName), Tcl_PosixError(interp))); } /* @@ -1589,11 +1504,11 @@ GetWinFileAttributes( Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */ { DWORD result; - CONST TCHAR *nativeName; + const TCHAR *nativeName; int attr; nativeName = Tcl_FSGetNativePath(fileName); - result = (*tclWinProcs->getFileAttributesProc)(nativeName); + result = GetFileAttributes(nativeName); if (result == 0xffffffff) { StatError(interp, fileName); @@ -1611,7 +1526,7 @@ GetWinFileAttributes( */ int len; - char *str = Tcl_GetStringFromObj(fileName,&len); + const char *str = Tcl_GetStringFromObj(fileName,&len); if (len < 4) { if (len == 0) { @@ -1677,9 +1592,11 @@ ConvertFileNameFormat( if (splitPath == NULL || pathc == 0) { if (interp != NULL) { - Tcl_AppendResult(interp, "could not read \"", - Tcl_GetString(fileName), "\": no such file or directory", - (char *) NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "could not read \"%s\": no such file or directory", + Tcl_GetString(fileName))); + errno = ENOENT; + Tcl_PosixError(interp); } goto cleanup; } @@ -1720,10 +1637,10 @@ ConvertFileNameFormat( Tcl_Obj *tempPath; Tcl_DString ds; Tcl_DString dsTemp; - TCHAR *nativeName; - char *tempString; + const TCHAR *nativeName; + const char *tempString; int tempLen; - WIN32_FIND_DATAT data; + WIN32_FIND_DATA data; HANDLE handle; DWORD attr; @@ -1739,7 +1656,7 @@ ConvertFileNameFormat( tempString = Tcl_GetStringFromObj(tempPath,&tempLen); nativeName = Tcl_WinUtfToTChar(tempString, tempLen, &ds); Tcl_DecrRefCount(tempPath); - handle = (*tclWinProcs->findFirstFileProc)(nativeName, &data); + handle = FindFirstFile(nativeName, &data); if (handle == INVALID_HANDLE_VALUE) { /* * FindFirstFile() doesn't like root directories. We would @@ -1748,7 +1665,7 @@ ConvertFileNameFormat( * root directory */ - attr = (*tclWinProcs->getFileAttributesProc)(nativeName); + attr = GetFileAttributes(nativeName); if ((attr!=0xFFFFFFFF) && (attr & FILE_ATTRIBUTE_DIRECTORY)) { Tcl_DStringFree(&ds); goto simple; @@ -1762,27 +1679,14 @@ ConvertFileNameFormat( } goto cleanup; } - if (tclWinProcs->useWide) { - nativeName = (TCHAR *) data.w.cAlternateFileName; - if (longShort) { - if (data.w.cFileName[0] != '\0') { - nativeName = (TCHAR *) data.w.cFileName; - } - } else { - if (data.w.cAlternateFileName[0] == '\0') { - nativeName = (TCHAR *) data.w.cFileName; - } + nativeName = data.cAlternateFileName; + if (longShort) { + if (data.cFileName[0] != '\0') { + nativeName = data.cFileName; } } else { - nativeName = (TCHAR *) data.a.cAlternateFileName; - if (longShort) { - if (data.a.cFileName[0] != '\0') { - nativeName = (TCHAR *) data.a.cFileName; - } - } else { - if (data.a.cAlternateFileName[0] == '\0') { - nativeName = (TCHAR *) data.a.cFileName; - } + if (data.cAlternateFileName[0] == '\0') { + nativeName = (TCHAR *) data.cFileName; } } @@ -1800,22 +1704,21 @@ ConvertFileNameFormat( Tcl_DStringInit(&dsTemp); Tcl_WinTCharToUtf(nativeName, -1, &dsTemp); + Tcl_DStringFree(&ds); /* * Deal with issues of tildes being absolute. */ if (Tcl_DStringValue(&dsTemp)[0] == '~') { - tempPath = Tcl_NewStringObj("./",2); + TclNewLiteralStringObj(tempPath, "./"); Tcl_AppendToObj(tempPath, Tcl_DStringValue(&dsTemp), Tcl_DStringLength(&dsTemp)); + Tcl_DStringFree(&dsTemp); } else { - tempPath = Tcl_NewStringObj(Tcl_DStringValue(&dsTemp), - Tcl_DStringLength(&dsTemp)); + tempPath = TclDStringToObj(&dsTemp); } Tcl_ListObjReplace(NULL, splitPath, i, 1, 1, &tempPath); - Tcl_DStringFree(&ds); - Tcl_DStringFree(&dsTemp); FindClose(handle); } } @@ -1927,13 +1830,12 @@ SetWinFileAttributes( Tcl_Obj *fileName, /* The name of the file. */ Tcl_Obj *attributePtr) /* The new value of the attribute. */ { - DWORD fileAttributes; - int yesNo; - int result; - CONST TCHAR *nativeName; + DWORD fileAttributes, old; + int yesNo, result; + const TCHAR *nativeName; nativeName = Tcl_FSGetNativePath(fileName); - fileAttributes = (*tclWinProcs->getFileAttributesProc)(nativeName); + fileAttributes = old = GetFileAttributes(nativeName); if (fileAttributes == 0xffffffff) { StatError(interp, fileName); @@ -1951,7 +1853,8 @@ SetWinFileAttributes( fileAttributes &= ~(attributeArray[objIndex]); } - if (!(*tclWinProcs->setFileAttributesProc)(nativeName, fileAttributes)) { + if ((fileAttributes != old) + && !SetFileAttributes(nativeName, fileAttributes)) { StatError(interp, fileName); return TCL_ERROR; } @@ -1982,13 +1885,13 @@ CannotSetAttribute( Tcl_Obj *fileName, /* The name of the file. */ Tcl_Obj *attributePtr) /* The new value of the attribute. */ { - Tcl_AppendResult(interp, "cannot set attribute \"", - tclpFileAttrStrings[objIndex], "\" for file \"", - Tcl_GetString(fileName), "\": attribute is readonly", - (char *) NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "cannot set attribute \"%s\" for file \"%s\": attribute is readonly", + tclpFileAttrStrings[objIndex], Tcl_GetString(fileName))); + errno = EINVAL; + Tcl_PosixError(interp); return TCL_ERROR; } - /* *--------------------------------------------------------------------------- @@ -2006,7 +1909,7 @@ CannotSetAttribute( *--------------------------------------------------------------------------- */ -Tcl_Obj* +Tcl_Obj * TclpObjListVolumes(void) { Tcl_Obj *resultPtr, *elemPtr; diff --git a/win/tclWinFile.c b/win/tclWinFile.c index 4139dac..5761eeb 100644 --- a/win/tclWinFile.c +++ b/win/tclWinFile.c @@ -10,26 +10,21 @@ * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. - * - * RCS: @(#) $Id: tclWinFile.c,v 1.91 2007/02/20 15:36:47 patthoyts Exp $ */ -/* #define _WIN32_WINNT 0x0500 */ - #include "tclWinInt.h" #include "tclFileSystem.h" #include <winioctl.h> -#include <sys/stat.h> #include <shlobj.h> -#include <lmaccess.h> /* For TclpGetUserHome(). */ +#include <lm.h> /* For TclpGetUserHome(). */ /* * The number of 100-ns intervals between the Windows system epoch (1601-01-01 * on the proleptic Gregorian calendar) and the Posix epoch (1970-01-01). */ -#define POSIX_EPOCH_AS_FILETIME ((Tcl_WideInt)116444736 \ - * (Tcl_WideInt) 1000000000) +#define POSIX_EPOCH_AS_FILETIME \ + ((Tcl_WideInt) 116444736 * (Tcl_WideInt) 1000000000) /* * Declarations for 'link' related information. This information should come @@ -90,7 +85,7 @@ 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 /* @@ -123,6 +118,7 @@ typedef struct _REPARSE_DATA_BUFFER { WORD SubstituteNameLength; WORD PrintNameOffset; WORD PrintNameLength; + ULONG Flags; WCHAR PathBuffer[1]; } SymbolicLinkReparseBuffer; struct { @@ -141,31 +137,9 @@ typedef struct _REPARSE_DATA_BUFFER { 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) -#undef HAVE_NO_FINDEX_ENUMS -#define HAVE_NO_FINDEX_ENUMS -#elif !defined(_WIN32_WINNT) || (_WIN32_WINNT < 0x0400) -#undef HAVE_NO_FINDEX_ENUMS -#define HAVE_NO_FINDEX_ENUMS -#endif - -#ifdef HAVE_NO_FINDEX_ENUMS -/* These two aren't in VC++ 5.2 headers */ -typedef enum _FINDEX_INFO_LEVELS { - FindExInfoStandard, - FindExInfoMaxInfoLevel -} FINDEX_INFO_LEVELS; -typedef enum _FINDEX_SEARCH_OPS { - FindExSearchNameMatch, - FindExSearchLimitToDirectories, - FindExSearchLimitToDevices, - FindExSearchMaxSearchOp -} FINDEX_SEARCH_OPS; -#endif /* HAVE_NO_FINDEX_ENUMS */ - /* * Other typedefs required by this code. */ @@ -173,38 +147,32 @@ typedef enum _FINDEX_SEARCH_OPS { static time_t ToCTime(FILETIME fileTime); static void FromCTime(time_t posixTime, FILETIME *fileTime); -typedef NET_API_STATUS NET_API_FUNCTION NETUSERGETINFOPROC( - LPWSTR servername, LPWSTR username, DWORD level, LPBYTE *bufptr); - -typedef NET_API_STATUS NET_API_FUNCTION NETAPIBUFFERFREEPROC(LPVOID Buffer); - -typedef NET_API_STATUS NET_API_FUNCTION NETGETDCNAMEPROC( - LPWSTR servername, LPWSTR domainname, LPBYTE *bufptr); - /* * Declarations for local functions defined in this file: */ -static int NativeAccess(CONST TCHAR *path, int mode); -static int NativeDev(CONST TCHAR *path); -static int NativeStat(CONST TCHAR *path, Tcl_StatBuf *statPtr, +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 unsigned short NativeStatMode(DWORD attr, int checkLinks, + int isExec); +static int NativeIsExec(const TCHAR *path); +static int NativeReadReparse(const TCHAR *LinkDirectory, + REPARSE_DATA_BUFFER *buffer, DWORD desiredAccess); +static int NativeWriteReparse(const TCHAR *LinkDirectory, + REPARSE_DATA_BUFFER *buffer); static int NativeMatchType(int isDrive, DWORD attr, - CONST TCHAR *nativeName, Tcl_GlobTypeData *types); -static int WinIsDrive(CONST char *name, int nameLen); -static int WinIsReserved(CONST char *path); -static Tcl_Obj * WinReadLink(CONST TCHAR *LinkSource); -static Tcl_Obj * WinReadLinkDirectory(CONST TCHAR *LinkDirectory); -static int WinLink(CONST TCHAR *LinkSource, - CONST TCHAR *LinkTarget, int linkAction); -static int WinSymLinkDirectory(CONST TCHAR *LinkDirectory, - CONST TCHAR *LinkTarget); + const TCHAR *nativeName, Tcl_GlobTypeData *types); +static int WinIsDrive(const char *name, int nameLen); +static int WinIsReserved(const char *path); +static Tcl_Obj * WinReadLink(const TCHAR *LinkSource); +static Tcl_Obj * WinReadLinkDirectory(const TCHAR *LinkDirectory); +static int WinLink(const TCHAR *LinkSource, + const TCHAR *LinkTarget, int linkAction); +static int WinSymLinkDirectory(const TCHAR *LinkDirectory, + const TCHAR *LinkTarget); +MODULE_SCOPE void tclWinDebugPanic(const char *format, ...); /* *-------------------------------------------------------------------- @@ -218,20 +186,20 @@ static int WinSymLinkDirectory(CONST TCHAR *LinkDirectory, static int WinLink( - CONST TCHAR *linkSourcePath, - CONST TCHAR *linkTargetPath, + const TCHAR *linkSourcePath, + const TCHAR *linkTargetPath, int linkAction) { - WCHAR tempFileName[MAX_PATH]; + TCHAR tempFileName[MAX_PATH]; TCHAR *tempFilePart; - int attr; + DWORD attr; /* * Get the full path referenced by the target. */ - if (!(*tclWinProcs->getFullPathNameProc)(linkTargetPath, MAX_PATH, - tempFileName, &tempFilePart)) { + if (!GetFullPathName(linkTargetPath, MAX_PATH, tempFileName, + &tempFilePart)) { /* * Invalid file. */ @@ -244,8 +212,8 @@ WinLink( * Make sure source file doesn't exist. */ - attr = (*tclWinProcs->getFileAttributesProc)(linkSourcePath); - if (attr != 0xffffffff) { + attr = GetFileAttributes(linkSourcePath); + if (attr != INVALID_FILE_ATTRIBUTES) { Tcl_SetErrno(EEXIST); return -1; } @@ -254,8 +222,8 @@ WinLink( * Get the full path referenced by the source file/directory. */ - if (!(*tclWinProcs->getFullPathNameProc)(linkSourcePath, MAX_PATH, - tempFileName, &tempFilePart)) { + if (!GetFullPathName(linkSourcePath, MAX_PATH, tempFileName, + &tempFilePart)) { /* * Invalid file. */ @@ -268,45 +236,43 @@ WinLink( * Check the target. */ - attr = (*tclWinProcs->getFileAttributesProc)(linkTargetPath); - if (attr == 0xffffffff) { + attr = GetFileAttributes(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. */ - if (tclWinProcs->createHardLinkProc == NULL) { - Tcl_SetErrno(ENOTDIR); - return -1; - } - if (linkAction & TCL_CREATE_HARD_LINK) { - if (!(*tclWinProcs->createHardLinkProc)(linkSourcePath, - linkTargetPath, NULL)) { - TclWinConvertError(GetLastError()); - return -1; + if (CreateHardLink(linkSourcePath, linkTargetPath, NULL)) { + /* + * Success! + */ + + return 0; } - return 0; + TclWinConvertError(GetLastError()); } else if (linkAction & TCL_CREATE_SYMBOLIC_LINK) { /* * Can't symlink files. */ Tcl_SetErrno(ENOTDIR); - return -1; } else { Tcl_SetErrno(ENODEV); - 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(linkSourcePath, linkTargetPath); @@ -316,12 +282,11 @@ WinLink( */ Tcl_SetErrno(EISDIR); - return -1; } else { Tcl_SetErrno(ENODEV); - return -1; } } + return -1; } /* @@ -334,20 +299,20 @@ WinLink( *-------------------------------------------------------------------- */ -static Tcl_Obj* +static Tcl_Obj * WinReadLink( - CONST TCHAR *linkSourcePath) + const TCHAR *linkSourcePath) { - WCHAR tempFileName[MAX_PATH]; + TCHAR tempFileName[MAX_PATH]; TCHAR *tempFilePart; - int attr; + DWORD attr; /* * Get the full path referenced by the target. */ - if (!(*tclWinProcs->getFullPathNameProc)(linkSourcePath, MAX_PATH, - tempFileName, &tempFilePart)) { + if (!GetFullPathName(linkSourcePath, MAX_PATH, tempFileName, + &tempFilePart)) { /* * Invalid file. */ @@ -360,8 +325,8 @@ WinReadLink( * Make sure source file does exist. */ - attr = (*tclWinProcs->getFileAttributesProc)(linkSourcePath); - if (attr == 0xffffffff) { + attr = GetFileAttributes(linkSourcePath); + if (attr == INVALID_FILE_ATTRIBUTES) { /* * The source doesn't exist. */ @@ -376,9 +341,9 @@ WinReadLink( Tcl_SetErrno(ENOTDIR); return NULL; - } else { - return WinReadLinkDirectory(linkSourcePath); } + + return WinReadLinkDirectory(linkSourcePath); } /* @@ -400,11 +365,11 @@ WinReadLink( static int WinSymLinkDirectory( - CONST TCHAR *linkDirPath, - CONST TCHAR *linkTargetPath) + const TCHAR *linkDirPath, + const TCHAR *linkTargetPath) { DUMMY_REPARSE_BUFFER dummy; - REPARSE_DATA_BUFFER *reparseBuffer = (REPARSE_DATA_BUFFER*)&dummy; + REPARSE_DATA_BUFFER *reparseBuffer = (REPARSE_DATA_BUFFER *) &dummy; int len; WCHAR nativeTarget[MAX_PATH]; WCHAR *loop; @@ -413,8 +378,8 @@ WinSymLinkDirectory( * Make the native target name. */ - memcpy((void *) nativeTarget, (void *) L"\\??\\", 4*sizeof(WCHAR)); - memcpy((void *) (nativeTarget + 4), (void *) linkTargetPath, + memcpy(nativeTarget, L"\\??\\", 4 * sizeof(WCHAR)); + memcpy(nativeTarget + 4, linkTargetPath, sizeof(WCHAR) * (1+wcslen((WCHAR *) linkTargetPath))); len = wcslen(nativeTarget); @@ -439,18 +404,18 @@ WinSymLinkDirectory( memset(reparseBuffer, 0, sizeof(DUMMY_REPARSE_BUFFER)); reparseBuffer->ReparseTag = IO_REPARSE_TAG_MOUNT_POINT; - reparseBuffer->SymbolicLinkReparseBuffer.SubstituteNameLength = + reparseBuffer->MountPointReparseBuffer.SubstituteNameLength = wcslen(nativeTarget) * sizeof(WCHAR); reparseBuffer->Reserved = 0; - reparseBuffer->SymbolicLinkReparseBuffer.PrintNameLength = 0; - reparseBuffer->SymbolicLinkReparseBuffer.PrintNameOffset = - reparseBuffer->SymbolicLinkReparseBuffer.SubstituteNameLength + reparseBuffer->MountPointReparseBuffer.PrintNameLength = 0; + reparseBuffer->MountPointReparseBuffer.PrintNameOffset = + reparseBuffer->MountPointReparseBuffer.SubstituteNameLength + sizeof(WCHAR); - memcpy(reparseBuffer->SymbolicLinkReparseBuffer.PathBuffer, nativeTarget, + memcpy(reparseBuffer->MountPointReparseBuffer.PathBuffer, nativeTarget, sizeof(WCHAR) - + reparseBuffer->SymbolicLinkReparseBuffer.SubstituteNameLength); + + reparseBuffer->MountPointReparseBuffer.SubstituteNameLength); reparseBuffer->ReparseDataLength = - reparseBuffer->SymbolicLinkReparseBuffer.SubstituteNameLength + 12; + reparseBuffer->MountPointReparseBuffer.SubstituteNameLength+12; return NativeWriteReparse(linkDirPath, reparseBuffer); } @@ -472,13 +437,13 @@ WinSymLinkDirectory( int TclWinSymLinkCopyDirectory( - CONST TCHAR *linkOrigPath, /* Existing junction - reparse point */ - CONST TCHAR *linkCopyPath) /* Will become a duplicate junction */ + const TCHAR *linkOrigPath, /* Existing junction - reparse point */ + const TCHAR *linkCopyPath) /* Will become a duplicate junction */ { DUMMY_REPARSE_BUFFER dummy; REPARSE_DATA_BUFFER *reparseBuffer = (REPARSE_DATA_BUFFER *) &dummy; - if (NativeReadReparse(linkOrigPath, reparseBuffer)) { + if (NativeReadReparse(linkOrigPath, reparseBuffer, GENERIC_READ)) { return -1; } return NativeWriteReparse(linkCopyPath, reparseBuffer); @@ -503,7 +468,7 @@ TclWinSymLinkCopyDirectory( int TclWinSymLinkDelete( - CONST TCHAR *linkOrigPath, + const TCHAR *linkOrigPath, int linkOnly) { /* @@ -517,9 +482,8 @@ TclWinSymLinkDelete( memset(reparseBuffer, 0, sizeof(DUMMY_REPARSE_BUFFER)); reparseBuffer->ReparseTag = IO_REPARSE_TAG_MOUNT_POINT; - hFile = (*tclWinProcs->createFileProc)(linkOrigPath, GENERIC_WRITE, 0, - NULL, OPEN_EXISTING, - FILE_FLAG_OPEN_REPARSE_POINT|FILE_FLAG_BACKUP_SEMANTICS, NULL); + hFile = CreateFile(linkOrigPath, GENERIC_WRITE, 0, NULL, OPEN_EXISTING, + FILE_FLAG_OPEN_REPARSE_POINT | FILE_FLAG_BACKUP_SEMANTICS, NULL); if (hFile != INVALID_HANDLE_VALUE) { if (!DeviceIoControl(hFile, FSCTL_DELETE_REPARSE_POINT, reparseBuffer, @@ -533,7 +497,7 @@ TclWinSymLinkDelete( } else { CloseHandle(hFile); if (!linkOnly) { - (*tclWinProcs->removeDirectoryProc)(linkOrigPath); + RemoveDirectory(linkOrigPath); } return 0; } @@ -562,23 +526,22 @@ TclWinSymLinkDelete( *-------------------------------------------------------------------- */ -static Tcl_Obj* +static Tcl_Obj * WinReadLinkDirectory( - CONST TCHAR *linkDirPath) + const TCHAR *linkDirPath) { - int attr; + int attr, len, offset; DUMMY_REPARSE_BUFFER dummy; - REPARSE_DATA_BUFFER *reparseBuffer = (REPARSE_DATA_BUFFER*)&dummy; + REPARSE_DATA_BUFFER *reparseBuffer = (REPARSE_DATA_BUFFER *) &dummy; Tcl_Obj *retVal; Tcl_DString ds; - CONST char *copy; - int len, offset; + const char *copy; - attr = (*tclWinProcs->getFileAttributesProc)(linkDirPath); + attr = GetFileAttributes(linkDirPath); if (!(attr & FILE_ATTRIBUTE_REPARSE_POINT)) { goto invalidError; } - if (NativeReadReparse(linkDirPath, reparseBuffer)) { + if (NativeReadReparse(linkDirPath, reparseBuffer, 0)) { return NULL; } @@ -599,12 +562,13 @@ WinReadLinkDirectory( */ offset = 0; - if (reparseBuffer->SymbolicLinkReparseBuffer.PathBuffer[0] == L'\\') { +#ifdef UNICODE + if (reparseBuffer->MountPointReparseBuffer.PathBuffer[0] == L'\\') { /* * Check whether this is a mounted volume. */ - if (wcsncmp(reparseBuffer->SymbolicLinkReparseBuffer.PathBuffer, + if (wcsncmp(reparseBuffer->MountPointReparseBuffer.PathBuffer, L"\\??\\Volume{",11) == 0) { char drive; @@ -613,7 +577,7 @@ WinReadLinkDirectory( * to fix here. It doesn't seem very well documented. */ - reparseBuffer->SymbolicLinkReparseBuffer.PathBuffer[1] = L'\\'; + reparseBuffer->MountPointReparseBuffer.PathBuffer[1]=L'\\'; /* * Check if a corresponding drive letter exists, and use that @@ -621,7 +585,7 @@ WinReadLinkDirectory( */ drive = TclWinDriveLetterForVolMountPoint( - reparseBuffer->SymbolicLinkReparseBuffer.PathBuffer); + reparseBuffer->MountPointReparseBuffer.PathBuffer); if (drive != -1) { char driveSpec[3] = { '\0', ':', '\0' @@ -644,14 +608,14 @@ WinReadLinkDirectory( */ goto invalidError; - } else if (wcsncmp(reparseBuffer->SymbolicLinkReparseBuffer + } else if (wcsncmp(reparseBuffer->MountPointReparseBuffer .PathBuffer, L"\\\\?\\",4) == 0) { /* * Strip off the prefix. */ offset = 4; - } else if (wcsncmp(reparseBuffer->SymbolicLinkReparseBuffer + } else if (wcsncmp(reparseBuffer->MountPointReparseBuffer .PathBuffer, L"\\??\\",4) == 0) { /* * Strip off the prefix. @@ -660,10 +624,11 @@ WinReadLinkDirectory( offset = 4; } } +#endif /* UNICODE */ - Tcl_WinTCharToUtf((CONST char*) - reparseBuffer->SymbolicLinkReparseBuffer.PathBuffer, - (int) reparseBuffer->SymbolicLinkReparseBuffer + Tcl_WinTCharToUtf((const TCHAR *) + reparseBuffer->MountPointReparseBuffer.PathBuffer, + (int) reparseBuffer->MountPointReparseBuffer .SubstituteNameLength, &ds); copy = Tcl_DStringValue(&ds)+offset; @@ -696,15 +661,15 @@ WinReadLinkDirectory( static int NativeReadReparse( - CONST TCHAR *linkDirPath, /* The junction to read */ - REPARSE_DATA_BUFFER *buffer)/* Pointer to buffer. Cannot be NULL */ + const TCHAR *linkDirPath, /* The junction to read */ + REPARSE_DATA_BUFFER *buffer,/* Pointer to buffer. Cannot be NULL */ + DWORD desiredAccess) { HANDLE hFile; DWORD returnedLength; - hFile = (*tclWinProcs->createFileProc)(linkDirPath, GENERIC_READ, 0, - NULL, OPEN_EXISTING, - FILE_FLAG_OPEN_REPARSE_POINT|FILE_FLAG_BACKUP_SEMANTICS, NULL); + hFile = CreateFile(linkDirPath, desiredAccess, 0, NULL, OPEN_EXISTING, + FILE_FLAG_OPEN_REPARSE_POINT | FILE_FLAG_BACKUP_SEMANTICS, NULL); if (hFile == INVALID_HANDLE_VALUE) { /* @@ -752,8 +717,8 @@ NativeReadReparse( static int NativeWriteReparse( - CONST TCHAR *linkDirPath, - REPARSE_DATA_BUFFER* buffer) + const TCHAR *linkDirPath, + REPARSE_DATA_BUFFER *buffer) { HANDLE hFile; DWORD returnedLength; @@ -762,7 +727,7 @@ NativeWriteReparse( * Create the directory - it must not already exist. */ - if ((*tclWinProcs->createDirectoryProc)(linkDirPath, NULL) == 0) { + if (CreateDirectory(linkDirPath, NULL) == 0) { /* * Error creating directory. */ @@ -770,10 +735,9 @@ NativeWriteReparse( TclWinConvertError(GetLastError()); return -1; } - - hFile = (*tclWinProcs->createFileProc)(linkDirPath, GENERIC_WRITE, 0, - NULL, OPEN_EXISTING, - FILE_FLAG_OPEN_REPARSE_POINT|FILE_FLAG_BACKUP_SEMANTICS, NULL); + hFile = CreateFile(linkDirPath, GENERIC_WRITE, 0, NULL, + OPEN_EXISTING, FILE_FLAG_OPEN_REPARSE_POINT + | FILE_FLAG_BACKUP_SEMANTICS, NULL); if (hFile == INVALID_HANDLE_VALUE) { /* * Error creating directory. @@ -796,7 +760,7 @@ NativeWriteReparse( TclWinConvertError(GetLastError()); CloseHandle(hFile); - (*tclWinProcs->removeDirectoryProc)(linkDirPath); + RemoveDirectory(linkDirPath); return -1; } CloseHandle(hFile); @@ -809,6 +773,65 @@ NativeWriteReparse( } /* + *---------------------------------------------------------------------- + * + * tclWinDebugPanic -- + * + * Display a message. If a debugger is present, present it directly to + * the debugger, otherwise use a MessageBox. + * + * Results: + * None. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +void +tclWinDebugPanic( + const char *format, ...) +{ +#define TCL_MAX_WARN_LEN 1024 + va_list argList; + char buf[TCL_MAX_WARN_LEN * TCL_UTF_MAX]; + WCHAR msgString[TCL_MAX_WARN_LEN]; + + va_start(argList, format); + vsnprintf(buf, sizeof(buf), format, argList); + + msgString[TCL_MAX_WARN_LEN-1] = L'\0'; + MultiByteToWideChar(CP_UTF8, 0, buf, -1, msgString, TCL_MAX_WARN_LEN); + + /* + * Truncate MessageBox string if it is too long to not overflow the screen + * and cause possible oversized window error. + */ + + if (msgString[TCL_MAX_WARN_LEN-1] != L'\0') { + memcpy(msgString + (TCL_MAX_WARN_LEN - 5), L" ...", 5 * sizeof(WCHAR)); + } + if (IsDebuggerPresent()) { + OutputDebugStringW(msgString); + } else { + MessageBeep(MB_ICONEXCLAMATION); + MessageBoxW(NULL, msgString, L"Fatal Error", + MB_ICONSTOP | MB_OK | MB_TASKMODAL | MB_SETFOREGROUND); + } +#if defined(__GNUC__) + __builtin_trap(); +#elif defined(_WIN64) + __debugbreak(); +#elif defined(_MSC_VER) + _asm {int 3} +#else + DebugBreak(); +#endif + abort(); +} + +/* *--------------------------------------------------------------------------- * * TclpFindExecutable -- @@ -827,27 +850,32 @@ NativeWriteReparse( void TclpFindExecutable( - CONST char *argv0) /* The value of the application's argv[0] - * (native). */ + const char *argv0) /* If NULL, install PanicMessageBox, otherwise + * ignore. */ { WCHAR wName[MAX_PATH]; char name[MAX_PATH * TCL_UTF_MAX]; /* * Under Windows we ignore argv0, and return the path for the file used to - * create this process. + * create this process. Only if it is NULL, install a new panic handler. */ - if (GetModuleFileNameW(NULL, wName, MAX_PATH) == 0) { - GetModuleFileNameA(NULL, name, sizeof(name)); + if (argv0 == NULL) { + Tcl_SetPanicProc(tclWinDebugPanic); + } - /* - * Convert to WCHAR to get out of ANSI codepage - */ +#ifdef UNICODE + GetModuleFileNameW(NULL, wName, MAX_PATH); +#else + GetModuleFileNameA(NULL, name, sizeof(name)); - MultiByteToWideChar(CP_ACP, 0, name, -1, wName, MAX_PATH); - } + /* + * Convert to WCHAR to get out of ANSI codepage + */ + MultiByteToWideChar(CP_ACP, 0, name, -1, wName, MAX_PATH); +#endif WideCharToMultiByte(CP_UTF8, 0, wName, -1, name, sizeof(name), NULL, NULL); TclWinNoBackslash(name); TclSetObjNameOfExecutable(Tcl_NewStringObj(name, -1), NULL); @@ -877,12 +905,12 @@ 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. */ + 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) { /* @@ -894,6 +922,7 @@ TclpMatchInDirectory( if (pattern == NULL || (*pattern == '\0')) { Tcl_Obj *norm = Tcl_FSGetNormalizedPath(NULL, pathPtr); + if (norm != NULL) { /* * Match a single file directly. @@ -901,23 +930,16 @@ TclpMatchInDirectory( int len; DWORD attr; - CONST char *str = Tcl_GetStringFromObj(norm,&len); + WIN32_FILE_ATTRIBUTE_DATA data; + const char *str = Tcl_GetStringFromObj(norm,&len); - native = (CONST TCHAR *) Tcl_FSGetNativePath(pathPtr); + native = Tcl_FSGetNativePath(pathPtr); - if (tclWinProcs->getFileAttributesExProc == NULL) { - attr = (*tclWinProcs->getFileAttributesProc)(native); - if (attr == 0xffffffff) { - return TCL_OK; - } - } else { - WIN32_FILE_ATTRIBUTE_DATA data; - if ((*tclWinProcs->getFileAttributesExProc)(native, - GetFileExInfoStandard, &data) != TRUE) { - return TCL_OK; - } - attr = data.dwFileAttributes; + if (GetFileAttributesEx(native, + GetFileExInfoStandard, &data) != TRUE) { + return TCL_OK; } + attr = data.dwFileAttributes; if (NativeMatchType(WinIsDrive(str,len), attr, native, types)) { Tcl_ListObjAppendElement(interp, resultPtr, pathPtr); @@ -927,8 +949,8 @@ TclpMatchInDirectory( } else { DWORD attr; HANDLE handle; - WIN32_FIND_DATAT data; - CONST char *dirName; /* UTF-8 dir name, later with pattern + WIN32_FIND_DATA data; + const char *dirName; /* UTF-8 dir name, later with pattern * appended. */ int dirLength; int matchSpecialDots; @@ -956,9 +978,10 @@ TclpMatchInDirectory( if (native == NULL) { return TCL_OK; } - attr = (*tclWinProcs->getFileAttributesProc)(native); + attr = GetFileAttributes(native); - if ((attr == 0xffffffff) || ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0)) { + if ((attr == INVALID_FILE_ATTRIBUTES) + || ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0)) { return TCL_OK; } @@ -973,7 +996,7 @@ TclpMatchInDirectory( lastChar = dirName[dirLength -1]; if ((lastChar != '\\') && (lastChar != '/') && (lastChar != ':')) { - Tcl_DStringAppend(&dsOrig, "/", 1); + TclDStringAppendLiteral(&dsOrig, "/"); dirLength++; } dirName = Tcl_DStringValue(&dsOrig); @@ -993,25 +1016,25 @@ TclpMatchInDirectory( dirName = Tcl_DStringAppend(&dsOrig, pattern, -1); } else { - dirName = Tcl_DStringAppend(&dsOrig, "*.*", 3); + dirName = TclDStringAppendLiteral(&dsOrig, "*.*"); } native = Tcl_WinUtfToTChar(dirName, -1, &ds); - if (tclWinProcs->findFirstFileExProc == NULL || (types == NULL) - || (types->type != TCL_GLOB_TYPE_DIR)) { - handle = (*tclWinProcs->findFirstFileProc)(native, &data); + if ((types == NULL) || (types->type != TCL_GLOB_TYPE_DIR)) { + handle = FindFirstFile(native, &data); } else { /* * We can be more efficient, for pure directory requests. */ - handle = (*tclWinProcs->findFirstFileExProc)(native, + handle = FindFirstFileEx(native, FindExInfoStandard, &data, FindExSearchLimitToDirectories, NULL, 0); } if (handle == INVALID_HANDLE_VALUE) { DWORD err = GetLastError(); + Tcl_DStringFree(&ds); if (err == ERROR_FILE_NOT_FOUND) { /* @@ -1025,10 +1048,9 @@ TclpMatchInDirectory( TclWinConvertError(err); if (interp != NULL) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "couldn't read directory \"", - Tcl_DStringValue(&dsOrig), "\": ", - Tcl_PosixError(interp), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "couldn't read directory \"%s\": %s", + Tcl_DStringValue(&dsOrig), Tcl_PosixError(interp))); } Tcl_DStringFree(&dsOrig); return TCL_ERROR; @@ -1064,19 +1086,12 @@ TclpMatchInDirectory( */ 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; - attr = data.w.dwFileAttributes; - } else { - native = (CONST TCHAR *) data.a.cFileName; - attr = data.a.dwFileAttributes; - } - + native = data.cFileName; + attr = data.dwFileAttributes; utfname = Tcl_WinTCharToUtf(native, -1, &ds); if (!matchSpecialDots) { @@ -1117,8 +1132,9 @@ TclpMatchInDirectory( */ 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); } else { @@ -1136,7 +1152,7 @@ TclpMatchInDirectory( */ Tcl_DStringFree(&ds); - } while ((*tclWinProcs->findNextFileProc)(handle, &data) == TRUE); + } while (FindNextFile(handle, &data) == TRUE); FindClose(handle); Tcl_DStringFree(&dsOrig); @@ -1152,10 +1168,11 @@ TclpMatchInDirectory( static int WinIsDrive( - CONST char *name, /* Name (UTF-8) */ + 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] != '\\')) { @@ -1217,8 +1234,9 @@ WinIsDrive( * (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')) { @@ -1256,8 +1274,8 @@ static int WinIsReserved( } } - } else if (!stricmp(path, "prn") || !stricmp(path, "nul") - || !stricmp(path, "aux")) { + } else if (!strcasecmp(path, "prn") || !strcasecmp(path, "nul") + || !strcasecmp(path, "aux")) { /* * Have match for 'prn', 'nul' or 'aux'. */ @@ -1276,7 +1294,7 @@ static int WinIsReserved( * 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 + * We never make any calls to a 'get attributes' routine here, since we * have arranged things so that our caller already knows such * information. * @@ -1292,7 +1310,7 @@ NativeMatchType( int isDrive, /* Is this a drive. */ DWORD attr, /* We already know the attributes for the * file. */ - CONST TCHAR *nativeName, /* Native path to check. */ + const TCHAR *nativeName, /* Native path to check. */ Tcl_GlobTypeData *types) /* Type description to match against. */ { /* @@ -1307,81 +1325,80 @@ NativeMatchType( * If invisible, don't return the file. */ - if (attr & FILE_ATTRIBUTE_HIDDEN && !isDrive) { + return !(attr & FILE_ATTRIBUTE_HIDDEN && !isDrive); + } + + if (attr & FILE_ATTRIBUTE_HIDDEN && !isDrive) { + /* + * If invisible. + */ + + if ((types->perm == 0) || !(types->perm & TCL_GLOB_PERM_HIDDEN)) { return 0; } } else { - if (attr & FILE_ATTRIBUTE_HIDDEN && !isDrive) { - /* - * 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 & TCL_GLOB_PERM_HIDDEN) { + return 0; } + } - if (types->perm != 0) { - if (((types->perm & TCL_GLOB_PERM_RONLY) && - !(attr & FILE_ATTRIBUTE_READONLY)) || - ((types->perm & TCL_GLOB_PERM_R) && - (0 /* File exists => R_OK on Windows */)) || - ((types->perm & TCL_GLOB_PERM_W) && - (attr & FILE_ATTRIBUTE_READONLY)) || - ((types->perm & TCL_GLOB_PERM_X) && - (!(attr & FILE_ATTRIBUTE_DIRECTORY) - && !NativeIsExec(nativeName)))) { - return 0; - } + if (types->perm != 0) { + if (((types->perm & TCL_GLOB_PERM_RONLY) && + !(attr & FILE_ATTRIBUTE_READONLY)) || + ((types->perm & TCL_GLOB_PERM_R) && + (0 /* File exists => R_OK on Windows */)) || + ((types->perm & TCL_GLOB_PERM_W) && + (attr & FILE_ATTRIBUTE_READONLY)) || + ((types->perm & TCL_GLOB_PERM_X) && + (!(attr & FILE_ATTRIBUTE_DIRECTORY) + && !NativeIsExec(nativeName)))) { + return 0; } - if ((types->type & TCL_GLOB_TYPE_DIR) - && (attr & FILE_ATTRIBUTE_DIRECTORY)) { - /* - * Quicker test for directory, which is a common case. - */ + } - return 1; + 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); + } else if (types->type != 0) { + unsigned short st_mode; + int isExec = NativeIsExec(nativeName); - st_mode = NativeStatMode(attr, 0, isExec); + st_mode = NativeStatMode(attr, 0, isExec); - /* - * In order bcdpfls as in 'find -t' - */ + /* + * In order bcdpfls as in 'find -t' + */ - if (((types->type&TCL_GLOB_TYPE_BLOCK) && S_ISBLK(st_mode)) || - ((types->type&TCL_GLOB_TYPE_CHAR) && S_ISCHR(st_mode)) || - ((types->type&TCL_GLOB_TYPE_DIR) && S_ISDIR(st_mode)) || - ((types->type&TCL_GLOB_TYPE_PIPE) && S_ISFIFO(st_mode)) || + if (((types->type&TCL_GLOB_TYPE_BLOCK) && S_ISBLK(st_mode)) || + ((types->type&TCL_GLOB_TYPE_CHAR) && S_ISCHR(st_mode)) || + ((types->type&TCL_GLOB_TYPE_DIR) && S_ISDIR(st_mode)) || + ((types->type&TCL_GLOB_TYPE_PIPE) && S_ISFIFO(st_mode)) || #ifdef S_ISSOCK - ((types->type&TCL_GLOB_TYPE_SOCK) && S_ISSOCK(st_mode)) || + ((types->type&TCL_GLOB_TYPE_SOCK) && S_ISSOCK(st_mode)) || #endif - ((types->type&TCL_GLOB_TYPE_FILE) && S_ISREG(st_mode))) { - /* - * Do nothing - this file is ok. - */ - } else { + ((types->type&TCL_GLOB_TYPE_FILE) && S_ISREG(st_mode))) { + /* + * Do nothing - this file is ok. + */ + } else { #ifdef S_ISLNK - if (types->type & TCL_GLOB_TYPE_LINK) { - st_mode = NativeStatMode(attr, 1, isExec); - if (S_ISLNK(st_mode)) { - return 1; - } + if (types->type & TCL_GLOB_TYPE_LINK) { + st_mode = NativeStatMode(attr, 1, isExec); + if (S_ISLNK(st_mode)) { + return 1; } -#endif - return 0; } +#endif /* S_ISLNK */ + return 0; } } return 1; @@ -1408,81 +1425,56 @@ NativeMatchType( *---------------------------------------------------------------------- */ -char * +const char * TclpGetUserHome( - CONST char *name, /* User name for desired home directory. */ + 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; + const char *result = NULL; + USER_INFO_1 *uiPtr, **uiPtrPtr = &uiPtr; + Tcl_DString ds; + int nameLen = -1; + int badDomain = 0; + char *domain; + WCHAR *wName, *wHomeDir, *wDomain, **wDomainPtr = &wDomain; + WCHAR buf[MAX_PATH]; Tcl_DStringInit(bufferPtr); + wDomain = NULL; + domain = strchr(name, '@'); + if (domain != NULL) { + Tcl_DStringInit(&ds); + wName = Tcl_UtfToUniCharDString(domain + 1, -1, &ds); + badDomain = NetGetDCName(NULL, wName, (LPBYTE *) wDomainPtr); + Tcl_DStringFree(&ds); + nameLen = domain - name; + } + if (badDomain == 0) { + Tcl_DStringInit(&ds); + wName = Tcl_UtfToUniCharDString(name, nameLen, &ds); + if (NetUserGetInfo(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 + * "{Windows Drive}:/users/default". + */ - netapiInst = LoadLibraryA("netapi32.dll"); - if (netapiInst != NULL) { - NETAPIBUFFERFREEPROC *netApiBufferFreeProc; - NETGETDCNAMEPROC *netGetDCNameProc; - NETUSERGETINFOPROC *netUserGetInfoProc; - - netApiBufferFreeProc = (NETAPIBUFFERFREEPROC *) - GetProcAddress(netapiInst, "NetApiBufferFree"); - netGetDCNameProc = (NETGETDCNAMEPROC *) - GetProcAddress(netapiInst, "NetGetDCName"); - netUserGetInfoProc = (NETUSERGETINFOPROC *) - GetProcAddress(netapiInst, "NetUserGetInfo"); - if ((netUserGetInfoProc != NULL) && (netGetDCNameProc != NULL) - && (netApiBufferFreeProc != NULL)) { - USER_INFO_1 *uiPtr; - Tcl_DString ds; - int nameLen, badDomain; - char *domain; - WCHAR *wName, *wHomeDir, *wDomain; - WCHAR buf[MAX_PATH]; - - badDomain = 0; - nameLen = -1; - wDomain = NULL; - domain = strchr(name, '@'); - if (domain != NULL) { - Tcl_DStringInit(&ds); - wName = Tcl_UtfToUniCharDString(domain + 1, -1, &ds); - badDomain = (netGetDCNameProc)(NULL, wName, - (LPBYTE *) &wDomain); - 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) { - 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 - * "{Windows Drive}:/users/default". - */ - - GetWindowsDirectoryW(buf, MAX_PATH); - Tcl_UniCharToUtfDString(buf, 2, bufferPtr); - Tcl_DStringAppend(bufferPtr, "/users/default", -1); - } - result = Tcl_DStringValue(bufferPtr); - (*netApiBufferFreeProc)((void *) uiPtr); - } - Tcl_DStringFree(&ds); - } - if (wDomain != NULL) { - (*netApiBufferFreeProc)((void *) wDomain); + GetWindowsDirectoryW(buf, MAX_PATH); + Tcl_UniCharToUtfDString(buf, 2, bufferPtr); + TclDStringAppendLiteral(bufferPtr, "/users/default"); } + result = Tcl_DStringValue(bufferPtr); + NetApiBufferFree((void *) uiPtr); } - FreeLibrary(netapiInst); + Tcl_DStringFree(&ds); + } + if (wDomain != NULL) { + NetApiBufferFree((void *) wDomain); } if (result == NULL) { /* @@ -1533,30 +1525,44 @@ TclpGetUserHome( static int NativeAccess( - CONST TCHAR *nativePath, /* Path of file to access, native encoding. */ + const TCHAR *nativePath, /* Path of file to access, native encoding. */ int mode) /* Permission setting. */ { DWORD attr; - attr = (*tclWinProcs->getFileAttributesProc)(nativePath); + attr = GetFileAttributes(nativePath); - if (attr == 0xffffffff) { + if (attr == INVALID_FILE_ATTRIBUTES) { /* - * File doesn't exist. + * File might not exist. */ - TclWinConvertError(GetLastError()); - return -1; + DWORD lasterror = GetLastError(); + if (lasterror != ERROR_SHARING_VIOLATION) { + TclWinConvertError(lasterror); + return -1; + } } - if ((mode & W_OK) - && (tclWinProcs->getFileSecurityProc == NULL) - && (attr & FILE_ATTRIBUTE_READONLY)) { + if (mode == F_OK) { /* - * 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. + * File exists, nothing else to check. + */ + + return 0; + } + + if ((mode & W_OK) + && (attr & FILE_ATTRIBUTE_READONLY) + && !(attr & FILE_ATTRIBUTE_DIRECTORY)) { + /* + * The attributes say the file is not writable. If the file is a + * regular file (i.e., not a directory), then the file is not + * writable, full stop. For directories, the read-only bit is + * (mostly) ignored by Windows, so we can't ascertain anything about + * directory access from the attrib data. However, if we have the + * advanced 'getFileSecurityProc', then more robust ACL checks + * will be done below. */ Tcl_SetErrno(EACCES); @@ -1580,32 +1586,32 @@ NativeAccess( * we have a more complex permissions structure so we try to check that. * The code below is remarkably complex for such a simple thing as finding * what permissions the OS has set for a file. - * - * If we are simply checking for file existence, then we don't need all - * these complications (which are really quite slow: with this code 'file - * readable' is 5-6 times slower than 'file exists'). */ - if ((mode != F_OK) && (tclWinProcs->getFileSecurityProc != NULL)) { +#ifdef UNICODE + { SECURITY_DESCRIPTOR *sdPtr = NULL; unsigned long size; + PSID pSid = 0; + BOOL SidDefaulted; + SID_IDENTIFIER_AUTHORITY samba_unmapped = {{0, 0, 0, 0, 0, 22}}; GENERIC_MAPPING genMap; HANDLE hToken = NULL; - DWORD desiredAccess = 0; - DWORD grantedAccess = 0; + DWORD desiredAccess = 0, grantedAccess = 0; BOOL accessYesNo = FALSE; PRIVILEGE_SET privSet; DWORD privSetSize = sizeof(PRIVILEGE_SET); int error; /* - * First find out how big the buffer needs to be + * First find out how big the buffer needs to be. */ size = 0; - (*tclWinProcs->getFileSecurityProc)(nativePath, + GetFileSecurity(nativePath, OWNER_SECURITY_INFORMATION | GROUP_SECURITY_INFORMATION - | DACL_SECURITY_INFORMATION, 0, 0, &size); + | DACL_SECURITY_INFORMATION | LABEL_SECURITY_INFORMATION, + 0, 0, &size); /* * Should have failed with ERROR_INSUFFICIENT_BUFFER @@ -1618,12 +1624,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); @@ -1633,12 +1639,13 @@ NativeAccess( } /* - * Call GetFileSecurity() for real + * Call GetFileSecurity() for real. */ - if (!(*tclWinProcs->getFileSecurityProc)(nativePath, + if (!GetFileSecurity(nativePath, OWNER_SECURITY_INFORMATION | GROUP_SECURITY_INFORMATION - | DACL_SECURITY_INFORMATION, sdPtr, size, &size)) { + | DACL_SECURITY_INFORMATION | LABEL_SECURITY_INFORMATION, + sdPtr, size, &size)) { /* * Error getting owner SD */ @@ -1647,28 +1654,48 @@ NativeAccess( } /* - * Perform security impersonation of the user and open the - * resulting thread token. + * As of Samba 3.0.23 (10-Jul-2006), unmapped users and groups are + * assigned to SID domains S-1-22-1 and S-1-22-2, where "22" is the + * top-level authority. If the file owner and group is unmapped then + * the ACL access check below will only test against world access, + * which is likely to be more restrictive than the actual access + * restrictions. Since the ACL tests are more likely wrong than + * right, skip them. Moreover, the unix owner access permissions are + * usually mapped to the Windows attributes, so if the user is the + * file owner then the attrib checks above are correct (as far as they + * go). */ - if (!(*tclWinProcs->impersonateSelfProc)(SecurityImpersonation)) { + if(!GetSecurityDescriptorOwner(sdPtr,&pSid,&SidDefaulted) || + memcmp(GetSidIdentifierAuthority(pSid),&samba_unmapped, + sizeof(SID_IDENTIFIER_AUTHORITY))==0) { + HeapFree(GetProcessHeap(), 0, sdPtr); + return 0; /* Attrib tests say access allowed. */ + } + + /* + * Perform security impersonation of the user and open the resulting + * thread token. + */ + + if (!ImpersonateSelf(SecurityImpersonation)) { /* * Unable to perform security impersonation. */ - + goto accessError; } - if (!(*tclWinProcs->openThreadTokenProc)(GetCurrentThread (), + if (!OpenThreadToken(GetCurrentThread(), TOKEN_DUPLICATE | TOKEN_QUERY, FALSE, &hToken)) { /* * Unable to get current thread's token. */ - + goto accessError; } - - (*tclWinProcs->revertToSelfProc)(); - + + RevertToSelf(); + /* * Setup desiredAccess according to the access priveleges we are * checking. @@ -1684,17 +1711,17 @@ 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. */ - if (!(*tclWinProcs->accessCheckProc)(sdPtr, hToken, desiredAccess, + if (!AccessCheck(sdPtr, hToken, desiredAccess, &genMap, &privSet, &privSetSize, &grantedAccess, &accessYesNo)) { /* @@ -1716,23 +1743,15 @@ 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. - */ - if ((mode & W_OK) - && !(attr & FILE_ATTRIBUTE_DIRECTORY) - && (attr & FILE_ATTRIBUTE_READONLY)) { - Tcl_SetErrno(EACCES); - return -1; - } + } +#endif /* !UNICODE */ return 0; } @@ -1752,58 +1771,22 @@ NativeAccess( static int NativeIsExec( - CONST TCHAR *nativePath) + const TCHAR *path) { - if (tclWinProcs->useWide) { - CONST WCHAR *path; - int len; - - path = (CONST WCHAR*)nativePath; - len = wcslen(path); - - if (len < 5) { - return 0; - } - - if (path[len-4] != L'.') { - return 0; - } - - /* - * Use wide-char case-insensitive comparison - */ - - if ((_wcsicmp(path+len-3,L"exe") == 0) - || (_wcsicmp(path+len-3,L"com") == 0) - || (_wcsicmp(path+len-3,L"bat") == 0)) { - return 1; - } - } else { - CONST char *p; + int len = _tcslen(path); - /* - * We are only looking for pure ascii. - */ - - p = strrchr((CONST char*)nativePath, '.'); - if (p != NULL) { - p++; - - /* - * Note: in the old code, stat considered '.pif' files as - * executable, whereas access did not. - */ + if (len < 5) { + return 0; + } - if ((stricmp(p, "exe") == 0) - || (stricmp(p, "com") == 0) - || (stricmp(p, "bat") == 0)) { - /* - * File that ends with .exe, .com, or .bat is executable. - */ + if (path[len-4] != '.') { + return 0; + } - return 1; - } - } + if ((_tcsicmp(path+len-3, TEXT("exe")) == 0) + || (_tcsicmp(path+len-3, TEXT("com")) == 0) + || (_tcsicmp(path+len-3, TEXT("bat")) == 0)) { + return 1; } return 0; } @@ -1829,28 +1812,14 @@ TclpObjChdir( Tcl_Obj *pathPtr) /* Path to new working directory. */ { int result; - CONST TCHAR *nativePath; -#ifdef __CYGWIN__ - extern int cygwin_conv_to_posix_path(CONST char *, char *); - char posixPath[MAX_PATH+1]; - CONST char *path; - Tcl_DString ds; -#endif /* __CYGWIN__ */ + const TCHAR *nativePath; - nativePath = (CONST TCHAR *) Tcl_FSGetNativePath(pathPtr); + nativePath = Tcl_FSGetNativePath(pathPtr); -#ifdef __CYGWIN__ - /* - * 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); - Tcl_DStringFree(&ds); -#else /* __CYGWIN__ */ - result = (*tclWinProcs->setCurrentDirectoryProc)(nativePath); -#endif /* __CYGWIN__ */ + if (!nativePath) { + return -1; + } + result = SetCurrentDirectory(nativePath); if (result == 0) { TclWinConvertError(GetLastError()); @@ -1859,51 +1828,6 @@ TclpObjChdir( return 0; } -#ifdef __CYGWIN__ -/* - *--------------------------------------------------------------------------- - * - * TclpReadlink -- - * - * 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. - * - * Side effects: - * See readlink() documentation. - * - *--------------------------------------------------------------------------- - */ - -char * -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; - char *native; - Tcl_DString ds; - - native = Tcl_UtfToExternalDString(NULL, path, -1, &ds); - length = readlink(native, link, sizeof(link)); /* INTL: Native. */ - Tcl_DStringFree(&ds); - - if (length < 0) { - return NULL; - } - - Tcl_ExternalToUtfDString(NULL, link, length, linkPtr); - return Tcl_DStringValue(linkPtr); -} -#endif /* __CYGWIN__ */ - /* *---------------------------------------------------------------------- * @@ -1926,20 +1850,22 @@ TclpReadlink( *---------------------------------------------------------------------- */ -CONST char * +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]; + TCHAR buffer[MAX_PATH]; char *p; + WCHAR *native; - if ((*tclWinProcs->getCurrentDirectoryProc)(MAX_PATH, buffer) == 0) { + if (GetCurrentDirectory(MAX_PATH, buffer) == 0) { TclWinConvertError(GetLastError()); if (interp != NULL) { - Tcl_AppendResult(interp, "error getting working directory name: ", - Tcl_PosixError(interp), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "error getting working directory name: %s", + Tcl_PosixError(interp))); } return NULL; } @@ -1948,25 +1874,12 @@ TclpGetCwd( * Watch for the weird Windows c:\\UNC syntax. */ - if (tclWinProcs->useWide) { - WCHAR *native; - - native = (WCHAR *) buffer; - if ((native[0] != '\0') && (native[1] == ':') - && (native[2] == '\\') && (native[3] == '\\')) { - native += 2; - } - Tcl_WinTCharToUtf((TCHAR *) native, -1, bufferPtr); - } else { - char *native; - - native = (char *) buffer; - if ((native[0] != '\0') && (native[1] == ':') - && (native[2] == '\\') && (native[3] == '\\')) { - native += 2; - } - Tcl_WinTCharToUtf((TCHAR *) native, -1, bufferPtr); + native = (WCHAR *) buffer; + if ((native[0] != '\0') && (native[1] == ':') + && (native[2] == '\\') && (native[3] == '\\')) { + native += 2; } + Tcl_WinTCharToUtf((TCHAR *) native, -1, bufferPtr); /* * Convert to forward slashes for easier use in scripts. @@ -1993,7 +1906,7 @@ TclpObjStat( TclWinFlushDirtyChannels(); - return NativeStat((CONST TCHAR*) Tcl_FSGetNativePath(pathPtr), statPtr, 0); + return NativeStat(Tcl_FSGetNativePath(pathPtr), statPtr, 0); } /* @@ -2021,28 +1934,27 @@ TclpObjStat( static int NativeStat( - CONST TCHAR *nativePath, /* Path of file to stat */ + const TCHAR *nativePath, /* Path of file to stat */ Tcl_StatBuf *statPtr, /* Filled with results of stat call. */ int checkLinks) /* If non-zero, behave like 'lstat' */ { DWORD attr; - int dev; + int dev, nlink = 1; unsigned short mode; - int nlink = 1; 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. + * 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); + + fileHandle = CreateFile(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; @@ -2056,92 +1968,62 @@ NativeStat( attr = data.dwFileAttributes; - statPtr->st_size = ((Tcl_WideInt)data.nFileSizeLow) | - (((Tcl_WideInt)data.nFileSizeHigh) << 32); + statPtr->st_size = ((Tcl_WideInt) data.nFileSizeLow) | + (((Tcl_WideInt) data.nFileSizeHigh) << 32); statPtr->st_atime = ToCTime(data.ftLastAccessTime); statPtr->st_mtime = ToCTime(data.ftLastWriteTime); statPtr->st_ctime = ToCTime(data.ftCreationTime); /* - * On Unix, for directories, nlink apparently depends on the - * number of 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. + * 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'. + * 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) { + } else { /* - * Fall back on the less capable routines. This means - * no nlink or ino. + * Fall back on the less capable routines. This means no nlink or ino. */ WIN32_FILE_ATTRIBUTE_DATA data; - if ((*tclWinProcs->getFileAttributesExProc)(nativePath, + if (GetFileAttributesEx(nativePath, GetFileExInfoStandard, &data) != TRUE) { - Tcl_SetErrno(ENOENT); - return -1; + HANDLE hFind; + WIN32_FIND_DATA ffd; + DWORD lasterror = GetLastError(); + + if (lasterror != ERROR_SHARING_VIOLATION) { + TclWinConvertError(lasterror); + return -1; + } + hFind = FindFirstFile(nativePath, &ffd); + if (hFind == INVALID_HANDLE_VALUE) { + TclWinConvertError(GetLastError()); + return -1; + } + memcpy(&data, &ffd, sizeof(data)); + FindClose(hFind); } attr = data.dwFileAttributes; - statPtr->st_size = ((Tcl_WideInt)data.nFileSizeLow) | - (((Tcl_WideInt)data.nFileSizeHigh) << 32); + statPtr->st_size = ((Tcl_WideInt) data.nFileSizeLow) | + (((Tcl_WideInt) data.nFileSizeHigh) << 32); statPtr->st_atime = ToCTime(data.ftLastAccessTime); statPtr->st_mtime = ToCTime(data.ftLastWriteTime); statPtr->st_ctime = ToCTime(data.ftCreationTime); - } else { - /* - * We don't have the faster attributes proc, so we're probably - * running on Win95. - */ - - WIN32_FIND_DATAT data; - HANDLE handle; - - handle = (*tclWinProcs->findFirstFileProc)(nativePath, &data); - if (handle == INVALID_HANDLE_VALUE) { - /* - * FindFirstFile() doesn't work on root directories, so call - * GetFileAttributes() to see if the specified file exists. - */ - - attr = (*tclWinProcs->getFileAttributesProc)(nativePath); - if (attr == INVALID_FILE_ATTRIBUTES) { - Tcl_SetErrno(ENOENT); - return -1; - } - - /* - * Make up some fake information for this file. It has the - * correct file attributes and a time of 0. - */ - - memset(&data, 0, sizeof(data)); - data.a.dwFileAttributes = attr; - } else { - FindClose(handle); - } - - attr = data.a.dwFileAttributes; - - statPtr->st_size = ((Tcl_WideInt)data.a.nFileSizeLow) | - (((Tcl_WideInt)data.a.nFileSizeHigh) << 32); - statPtr->st_atime = ToCTime(data.a.ftLastAccessTime); - statPtr->st_mtime = ToCTime(data.a.ftLastWriteTime); - statPtr->st_ctime = ToCTime(data.a.ftCreationTime); } dev = NativeDev(nativePath); @@ -2169,49 +2051,46 @@ NativeStat( static int NativeDev( - CONST TCHAR *nativePath) /* Full path of file to stat */ + const TCHAR *nativePath) /* Full path of file to stat */ { int dev; Tcl_DString ds; - WCHAR nativeFullPath[MAX_PATH]; + TCHAR nativeFullPath[MAX_PATH]; TCHAR *nativePart; - CONST char *fullPath; - - (*tclWinProcs->getFullPathNameProc)(nativePath, MAX_PATH, - nativeFullPath, &nativePart); + const char *fullPath; - fullPath = Tcl_WinTCharToUtf((TCHAR*)nativeFullPath, -1, &ds); + GetFullPathName(nativePath, MAX_PATH, nativeFullPath, &nativePart); + fullPath = Tcl_WinTCharToUtf(nativeFullPath, -1, &ds); if ((fullPath[0] == '\\') && (fullPath[1] == '\\')) { - CONST char *p; + const char *p; DWORD dw; - CONST TCHAR *nativeVol; + 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. + * Add terminating backslash to fullpath or GetVolumeInformation() + * won't work. */ - fullPath = Tcl_DStringAppend(&ds, "\\", 1); + fullPath = TclDStringAppendLiteral(&ds, "\\"); 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); + GetVolumeInformation(nativeVol, NULL, 0, &dw, NULL, NULL, NULL, 0); /* - * GetFullPathName() turns special devices like "NUL" into - * "\\.\NUL", but GetVolumeInformation() returns failure for - * "\\.\NUL". This will cause "NUL" to get a drive number of -1, - * which makes about as much sense as anything since the special - * devices don't live on any drive. + * 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; @@ -2246,6 +2125,7 @@ NativeStatMode( int isExec) { int mode; + if (checkLinks && (attr & FILE_ATTRIBUTE_REPARSE_POINT)) { /* * It is a link. @@ -2253,9 +2133,9 @@ NativeStatMode( 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; } @@ -2265,9 +2145,9 @@ NativeStatMode( * positions. */ - mode |= (mode & 0x0700) >> 3; - mode |= (mode & 0x0700) >> 6; - return (unsigned short)mode; + mode |= (mode & (S_IREAD|S_IWRITE|S_IEXEC)) >> 3; + mode |= (mode & (S_IREAD|S_IWRITE|S_IEXEC)) >> 6; + return (unsigned short) mode; } /* @@ -2292,8 +2172,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); } /* @@ -2312,93 +2192,16 @@ ToCTime( static void FromCTime( time_t posixTime, - FILETIME* fileTime) /* UTC Time */ + FILETIME *fileTime) /* UTC Time */ { LARGE_INTEGER convertedTime; + convertedTime.QuadPart = ((LONGLONG) posixTime) * 10000000 - + POSIX_EPOCH_AS_FILETIME; + + POSIX_EPOCH_AS_FILETIME; fileTime->dwLowDateTime = convertedTime.LowPart; fileTime->dwHighDateTime = convertedTime.HighPart; } -#if 0 -/* - *------------------------------------------------------------------------- - * - * TclWinResolveShortcut -- - * - * Resolve a potential Windows shortcut to get the actual file or - * directory in question. - * - * 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. - * - * Side effects: - * Loads and unloads OLE package to determine if filename refers to a - * shortcut. - * - *------------------------------------------------------------------------- - */ - -int -TclWinResolveShortcut( - Tcl_DString *bufferPtr) /* Holds name of file to resolve. On return, - * holds resolved file name. */ -{ - HRESULT hres; - IShellLink *psl; - IPersistFile *ppf; - WIN32_FIND_DATA wfd; - WCHAR wpath[MAX_PATH]; - char *path, *ext; - char realFileName[MAX_PATH]; - - /* - * Windows system calls do not automatically resolve shortcuts like UNIX - * automatically will with symbolic links. - */ - - 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; - } - return 0; -} -#endif - /* *--------------------------------------------------------------------------- * @@ -2424,34 +2227,20 @@ ClientData TclpGetNativeCwd( ClientData clientData) { - WCHAR buffer[MAX_PATH]; + TCHAR buffer[MAX_PATH]; - if ((*tclWinProcs->getCurrentDirectoryProc)(MAX_PATH, buffer) == 0) { + if (GetCurrentDirectory(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. - */ - - if (strcmp((CONST char*)clientData, (CONST char*)buffer) == 0) { - return clientData; - } + if (_tcscmp((const TCHAR*)clientData, buffer) == 0) { + return clientData; } } - return TclNativeDupInternalRep((ClientData)buffer); + return TclNativeDupInternalRep(buffer); } int @@ -2459,7 +2248,7 @@ TclpObjAccess( Tcl_Obj *pathPtr, int mode) { - return NativeAccess((CONST TCHAR *) Tcl_FSGetNativePath(pathPtr), mode); + return NativeAccess(Tcl_FSGetNativePath(pathPtr), mode); } int @@ -2475,11 +2264,11 @@ TclpObjLstat( TclWinFlushDirtyChannels(); - return NativeStat((CONST TCHAR*) Tcl_FSGetNativePath(pathPtr), statPtr, 1); + return NativeStat(Tcl_FSGetNativePath(pathPtr), statPtr, 1); } #ifdef S_IFLNK -Tcl_Obj* +Tcl_Obj * TclpObjLink( Tcl_Obj *pathPtr, Tcl_Obj *toPtr, @@ -2487,15 +2276,15 @@ TclpObjLink( { if (toPtr != NULL) { int res; - TCHAR *LinkTarget; - TCHAR *LinkSource = (TCHAR *) Tcl_FSGetNativePath(pathPtr); + const TCHAR *LinkTarget; + const TCHAR *LinkSource = Tcl_FSGetNativePath(pathPtr); Tcl_Obj *normalizedToPtr = Tcl_FSGetNormalizedPath(NULL, toPtr); if (normalizedToPtr == NULL) { return NULL; } - LinkTarget = (TCHAR *) Tcl_FSGetNativePath(normalizedToPtr); + LinkTarget = Tcl_FSGetNativePath(normalizedToPtr); if (LinkSource == NULL || LinkTarget == NULL) { return NULL; @@ -2507,7 +2296,7 @@ TclpObjLink( return NULL; } } else { - TCHAR *LinkSource = (TCHAR *) Tcl_FSGetNativePath(pathPtr); + const TCHAR *LinkSource = Tcl_FSGetNativePath(pathPtr); if (LinkSource == NULL) { return NULL; @@ -2515,7 +2304,7 @@ TclpObjLink( return WinReadLink(LinkSource); } } -#endif +#endif /* S_IFLNK */ /* *--------------------------------------------------------------------------- @@ -2535,15 +2324,15 @@ TclpObjLink( *--------------------------------------------------------------------------- */ -Tcl_Obj* +Tcl_Obj * TclpFilesystemPathType( - Tcl_Obj* pathPtr) + Tcl_Obj *pathPtr) { #define VOL_BUF_SIZE 32 int found; - WCHAR volType[VOL_BUF_SIZE]; - char* firstSeparator; - CONST char *path; + TCHAR volType[VOL_BUF_SIZE]; + char *firstSeparator; + const char *path; Tcl_Obj *normPath = Tcl_FSGetNormalizedPath(NULL, pathPtr); if (normPath == NULL) { @@ -2556,16 +2345,14 @@ TclpFilesystemPathType( firstSeparator = strchr(path, '/'); if (firstSeparator == NULL) { - found = tclWinProcs->getVolumeInformationProc( - Tcl_FSGetNativePath(pathPtr), NULL, 0, NULL, NULL, NULL, - (WCHAR *) volType, VOL_BUF_SIZE); + found = GetVolumeInformation(Tcl_FSGetNativePath(pathPtr), + NULL, 0, NULL, NULL, NULL, volType, VOL_BUF_SIZE); } else { Tcl_Obj *driveName = Tcl_NewStringObj(path, firstSeparator - path+1); Tcl_IncrRefCount(driveName); - found = tclWinProcs->getVolumeInformationProc( - Tcl_FSGetNativePath(driveName), NULL, 0, NULL, NULL, NULL, - (WCHAR *) volType, VOL_BUF_SIZE); + found = GetVolumeInformation(Tcl_FSGetNativePath(driveName), + NULL, 0, NULL, NULL, NULL, volType, VOL_BUF_SIZE); Tcl_DecrRefCount(driveName); } @@ -2573,13 +2360,9 @@ TclpFilesystemPathType( return NULL; } else { Tcl_DString ds; - Tcl_Obj *objPtr; - Tcl_WinTCharToUtf((CONST char *)volType, -1, &ds); - objPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), - Tcl_DStringLength(&ds)); - Tcl_DStringFree(&ds); - return objPtr; + Tcl_WinTCharToUtf(volType, -1, &ds); + return TclDStringToObj(&ds); } #undef VOL_BUF_SIZE } @@ -2627,360 +2410,221 @@ TclpObjNormalizePath( { char *lastValidPathEnd = NULL; Tcl_DString dsNorm; /* This will hold the normalized string. */ - char *path; - char *currentPathEndPosition; + char *path, *currentPathEndPosition; + Tcl_Obj *temp = NULL; + int isDrive = 1; + Tcl_DString ds; /* Some workspace. */ 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. - */ - - int isDrive = 1; - Tcl_DString ds; - - currentPathEndPosition = path + nextCheckpoint; - if (*currentPathEndPosition == '/') { - currentPathEndPosition++; - } + currentPathEndPosition = path + nextCheckpoint; + if (*currentPathEndPosition == '/') { + currentPathEndPosition++; + } + while (1) { + char cur = *currentPathEndPosition; - 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. + */ - CONST char *nativePath = Tcl_UtfToExternalDString(NULL, path, - currentPathEndPosition - path, &ds); + WIN32_FILE_ATTRIBUTE_DATA data; + const TCHAR *nativePath = Tcl_WinUtfToTChar(path, + currentPathEndPosition - path, &ds); + if (GetFileAttributesEx(nativePath, + GetFileExInfoStandard, &data) != TRUE) { /* - * 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. + * File doesn't exist. */ if (isDrive) { - 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. - */ - - int i; - - for (i=0;i<len;i++) { - if (nativePath[i] >= 'a') { - ((char*)nativePath)[i] -= ('a' - 'A'); - } - } - Tcl_DStringAppend(&dsNorm, nativePath, len); - lastValidPathEnd = currentPathEndPosition; - } - } - Tcl_DStringFree(&ds); - break; - } - if (nativePath[0] >= 'a') { - ((char*)nativePath)[0] -= ('a' - 'A'); - } - Tcl_DStringAppend(&dsNorm, nativePath, - Tcl_DStringLength(&ds)); - } else { - char *checkDots = NULL; - - if (lastValidPathEnd[1] == '.') { - checkDots = lastValidPathEnd + 1; - while (checkDots < currentPathEndPosition) { - if (*checkDots != '.') { - checkDots = NULL; - break; - } - checkDots++; - } - } - if (checkDots != NULL) { - int dotLen = currentPathEndPosition - lastValidPathEnd; + int len = WinIsReserved(path); + if (len > 0) { /* - * 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 + * Actually it does exist - COM1, etc. */ - Tcl_DStringAppend(&dsNorm, (TCHAR *) - (nativePath + Tcl_DStringLength(&ds) - dotLen), - dotLen); - } else { - /* - * Normal path. - */ + int i; - WIN32_FIND_DATA fData; - HANDLE handle; + for (i=0 ; i<len ; i++) { + WCHAR wc = ((WCHAR *) nativePath)[i]; - handle = FindFirstFileA(nativePath, &fData); - if (handle == INVALID_HANDLE_VALUE) { - if (GetFileAttributesA(nativePath) == INVALID_FILE_ATTRIBUTES) { - /* - * File doesn't exist. - */ - - Tcl_DStringFree(&ds); - break; + if (wc >= L'a') { + wc -= (L'a' - L'A'); + ((WCHAR *) nativePath)[i] = wc; } - - /* - * This is usually the '/' in 'c:/' at end of - * string. - */ - - Tcl_DStringAppend(&dsNorm,"/", 1); - } else { - char *nativeName; - - if (fData.cFileName[0] != '\0') { - nativeName = fData.cFileName; - } else { - nativeName = fData.cAlternateFileName; - } - FindClose(handle); - Tcl_DStringAppend(&dsNorm,"/", 1); - Tcl_DStringAppend(&dsNorm,nativeName,-1); } + Tcl_DStringAppend(&dsNorm, + (const char *)nativePath, + (int)(sizeof(WCHAR) * len)); + lastValidPathEnd = currentPathEndPosition; + } else if (nextCheckpoint == 0) { + /* Path starts with a drive designation + * that's not actually on the system. + * We still must normalize up past the + * first separator. [Bug 3603434] */ + currentPathEndPosition++; } } Tcl_DStringFree(&ds); - lastValidPathEnd = currentPathEndPosition; - if (cur == 0) { - break; - } - - /* - * If we get here, we've got past one directory delimiter, so - * we know it is no longer a drive. - */ - - isDrive = 0; + break; } - currentPathEndPosition++; - } - } else { - /* - * We're on WinNT (or 2000 or XP; something with an NT core). - */ - Tcl_Obj *temp = NULL; - int isDrive = 1; - Tcl_DString ds; + /* + * 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. + */ - currentPathEndPosition = path + nextCheckpoint; - if (*currentPathEndPosition == '/') { - currentPathEndPosition++; - } - while (1) { - char cur = *currentPathEndPosition; - if ((cur == '/' || cur == 0) && (path != currentPathEndPosition)) { - /* - * Reached directory separator, or end of string. - */ + /* + * 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. + */ - WIN32_FILE_ATTRIBUTE_DATA data; - CONST char *nativePath = Tcl_WinUtfToTChar(path, - currentPathEndPosition - path, &ds); + if (cur != 0 && !isDrive && + data.dwFileAttributes & FILE_ATTRIBUTE_REPARSE_POINT){ + Tcl_Obj *to = WinReadLinkDirectory(nativePath); - if ((*tclWinProcs->getFileAttributesExProc)(nativePath, - GetFileExInfoStandard, &data) != TRUE) { + if (to != NULL) { /* - * File doesn't exist. + * 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. */ - if (isDrive) { - int len = WinIsReserved(path); - - if (len > 0) { - /* - * Actually it does exist - COM1, etc. - */ + nextCheckpoint = 0; + Tcl_AppendToObj(to, currentPathEndPosition, -1); - int i; + /* + * Convert link to forward slashes. + */ - for (i=0;i<len;i++) { - WCHAR wc = ((WCHAR*)nativePath)[i]; - if (wc >= L'a') { - wc -= (L'a' - L'A'); - ((WCHAR*)nativePath)[i] = wc; - } - } - Tcl_DStringAppend(&dsNorm, nativePath, - (int)(sizeof(WCHAR)*len)); - lastValidPathEnd = currentPathEndPosition; + for (path = Tcl_GetString(to); *path != 0; path++) { + if (*path == '\\') { + *path = '/'; } } - Tcl_DStringFree(&ds); - break; - } - - /* - * File 'nativePath' does exist if we get here. We now want to - * check if it is a symlink and otherwise continue with the - * rest of the path. - */ - - /* - * Check for symlinks, except at last component of path (we - * don't follow final symlinks). Also a drive (C:/) for - * example, may sometimes have the reparse flag set for some - * reason I don't understand. We therefore don't perform this - * check for drives. - */ + path = Tcl_GetString(to); + currentPathEndPosition = path + nextCheckpoint; + if (temp != NULL) { + Tcl_DecrRefCount(temp); + } + temp = to; - if (cur != 0 && !isDrive && - (data.dwFileAttributes&FILE_ATTRIBUTE_REPARSE_POINT)) { - Tcl_Obj *to = WinReadLinkDirectory(nativePath); + /* + * Reset variables so we can restart normalization. + */ - if (to != NULL) { - /* - * Read the reparse point ok. Now, reparse points need - * not be normalized, otherwise we could use: - * - * Tcl_GetStringFromObj(to, &pathLen); - * nextCheckpoint = pathLen - * - * So, instead we have to start from the beginning. - */ + isDrive = 1; + Tcl_DStringFree(&dsNorm); + Tcl_DStringFree(&ds); + continue; + } + } - nextCheckpoint = 0; - Tcl_AppendToObj(to, currentPathEndPosition, -1); +#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 + */ - /* - * Convert link to forward slashes. - */ + if (isDrive) { + WCHAR drive = ((WCHAR *) nativePath)[0]; - for (path = Tcl_GetString(to); *path != 0; path++) { - if (*path == '\\') *path = '/'; - } - path = Tcl_GetString(to); - currentPathEndPosition = path + nextCheckpoint; - if (temp != NULL) { - Tcl_DecrRefCount(temp); + if (drive >= L'a') { + drive -= (L'a' - L'A'); + ((WCHAR *) nativePath)[0] = drive; + } + Tcl_DStringAppend(&dsNorm, (const char *)nativePath, + Tcl_DStringLength(&ds)); + } else { + char *checkDots = NULL; + + if (lastValidPathEnd[1] == '.') { + checkDots = lastValidPathEnd + 1; + while (checkDots < currentPathEndPosition) { + if (*checkDots != '.') { + checkDots = NULL; + break; } - temp = to; - - /* - * Reset variables so we can restart normalization. - */ - - isDrive = 1; - Tcl_DStringFree(&dsNorm); - Tcl_DStringInit(&dsNorm); - Tcl_DStringFree(&ds); - continue; + checkDots++; } } + if (checkDots != NULL) { + int dotLen = currentPathEndPosition-lastValidPathEnd; -#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 - */ + /* + * 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. + */ - if (isDrive) { - WCHAR drive = ((WCHAR*)nativePath)[0]; - if (drive >= L'a') { - drive -= (L'a' - L'A'); - ((WCHAR*)nativePath)[0] = drive; - } - Tcl_DStringAppend(&dsNorm, nativePath, - Tcl_DStringLength(&ds)); + Tcl_DStringAppend(&dsNorm, ((const char *)nativePath) + + Tcl_DStringLength(&ds) + - (dotLen * sizeof(TCHAR)), + (int)(dotLen * sizeof(TCHAR))); } else { - char *checkDots = NULL; - - if (lastValidPathEnd[1] == '.') { - checkDots = lastValidPathEnd + 1; - while (checkDots < currentPathEndPosition) { - if (*checkDots != '.') { - checkDots = NULL; - break; - } - checkDots++; - } - } - if (checkDots != NULL) { - int dotLen = currentPathEndPosition - lastValidPathEnd; + /* + * Normal path. + */ - /* - * 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. - */ + WIN32_FIND_DATAW fData; + HANDLE handle; - Tcl_DStringAppend(&dsNorm, (TCHAR *) - ((WCHAR*)(nativePath + Tcl_DStringLength(&ds)) - - dotLen), (int)(dotLen * sizeof(WCHAR))); - } else { + handle = FindFirstFileW((WCHAR *) nativePath, &fData); + if (handle == INVALID_HANDLE_VALUE) { /* - * Normal path. + * This is usually the '/' in 'c:/' at end of + * string. */ - WIN32_FIND_DATAW fData; - HANDLE handle; - - handle = FindFirstFileW((WCHAR*)nativePath, &fData); - if (handle == INVALID_HANDLE_VALUE) { - /* - * This is usually the '/' in 'c:/' at end of - * string. - */ + Tcl_DStringAppend(&dsNorm, (const char *) L"/", + sizeof(WCHAR)); + } else { + WCHAR *nativeName; - Tcl_DStringAppend(&dsNorm,(CONST char*)L"/", - sizeof(WCHAR)); + if (fData.cFileName[0] != '\0') { + nativeName = fData.cFileName; } 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))); + nativeName = fData.cAlternateFileName; } + FindClose(handle); + Tcl_DStringAppend(&dsNorm, (const char *) L"/", + sizeof(WCHAR)); + Tcl_DStringAppend(&dsNorm, + (const char *) nativeName, + (int) (wcslen(nativeName)*sizeof(WCHAR))); } } -#endif - Tcl_DStringFree(&ds); - lastValidPathEnd = currentPathEndPosition; - if (cur == 0) { - break; - } + } +#endif /* !TclNORM_LONG_PATH */ + Tcl_DStringFree(&ds); + lastValidPathEnd = currentPathEndPosition; + if (cur == 0) { + break; + } - /* - * If we get here, we've got past one directory delimiter, so - * we know it is no longer a drive. - */ + /* + * If we get here, we've got past one directory delimiter, so + * we know it is no longer a drive. + */ - isDrive = 0; - } - currentPathEndPosition++; + isDrive = 0; } + currentPathEndPosition++; #ifdef TclNORM_LONG_PATH /* @@ -2989,10 +2633,10 @@ TclpObjNormalizePath( if (1) { WCHAR wpath[MAX_PATH]; - CONST char *nativePath = + const TCHAR *nativePath = Tcl_WinUtfToTChar(path, lastValidPathEnd - path, &ds); - DWORD wpathlen = (*tclWinProcs->getLongPathNameProc)( - nativePath, (TCHAR *) wpath, MAX_PATH); + DWORD wpathlen = GetLongPathNameProc(nativePath, + (TCHAR *) wpath, MAX_PATH); /* * We have to make the drive letter uppercase. @@ -3001,10 +2645,11 @@ TclpObjNormalizePath( if (wpath[0] >= L'a') { wpath[0] -= (L'a' - L'A'); } - Tcl_DStringAppend(&dsNorm, (TCHAR*)wpath, wpathlen*sizeof(WCHAR)); + Tcl_DStringAppend(&dsNorm, (const char *) wpath, + wpathlen * sizeof(WCHAR)); Tcl_DStringFree(&ds); } -#endif +#endif /* TclNORM_LONG_PATH */ } /* @@ -3019,11 +2664,9 @@ TclpObjNormalizePath( * native encoding, so we have to convert it to Utf. */ - Tcl_DString dsTemp; - - Tcl_WinTCharToUtf(Tcl_DStringValue(&dsNorm), - Tcl_DStringLength(&dsNorm), &dsTemp); - nextCheckpoint = Tcl_DStringLength(&dsTemp); + Tcl_WinTCharToUtf((const TCHAR *) Tcl_DStringValue(&dsNorm), + Tcl_DStringLength(&dsNorm), &ds); + nextCheckpoint = Tcl_DStringLength(&ds); if (*lastValidPathEnd != 0) { /* * Not the end of the string. @@ -3033,7 +2676,7 @@ TclpObjNormalizePath( char *path; Tcl_Obj *tmpPathPtr; - tmpPathPtr = Tcl_NewStringObj(Tcl_DStringValue(&dsTemp), + tmpPathPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), nextCheckpoint); Tcl_AppendToObj(tmpPathPtr, lastValidPathEnd, -1); path = Tcl_GetStringFromObj(tmpPathPtr, &len); @@ -3044,12 +2687,21 @@ TclpObjNormalizePath( * End of string was reached above. */ - Tcl_SetStringObj(pathPtr, Tcl_DStringValue(&dsTemp), - nextCheckpoint); + Tcl_SetStringObj(pathPtr, Tcl_DStringValue(&ds), nextCheckpoint); } - Tcl_DStringFree(&dsTemp); + Tcl_DStringFree(&ds); } Tcl_DStringFree(&dsNorm); + + /* + * This must be done after we are totally finished with 'path' as we are + * sharing the same underlying string. + */ + + if (temp != NULL) { + Tcl_DecrRefCount(temp); + } + return nextCheckpoint; } @@ -3080,7 +2732,7 @@ TclpObjNormalizePath( Tcl_Obj * TclWinVolumeRelativeNormalize( Tcl_Interp *interp, - CONST char *path, + const char *path, Tcl_Obj **useThisCwdPtr) { Tcl_Obj *absolutePath, *useThisCwd; @@ -3096,7 +2748,7 @@ TclWinVolumeRelativeNormalize( * current volume. */ - CONST char *drive = Tcl_GetString(useThisCwd); + const char *drive = Tcl_GetString(useThisCwd); absolutePath = Tcl_NewStringObj(drive,2); Tcl_AppendToObj(absolutePath, path, -1); @@ -3112,7 +2764,7 @@ TclWinVolumeRelativeNormalize( */ int cwdLen; - CONST char *drive = + const char *drive = Tcl_GetStringFromObj(useThisCwd, &cwdLen); char drive_cur = path[0]; @@ -3187,11 +2839,9 @@ TclpNativeToNormalized( Tcl_DString ds; Tcl_Obj *objPtr; int len; + char *copy, *p; - char *copy; - char *p; - Tcl_WinTCharToUtf((CONST char*)clientData, -1, &ds); - + Tcl_WinTCharToUtf((const TCHAR *) clientData, -1, &ds); copy = Tcl_DStringValue(&ds); len = Tcl_DStringLength(&ds); @@ -3247,11 +2897,11 @@ ClientData TclNativeCreateNativeRep( Tcl_Obj *pathPtr) { - char *nativePathPtr; - Tcl_DString ds; - Tcl_Obj* validPathPtr; + WCHAR *nativePathPtr; + const char *str; + Tcl_Obj *validPathPtr; int len; - char *str; + WCHAR *wp; if (TclFSCwdIsNative()) { /* @@ -3277,25 +2927,73 @@ TclNativeCreateNativeRep( } 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 = '\\'; - } + + if (strlen(str)!=len) { + /* String contains NUL-bytes. This is invalid. */ + return 0; } - Tcl_WinUtfToTChar(str, len, &ds); - if (tclWinProcs->useWide) { - len = Tcl_DStringLength(&ds) + sizeof(WCHAR); - } else { - len = Tcl_DStringLength(&ds) + sizeof(char); + /* Let MultiByteToWideChar check for other invalid sequences, like + * 0xC0 0x80 (== overlong NUL). See bug [3118489]: NUL in filenames */ + len = MultiByteToWideChar(CP_UTF8, MB_ERR_INVALID_CHARS, str, -1, 0, 0); + if (len==0) { + return 0; } - Tcl_DecrRefCount(validPathPtr); - nativePathPtr = ckalloc((unsigned) len); - memcpy((VOID*)nativePathPtr, (VOID*)Tcl_DStringValue(&ds), (size_t) len); - - Tcl_DStringFree(&ds); - return (ClientData)nativePathPtr; + /* Overallocate 6 chars, making some room for extended paths */ + wp = nativePathPtr = ckalloc( (len+6) * sizeof(WCHAR) ); + if (nativePathPtr==0) { + return 0; + } + MultiByteToWideChar(CP_UTF8, MB_ERR_INVALID_CHARS, str, -1, nativePathPtr, len); + /* + ** If path starts with "//?/" or "\\?\" (extended path), translate + ** any slashes to backslashes but leave the '?' intact + */ + if ((str[0]=='\\' || str[0]=='/') && (str[1]=='\\' || str[1]=='/') + && str[2]=='?' && (str[3]=='\\' || str[3]=='/')) { + wp[0] = wp[1] = wp[3] = '\\'; + str += 4; + wp += 4; + } + /* + ** If there is no "\\?\" prefix but there is a drive or UNC + ** path prefix and the path is larger than MAX_PATH chars, + ** no Win32 API function can handle that unless it is + ** prefixed with the extended path prefix. See: + ** <http://msdn.microsoft.com/en-us/library/aa365247(VS.85).aspx#maxpath> + **/ + if (((str[0]>='A'&&str[0]<='Z') || (str[0]>='a'&&str[0]<='z')) + && str[1]==':' && (str[2]=='\\' || str[2]=='/')) { + if (wp==nativePathPtr && len>MAX_PATH) { + memmove(wp+4, wp, len*sizeof(WCHAR)); + memcpy(wp, L"\\\\?\\", 4*sizeof(WCHAR)); + wp += 4; + } + /* + ** If (remainder of) path starts with "<drive>:/" or "<drive>:\", + ** leave the ':' intact but translate the backslash to a slash. + */ + wp[2] = '\\'; + wp += 3; + } else if (wp==nativePathPtr && len>MAX_PATH + && (str[0]=='\\' || str[0]=='/') + && (str[1]=='\\' || str[1]=='/') && str[2]!='?') { + memmove(wp+6, wp, len*sizeof(WCHAR)); + memcpy(wp, L"\\\\?\\UNC", 7*sizeof(WCHAR)); + wp += 7; + } + /* + ** In the remainder of the path, translate invalid characters to + ** characters in the Unicode private use area. + */ + while (*wp != '\0') { + if ((*wp < ' ') || wcschr(L"\"*:<>?|", *wp)) { + *wp |= 0xF000; + } else if (*wp == '/') { + *wp = '\\'; + } + ++wp; + } + return nativePathPtr; } /* @@ -3326,23 +3024,11 @@ TclNativeDupInternalRep( 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(TCHAR) * (_tcslen((const TCHAR *) clientData) + 1); - len = sizeof(char) * (strlen((CONST char *) clientData) + 1); - } - - copy = (char *) ckalloc(len); - memcpy((VOID *) copy, (VOID *) clientData, len); - return (ClientData) copy; + copy = ckalloc(len); + memcpy(copy, clientData, len); + return copy; } /* @@ -3369,17 +3055,17 @@ TclpUtime( { int res = 0; HANDLE fileHandle; - CONST TCHAR *native; + const TCHAR *native; DWORD attr = 0; DWORD flags = FILE_ATTRIBUTE_NORMAL; FILETIME lastAccessTime, lastModTime; FromCTime(tval->actime, &lastAccessTime); FromCTime(tval->modtime, &lastModTime); - - native = (CONST TCHAR *)Tcl_FSGetNativePath(pathPtr); - attr = (*tclWinProcs->getFileAttributesProc)(native); + native = Tcl_FSGetNativePath(pathPtr); + + attr = GetFileAttributes(native); if (attr != INVALID_FILE_ATTRIBUTES && attr & FILE_ATTRIBUTE_DIRECTORY) { flags = FILE_FLAG_BACKUP_SEMANTICS; @@ -3390,8 +3076,7 @@ TclpUtime( * savings complications that utime gets wrong. */ - fileHandle = (tclWinProcs->createFileProc) ( - native, FILE_WRITE_ATTRIBUTES, 0, NULL, + fileHandle = CreateFile(native, FILE_WRITE_ATTRIBUTES, 0, NULL, OPEN_EXISTING, flags, NULL); if (fileHandle == INVALID_HANDLE_VALUE || diff --git a/win/tclWinInit.c b/win/tclWinInit.c index 93785b7..8b600f6 100644 --- a/win/tclWinInit.c +++ b/win/tclWinInit.c @@ -9,8 +9,6 @@ * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. - * - * RCS: @(#) $Id: tclWinInit.c,v 1.71 2006/04/05 17:25:27 vincentdarley Exp $ */ #include "tclWinInt.h" @@ -85,12 +83,12 @@ typedef struct { #define NUMPLATFORMS 4 -static char* platforms[NUMPLATFORMS] = { +static const char *const platforms[NUMPLATFORMS] = { "Win32s", "Windows 95", "Windows NT", "Windows CE" }; #define NUMPROCESSORS 11 -static char* processors[NUMPROCESSORS] = { +static const char *const processors[NUMPROCESSORS] = { "intel", "mips", "alpha", "ppc", "shx", "arm", "ia64", "alpha64", "msil", "amd64", "ia32_on_win64" }; @@ -103,16 +101,20 @@ static TclInitProcessGlobalValueProc InitializeDefaultLibraryDir; static ProcessGlobalValue defaultLibraryDir = {0, 0, NULL, NULL, InitializeDefaultLibraryDir, NULL, NULL}; -static void AppendEnvironment(Tcl_Obj *listPtr, CONST char *lib); -static int ToUtf(CONST WCHAR *wSrc, char *dst); +static TclInitProcessGlobalValueProc InitializeSourceLibraryDir; +static ProcessGlobalValue sourceLibraryDir = + {0, 0, NULL, NULL, InitializeSourceLibraryDir, NULL, NULL}; + +static void AppendEnvironment(Tcl_Obj *listPtr, const char *lib); +static int ToUtf(const WCHAR *wSrc, char *dst); /* *--------------------------------------------------------------------------- * * TclpInitPlatform -- * - * Initialize all the platform-dependant things like signals and - * floating-point error handling. + * Initialize all the platform-dependant things like signals, + * floating-point error handling and sockets. * * Called at process initialization time. * @@ -128,20 +130,16 @@ static int ToUtf(CONST WCHAR *wSrc, char *dst); void TclpInitPlatform(void) { + WSADATA wsaData; + WORD wVersionRequested = MAKEWORD(2, 2); + 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. - * - * Under 95 and NT 4.0, this is a NOOP because the system doesn't - * automatically put up dialogs when the above operations fail. + * Initialize the winsock library. On Windows XP and higher this + * can never fail. */ - - SetErrorMode(SetErrorMode(0) | SEM_FAILCRITICALERRORS); + WSAStartup(wVersionRequested, &wsaData); #ifdef STATIC_BUILD /* @@ -177,10 +175,10 @@ TclpInitLibraryPath( int *lengthPtr, Tcl_Encoding *encodingPtr) { -#define LIBRARY_SIZE 32 +#define LIBRARY_SIZE 64 Tcl_Obj *pathPtr; char installLib[LIBRARY_SIZE]; - char *bytes; + const char *bytes; pathPtr = Tcl_NewObj(); @@ -208,10 +206,17 @@ TclpInitLibraryPath( Tcl_ListObjAppendElement(NULL, pathPtr, TclGetProcessGlobalValue(&defaultLibraryDir)); + /* + * Look for the library in its source checkout location. + */ + + Tcl_ListObjAppendElement(NULL, pathPtr, + TclGetProcessGlobalValue(&sourceLibraryDir)); + *encodingPtr = NULL; bytes = Tcl_GetStringFromObj(pathPtr, lengthPtr); - *valuePtr = ckalloc((unsigned int)(*lengthPtr)+1); - memcpy((VOID *) *valuePtr, (VOID *) bytes, (size_t)(*lengthPtr)+1); + *valuePtr = ckalloc((*lengthPtr) + 1); + memcpy(*valuePtr, bytes, (size_t)(*lengthPtr)+1); Tcl_DecrRefCount(pathPtr); } @@ -237,14 +242,14 @@ TclpInitLibraryPath( static void AppendEnvironment( Tcl_Obj *pathPtr, - CONST char *lib) + const char *lib) { int pathc; WCHAR wBuf[MAX_PATH]; char buf[MAX_PATH * TCL_UTF_MAX]; Tcl_Obj *objPtr; Tcl_DString ds; - CONST char **pathv; + const char **pathv; char *shortlib; /* @@ -290,8 +295,6 @@ AppendEnvironment( */ 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 @@ -301,14 +304,13 @@ AppendEnvironment( pathv[pathc - 1] = shortlib; Tcl_DStringInit(&ds); - str = Tcl_JoinPath(pathc, pathv, &ds); - objPtr = Tcl_NewStringObj(str, Tcl_DStringLength(&ds)); - Tcl_DStringFree(&ds); + (void) Tcl_JoinPath(pathc, pathv, &ds); + objPtr = TclDStringToObj(&ds); } else { objPtr = Tcl_NewStringObj(buf, -1); } Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); - ckfree((char *) pathv); + ckfree(pathv); } } @@ -357,17 +359,19 @@ InitializeDefaultLibraryDir( TclWinNoBackslash(name); sprintf(end + 1, "lib/tcl%s", TCL_VERSION); *lengthPtr = strlen(name); - *valuePtr = ckalloc((unsigned int) *lengthPtr + 1); + *valuePtr = ckalloc(*lengthPtr + 1); *encodingPtr = NULL; - memcpy((VOID *) *valuePtr, (VOID *) name, (size_t) *lengthPtr + 1); + memcpy(*valuePtr, name, (size_t) *lengthPtr + 1); } /* *--------------------------------------------------------------------------- * - * ToUtf -- + * InitializeSourceLibraryDir -- * - * Convert a char string to a UTF string. + * Locate the Tcl script library default location relative to the + * location of the Tcl DLL as it exists in the build output directory + * associated with the source checkout. * * Results: * None. @@ -378,45 +382,69 @@ InitializeDefaultLibraryDir( *--------------------------------------------------------------------------- */ -static int -ToUtf( - CONST WCHAR *wSrc, - char *dst) +static void +InitializeSourceLibraryDir( + char **valuePtr, + int *lengthPtr, + Tcl_Encoding *encodingPtr) { - char *start; + HMODULE hModule = TclWinGetTclInstance(); + WCHAR wName[MAX_PATH + LIBRARY_SIZE]; + char name[(MAX_PATH + LIBRARY_SIZE) * TCL_UTF_MAX]; + char *end, *p; - start = dst; - while (*wSrc != '\0') { - dst += Tcl_UniCharToUtf(*wSrc, dst); - wSrc++; + if (GetModuleFileNameW(hModule, wName, MAX_PATH) == 0) { + GetModuleFileNameA(hModule, name, MAX_PATH); + } else { + ToUtf(wName, name); } - *dst = '\0'; - return (int) (dst - start); + + end = strrchr(name, '\\'); + *end = '\0'; + p = strrchr(name, '\\'); + if (p != NULL) { + end = p; + } + *end = '\\'; + + TclWinNoBackslash(name); + sprintf(end + 1, "../library"); + *lengthPtr = strlen(name); + *valuePtr = ckalloc(*lengthPtr + 1); + *encodingPtr = NULL; + memcpy(*valuePtr, name, (size_t) *lengthPtr + 1); } /* *--------------------------------------------------------------------------- * - * TclWinEncodingsCleanup -- + * ToUtf -- * - * 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. + * Convert a char string to a UTF string. * * Results: * None. * * Side effects: - * Static information reset to startup state. + * None. * *--------------------------------------------------------------------------- */ -void -TclWinEncodingsCleanup(void) +static int +ToUtf( + const WCHAR *wSrc, + char *dst) { - TclWinResetInterfaceEncodings(); + char *start; + + start = dst; + while (*wSrc != '\0') { + dst += Tcl_UniCharToUtf(*wSrc, dst); + wSrc++; + } + *dst = '\0'; + return (int) (dst - start); } /* @@ -454,18 +482,13 @@ TclpSetInitialEncodings(void) Tcl_DStringFree(&encodingName); } -void -TclpSetInterfaces(void) +void TclWinSetInterfaces( + int dummy) /* Not used. */ { - int platformId, useWide; - - platformId = TclWinGetPlatformId(); - useWide = ((platformId == VER_PLATFORM_WIN32_NT) - || (platformId == VER_PLATFORM_WIN32_CE)); - TclWinSetInterfaces(useWide); + TclpSetInterfaces(); } -CONST char * +const char * Tcl_GetEncodingNameFromEnvironment( Tcl_DString *bufPtr) { @@ -497,23 +520,35 @@ void TclpSetVariables( Tcl_Interp *interp) /* Interp to initialize. */ { - CONST char *ptr; + const char *ptr; char buffer[TCL_INTEGER_SPACE * 2]; - SYSTEM_INFO sysInfo; - OemId *oemId; - OSVERSIONINFOA osInfo; + union { + SYSTEM_INFO info; + OemId oemId; + } sys; + static OSVERSIONINFOW osInfo; + static int osInfoInitialized = 0; Tcl_DString ds; TCHAR szUserName[UNLEN+1]; - DWORD dwUserNameLen = sizeof(szUserName); + DWORD cchUserNameLen = UNLEN; Tcl_SetVar2Ex(interp, "tclDefaultLibrary", NULL, TclGetProcessGlobalValue(&defaultLibraryDir), TCL_GLOBAL_ONLY); - osInfo.dwOSVersionInfoSize = sizeof(OSVERSIONINFOA); - GetVersionExA(&osInfo); - - oemId = (OemId *) &sysInfo; - GetSystemInfo(&sysInfo); + if (!osInfoInitialized) { + HANDLE handle = LoadLibraryW(L"NTDLL"); + int(__stdcall *getversion)(void *) = + (int(__stdcall *)(void *)) GetProcAddress(handle, "RtlGetVersion"); + osInfo.dwOSVersionInfoSize = sizeof(OSVERSIONINFOW); + if (!getversion || getversion(&osInfo)) { + GetVersionExW(&osInfo); + } + if (handle) { + FreeLibrary(handle); + } + osInfoInitialized = 1; + } + GetSystemInfo(&sys.info); /* * Define the tcl_platform array. @@ -527,9 +562,9 @@ TclpSetVariables( } 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); } @@ -573,17 +608,26 @@ TclpSetVariables( /* * 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); if (TclGetEnv("USERNAME", &ds) == NULL) { - if (GetUserName(szUserName, &dwUserNameLen) != 0) { - Tcl_WinTCharToUtf(szUserName, (int) dwUserNameLen, &ds); + if (GetUserName(szUserName, &cchUserNameLen) != 0) { + int cbUserNameLen = cchUserNameLen - 1; + cbUserNameLen *= sizeof(TCHAR); + Tcl_WinTCharToUtf(szUserName, cbUserNameLen, &ds); } } Tcl_SetVar2(interp, "tcl_platform", "user", Tcl_DStringValue(&ds), TCL_GLOBAL_ONLY); Tcl_DStringFree(&ds); + + /* + * Define what the platform PATH separator is. [TIP #315] + */ + + Tcl_SetVar2(interp, "tcl_platform","pathSeparator", ";", TCL_GLOBAL_ONLY); } /* @@ -592,7 +636,7 @@ TclpSetVariables( * TclpFindVariable -- * * Locate the entry in environ for a given name. On Unix this routine is - * case sensetive, on Windows this matches mioxed case. + * case sensitive, on Windows this matches mioxed case. * * Results: * The return value is the index in environ of an entry with the name @@ -608,7 +652,7 @@ TclpSetVariables( int TclpFindVariable( - CONST char *name, /* Name of desired environment variable + const char *name, /* Name of desired environment variable * (UTF-8). */ int *lengthPtr) /* Used to return length of name (for * successful searches) or number of non-NULL @@ -616,7 +660,7 @@ TclpFindVariable( * searches). */ { int i, length, result = -1; - register CONST char *env, *p1, *p2; + register const char *env, *p1, *p2; char *envUpper, *nameUpper; Tcl_DString envString; @@ -625,8 +669,8 @@ TclpFindVariable( */ length = strlen(name); - nameUpper = (char *) ckalloc((unsigned) length+1); - memcpy((VOID *) nameUpper, (VOID *) name, (size_t) length+1); + nameUpper = ckalloc(length + 1); + memcpy(nameUpper, name, (size_t) length+1); Tcl_UtfToUpper(nameUpper); Tcl_DStringInit(&envString); diff --git a/win/tclWinInt.h b/win/tclWinInt.h index 40aa67c..9df424f 100644 --- a/win/tclWinInt.h +++ b/win/tclWinInt.h @@ -7,8 +7,6 @@ * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. - * - * RCS: @(#) $Id: tclWinInt.h,v 1.29 2005/11/03 01:16:07 patthoyts Exp $ */ #ifndef _TCLWININT @@ -16,13 +14,22 @@ #include "tclInt.h" +#ifdef HAVE_NO_SEH /* - * The following specifies how much stack space TclpCheckStackSpace() - * ensures is available. TclpCheckStackSpace() is called by Tcl_EvalObj() - * to help avoid overflowing the stack in the case of infinite recursion. + * Unlike Borland and Microsoft, we don't register exception handlers by + * pushing registration records onto the runtime stack. Instead, we register + * them by creating an TCLEXCEPTION_REGISTRATION within the activation record. */ -#define TCL_WIN_STACK_THRESHOLD 0x8000 +typedef struct TCLEXCEPTION_REGISTRATION { + struct TCLEXCEPTION_REGISTRATION *link; + EXCEPTION_DISPOSITION (*handler)( + struct _EXCEPTION_RECORD*, void*, struct _CONTEXT*, void*); + void *ebp; + void *esp; + int status; +} TCLEXCEPTION_REGISTRATION; +#endif /* * Some versions of Borland C have a define for the OSVERSIONINFO for @@ -37,116 +44,11 @@ #define VER_PLATFORM_WIN32_CE 3 #endif -/* - * The following structure keeps track of whether we are using the - * multi-byte or the wide-character interfaces to the operating system. - * System calls should be made through the following function table. - */ - -typedef union { - WIN32_FIND_DATAA a; - WIN32_FIND_DATAW w; -} WIN32_FIND_DATAT; - -typedef struct TclWinProcs { - int useWide; - - BOOL (WINAPI *buildCommDCBProc)(CONST TCHAR *, LPDCB); - TCHAR *(WINAPI *charLowerProc)(TCHAR *); - BOOL (WINAPI *copyFileProc)(CONST TCHAR *, CONST TCHAR *, BOOL); - BOOL (WINAPI *createDirectoryProc)(CONST TCHAR *, LPSECURITY_ATTRIBUTES); - HANDLE (WINAPI *createFileProc)(CONST TCHAR *, DWORD, DWORD, - LPSECURITY_ATTRIBUTES, DWORD, DWORD, HANDLE); - BOOL (WINAPI *createProcessProc)(CONST TCHAR *, TCHAR *, - LPSECURITY_ATTRIBUTES, LPSECURITY_ATTRIBUTES, BOOL, DWORD, - LPVOID, CONST TCHAR *, LPSTARTUPINFOA, LPPROCESS_INFORMATION); - BOOL (WINAPI *deleteFileProc)(CONST TCHAR *); - HANDLE (WINAPI *findFirstFileProc)(CONST TCHAR *, WIN32_FIND_DATAT *); - BOOL (WINAPI *findNextFileProc)(HANDLE, WIN32_FIND_DATAT *); - BOOL (WINAPI *getComputerNameProc)(WCHAR *, LPDWORD); - DWORD (WINAPI *getCurrentDirectoryProc)(DWORD, WCHAR *); - DWORD (WINAPI *getFileAttributesProc)(CONST TCHAR *); - DWORD (WINAPI *getFullPathNameProc)(CONST TCHAR *, DWORD nBufferLength, - WCHAR *, TCHAR **); - DWORD (WINAPI *getModuleFileNameProc)(HMODULE, WCHAR *, int); - DWORD (WINAPI *getShortPathNameProc)(CONST TCHAR *, WCHAR *, DWORD); - UINT (WINAPI *getTempFileNameProc)(CONST TCHAR *, CONST TCHAR *, UINT, - WCHAR *); - DWORD (WINAPI *getTempPathProc)(DWORD, WCHAR *); - BOOL (WINAPI *getVolumeInformationProc)(CONST TCHAR *, WCHAR *, DWORD, - LPDWORD, LPDWORD, LPDWORD, WCHAR *, DWORD); - HINSTANCE (WINAPI *loadLibraryProc)(CONST TCHAR *); - TCHAR (WINAPI *lstrcpyProc)(WCHAR *, CONST TCHAR *); - BOOL (WINAPI *moveFileProc)(CONST TCHAR *, CONST TCHAR *); - BOOL (WINAPI *removeDirectoryProc)(CONST TCHAR *); - DWORD (WINAPI *searchPathProc)(CONST TCHAR *, CONST TCHAR *, - CONST TCHAR *, DWORD, WCHAR *, TCHAR **); - BOOL (WINAPI *setCurrentDirectoryProc)(CONST TCHAR *); - BOOL (WINAPI *setFileAttributesProc)(CONST TCHAR *, DWORD); - /* - * These two function pointers will only be set when - * Tcl_FindExecutable is called. If you don't ever call that - * function, the application will crash whenever WinTcl tries to call - * functions through these null pointers. That is not a bug in Tcl - * -- Tcl_FindExecutable is obligatory in recent Tcl releases. - */ - BOOL (WINAPI *getFileAttributesExProc)(CONST TCHAR *, - GET_FILEEX_INFO_LEVELS, LPVOID); - BOOL (WINAPI *createHardLinkProc)(CONST TCHAR*, CONST TCHAR*, - LPSECURITY_ATTRIBUTES); - - /* deleted INT (__cdecl *utimeProc)(CONST TCHAR*, struct _utimbuf *); */ - /* These two are also NULL at start; see comment above */ - HANDLE (WINAPI *findFirstFileExProc)(CONST TCHAR*, UINT, - LPVOID, UINT, - LPVOID, DWORD); - BOOL (WINAPI *getVolumeNameForVMPProc)(CONST TCHAR*, TCHAR*, DWORD); - DWORD (WINAPI *getLongPathNameProc)(CONST TCHAR*, TCHAR*, DWORD); - /* - * These six are for the security sdk to get correct file - * permissions on NT, 2000, XP, etc. On 95,98,ME they are - * always null. - */ - BOOL (WINAPI *getFileSecurityProc)(LPCTSTR lpFileName, - SECURITY_INFORMATION RequestedInformation, - PSECURITY_DESCRIPTOR pSecurityDescriptor, - DWORD nLength, - LPDWORD lpnLengthNeeded); - BOOL (WINAPI *impersonateSelfProc) (SECURITY_IMPERSONATION_LEVEL - ImpersonationLevel); - BOOL (WINAPI *openThreadTokenProc) (HANDLE ThreadHandle, - DWORD DesiredAccess, BOOL OpenAsSelf, - PHANDLE TokenHandle); - BOOL (WINAPI *revertToSelfProc) (void); - VOID (WINAPI *mapGenericMaskProc) (PDWORD AccessMask, - PGENERIC_MAPPING GenericMapping); - BOOL (WINAPI *accessCheckProc)(PSECURITY_DESCRIPTOR pSecurityDescriptor, - HANDLE ClientToken, DWORD DesiredAccess, - PGENERIC_MAPPING GenericMapping, - PPRIVILEGE_SET PrivilegeSet, - LPDWORD PrivilegeSetLength, - LPDWORD GrantedAccess, - LPBOOL AccessStatus); - /* - * Unicode console support. WriteConsole and ReadConsole - */ - BOOL (WINAPI *readConsoleProc)( - HANDLE hConsoleInput, - LPVOID lpBuffer, - DWORD nNumberOfCharsToRead, - LPDWORD lpNumberOfCharsRead, - LPVOID lpReserved - ); - BOOL (WINAPI *writeConsoleProc)( - HANDLE hConsoleOutput, - const VOID* lpBuffer, - DWORD nNumberOfCharsToWrite, - LPDWORD lpNumberOfCharsWritten, - LPVOID lpReserved - ); -} TclWinProcs; - -MODULE_SCOPE TclWinProcs *tclWinProcs; +#ifdef _WIN64 +# define TCL_I_MODIFIER "I" +#else +# define TCL_I_MODIFIER "" +#endif /* * Declarations of functions that are not accessible by way of the @@ -154,7 +56,7 @@ MODULE_SCOPE TclWinProcs *tclWinProcs; */ MODULE_SCOPE char TclWinDriveLetterForVolMountPoint( - CONST WCHAR *mountPoint); + const TCHAR *mountPoint); MODULE_SCOPE void TclWinEncodingsCleanup(); MODULE_SCOPE void TclWinInit(HINSTANCE hInst); MODULE_SCOPE TclFile TclWinMakeFile(HANDLE handle); @@ -164,12 +66,11 @@ 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, +MODULE_SCOPE HANDLE TclWinSerialOpen(HANDLE handle, const TCHAR *name, DWORD access); -MODULE_SCOPE int TclWinSymLinkCopyDirectory(CONST TCHAR* LinkOriginal, - CONST TCHAR* LinkCopy); -MODULE_SCOPE int TclWinSymLinkDelete(CONST TCHAR* LinkOriginal, +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) MODULE_SCOPE void TclWinFreeAllocCache(void); diff --git a/win/tclWinLoad.c b/win/tclWinLoad.c index 7079571..3e11224 100644 --- a/win/tclWinLoad.c +++ b/win/tclWinLoad.c @@ -9,12 +9,27 @@ * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. - * - * RCS: @(#) $Id: tclWinLoad.c,v 1.19 2005/11/04 00:06:50 dkf Exp $ */ #include "tclWinInt.h" +/* + * Native name of the directory in the native filesystem where DLLs used in + * this process are copied prior to loading, and mutex used to protect its + * allocation. + */ + +static WCHAR *dllDirectoryName = NULL; +static Tcl_Mutex dllDirectoryNameMutex; + +/* + * Static functions defined within this file. + */ + +static void * FindSymbol(Tcl_Interp *interp, + Tcl_LoadHandle loadHandle, const char *symbol); +static int InitDLLDirectoryName(void); +static void UnloadFile(Tcl_LoadHandle loadHandle); /* *---------------------------------------------------------------------- @@ -42,13 +57,15 @@ TclpDlopen( Tcl_LoadHandle *loadHandle, /* Filled with token for dynamically loaded * file which will be passed back to * (*unloadProcPtr)() to unload the file. */ - Tcl_FSUnloadFileProc **unloadProcPtr) + Tcl_FSUnloadFileProc **unloadProcPtr, /* Filled with address of Tcl_FSUnloadFileProc * function which should be used for this * file. */ + int flags) { - HINSTANCE handle; - CONST TCHAR *nativeName; + HINSTANCE hInstance; + const TCHAR *nativeName; + Tcl_LoadHandle handlePtr; /* * First try the full path the user gave us. This is particularly @@ -57,8 +74,8 @@ TclpDlopen( */ nativeName = Tcl_FSGetNativePath(pathPtr); - handle = (*tclWinProcs->loadLibraryProc)(nativeName); - if (handle == NULL) { + hInstance = LoadLibraryEx(nativeName,NULL,LOAD_WITH_ALTERED_SEARCH_PATH); + if (hInstance == NULL) { /* * Let the OS loader examine the binary search path for whatever * string the user gave us which hopefully refers to a file on the @@ -66,37 +83,17 @@ TclpDlopen( */ Tcl_DString ds; - char *fileName = Tcl_GetString(pathPtr); - nativeName = Tcl_WinUtfToTChar(fileName, -1, &ds); - handle = (*tclWinProcs->loadLibraryProc)(nativeName); + nativeName = Tcl_WinUtfToTChar(Tcl_GetString(pathPtr), -1, &ds); + hInstance = LoadLibraryEx(nativeName, NULL, + LOAD_WITH_ALTERED_SEARCH_PATH); Tcl_DStringFree(&ds); } - *loadHandle = (Tcl_LoadHandle) handle; - - if (handle == NULL) { + if (hInstance == NULL) { DWORD lastError = GetLastError(); - -#if 0 - /* - * It would be ideal if the FormatMessage stuff worked better, but - * unfortunately it doesn't seem to want to... - */ - - LPTSTR lpMsgBuf; - char *buf; - int size; - - size = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM | - FORMAT_MESSAGE_ALLOCATE_BUFFER, NULL, lastError, 0, - (LPTSTR) &lpMsgBuf, 0, NULL); - buf = (char *) ckalloc((unsigned) TCL_INTEGER_SPACE + size + 1); - sprintf(buf, "%d %s", lastError, (char *)lpMsgBuf); -#endif - - Tcl_AppendResult(interp, "couldn't load library \"", - Tcl_GetString(pathPtr), "\": ", NULL); + Tcl_Obj *errMsg = Tcl_ObjPrintf("couldn't load library \"%s\": ", + Tcl_GetString(pathPtr)); /* * Check for possible DLL errors. This doesn't work quite right, @@ -107,38 +104,55 @@ TclpDlopen( switch (lastError) { case ERROR_MOD_NOT_FOUND: + Tcl_SetErrorCode(interp, "WIN_LOAD", "MOD_NOT_FOUND", NULL); + goto notFoundMsg; case ERROR_DLL_NOT_FOUND: - Tcl_AppendResult(interp, "this library or a dependent library", - " could not be found in library path", NULL); + Tcl_SetErrorCode(interp, "WIN_LOAD", "DLL_NOT_FOUND", NULL); + notFoundMsg: + Tcl_AppendToObj(errMsg, "this library or a dependent library" + " could not be found in library path", -1); break; case ERROR_PROC_NOT_FOUND: - Tcl_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); + Tcl_SetErrorCode(interp, "WIN_LOAD", "PROC_NOT_FOUND", NULL); + Tcl_AppendToObj(errMsg, "A function specified in the import" + " table could not be resolved by the system. Windows" + " is not telling which one, I'm sorry.", -1); break; case ERROR_INVALID_DLL: - Tcl_AppendResult(interp, "this library or a dependent library", - " is damaged", NULL); + Tcl_SetErrorCode(interp, "WIN_LOAD", "INVALID_DLL", NULL); + Tcl_AppendToObj(errMsg, "this library or a dependent library" + " is damaged", -1); break; case ERROR_DLL_INIT_FAILED: - Tcl_AppendResult(interp, "the library initialization", - " routine failed", NULL); + Tcl_SetErrorCode(interp, "WIN_LOAD", "DLL_INIT_FAILED", NULL); + Tcl_AppendToObj(errMsg, "the library initialization" + " routine failed", -1); break; default: TclWinConvertError(lastError); - Tcl_AppendResult(interp, Tcl_PosixError(interp), NULL); + Tcl_AppendToObj(errMsg, Tcl_PosixError(interp), -1); } + Tcl_SetObjResult(interp, errMsg); return TCL_ERROR; - } else { - *unloadProcPtr = &TclpUnloadFile; } + + /* + * Succeded; package everything up for Tcl. + */ + + handlePtr = ckalloc(sizeof(struct Tcl_LoadHandle_)); + handlePtr->clientData = (ClientData) hInstance; + handlePtr->findSymbolProcPtr = &FindSymbol; + handlePtr->unloadFileProcPtr = &UnloadFile; + *loadHandle = handlePtr; + *unloadProcPtr = &UnloadFile; return TCL_OK; } /* *---------------------------------------------------------------------- * - * TclpFindSymbol -- + * FindSymbol -- * * Looks up a symbol, by name, through a handle associated with a * previously loaded piece of code (shared library). @@ -151,37 +165,43 @@ TclpDlopen( *---------------------------------------------------------------------- */ -Tcl_PackageInitProc * -TclpFindSymbol( +static void * +FindSymbol( Tcl_Interp *interp, Tcl_LoadHandle loadHandle, - CONST char *symbol) + const char *symbol) { + HINSTANCE hInstance = (HINSTANCE) loadHandle->clientData; Tcl_PackageInitProc *proc = NULL; - HINSTANCE handle = (HINSTANCE)loadHandle; /* * For each symbol, check for both Symbol and _Symbol, since Borland * generates C symbols with a leading '_' by default. */ - proc = (Tcl_PackageInitProc *) GetProcAddress(handle, symbol); + proc = (void *) GetProcAddress(hInstance, symbol); if (proc == NULL) { Tcl_DString ds; + const char *sym2; Tcl_DStringInit(&ds); - Tcl_DStringAppend(&ds, "_", 1); - symbol = Tcl_DStringAppend(&ds, symbol, -1); - proc = (Tcl_PackageInitProc *) GetProcAddress(handle, symbol); + TclDStringAppendLiteral(&ds, "_"); + sym2 = Tcl_DStringAppend(&ds, symbol, -1); + proc = (Tcl_PackageInitProc *) GetProcAddress(hInstance, sym2); Tcl_DStringFree(&ds); } + if (proc == NULL && interp != NULL) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "cannot find symbol \"%s\"", symbol)); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LOAD_SYMBOL", symbol, NULL); + } return proc; } /* *---------------------------------------------------------------------- * - * TclpUnloadFile -- + * UnloadFile -- * * Unloads a dynamically loaded binary code file from memory. Code * pointers in the formerly loaded file are no longer valid after calling @@ -196,16 +216,16 @@ TclpFindSymbol( *---------------------------------------------------------------------- */ -void -TclpUnloadFile( +static void +UnloadFile( Tcl_LoadHandle loadHandle) /* loadHandle returned by a previous call to * TclpDlopen(). The loadHandle is a token * that represents the loaded file. */ { - HINSTANCE handle; + HINSTANCE hInstance = (HINSTANCE) loadHandle->clientData; - handle = (HINSTANCE) loadHandle; - FreeLibrary(handle); + FreeLibrary(hInstance); + ckfree(loadHandle); } /* @@ -230,7 +250,7 @@ TclpUnloadFile( int TclGuessPackageName( - CONST char *fileName, /* Name of file containing package (already + 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. */ @@ -239,6 +259,139 @@ TclGuessPackageName( } /* + *---------------------------------------------------------------------- + * + * TclpTempFileNameForLibrary -- + * + * Constructs a temporary file name for loading a shared object (DLL). + * + * Results: + * Returns the constructed file name. + * + * On Windows, a DLL is identified by the final component of its path name. + * Cross linking among DLL's (and hence, preloading) will not work unless this + * name is preserved when copying a DLL from a VFS to a temp file for + * preloading. For this reason, all DLLs in a given process are copied to a + * temp directory, and their names are preserved. + * + *---------------------------------------------------------------------- + */ + +Tcl_Obj * +TclpTempFileNameForLibrary( + Tcl_Interp *interp, /* Tcl interpreter. */ + Tcl_Obj *path) /* Path name of the DLL in the VFS. */ +{ + Tcl_Obj *fileName; /* Name of the temp file. */ + Tcl_Obj *tail; /* Tail of the source path. */ + + Tcl_MutexLock(&dllDirectoryNameMutex); + if (dllDirectoryName == NULL) { + if (InitDLLDirectoryName() == TCL_ERROR) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "couldn't create temporary directory: %s", + Tcl_PosixError(interp))); + Tcl_MutexUnlock(&dllDirectoryNameMutex); + return NULL; + } + } + Tcl_MutexUnlock(&dllDirectoryNameMutex); + + /* + * Now we know where to put temporary DLLs, construct the name. + */ + + fileName = TclpNativeToNormalized(dllDirectoryName); + tail = TclPathPart(interp, path, TCL_PATH_TAIL); + if (tail == NULL) { + Tcl_DecrRefCount(fileName); + return NULL; + } + Tcl_AppendToObj(fileName, "/", 1); + Tcl_AppendObjToObj(fileName, tail); + return fileName; +} + +/* + *---------------------------------------------------------------------- + * + * InitDLLDirectoryName -- + * + * Helper for TclpTempFileNameForLibrary; builds a temporary directory + * that is specific to the current process. Should only be called once + * per process start. Caller must hold dllDirectoryNameMutex. + * + * Results: + * Tcl result code. + * + * Side-effects: + * Creates temp directory. + * Allocates memory pointed to by dllDirectoryName. + * + *---------------------------------------------------------------------- + * [Candidate for process global?] + */ + +static int +InitDLLDirectoryName(void) +{ + size_t nameLen; /* Length of the temp folder name. */ + WCHAR name[MAX_PATH]; /* Path name of the temp folder. */ + DWORD id; /* The process id. */ + DWORD lastError; /* Last error to happen in Win API. */ + int i; + + /* + * Determine the name of the directory to use, and create it. (Keep + * trying with new names until an attempt to create the directory + * succeeds) + */ + + nameLen = GetTempPathW(MAX_PATH, name); + if (nameLen >= MAX_PATH-12) { + Tcl_SetErrno(ENAMETOOLONG); + return TCL_ERROR; + } + + wcscpy(name+nameLen, L"TCLXXXXXXXX"); + nameLen += 11; + + id = GetCurrentProcessId(); + lastError = ERROR_ALREADY_EXISTS; + + for (i=0 ; i<256 ; i++) { + wsprintfW(name+nameLen-8, L"%08x", id); + if (CreateDirectoryW(name, NULL)) { + /* + * Issue: we don't schedule this directory for deletion by anyone. + * Can we ask the OS to do this for us? There appears to be + * potential for using CreateFile (with the flag + * FILE_FLAG_BACKUP_SEMANTICS) and RemoveDirectory to do this... + */ + + goto copyToGlobalBuffer; + } + lastError = GetLastError(); + if (lastError != ERROR_ALREADY_EXISTS) { + break; + } + id *= 16777619; + } + + TclWinConvertError(lastError); + return TCL_ERROR; + + /* + * Store our computed value in the global. + */ + + copyToGlobalBuffer: + dllDirectoryName = ckalloc((nameLen+1) * sizeof(WCHAR)); + wcscpy(dllDirectoryName, name); + return TCL_OK; +} + +/* * Local Variables: * mode: c * c-basic-offset: 4 diff --git a/win/tclWinNotify.c b/win/tclWinNotify.c index d1cbf74..4543b02 100644 --- a/win/tclWinNotify.c +++ b/win/tclWinNotify.c @@ -9,8 +9,6 @@ * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. - * - * RCS: @(#) $Id: tclWinNotify.c,v 1.21 2005/11/04 00:06:50 dkf Exp $ */ #include "tclInt.h" @@ -44,9 +42,6 @@ typedef struct ThreadSpecificData { static Tcl_ThreadDataKey dataKey; -extern TclStubs tclStubs; -extern Tcl_NotifierProcs tclOriginalNotifier; - /* * The following static indicates the number of threads that have initialized * notifiers. It controls the lifetime of the TclNotifier window class. @@ -55,6 +50,7 @@ extern Tcl_NotifierProcs tclOriginalNotifier; */ static int notifierCount = 0; +static const TCHAR classname[] = TEXT("TclNotifier"); TCL_DECLARE_MUTEX(notifierMutex) /* @@ -83,45 +79,49 @@ static LRESULT CALLBACK NotifierProc(HWND hwnd, UINT message, ClientData Tcl_InitNotifier(void) { - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - WNDCLASS class; + if (tclNotifierHooks.initNotifierProc) { + return tclNotifierHooks.initNotifierProc(); + } else { + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + WNDCLASS class; - /* - * Register Notifier window class if this is the first thread to use this - * module. - */ + /* + * Register Notifier window class if this is the first thread to use + * this module. + */ - Tcl_MutexLock(¬ifierMutex); - if (notifierCount == 0) { - class.style = 0; - class.cbClsExtra = 0; - class.cbWndExtra = 0; - class.hInstance = TclWinGetTclInstance(); - class.hbrBackground = NULL; - class.lpszMenuName = NULL; - class.lpszClassName = "TclNotifier"; - class.lpfnWndProc = NotifierProc; - class.hIcon = NULL; - class.hCursor = NULL; - - if (!RegisterClassA(&class)) { - Tcl_Panic("Unable to register TclNotifier window class"); + Tcl_MutexLock(¬ifierMutex); + if (notifierCount == 0) { + class.style = 0; + class.cbClsExtra = 0; + class.cbWndExtra = 0; + class.hInstance = TclWinGetTclInstance(); + class.hbrBackground = NULL; + class.lpszMenuName = NULL; + class.lpszClassName = classname; + class.lpfnWndProc = NotifierProc; + class.hIcon = NULL; + class.hCursor = NULL; + + if (!RegisterClass(&class)) { + Tcl_Panic("Unable to register TclNotifier window class"); + } } - } - notifierCount++; - Tcl_MutexUnlock(¬ifierMutex); + notifierCount++; + Tcl_MutexUnlock(¬ifierMutex); - tsdPtr->pending = 0; - tsdPtr->timerActive = 0; + tsdPtr->pending = 0; + tsdPtr->timerActive = 0; - InitializeCriticalSection(&tsdPtr->crit); + InitializeCriticalSection(&tsdPtr->crit); - tsdPtr->hwnd = NULL; - tsdPtr->thread = GetCurrentThreadId(); - tsdPtr->event = CreateEvent(NULL, TRUE /* manual */, - FALSE /* !signaled */, NULL); + tsdPtr->hwnd = NULL; + tsdPtr->thread = GetCurrentThreadId(); + tsdPtr->event = CreateEvent(NULL, TRUE /* manual */, + FALSE /* !signaled */, NULL); - return (ClientData) tsdPtr; + return tsdPtr; + } } /* @@ -145,46 +145,51 @@ void Tcl_FinalizeNotifier( ClientData clientData) /* Pointer to notifier data. */ { - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData; + if (tclNotifierHooks.finalizeNotifierProc) { + tclNotifierHooks.finalizeNotifierProc(clientData); + return; + } else { + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData; - /* - * Only finalize the notifier if a notifier was installed in the current - * thread; there is a route in which this is not guaranteed to be true - * (when tclWin32Dll.c:DllMain() is called with the flag - * DLL_PROCESS_DETACH by the OS, which could be doing so from a thread - * that's never previously been involved with Tcl, e.g. the task manager) - * so this check is important. - * - * Fixes Bug #217982 reported by Hugh Vu and Gene Leache. - */ + /* + * 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; - } + if (tsdPtr == NULL) { + return; + } - DeleteCriticalSection(&tsdPtr->crit); - CloseHandle(tsdPtr->event); + DeleteCriticalSection(&tsdPtr->crit); + CloseHandle(tsdPtr->event); - /* - * Clean up the timer and messaging window for this thread. - */ + /* + * Clean up the timer and messaging window for this thread. + */ - if (tsdPtr->hwnd) { - KillTimer(tsdPtr->hwnd, INTERVAL_TIMER); - DestroyWindow(tsdPtr->hwnd); - } + if (tsdPtr->hwnd) { + KillTimer(tsdPtr->hwnd, INTERVAL_TIMER); + DestroyWindow(tsdPtr->hwnd); + } - /* - * If this is the last thread to use the notifier, unregister the notifier - * window class. - */ + /* + * If this is the last thread to use the notifier, unregister the + * notifier window class. + */ - Tcl_MutexLock(¬ifierMutex); - notifierCount--; - if (notifierCount == 0) { - UnregisterClassA("TclNotifier", TclWinGetTclInstance()); + Tcl_MutexLock(¬ifierMutex); + notifierCount--; + if (notifierCount == 0) { + UnregisterClass(classname, TclWinGetTclInstance()); + } + Tcl_MutexUnlock(¬ifierMutex); } - Tcl_MutexUnlock(¬ifierMutex); } /* @@ -213,27 +218,32 @@ void 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. - */ + if (tclNotifierHooks.alertNotifierProc) { + tclNotifierHooks.alertNotifierProc(clientData); + return; + } else { + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData; - if (tsdPtr->hwnd) { /* - * We do need to lock around access to the pending flag. + * 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. */ - EnterCriticalSection(&tsdPtr->crit); - if (!tsdPtr->pending) { - PostMessage(tsdPtr->hwnd, WM_WAKEUP, 0, 0); + if (tsdPtr->hwnd) { + /* + * We do need to lock around access to the pending flag. + */ + + EnterCriticalSection(&tsdPtr->crit); + if (!tsdPtr->pending) { + PostMessage(tsdPtr->hwnd, WM_WAKEUP, 0, 0); + } + tsdPtr->pending = 1; + LeaveCriticalSection(&tsdPtr->crit); + } else { + SetEvent(tsdPtr->event); } - tsdPtr->pending = 1; - LeaveCriticalSection(&tsdPtr->crit); - } else { - SetEvent(tsdPtr->event); } } @@ -257,52 +267,47 @@ Tcl_AlertNotifier( void Tcl_SetTimer( - Tcl_Time *timePtr) /* Maximum block time, or NULL. */ + const Tcl_Time *timePtr) /* Maximum block time, or NULL. */ { - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - UINT timeout; - - /* - * Allow the notifier to be hooked. This may not make sense on Windows, - * but mirrors the UNIX hook. - */ - - if (tclStubs.tcl_SetTimer != tclOriginalNotifier.setTimerProc) { - tclStubs.tcl_SetTimer(timePtr); - return; - } - - /* - * We only need to set up an interval timer if we're being called from an - * external event loop. If we don't have a window handle then we just - * return immediately and let Tcl_WaitForEvent handle timeouts. - */ - - if (!tsdPtr->hwnd) { + if (tclNotifierHooks.setTimerProc) { + tclNotifierHooks.setTimerProc(timePtr); return; - } - - if (!timePtr) { - timeout = 0; } else { + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + UINT timeout; + /* - * Make sure we pass a non-zero value into the timeout argument. - * Windows seems to get confused by zero length timers. + * 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. */ - timeout = timePtr->sec * 1000 + timePtr->usec / 1000; - if (timeout == 0) { - timeout = 1; + if (!tsdPtr->hwnd) { + return; + } + + if (!timePtr) { + timeout = 0; + } else { + /* + * Make sure we pass a non-zero value into the timeout argument. + * Windows seems to get confused by zero length timers. + */ + + timeout = timePtr->sec * 1000 + timePtr->usec / 1000; + if (timeout == 0) { + timeout = 1; + } + } + tsdPtr->timeout = timeout; + if (timeout != 0) { + tsdPtr->timerActive = 1; + SetTimer(tsdPtr->hwnd, INTERVAL_TIMER, + (unsigned long) tsdPtr->timeout, NULL); + } else { + tsdPtr->timerActive = 0; + KillTimer(tsdPtr->hwnd, INTERVAL_TIMER); } - } - tsdPtr->timeout = timeout; - if (timeout != 0) { - tsdPtr->timerActive = 1; - SetTimer(tsdPtr->hwnd, INTERVAL_TIMER, (unsigned long) tsdPtr->timeout, - NULL); - } else { - tsdPtr->timerActive = 0; - KillTimer(tsdPtr->hwnd, INTERVAL_TIMER); } } @@ -328,29 +333,36 @@ 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 (mode == TCL_SERVICE_ALL && !tsdPtr->hwnd) { - tsdPtr->hwnd = CreateWindowA("TclNotifier", "TclNotifier", WS_TILED, - 0, 0, 0, 0, NULL, NULL, TclWinGetTclInstance(), NULL); + if (tclNotifierHooks.serviceModeHookProc) { + tclNotifierHooks.serviceModeHookProc(mode); + return; + } else { + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); /* - * 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. + * 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. */ - Tcl_AlertNotifier((ClientData)tsdPtr); + if (mode == TCL_SERVICE_ALL && !tsdPtr->hwnd) { + tsdPtr->hwnd = CreateWindow(classname, classname, + WS_TILED, 0, 0, 0, 0, NULL, NULL, TclWinGetTclInstance(), + NULL); + + /* + * Send an initial message to the window to ensure that we wake up + * the notifier once we get into the modal loop. This will force + * the notifier to recompute the timeout value and schedule a timer + * if one is needed. + */ + + Tcl_AlertNotifier(tsdPtr); + } } } @@ -418,107 +430,102 @@ NotifierProc( int Tcl_WaitForEvent( - Tcl_Time *timePtr) /* Maximum block time, or NULL. */ + const Tcl_Time *timePtr) /* Maximum block time, or NULL. */ { - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - MSG msg; - DWORD timeout, result; - int status; - - /* - * Allow the notifier to be hooked. This may not make sense on windows, - * but mirrors the UNIX hook. - */ - - if (tclStubs.tcl_WaitForEvent != tclOriginalNotifier.waitForEventProc) { - return tclStubs.tcl_WaitForEvent(timePtr); - } - - /* - * Compute the timeout in milliseconds. - */ + if (tclNotifierHooks.waitForEventProc) { + return tclNotifierHooks.waitForEventProc(timePtr); + } else { + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + MSG msg; + DWORD timeout, result; + int status; - if (timePtr) { /* - * TIP #233 (Virtualized Time). Convert virtual domain delay to - * real-time. + * Compute the timeout in milliseconds. */ - Tcl_Time myTime; + if (timePtr) { + /* + * TIP #233 (Virtualized Time). Convert virtual domain delay to + * real-time. + */ - myTime.sec = timePtr->sec; - myTime.usec = timePtr->usec; + Tcl_Time myTime; - if (myTime.sec != 0 || myTime.usec != 0) { - (*tclScaleTimeProcPtr) (&myTime, tclTimeClientData); - } + myTime.sec = timePtr->sec; + myTime.usec = timePtr->usec; - timeout = myTime.sec * 1000 + myTime.usec / 1000; - } else { - timeout = INFINITE; - } + if (myTime.sec != 0 || myTime.usec != 0) { + tclScaleTimeProcPtr(&myTime, tclTimeClientData); + } - /* - * Check to see if there are any messages in the queue before waiting - * because MsgWaitForMultipleObjects will not wake up if there are events - * currently sitting in the queue. - */ + timeout = myTime.sec * 1000 + myTime.usec / 1000; + } else { + timeout = INFINITE; + } - if (!PeekMessage(&msg, NULL, 0, 0, PM_NOREMOVE)) { /* - * Wait for something to happen (a signal from another thread, a - * message, or timeout) or loop servicing asynchronous procedure calls - * queued to this thread. + * Check to see if there are any messages in the queue before waiting + * because MsgWaitForMultipleObjects will not wake up if there are + * events currently sitting in the queue. */ - 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; - } - } + if (!PeekMessage(&msg, NULL, 0, 0, PM_NOREMOVE)) { + /* + * Wait for something to happen (a signal from another thread, a + * message, or timeout) or loop servicing asynchronous procedure + * calls queued to this thread. + */ - /* - * Check to see if there are any messages to process. - */ + 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; + } + } - if (PeekMessage(&msg, NULL, 0, 0, PM_NOREMOVE)) { /* - * Retrieve and dispatch the first message. + * Check to see if there are any messages to process. */ - result = GetMessage(&msg, NULL, 0, 0); - if (result == 0) { - /* - * We received a request to exit this thread (WM_QUIT), so - * propagate the quit message and start unwinding. - */ - - PostQuitMessage((int) msg.wParam); - status = -1; - } else if (result == -1) { + if (PeekMessage(&msg, NULL, 0, 0, PM_NOREMOVE)) { /* - * We got an error from the system. I have no idea why this would - * happen, so we'll just unwind. + * Retrieve and dispatch the first message. */ - status = -1; + result = GetMessage(&msg, NULL, 0, 0); + if (result == 0) { + /* + * We received a request to exit this thread (WM_QUIT), so + * propagate the quit message and start unwinding. + */ + + PostQuitMessage((int) msg.wParam); + status = -1; + } else if (result == (DWORD)-1) { + /* + * We got an error from the system. I have no idea why this + * would happen, so we'll just unwind. + */ + + status = -1; + } else { + TranslateMessage(&msg); + DispatchMessage(&msg); + status = 1; + } } else { - TranslateMessage(&msg); - DispatchMessage(&msg); - status = 1; + status = 0; } - } else { - status = 0; - } - end: - ResetEvent(tsdPtr->event); - return status; + end: + ResetEvent(tsdPtr->event); + return status; + } } /* @@ -572,11 +579,11 @@ Tcl_Sleep( * TIP #233: Scale delay from virtual to real-time. */ - (*tclScaleTimeProcPtr) (&vdelay, tclTimeClientData); + tclScaleTimeProcPtr(&vdelay, tclTimeClientData); sleepTime = vdelay.sec * 1000 + vdelay.usec / 1000; for (;;) { - Sleep(sleepTime); + SleepEx(sleepTime, TRUE); Tcl_GetTime(&now); if (now.sec > desired.sec) { break; @@ -587,7 +594,7 @@ Tcl_Sleep( vdelay.sec = desired.sec - now.sec; vdelay.usec = desired.usec - now.usec; - (*tclScaleTimeProcPtr) (&vdelay, tclTimeClientData); + tclScaleTimeProcPtr(&vdelay, tclTimeClientData); sleepTime = vdelay.sec * 1000 + vdelay.usec / 1000; } } diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c index b27a762..a9eec6d 100644 --- a/win/tclWinPipe.c +++ b/win/tclWinPipe.c @@ -8,16 +8,10 @@ * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. - * - * RCS: @(#) $Id: tclWinPipe.c,v 1.65 2007/02/20 23:24:07 nijtmans Exp $ */ #include "tclWinInt.h" -#include <fcntl.h> -#include <io.h> -#include <sys/stat.h> - /* * The following variable is used to tell whether this module has been * initialized. @@ -88,6 +82,12 @@ static ProcInfo *procList; #define PIPE_EXTRABYTE (1<<3) /* The reader thread has consumed one byte. */ /* + * TODO: It appears the whole EXTRABYTE machinery is in place to support + * outdated Win 95 systems. If this can be confirmed, much code can be + * deleted. + */ + +/* * This structure describes per-instance data for a pipe based channel. */ @@ -198,7 +198,7 @@ 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 TempFileName(TCHAR name[MAX_PATH]); static int WaitForRead(PipeInfo *infoPtr, int blocking); static void PipeThreadActionProc(ClientData instanceData, int action); @@ -208,7 +208,7 @@ static void PipeThreadActionProc(ClientData instanceData, * I/O. */ -static Tcl_ChannelType pipeChannelType = { +static const Tcl_ChannelType pipeChannelType = { "pipe", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ TCL_CLOSE2PROC, /* Close proc. */ @@ -225,7 +225,7 @@ static Tcl_ChannelType pipeChannelType = { NULL, /* handler proc. */ NULL, /* wide seek proc */ PipeThreadActionProc, /* thread action proc */ - NULL, /* truncate */ + NULL /* truncate */ }; /* @@ -324,7 +324,6 @@ PipeSetupProc( PipeInfo *infoPtr; Tcl_Time blockTime = { 0, 0 }; int block = 1; - WinFile *filePtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); if (!(flags & TCL_FILE_EVENTS)) { @@ -338,13 +337,11 @@ PipeSetupProc( for (infoPtr = tsdPtr->firstPipePtr; infoPtr != NULL; infoPtr = infoPtr->nextPtr) { if (infoPtr->watchMask & TCL_WRITABLE) { - filePtr = (WinFile*) infoPtr->writeFile; if (WaitForSingleObject(infoPtr->writable, 0) != WAIT_TIMEOUT) { block = 0; } } if (infoPtr->watchMask & TCL_READABLE) { - filePtr = (WinFile*) infoPtr->readFile; if (WaitForRead(infoPtr, 0) >= 0) { block = 0; } @@ -379,7 +376,6 @@ PipeCheckProc( { PipeInfo *infoPtr; PipeEvent *evPtr; - WinFile *filePtr; int needEvent; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -402,13 +398,11 @@ PipeCheckProc( */ needEvent = 0; - filePtr = (WinFile*) infoPtr->writeFile; if ((infoPtr->watchMask & TCL_WRITABLE) && (WaitForSingleObject(infoPtr->writable, 0) != WAIT_TIMEOUT)) { needEvent = 1; } - filePtr = (WinFile*) infoPtr->readFile; if ((infoPtr->watchMask & TCL_READABLE) && (WaitForRead(infoPtr, 0) >= 0)) { needEvent = 1; @@ -416,7 +410,7 @@ PipeCheckProc( if (needEvent) { infoPtr->flags |= PIPE_PENDING; - evPtr = (PipeEvent *) ckalloc(sizeof(PipeEvent)); + evPtr = ckalloc(sizeof(PipeEvent)); evPtr->header.proc = PipeEventProc; evPtr->infoPtr = infoPtr; Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL); @@ -447,7 +441,7 @@ TclWinMakeFile( { WinFile *filePtr; - filePtr = (WinFile *) ckalloc(sizeof(WinFile)); + filePtr = ckalloc(sizeof(WinFile)); filePtr->type = WIN_FILE; filePtr->handle = handle; @@ -476,27 +470,18 @@ TclWinMakeFile( static int TempFileName( - WCHAR name[MAX_PATH]) /* Buffer in which name for temporary file + TCHAR 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, - name) != 0) { + const TCHAR *prefix = TEXT("TCL"); + if (GetTempPath(MAX_PATH, name) != 0) { + if (GetTempFileName(name, prefix, 0, name) != 0) { return 1; } } - if (tclWinProcs->useWide) { - ((WCHAR *) name)[0] = '.'; - ((WCHAR *) name)[1] = '\0'; - } else { - ((char *) name)[0] = '.'; - ((char *) name)[1] = '\0'; - } - return (*tclWinProcs->getTempFileNameProc)((TCHAR *) name, prefix, 0, - name); + name[0] = '.'; + name[1] = '\0'; + return GetTempFileName(name, prefix, 0, name); } /* @@ -608,7 +593,7 @@ TclpOpenFile( flags = 0; if (!(mode & O_CREAT)) { - flags = (*tclWinProcs->getFileAttributesProc)(nativePath); + flags = GetFileAttributes(nativePath); if (flags == 0xFFFFFFFF) { flags = 0; } @@ -624,8 +609,8 @@ TclpOpenFile( * Now we get to create the file. */ - handle = (*tclWinProcs->createFileProc)(nativePath, accessMode, - shareMode, NULL, createMode, flags, NULL); + handle = CreateFile(nativePath, accessMode, shareMode, + NULL, createMode, flags, NULL); Tcl_DStringFree(&ds); if (handle == INVALID_HANDLE_VALUE) { @@ -672,7 +657,7 @@ TclFile TclpCreateTempFile( const char *contents) /* String to write into temp file, or NULL. */ { - WCHAR name[MAX_PATH]; + TCHAR name[MAX_PATH]; const char *native; Tcl_DString dstring; HANDLE handle; @@ -681,7 +666,7 @@ TclpCreateTempFile( return NULL; } - handle = (*tclWinProcs->createFileProc)((TCHAR *) name, + handle = CreateFile(name, GENERIC_READ | GENERIC_WRITE, 0, NULL, CREATE_ALWAYS, FILE_ATTRIBUTE_TEMPORARY|FILE_FLAG_DELETE_ON_CLOSE, NULL); if (handle == INVALID_HANDLE_VALUE) { @@ -695,6 +680,7 @@ TclpCreateTempFile( if (contents != NULL) { DWORD result, length; const char *p; + int toCopy; /* * Convert the contents from UTF to native encoding @@ -702,7 +688,8 @@ TclpCreateTempFile( native = Tcl_UtfToExternalDString(NULL, contents, -1, &dstring); - for (p = native; *p != '\0'; p++) { + toCopy = Tcl_DStringLength(&dstring); + for (p = native; toCopy > 0; p++, toCopy--) { if (*p == '\n') { length = p - native; if (length > 0) { @@ -741,7 +728,7 @@ TclpCreateTempFile( TclWinConvertError(GetLastError()); CloseHandle(handle); - (*tclWinProcs->deleteFileProc)((TCHAR *) name); + DeleteFile(name); return NULL; } @@ -764,13 +751,13 @@ TclpCreateTempFile( Tcl_Obj * TclpTempFileName(void) { - WCHAR fileName[MAX_PATH]; + TCHAR fileName[MAX_PATH]; if (TempFileName(fileName) == 0) { return NULL; } - return TclpNativeToNormalized((ClientData) fileName); + return TclpNativeToNormalized(fileName); } /* @@ -846,7 +833,7 @@ TclpCloseFile( if (filePtr->handle != NULL && CloseHandle(filePtr->handle) == FALSE) { TclWinConvertError(GetLastError()); - ckfree((char *) filePtr); + ckfree(filePtr); return -1; } } @@ -856,7 +843,7 @@ TclpCloseFile( Tcl_Panic("TclpCloseFile: unexpected file type"); } - ckfree((char *) filePtr); + ckfree(filePtr); return 0; } @@ -879,7 +866,7 @@ TclpCloseFile( *-------------------------------------------------------------------------- */ -unsigned long +int TclpGetPid( Tcl_Pid pid) /* The HANDLE of the child process. */ { @@ -957,7 +944,7 @@ TclpCreateProcess( { int result, applType, createFlags; Tcl_DString cmdLine; /* Complete command line (TCHAR). */ - STARTUPINFOA startInfo; + STARTUPINFO startInfo; PROCESS_INFORMATION procInfo; SECURITY_ATTRIBUTES secAtts; HANDLE hProcess, h, inputHandle, outputHandle, errorHandle; @@ -1047,8 +1034,9 @@ TclpCreateProcess( } if (startInfo.hStdInput == INVALID_HANDLE_VALUE) { TclWinConvertError(GetLastError()); - Tcl_AppendResult(interp, "couldn't duplicate input handle: ", - Tcl_PosixError(interp), (char *) NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "couldn't duplicate input handle: %s", + Tcl_PosixError(interp))); goto end; } @@ -1067,23 +1055,17 @@ TclpCreateProcess( * sink. */ - if ((TclWinGetPlatformId() == VER_PLATFORM_WIN32_WINDOWS) - && (applType == APPL_DOS)) { - if (CreatePipe(&h, &startInfo.hStdOutput, &secAtts, 0) != FALSE) { - CloseHandle(h); - } - } else { - startInfo.hStdOutput = CreateFileA("NUL:", GENERIC_WRITE, 0, - &secAtts, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, NULL); - } + startInfo.hStdOutput = CreateFile(TEXT("NUL:"), GENERIC_WRITE, 0, + &secAtts, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, NULL); } else { DuplicateHandle(hProcess, outputHandle, hProcess, &startInfo.hStdOutput, 0, TRUE, DUPLICATE_SAME_ACCESS); } if (startInfo.hStdOutput == INVALID_HANDLE_VALUE) { TclWinConvertError(GetLastError()); - Tcl_AppendResult(interp, "couldn't duplicate output handle: ", - Tcl_PosixError(interp), (char *) NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "couldn't duplicate output handle: %s", + Tcl_PosixError(interp))); goto end; } @@ -1093,7 +1075,7 @@ TclpCreateProcess( * sink. */ - startInfo.hStdError = CreateFileA("NUL:", GENERIC_WRITE, 0, + startInfo.hStdError = CreateFile(TEXT("NUL:"), GENERIC_WRITE, 0, &secAtts, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL); } else { DuplicateHandle(hProcess, errorHandle, hProcess, &startInfo.hStdError, @@ -1101,8 +1083,9 @@ TclpCreateProcess( } if (startInfo.hStdError == INVALID_HANDLE_VALUE) { TclWinConvertError(GetLastError()); - Tcl_AppendResult(interp, "couldn't duplicate error handle: ", - Tcl_PosixError(interp), (char *) NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "couldn't duplicate error handle: %s", + Tcl_PosixError(interp))); goto end; } @@ -1134,7 +1117,7 @@ TclpCreateProcess( startInfo.wShowWindow = SW_HIDE; startInfo.dwFlags |= STARTF_USESHOWWINDOW; createFlags = CREATE_NEW_CONSOLE; - Tcl_DStringAppend(&cmdLine, "cmd.exe /c", -1); + TclDStringAppendLiteral(&cmdLine, "cmd.exe /c"); } else { createFlags = DETACHED_PROCESS; } @@ -1146,82 +1129,12 @@ TclpCreateProcess( } if (applType == APPL_DOS) { - /* - * Under Windows 95, 16-bit DOS applications do not work well with - * pipes: - * - * 1. EOF on a pipe between a detached 16-bit DOS application and - * another application is not seen at the other end of the pipe, - * so the listening process blocks forever on reads. This inablity - * to detect EOF happens when either a 16-bit app or the 32-bit - * app is the listener. - * - * 2. If a 16-bit DOS application (detached or not) blocks when - * writing to a pipe, it will never wake up again, and it - * eventually brings the whole system down around it. - * - * The 16-bit application is run as a normal process inside of a - * hidden helper console app, and this helper may be run as a - * detached process. If any of the stdio handles is a pipe, the - * helper application accumulates information into temp files and - * forwards it to or from the DOS application as appropriate. - * This means that DOS apps must receive EOF from a stdin pipe - * before they will actually begin, and must finish generating - * stdout or stderr before the data will be sent to the next stage - * of the pipe. - * - * The helper app should be located in the same directory as the - * tcl dll. - */ - Tcl_Obj *tclExePtr, *pipeDllPtr; - char *start, *end; - int i, fileExists; - Tcl_DString pipeDll; - - if (createFlags != 0) { - startInfo.wShowWindow = SW_HIDE; - startInfo.dwFlags |= STARTF_USESHOWWINDOW; - createFlags = CREATE_NEW_CONSOLE; - } - - Tcl_DStringInit(&pipeDll); - Tcl_DStringAppend(&pipeDll, TCL_PIPE_DLL, -1); - tclExePtr = TclGetObjNameOfExecutable(); - Tcl_IncrRefCount(tclExePtr); - start = Tcl_GetStringFromObj(tclExePtr, &i); - for (end = start + (i-1); end > start; end--) { - if (*end == '/') { - break; - } - } - if (*end != '/') { - Tcl_AppendResult(interp, "no / in executable path name \"", - start, "\"", (char *) NULL); - Tcl_DecrRefCount(tclExePtr); - Tcl_DStringFree(&pipeDll); - goto end; - } - i = (end - start) + 1; - pipeDllPtr = Tcl_NewStringObj(start, i); - Tcl_AppendToObj(pipeDllPtr, Tcl_DStringValue(&pipeDll), -1); - Tcl_IncrRefCount(pipeDllPtr); - if (Tcl_FSConvertToPathType(interp, pipeDllPtr) != TCL_OK) { - Tcl_Panic("Tcl_FSConvertToPathType failed"); - } - fileExists = (Tcl_FSAccess(pipeDllPtr, F_OK) == 0); - if (!fileExists) { - Tcl_AppendResult(interp, "Tcl pipe dll \"", - Tcl_DStringValue(&pipeDll), "\" not found", - (char *) NULL); - Tcl_DecrRefCount(tclExePtr); - Tcl_DecrRefCount(pipeDllPtr); - Tcl_DStringFree(&pipeDll); - goto end; - } - Tcl_DStringAppend(&cmdLine, Tcl_DStringValue(&pipeDll), -1); - Tcl_DecrRefCount(tclExePtr); - Tcl_DecrRefCount(pipeDllPtr); - Tcl_DStringFree(&pipeDll); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "DOS application process not supported on this platform", + -1)); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC", "DOS_APP", + NULL); + goto end; } } @@ -1245,12 +1158,12 @@ TclpCreateProcess( BuildCommandLine(execPath, argc, argv, &cmdLine); - if ((*tclWinProcs->createProcessProc)(NULL, - (TCHAR *) Tcl_DStringValue(&cmdLine), NULL, NULL, TRUE, - (DWORD) createFlags, NULL, NULL, &startInfo, &procInfo) == 0) { + if (CreateProcess(NULL, (TCHAR *) Tcl_DStringValue(&cmdLine), + NULL, NULL, TRUE, (DWORD) createFlags, NULL, NULL, &startInfo, + &procInfo) == 0) { TclWinConvertError(GetLastError()); - Tcl_AppendResult(interp, "couldn't execute \"", argv[0], - "\": ", Tcl_PosixError(interp), (char *) NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf("couldn't execute \"%s\": %s", + argv[0], Tcl_PosixError(interp))); goto end; } @@ -1378,8 +1291,8 @@ ApplicationType( IMAGE_DOS_HEADER header; Tcl_DString nameBuf, ds; const TCHAR *nativeName; - WCHAR nativeFullPath[MAX_PATH]; - static char extensions[][5] = {"", ".com", ".exe", ".bat"}; + TCHAR nativeFullPath[MAX_PATH]; + static const char extensions[][5] = {"", ".com", ".exe", ".bat"}; /* * Look for the program as an external program. First try the name as it @@ -1404,8 +1317,8 @@ ApplicationType( Tcl_DStringAppend(&nameBuf, extensions[i], -1); nativeName = Tcl_WinUtfToTChar(Tcl_DStringValue(&nameBuf), Tcl_DStringLength(&nameBuf), &ds); - found = (*tclWinProcs->searchPathProc)(NULL, nativeName, NULL, - MAX_PATH, nativeFullPath, &rest); + found = SearchPath(NULL, nativeName, NULL, MAX_PATH, + nativeFullPath, &rest); Tcl_DStringFree(&ds); if (found == 0) { continue; @@ -1416,20 +1329,20 @@ ApplicationType( * known type. */ - attr = (*tclWinProcs->getFileAttributesProc)((TCHAR *) nativeFullPath); + attr = GetFileAttributes(nativeFullPath); if ((attr == 0xffffffff) || (attr & FILE_ATTRIBUTE_DIRECTORY)) { continue; } - strcpy(fullName, Tcl_WinTCharToUtf((TCHAR *) nativeFullPath, -1, &ds)); + strcpy(fullName, Tcl_WinTCharToUtf(nativeFullPath, -1, &ds)); 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, + hFile = CreateFile(nativeFullPath, GENERIC_READ, FILE_SHARE_READ, NULL, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL); if (hFile == INVALID_HANDLE_VALUE) { @@ -1448,7 +1361,7 @@ ApplicationType( */ CloseHandle(hFile); - if ((ext != NULL) && (stricmp(ext, ".com") == 0)) { + if ((ext != NULL) && (strcasecmp(ext, ".com") == 0)) { applType = APPL_DOS; break; } @@ -1496,8 +1409,8 @@ ApplicationType( if (applType == APPL_NONE) { TclWinConvertError(GetLastError()); - Tcl_AppendResult(interp, "couldn't execute \"", originalName, - "\": ", Tcl_PosixError(interp), (char *) NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf("couldn't execute \"%s\": %s", + originalName, Tcl_PosixError(interp))); return APPL_NONE; } @@ -1509,9 +1422,8 @@ ApplicationType( * application name from the arguments. */ - (*tclWinProcs->getShortPathNameProc)((TCHAR *) nativeFullPath, - nativeFullPath, MAX_PATH); - strcpy(fullName, Tcl_WinTCharToUtf((TCHAR *) nativeFullPath, -1, &ds)); + GetShortPathName(nativeFullPath, nativeFullPath, MAX_PATH); + strcpy(fullName, Tcl_WinTCharToUtf(nativeFullPath, -1, &ds)); Tcl_DStringFree(&ds); } return applType; @@ -1555,9 +1467,9 @@ BuildCommandLine( * Prime the path. Add a space separator if we were primed with something. */ - Tcl_DStringAppend(&ds, Tcl_DStringValue(linePtr), -1); + TclDStringAppendDString(&ds, linePtr); if (Tcl_DStringLength(linePtr) > 0) { - Tcl_DStringAppend(&ds, " ", 1); + TclDStringAppendLiteral(&ds, " "); } for (i = 0; i < argc; i++) { @@ -1565,7 +1477,7 @@ BuildCommandLine( arg = executable; } else { arg = argv[i]; - Tcl_DStringAppend(&ds, " ", 1); + TclDStringAppendLiteral(&ds, " "); } quote = 0; @@ -1574,6 +1486,7 @@ BuildCommandLine( } else { int count; Tcl_UniChar ch; + for (start = arg; *start != '\0'; start += count) { count = Tcl_UtfToUniChar(start, &ch); if (Tcl_UniCharIsSpace(ch)) { /* INTL: ISO space. */ @@ -1583,7 +1496,7 @@ BuildCommandLine( } } if (quote) { - Tcl_DStringAppend(&ds, "\"", 1); + TclDStringAppendLiteral(&ds, "\""); } start = arg; for (special = arg; ; ) { @@ -1612,7 +1525,7 @@ BuildCommandLine( } if (*special == '"') { Tcl_DStringAppend(&ds, start, (int) (special - start)); - Tcl_DStringAppend(&ds, "\\\"", 2); + TclDStringAppendLiteral(&ds, "\\\""); start = special + 1; } if (*special == '\0') { @@ -1622,7 +1535,7 @@ BuildCommandLine( } Tcl_DStringAppend(&ds, start, (int) (special - start)); if (quote) { - Tcl_DStringAppend(&ds, "\"", 1); + TclDStringAppendLiteral(&ds, "\""); } } Tcl_DStringFree(linePtr); @@ -1657,9 +1570,8 @@ TclpCreateCommandChannel( Tcl_Pid *pidPtr) /* An array of process identifiers. */ { char channelName[16 + TCL_INTEGER_SPACE]; - int channelId; DWORD id; - PipeInfo *infoPtr = (PipeInfo *) ckalloc((unsigned) sizeof(PipeInfo)); + PipeInfo *infoPtr = ckalloc(sizeof(PipeInfo)); PipeInit(); @@ -1674,21 +1586,7 @@ TclpCreateCommandChannel( infoPtr->writeBuf = 0; infoPtr->writeBufLen = 0; infoPtr->writeError = 0; - infoPtr->channel = (Tcl_Channel) NULL; - - /* - * Use one of the fds associated with the channel as the channel id. - */ - - if (readFile) { - channelId = (int) ((WinFile*)readFile)->handle; - } else if (writeFile) { - channelId = (int) ((WinFile*)writeFile)->handle; - } else if (errorFile) { - channelId = (int) ((WinFile*)errorFile)->handle; - } else { - channelId = 0; - } + infoPtr->channel = NULL; infoPtr->validMask = 0; @@ -1730,9 +1628,9 @@ TclpCreateCommandChannel( * unique, in case channels share handles (stdin/stdout). */ - wsprintfA(channelName, "file%lx", infoPtr); + sprintf(channelName, "file%" TCL_I_MODIFIER "x", (size_t) infoPtr); infoPtr->channel = Tcl_CreateChannel(&pipeChannelType, channelName, - (ClientData) infoPtr, infoPtr->validMask); + infoPtr, infoPtr->validMask); /* * Pipes have AUTO translation mode on Windows and ^Z eof char, which @@ -1740,16 +1638,58 @@ TclpCreateCommandChannel( * Windows programs that expect a ^Z at EOF. */ - Tcl_SetChannelOption((Tcl_Interp *) NULL, infoPtr->channel, - "-translation", "auto"); - Tcl_SetChannelOption((Tcl_Interp *) NULL, infoPtr->channel, - "-eofchar", "\032 {}"); + Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto"); + Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "\032 {}"); return infoPtr->channel; } /* *---------------------------------------------------------------------- * + * Tcl_CreatePipe -- + * + * System dependent interface to create a pipe for the [chan pipe] + * command. Stolen from TclX. + * + * Results: + * TCL_OK or TCL_ERROR. + * + *---------------------------------------------------------------------- + */ + +int +Tcl_CreatePipe( + Tcl_Interp *interp, /* Errors returned in result.*/ + Tcl_Channel *rchan, /* Where to return the read side. */ + Tcl_Channel *wchan, /* Where to return the write side. */ + int flags) /* Reserved for future use. */ +{ + HANDLE readHandle, writeHandle; + SECURITY_ATTRIBUTES sec; + + sec.nLength = sizeof(SECURITY_ATTRIBUTES); + sec.lpSecurityDescriptor = NULL; + sec.bInheritHandle = FALSE; + + if (!CreatePipe(&readHandle, &writeHandle, &sec, 0)) { + TclWinConvertError(GetLastError()); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "pipe creation failed: %s", Tcl_PosixError(interp))); + return TCL_ERROR; + } + + *rchan = Tcl_MakeFileChannel((ClientData) readHandle, TCL_READABLE); + Tcl_RegisterChannel(interp, *rchan); + + *wchan = Tcl_MakeFileChannel((ClientData) writeHandle, TCL_WRITABLE); + Tcl_RegisterChannel(interp, *wchan); + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * * TclGetAndDetachPids -- * * Stores a list of the command PIDs for a command channel in the @@ -1771,8 +1711,8 @@ TclGetAndDetachPids( { PipeInfo *pipePtr; const Tcl_ChannelType *chanTypePtr; + Tcl_Obj *pidsObj; int i; - char buf[TCL_INTEGER_SPACE]; /* * Punt if the channel is not a command channel. @@ -1783,14 +1723,17 @@ TclGetAndDetachPids( return; } - pipePtr = (PipeInfo *) Tcl_GetChannelInstanceData(chan); + pipePtr = Tcl_GetChannelInstanceData(chan); + TclNewObj(pidsObj); for (i = 0; i < pipePtr->numPids; i++) { - wsprintfA(buf, "%lu", TclpGetPid(pipePtr->pidPtr[i])); - Tcl_AppendElement(interp, buf); - Tcl_DetachPids(1, &(pipePtr->pidPtr[i])); + Tcl_ListObjAppendElement(NULL, pidsObj, + Tcl_NewWideIntObj((unsigned) + TclpGetPid(pipePtr->pidPtr[i]))); + Tcl_DetachPids(1, &pipePtr->pidPtr[i]); } + Tcl_SetObjResult(interp, pidsObj); if (pipePtr->numPids > 0) { - ckfree((char *) pipePtr->pidPtr); + ckfree(pipePtr->pidPtr); pipePtr->numPids = 0; } } @@ -1935,12 +1878,26 @@ PipeClose2Proc( && (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 but blocked during exit, bail out since the worker + * thread is not interruptible and we want TIP#398-fast-exit. */ + if (TclInExit() + && (pipePtr->flags & PIPE_ASYNC)) { + + /* give it a chance to leave honorably */ + SetEvent(pipePtr->stopWriter); + + if (WaitForSingleObject(pipePtr->writable, 0) == WAIT_TIMEOUT) { + return EWOULDBLOCK; + } + + } else { - WaitForSingleObject(pipePtr->writable, INFINITE); + WaitForSingleObject(pipePtr->writable, INFINITE); + + } /* * The thread may already have closed on it's own. Check its exit @@ -2050,12 +2007,11 @@ PipeClose2Proc( */ if (pipePtr->errorFile) { - WinFile *filePtr; + WinFile *filePtr = (WinFile *) pipePtr->errorFile; - filePtr = (WinFile*)pipePtr->errorFile; errChan = Tcl_MakeFileChannel((ClientData) filePtr->handle, TCL_READABLE); - ckfree((char *) filePtr); + ckfree(filePtr); } else { errChan = NULL; } @@ -2065,14 +2021,14 @@ PipeClose2Proc( } if (pipePtr->numPids > 0) { - ckfree((char *) pipePtr->pidPtr); + ckfree(pipePtr->pidPtr); } if (pipePtr->writeBuf != NULL) { ckfree(pipePtr->writeBuf); } - ckfree((char*) pipePtr); + ckfree(pipePtr); if (errorCode == 0) { return result; @@ -2211,7 +2167,7 @@ PipeOutputProc( * the channel is in non-blocking mode. */ - errno = EAGAIN; + errno = EWOULDBLOCK; goto error; } @@ -2240,7 +2196,7 @@ PipeOutputProc( ckfree(infoPtr->writeBuf); } infoPtr->writeBufLen = toWrite; - infoPtr->writeBuf = ckalloc((unsigned int) toWrite); + infoPtr->writeBuf = ckalloc(toWrite); } memcpy(infoPtr->writeBuf, buf, (size_t) toWrite); infoPtr->toWrite = toWrite; @@ -2296,7 +2252,6 @@ PipeEventProc( { PipeEvent *pipeEvPtr = (PipeEvent *)evPtr; PipeInfo *infoPtr; - WinFile *filePtr; int mask; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -2333,14 +2288,12 @@ PipeEventProc( * detected EOF. */ - filePtr = (WinFile*) ((PipeInfo*)infoPtr)->writeFile; mask = 0; if ((infoPtr->watchMask & TCL_WRITABLE) && (WaitForSingleObject(infoPtr->writable, 0) != WAIT_TIMEOUT)) { mask = TCL_WRITABLE; } - filePtr = (WinFile*) ((PipeInfo*)infoPtr)->readFile; if ((infoPtr->watchMask & TCL_READABLE) && (WaitForRead(infoPtr,0) >= 0)) { if (infoPtr->readFlags & PIPE_EOF) { mask = TCL_READABLE; @@ -2622,7 +2575,7 @@ Tcl_WaitPid( */ CloseHandle(infoPtr->hProcess); - ckfree((char*)infoPtr); + ckfree(infoPtr); return result; } @@ -2647,10 +2600,10 @@ Tcl_WaitPid( void TclWinAddProcess( - HANDLE hProcess, /* Handle to process */ - DWORD id) /* Global process identifier */ + void *hProcess, /* Handle to process */ + unsigned long id) /* Global process identifier */ { - ProcInfo *procPtr = (ProcInfo *) ckalloc(sizeof(ProcInfo)); + ProcInfo *procPtr = ckalloc(sizeof(ProcInfo)); PipeInit(); @@ -2692,15 +2645,13 @@ Tcl_PidObjCmd( PipeInfo *pipePtr; int i; Tcl_Obj *resultPtr; - char buf[TCL_INTEGER_SPACE]; if (objc > 2) { Tcl_WrongNumArgs(interp, 1, objv, "?channelId?"); return TCL_ERROR; } if (objc == 1) { - wsprintfA(buf, "%lu", (unsigned long) getpid()); - Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, -1)); + Tcl_SetObjResult(interp, Tcl_NewWideIntObj((unsigned) getpid())); } else { chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], NULL), NULL); @@ -2715,9 +2666,9 @@ Tcl_PidObjCmd( 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_NewWideIntObj((unsigned) + TclpGetPid(pipePtr->pidPtr[i]))); } Tcl_SetObjResult(interp, resultPtr); } @@ -2767,7 +2718,7 @@ WaitForRead( * is in non-blocking mode. */ - errno = EAGAIN; + errno = EWOULDBLOCK; return -1; } @@ -3009,6 +2960,10 @@ PipeWriterThread( * an error, so exit. */ + if (waitResult == WAIT_OBJECT_0) { + SetEvent(infoPtr->writable); + } + break; } @@ -3109,6 +3064,100 @@ PipeThreadActionProc( } /* + *---------------------------------------------------------------------- + * + * TclpOpenTemporaryFile -- + * + * Creates a temporary file, possibly based on the supplied bits and + * pieces of template supplied in the first three arguments. If the + * fourth argument is non-NULL, it contains a Tcl_Obj to store the name + * of the temporary file in (and it is caller's responsibility to clean + * up). If the fourth argument is NULL, try to arrange for the temporary + * file to go away once it is no longer needed. + * + * Results: + * A read-write Tcl Channel open on the file. + * + *---------------------------------------------------------------------- + */ + +Tcl_Channel +TclpOpenTemporaryFile( + Tcl_Obj *dirObj, + Tcl_Obj *basenameObj, + Tcl_Obj *extensionObj, + Tcl_Obj *resultingNameObj) +{ + TCHAR name[MAX_PATH]; + char *namePtr; + HANDLE handle; + DWORD flags = FILE_ATTRIBUTE_TEMPORARY; + int length, counter, counter2; + Tcl_DString buf; + + if (!resultingNameObj) { + flags |= FILE_FLAG_DELETE_ON_CLOSE; + } + + namePtr = (char *) name; + length = GetTempPath(MAX_PATH, name); + if (length == 0) { + goto gotError; + } + namePtr += length * sizeof(TCHAR); + if (basenameObj) { + const char *string = Tcl_GetStringFromObj(basenameObj, &length); + + Tcl_WinUtfToTChar(string, length, &buf); + memcpy(namePtr, Tcl_DStringValue(&buf), Tcl_DStringLength(&buf)); + namePtr += Tcl_DStringLength(&buf); + Tcl_DStringFree(&buf); + } else { + const TCHAR *baseStr = TEXT("TCL"); + int length = 3 * sizeof(TCHAR); + + memcpy(namePtr, baseStr, length); + namePtr += length; + } + counter = TclpGetClicks() % 65533; + counter2 = 1024; /* Only try this many times! Prevents + * an infinite loop. */ + + do { + char number[TCL_INTEGER_SPACE + 4]; + + sprintf(number, "%d.TMP", counter); + counter = (unsigned short) (counter + 1); + Tcl_WinUtfToTChar(number, strlen(number), &buf); + Tcl_DStringSetLength(&buf, Tcl_DStringLength(&buf) + 1); + memcpy(namePtr, Tcl_DStringValue(&buf), Tcl_DStringLength(&buf) + 1); + Tcl_DStringFree(&buf); + + handle = CreateFile(name, + GENERIC_READ|GENERIC_WRITE, 0, NULL, CREATE_NEW, flags, NULL); + } while (handle == INVALID_HANDLE_VALUE + && --counter2 > 0 + && GetLastError() == ERROR_FILE_EXISTS); + if (handle == INVALID_HANDLE_VALUE) { + goto gotError; + } + + if (resultingNameObj) { + Tcl_Obj *tmpObj = TclpNativeToNormalized(name); + + Tcl_AppendObjToObj(resultingNameObj, tmpObj); + TclDecrRefCount(tmpObj); + } + + return Tcl_MakeFileChannel((ClientData) handle, + TCL_READABLE|TCL_WRITABLE); + + gotError: + TclWinConvertError(GetLastError()); + return NULL; +} + +/* * Local Variables: * mode: c * c-basic-offset: 4 diff --git a/win/tclWinPort.h b/win/tclWinPort.h index b1765dd..652cd06 100644 --- a/win/tclWinPort.h +++ b/win/tclWinPort.h @@ -9,13 +9,49 @@ * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. - * - * RCS: @(#) $Id: tclWinPort.h,v 1.48 2005/11/27 02:33:50 das Exp $ */ #ifndef _TCLWINPORT #define _TCLWINPORT +#if !defined(_WIN64) && defined(BUILD_tcl) +/* See [Bug 3354324]: file mtime sets wrong time */ +# define _USE_32BIT_TIME_T +#endif + +/* + * We must specify the lower version we intend to support. + * + * WINVER = 0x0500 means Windows 2000 and above + */ + +#ifndef WINVER +# define WINVER 0x0501 +#endif +#ifndef _WIN32_WINNT +# define _WIN32_WINNT 0x0501 +#endif + +#define WIN32_LEAN_AND_MEAN +#include <windows.h> +#undef WIN32_LEAN_AND_MEAN + +/* Compatibility to older visual studio / windows platform SDK */ +#if !defined(MAXULONG_PTR) +typedef DWORD DWORD_PTR; +typedef DWORD_PTR * PDWORD_PTR; +#endif + +/* + * Ask for the winsock function typedefs, also. + */ +#define INCL_WINSOCK_API_TYPEDEFS 1 +#include <winsock2.h> +#include <ws2tcpip.h> +#ifdef HAVE_WSPIAPI_H +# include <wspiapi.h> +#endif + #ifdef CHECK_UNICODE_CALLS # define _UNICODE # define UNICODE @@ -26,30 +62,41 @@ #endif /* CHECK_UNICODE_CALLS */ /* + * Pull in the typedef of TCHAR for windows. + */ +#include <tchar.h> +#ifndef _TCHAR_DEFINED + /* Borland seems to forget to set this. */ + typedef _TCHAR TCHAR; +# define _TCHAR_DEFINED +#endif +#if defined(_MSC_VER) && defined(__STDC__) + /* VS2005 SP1 misses this. See [Bug #3110161] */ + typedef _TCHAR TCHAR; +#endif + +/* *--------------------------------------------------------------------------- * The following sets of #includes and #ifdefs are required to get Tcl to * compile under the windows compilers. *--------------------------------------------------------------------------- */ -#include <stdio.h> -#include <stdlib.h> - +#include <time.h> +#include <wchar.h> +#include <io.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> - -/* - * These string functions are not defined with the same names on Windows. - */ +#include <limits.h> -#define strcasecmp stricmp -#define strncasecmp strnicmp +#ifndef __GNUC__ +# define strncasecmp _strnicmp +# define strcasecmp _stricmp +#endif /* * Need to block out these includes for building extensions with MetroWerks @@ -66,157 +113,169 @@ # endif /* __BORLANDC__ */ #endif /* __MWERKS__ */ -#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> - -/* - * Define EINPROGRESS in terms of WSAEINPROGRESS. - */ - -#ifndef EINPROGRESS -# define EINPROGRESS WSAEINPROGRESS -#endif - -/* - * If ENOTSUP is not defined, define it to a value that will never occur. - */ - -#ifndef ENOTSUP -# define ENOTSUP -1030507 -#endif - /* * The following defines redefine the Windows Socket errors as * BSD errors so Tcl_PosixError can do the right thing. */ -#ifndef EWOULDBLOCK -# define EWOULDBLOCK EAGAIN +#ifndef ENOTEMPTY +# define ENOTEMPTY 41 /* Directory not empty */ +#endif +#ifndef EREMOTE +# define EREMOTE 66 /* The object is remote */ +#endif +#ifndef EPFNOSUPPORT +# define EPFNOSUPPORT 96 /* Protocol family not supported */ +#endif +#ifndef EADDRINUSE +# define EADDRINUSE 100 /* Address already in use */ +#endif +#ifndef EADDRNOTAVAIL +# define EADDRNOTAVAIL 101 /* Can't assign requested address */ +#endif +#ifndef EAFNOSUPPORT +# define EAFNOSUPPORT 102 /* Address family not supported */ #endif #ifndef EALREADY -# define EALREADY 149 /* operation already in progress */ +# define EALREADY 103 /* Operation already in progress */ #endif -#ifndef ENOTSOCK -# define ENOTSOCK 95 /* Socket operation on non-socket */ +#ifndef EBADMSG +# define EBADMSG 104 /* Not a data message */ #endif -#ifndef EDESTADDRREQ -# define EDESTADDRREQ 96 /* Destination address required */ +#ifndef ECANCELED +# define ECANCELED 105 /* Canceled */ #endif -#ifndef EMSGSIZE -# define EMSGSIZE 97 /* Message too long */ +#ifndef ECONNABORTED +# define ECONNABORTED 106 /* Software caused connection abort */ #endif -#ifndef EPROTOTYPE -# define EPROTOTYPE 98 /* Protocol wrong type for socket */ +#ifndef ECONNREFUSED +# define ECONNREFUSED 107 /* Connection refused */ #endif -#ifndef ENOPROTOOPT -# define ENOPROTOOPT 99 /* Protocol not available */ +#ifndef ECONNRESET +# define ECONNRESET 108 /* Connection reset by peer */ #endif -#ifndef EPROTONOSUPPORT -# define EPROTONOSUPPORT 120 /* Protocol not supported */ +#ifndef EDESTADDRREQ +# define EDESTADDRREQ 109 /* Destination address required */ #endif -#ifndef ESOCKTNOSUPPORT -# define ESOCKTNOSUPPORT 121 /* Socket type not supported */ +#ifndef EHOSTUNREACH +# define EHOSTUNREACH 110 /* No route to host */ #endif -#ifndef EOPNOTSUPP -# define EOPNOTSUPP 122 /* Operation not supported on socket */ +#ifndef EIDRM +# define EIDRM 111 /* Identifier removed */ #endif -#ifndef EPFNOSUPPORT -# define EPFNOSUPPORT 123 /* Protocol family not supported */ +#ifndef EINPROGRESS +# define EINPROGRESS 112 /* Operation now in progress */ #endif -#ifndef EAFNOSUPPORT -# define EAFNOSUPPORT 124 /* Address family not supported */ +#ifndef EISCONN +# define EISCONN 113 /* Socket is already connected */ #endif -#ifndef EADDRINUSE -# define EADDRINUSE 125 /* Address already in use */ +#ifndef ELOOP +# define ELOOP 114 /* Symbolic link loop */ #endif -#ifndef EADDRNOTAVAIL -# define EADDRNOTAVAIL 126 /* Can't assign requested address */ +#ifndef EMSGSIZE +# define EMSGSIZE 115 /* Message too long */ #endif #ifndef ENETDOWN -# define ENETDOWN 127 /* Network is down */ +# define ENETDOWN 116 /* Network is down */ +#endif +#ifndef ENETRESET +# define ENETRESET 117 /* Network dropped connection on reset */ #endif #ifndef ENETUNREACH -# define ENETUNREACH 128 /* Network is unreachable */ +# define ENETUNREACH 118 /* Network is unreachable */ #endif -#ifndef ENETRESET -# define ENETRESET 129 /* Network dropped connection on reset */ +#ifndef ENOBUFS +# define ENOBUFS 119 /* No buffer space available */ #endif -#ifndef ECONNABORTED -# define ECONNABORTED 130 /* Software caused connection abort */ +#ifndef ENODATA +# define ENODATA 120 /* No data available */ #endif -#ifndef ECONNRESET -# define ECONNRESET 131 /* Connection reset by peer */ +#ifndef ENOLINK +# define ENOLINK 121 /* Link has be severed */ #endif -#ifndef ENOBUFS -# define ENOBUFS 132 /* No buffer space available */ +#ifndef ENOMSG +# define ENOMSG 122 /* No message of desired type */ #endif -#ifndef EISCONN -# define EISCONN 133 /* Socket is already connected */ +#ifndef ENOPROTOOPT +# define ENOPROTOOPT 123 /* Protocol not available */ +#endif +#ifndef ENOSR +# define ENOSR 124 /* Out of stream resources */ +#endif +#ifndef ENOSTR +# define ENOSTR 125 /* Not a stream device */ #endif #ifndef ENOTCONN -# define ENOTCONN 134 /* Socket is not connected */ +# define ENOTCONN 126 /* Socket is not connected */ #endif -#ifndef ESHUTDOWN -# define ESHUTDOWN 143 /* Can't send after socket shutdown */ +#ifndef ENOTRECOVERABLE +# define ENOTRECOVERABLE 127 /* Not recoverable */ #endif -#ifndef ETOOMANYREFS -# define ETOOMANYREFS 144 /* Too many references: can't splice */ +#ifndef ENOTSOCK +# define ENOTSOCK 128 /* Socket operation on non-socket */ +#endif +#ifndef ENOTSUP +# define ENOTSUP 129 /* Operation not supported */ +#endif +#ifndef EOPNOTSUPP +# define EOPNOTSUPP 130 /* Operation not supported on socket */ +#endif +#ifndef EOTHER +# define EOTHER 131 /* Other error */ +#endif +#ifndef EOVERFLOW +# define EOVERFLOW 132 /* File too big */ +#endif +#ifndef EOWNERDEAD +# define EOWNERDEAD 133 /* Owner dead */ +#endif +#ifndef EPROTO +# define EPROTO 134 /* Protocol error */ +#endif +#ifndef EPROTONOSUPPORT +# define EPROTONOSUPPORT 135 /* Protocol not supported */ +#endif +#ifndef EPROTOTYPE +# define EPROTOTYPE 136 /* Protocol wrong type for socket */ +#endif +#ifndef ETIME +# define ETIME 137 /* Timer expired */ #endif #ifndef ETIMEDOUT -# define ETIMEDOUT 145 /* Connection timed out */ +# define ETIMEDOUT 138 /* Connection timed out */ #endif -#ifndef ECONNREFUSED -# define ECONNREFUSED 146 /* Connection refused */ +#ifndef ETXTBSY +# define ETXTBSY 139 /* Text file or pseudo-device busy */ #endif -#ifndef ELOOP -# define ELOOP 90 /* Symbolic link loop */ +#ifndef EWOULDBLOCK +# define EWOULDBLOCK 140 /* Operation would block */ #endif -#ifndef EHOSTDOWN -# define EHOSTDOWN 147 /* Host is down */ + + +/* Visual Studio doesn't have these, so just choose some high numbers */ +#ifndef ESOCKTNOSUPPORT +# define ESOCKTNOSUPPORT 240 /* Socket type not supported */ #endif -#ifndef EHOSTUNREACH -# define EHOSTUNREACH 148 /* No route to host */ +#ifndef ESHUTDOWN +# define ESHUTDOWN 241 /* Can't send after socket shutdown */ #endif -#ifndef ENOTEMPTY -# define ENOTEMPTY 93 /* directory not empty */ +#ifndef ETOOMANYREFS +# define ETOOMANYREFS 242 /* Too many references: can't splice */ +#endif +#ifndef EHOSTDOWN +# define EHOSTDOWN 243 /* Host is down */ #endif #ifndef EUSERS -# define EUSERS 94 /* Too many users (for UFS) */ +# define EUSERS 244 /* Too many users (for UFS) */ #endif #ifndef EDQUOT -# define EDQUOT 69 /* Disc quota exceeded */ +# define EDQUOT 245 /* Disc quota exceeded */ #endif #ifndef ESTALE -# define ESTALE 151 /* Stale NFS file handle */ -#endif -#ifndef EREMOTE -# define EREMOTE 66 /* The object is remote */ +# define ESTALE 246 /* Stale NFS file handle */ #endif /* - * It is very hard to determine how Windows reacts to attempting to - * set a file pointer outside the input datatype's representable - * region. So we fake the error code ourselves. - */ - -#ifndef EOVERFLOW -# ifdef EFBIG -# define EOVERFLOW EFBIG /* The object couldn't fit in the datatype */ -# else /* !EFBIG */ -# define EOVERFLOW EINVAL /* Better than nothing! */ -# endif /* EFBIG */ -#endif /* !EOVERFLOW */ - -/* * Signals not known to the standard ANSI signal.h. These are used * by Tcl_WaitPid() and generic/tclPosixStr.c */ @@ -298,7 +357,7 @@ */ #ifndef S_IFLNK -#define S_IFLNK 0120000 /* Symbolic Link */ +# define S_IFLNK 0120000 /* Symbolic Link */ #endif #ifndef S_ISREG @@ -350,11 +409,11 @@ */ #ifndef MAXPATH -#define MAXPATH MAX_PATH +# define MAXPATH MAX_PATH #endif /* MAXPATH */ #ifndef MAXPATHLEN -#define MAXPATHLEN MAXPATH +# define MAXPATHLEN MAXPATH #endif /* MAXPATHLEN */ /* @@ -375,13 +434,15 @@ */ #if defined(_MSC_VER) || defined(__MINGW32__) -# define environ _environ -# define hypot _hypot -# define exception _exception -# undef EDEADLOCK -# if defined(__MINGW32__) && !defined(__MSVCRT__) +# 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 timezone _timezone -# endif +# endif #endif /* _MSC_VER || __MINGW32__ */ /* @@ -393,21 +454,7 @@ # 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 @@ -419,21 +466,16 @@ * 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) +#if defined(_MSC_VER) && (_MSC_VER >= 1400) +# pragma warning(disable:4244) +# pragma warning(disable:4267) +# pragma warning(disable:4996) #endif - -/* - * There is no platform-specific panic routine for Windows in the Tcl internals. - */ - -#define TclpPanic ((Tcl_PanicProc *) NULL) - /* *--------------------------------------------------------------------------- - * The following macros and declarations represent the interface between - * 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. *--------------------------------------------------------------------------- */ @@ -470,7 +512,7 @@ /* * Older version of Mingw are known to lack a MWMO_ALERTABLE define. */ -#if defined(HAVE_NO_MWMO_ALERTABLE) +#if !defined(MWMO_ALERTABLE) # define MWMO_ALERTABLE 2 #endif @@ -479,56 +521,37 @@ * use by tclAlloc.c. */ -#ifdef __CYGWIN__ -# define TclpSysAlloc(size, isBin) malloc((size)) -# define TclpSysFree(ptr) free((ptr)) -# define TclpSysRealloc(ptr, size) realloc((ptr), (size)) -#else -# define TclpSysAlloc(size, isBin) ((void*)HeapAlloc(GetProcessHeap(), \ +#define TclpSysAlloc(size, isBin) ((void*)HeapAlloc(GetProcessHeap(), \ (DWORD)0, (DWORD)size)) -# define TclpSysFree(ptr) (HeapFree(GetProcessHeap(), \ +#define TclpSysFree(ptr) (HeapFree(GetProcessHeap(), \ (DWORD)0, (HGLOBAL)ptr)) -# define TclpSysRealloc(ptr, size) ((void*)HeapReAlloc(GetProcessHeap(), \ +#define TclpSysRealloc(ptr, size) ((void*)HeapReAlloc(GetProcessHeap(), \ (DWORD)0, (LPVOID)ptr, (DWORD)size)) -#endif -/* - * The following defines map from standard socket names to our internal - * wrappers that redirect through the winSock function table (see the - * file tclWinSock.c). - */ - -#define getservbyname TclWinGetServByName -#define getsockopt TclWinGetSockOpt -#define ntohs TclWinNToHS -#define setsockopt TclWinSetSockOpt /* This type is not defined in the Windows headers */ #define socklen_t int /* - * 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 -#ifdef TCL_WIDE_INT_TYPE -MODULE_SCOPE Tcl_WideInt strtoll _ANSI_ARGS_((CONST char *string, - char **endPtr, int base)); -MODULE_SCOPE 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 */ +#ifndef LABEL_SECURITY_INFORMATION +# define LABEL_SECURITY_INFORMATION (0x00000010L) +#endif + #endif /* _TCLWINPORT */ diff --git a/win/tclWinReg.c b/win/tclWinReg.c index ca61554..327e4a3 100644 --- a/win/tclWinReg.c +++ b/win/tclWinReg.c @@ -10,16 +10,44 @@ * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. - * - * RCS: @(#) $Id: tclWinReg.c,v 1.38 2007/03/17 22:31:41 kennykb Exp $ */ +#undef STATIC_BUILD +#ifndef USE_TCL_STUBS +# define USE_TCL_STUBS +#endif #include "tclInt.h" #ifdef _MSC_VER # pragma comment (lib, "advapi32.lib") #endif #include <stdlib.h> +#ifndef UNICODE +# undef Tcl_WinTCharToUtf +# define Tcl_WinTCharToUtf(a,b,c) Tcl_ExternalToUtfDString(NULL,a,b,c) +# undef Tcl_WinUtfToTChar +# define Tcl_WinUtfToTChar(a,b,c) Tcl_UtfToExternalDString(NULL,a,b,c) +#endif /* !UNICODE */ + +/* + * Ensure that we can say which registry is being accessed. + */ + +#ifndef KEY_WOW64_64KEY +# define KEY_WOW64_64KEY (0x0100) +#endif +#ifndef KEY_WOW64_32KEY +# define KEY_WOW64_32KEY (0x0200) +#endif + +/* + * The maximum length of a sub-key name. + */ + +#ifndef MAX_KEY_LENGTH +# define MAX_KEY_LENGTH 256 +#endif + /* * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the * Registry_Init declaration is in the source file itself, which is only @@ -33,8 +61,8 @@ * The following macros convert between different endian ints. */ -#define SWAPWORD(x) MAKEWORD(HIBYTE(x), LOBYTE(x)) -#define SWAPLONG(x) MAKELONG(SWAPWORD(HIWORD(x)), SWAPWORD(LOWORD(x))) +#define SWAPWORD(x) MAKEWORD(HIBYTE(x), LOBYTE(x)) +#define SWAPLONG(x) MAKELONG(SWAPWORD(HIWORD(x)), SWAPWORD(LOWORD(x))) /* * The following flag is used in OpenKeys to indicate that the specified key @@ -48,18 +76,18 @@ * system predefined keys. */ -static CONST char *rootKeyNames[] = { +static const char *const rootKeyNames[] = { "HKEY_LOCAL_MACHINE", "HKEY_USERS", "HKEY_CLASSES_ROOT", "HKEY_CURRENT_USER", "HKEY_CURRENT_CONFIG", "HKEY_PERFORMANCE_DATA", "HKEY_DYN_DATA", NULL }; -static HKEY rootKeys[] = { +static const HKEY rootKeys[] = { HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_CURRENT_CONFIG, HKEY_PERFORMANCE_DATA, HKEY_DYN_DATA }; -static CONST char REGISTRY_ASSOC_KEY[] = "registry::command"; +static const char REGISTRY_ASSOC_KEY[] = "registry::command"; /* * The following table maps from registry types to strings. Note that the @@ -67,7 +95,7 @@ static CONST char REGISTRY_ASSOC_KEY[] = "registry::command"; * types so we don't need a separate table to hold the mapping. */ -static CONST char *typeNames[] = { +static const char *const typeNames[] = { "none", "sz", "expand_sz", "binary", "dword", "dword_big_endian", "link", "multi_sz", "resource_list", NULL }; @@ -75,109 +103,26 @@ static CONST char *typeNames[] = { 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. - */ - -typedef struct RegWinProcs { - int useWide; - - LONG (WINAPI *regConnectRegistryProc)(CONST TCHAR *, HKEY, PHKEY); - LONG (WINAPI *regCreateKeyExProc)(HKEY, CONST TCHAR *, DWORD, TCHAR *, - DWORD, REGSAM, SECURITY_ATTRIBUTES *, HKEY *, DWORD *); - LONG (WINAPI *regDeleteKeyProc)(HKEY, CONST TCHAR *); - LONG (WINAPI *regDeleteValueProc)(HKEY, CONST TCHAR *); - LONG (WINAPI *regEnumKeyProc)(HKEY, DWORD, TCHAR *, DWORD); - LONG (WINAPI *regEnumKeyExProc)(HKEY, DWORD, TCHAR *, DWORD *, DWORD *, - TCHAR *, DWORD *, FILETIME *); - LONG (WINAPI *regEnumValueProc)(HKEY, DWORD, TCHAR *, DWORD *, DWORD *, - DWORD *, BYTE *, DWORD *); - LONG (WINAPI *regOpenKeyExProc)(HKEY, CONST TCHAR *, DWORD, REGSAM, - HKEY *); - LONG (WINAPI *regQueryInfoKeyProc)(HKEY, TCHAR *, DWORD *, DWORD *, - DWORD *, DWORD *, DWORD *, DWORD *, DWORD *, DWORD *, DWORD *, - FILETIME *); - LONG (WINAPI *regQueryValueExProc)(HKEY, CONST TCHAR *, DWORD *, DWORD *, - BYTE *, DWORD *); - LONG (WINAPI *regSetValueExProc)(HKEY, CONST TCHAR *, DWORD, DWORD, - CONST BYTE*, DWORD); -} RegWinProcs; - -static RegWinProcs *regWinProcs; - -static RegWinProcs asciiProcs = { - 0, - - (LONG (WINAPI *)(CONST TCHAR *, HKEY, PHKEY)) RegConnectRegistryA, - (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD, TCHAR *, - DWORD, REGSAM, SECURITY_ATTRIBUTES *, HKEY *, - DWORD *)) RegCreateKeyExA, - (LONG (WINAPI *)(HKEY, CONST TCHAR *)) RegDeleteKeyA, - (LONG (WINAPI *)(HKEY, CONST TCHAR *)) RegDeleteValueA, - (LONG (WINAPI *)(HKEY, DWORD, TCHAR *, DWORD)) RegEnumKeyA, - (LONG (WINAPI *)(HKEY, DWORD, TCHAR *, DWORD *, DWORD *, - TCHAR *, DWORD *, FILETIME *)) RegEnumKeyExA, - (LONG (WINAPI *)(HKEY, DWORD, TCHAR *, DWORD *, DWORD *, - DWORD *, BYTE *, DWORD *)) RegEnumValueA, - (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD, REGSAM, - HKEY *)) RegOpenKeyExA, - (LONG (WINAPI *)(HKEY, TCHAR *, DWORD *, DWORD *, - DWORD *, DWORD *, DWORD *, DWORD *, DWORD *, DWORD *, DWORD *, - FILETIME *)) RegQueryInfoKeyA, - (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD *, DWORD *, - BYTE *, DWORD *)) RegQueryValueExA, - (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD, DWORD, - CONST BYTE*, DWORD)) RegSetValueExA, -}; - -static RegWinProcs unicodeProcs = { - 1, - - (LONG (WINAPI *)(CONST TCHAR *, HKEY, PHKEY)) RegConnectRegistryW, - (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD, TCHAR *, - DWORD, REGSAM, SECURITY_ATTRIBUTES *, HKEY *, - DWORD *)) RegCreateKeyExW, - (LONG (WINAPI *)(HKEY, CONST TCHAR *)) RegDeleteKeyW, - (LONG (WINAPI *)(HKEY, CONST TCHAR *)) RegDeleteValueW, - (LONG (WINAPI *)(HKEY, DWORD, TCHAR *, DWORD)) RegEnumKeyW, - (LONG (WINAPI *)(HKEY, DWORD, TCHAR *, DWORD *, DWORD *, - TCHAR *, DWORD *, FILETIME *)) RegEnumKeyExW, - (LONG (WINAPI *)(HKEY, DWORD, TCHAR *, DWORD *, DWORD *, - DWORD *, BYTE *, DWORD *)) RegEnumValueW, - (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD, REGSAM, - HKEY *)) RegOpenKeyExW, - (LONG (WINAPI *)(HKEY, TCHAR *, DWORD *, DWORD *, - DWORD *, DWORD *, DWORD *, DWORD *, DWORD *, DWORD *, DWORD *, - FILETIME *)) RegQueryInfoKeyW, - (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD *, DWORD *, - BYTE *, DWORD *)) RegQueryValueExW, - (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD, DWORD, - CONST BYTE*, DWORD)) RegSetValueExW, -}; - - -/* * Declarations for functions defined in this file. */ static void AppendSystemError(Tcl_Interp *interp, DWORD error); static int BroadcastValue(Tcl_Interp *interp, int objc, - Tcl_Obj * CONST objv[]); + 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 DeleteKey(Tcl_Interp *interp, Tcl_Obj *keyNameObj, + REGSAM mode); static int DeleteValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj, - Tcl_Obj *valueNameObj); + Tcl_Obj *valueNameObj, REGSAM mode); static int GetKeyNames(Tcl_Interp *interp, Tcl_Obj *keyNameObj, - Tcl_Obj *patternObj); + Tcl_Obj *patternObj, REGSAM mode); static int GetType(Tcl_Interp *interp, Tcl_Obj *keyNameObj, - Tcl_Obj *valueNameObj); + Tcl_Obj *valueNameObj, REGSAM mode); static int GetValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj, - Tcl_Obj *valueNameObj); + Tcl_Obj *valueNameObj, REGSAM mode); static int GetValueNames(Tcl_Interp *interp, Tcl_Obj *keyNameObj, - Tcl_Obj *patternObj); + Tcl_Obj *patternObj, REGSAM mode); static int OpenKey(Tcl_Interp *interp, Tcl_Obj *keyNameObj, REGSAM mode, int flags, HKEY *keyPtr); static DWORD OpenSubKey(char *hostName, HKEY rootKey, @@ -187,13 +132,13 @@ static int ParseKeyName(Tcl_Interp *interp, char *name, char **hostNamePtr, HKEY *rootKeyPtr, char **keyNamePtr); static DWORD RecursiveDeleteKey(HKEY hStartKey, - CONST TCHAR * pKeyName); + const TCHAR * pKeyName, REGSAM mode); static int RegistryObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj * CONST objv[]); + Tcl_Obj *const objv[]); static int SetValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj, Tcl_Obj *valueNameObj, Tcl_Obj *dataObj, - Tcl_Obj *typeObj); + Tcl_Obj *typeObj, REGSAM mode); EXTERN int Registry_Init(Tcl_Interp *interp); EXTERN int Registry_Unload(Tcl_Interp *interp, int flags); @@ -220,25 +165,14 @@ Registry_Init( { Tcl_Command cmd; - if (Tcl_InitStubs(interp, "8.1", 0) == NULL) { + if (Tcl_InitStubs(interp, "8.5", 0) == NULL) { return TCL_ERROR; } - /* - * Determine if the unicode interfaces are available and select the - * appropriate registry function table. - */ - - if (TclWinGetPlatformId() == VER_PLATFORM_WIN32_NT) { - regWinProcs = &unicodeProcs; - } else { - regWinProcs = &asciiProcs; - } - cmd = Tcl_CreateObjCommand(interp, "registry", RegistryObjCmd, - (ClientData)interp, DeleteCmd); - Tcl_SetAssocData(interp, REGISTRY_ASSOC_KEY, NULL, (ClientData)cmd); - return Tcl_PkgProvide(interp, "registry", "1.2"); + interp, DeleteCmd); + Tcl_SetAssocData(interp, REGISTRY_ASSOC_KEY, NULL, cmd); + return Tcl_PkgProvide(interp, "registry", "1.3.0"); } /* @@ -278,7 +212,7 @@ Registry_Unload( * Delete the originally registered command. */ - cmd = (Tcl_Command)Tcl_GetAssocData(interp, REGISTRY_ASSOC_KEY, NULL); + cmd = Tcl_GetAssocData(interp, REGISTRY_ASSOC_KEY, NULL); if (cmd != NULL) { Tcl_DeleteCommandFromToken(interp, cmd); } @@ -308,7 +242,8 @@ DeleteCmd( ClientData clientData) { Tcl_Interp *interp = clientData; - Tcl_SetAssocData(interp, REGISTRY_ASSOC_KEY, NULL, (ClientData)NULL); + + Tcl_SetAssocData(interp, REGISTRY_ASSOC_KEY, NULL, NULL); } /* @@ -332,89 +267,125 @@ RegistryObjCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj * CONST objv[]) /* Argument values. */ + Tcl_Obj *const objv[]) /* Argument values. */ { - int index; - char *errString = NULL; + int n = 1; + int index, argc; + REGSAM mode = 0; + const char *errString = NULL; - static CONST char *subcommands[] = { + static const char *const subcommands[] = { "broadcast", "delete", "get", "keys", "set", "type", "values", NULL }; enum SubCmdIdx { BroadcastIdx, DeleteIdx, GetIdx, KeysIdx, SetIdx, TypeIdx, ValuesIdx }; + static const char *const modes[] = { + "-32bit", "-64bit", NULL + }; if (objc < 2) { - Tcl_WrongNumArgs(interp, objc, objv, "option ?arg arg ...?"); + wrongArgs: + Tcl_WrongNumArgs(interp, 1, objv, "?-32bit|-64bit? option ?arg ...?"); return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[1], subcommands, "option", 0, &index) - != TCL_OK) { + if (Tcl_GetString(objv[n])[0] == '-') { + if (Tcl_GetIndexFromObj(interp, objv[n++], modes, "mode", 0, + &index) != TCL_OK) { + return TCL_ERROR; + } + switch (index) { + case 0: /* -32bit */ + mode |= KEY_WOW64_32KEY; + break; + case 1: /* -64bit */ + mode |= KEY_WOW64_64KEY; + break; + } + if (objc < 3) { + goto wrongArgs; + } + } + + if (Tcl_GetIndexFromObj(interp, objv[n++], subcommands, "option", 0, + &index) != TCL_OK) { return TCL_ERROR; } + argc = (objc - n); switch (index) { case BroadcastIdx: /* broadcast */ - return BroadcastValue(interp, objc, objv); + if (argc == 1 || argc == 3) { + int res = BroadcastValue(interp, argc, objv + n); + + if (res != TCL_BREAK) { + return res; + } + } + errString = "keyName ?-timeout milliseconds?"; break; case DeleteIdx: /* delete */ - if (objc == 3) { - return DeleteKey(interp, objv[2]); - } else if (objc == 4) { - return DeleteValue(interp, objv[2], objv[3]); + if (argc == 1) { + return DeleteKey(interp, objv[n], mode); + } else if (argc == 2) { + return DeleteValue(interp, objv[n], objv[n+1], mode); } errString = "keyName ?valueName?"; break; case GetIdx: /* get */ - if (objc == 4) { - return GetValue(interp, objv[2], objv[3]); + if (argc == 2) { + return GetValue(interp, objv[n], objv[n+1], mode); } 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]); + if (argc == 1) { + return GetKeyNames(interp, objv[n], NULL, mode); + } else if (argc == 2) { + return GetKeyNames(interp, objv[n], objv[n+1], mode); } errString = "keyName ?pattern?"; break; case SetIdx: /* set */ - if (objc == 3) { + if (argc == 1) { HKEY key; /* * Create the key and then close it immediately. */ - if (OpenKey(interp, objv[2], KEY_ALL_ACCESS, 1, &key) != TCL_OK) { + mode |= KEY_ALL_ACCESS; + if (OpenKey(interp, objv[n], mode, 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); + } else if (argc == 3) { + return SetValue(interp, objv[n], objv[n+1], objv[n+2], NULL, + mode); + } else if (argc == 4) { + return SetValue(interp, objv[n], objv[n+1], objv[n+2], objv[n+3], + mode); } errString = "keyName ?valueName data ?type??"; break; case TypeIdx: /* type */ - if (objc == 4) { - return GetType(interp, objv[2], objv[3]); + if (argc == 2) { + return GetType(interp, objv[n], objv[n+1], mode); } 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 (argc == 1) { + return GetValueNames(interp, objv[n], NULL, mode); + } else if (argc == 2) { + return GetValueNames(interp, objv[n], objv[n+1], mode); } errString = "keyName ?pattern?"; break; } - Tcl_WrongNumArgs(interp, 2, objv, errString); + Tcl_WrongNumArgs(interp, (mode ? 3 : 2), objv, errString); return TCL_ERROR; } @@ -437,21 +408,23 @@ RegistryObjCmd( static int DeleteKey( Tcl_Interp *interp, /* Current interpreter. */ - Tcl_Obj *keyNameObj) /* Name of key to delete. */ + Tcl_Obj *keyNameObj, /* Name of key to delete. */ + REGSAM mode) /* Mode flags to pass. */ { char *tail, *buffer, *hostName, *keyName; - CONST char *nativeTail; + const TCHAR *nativeTail; HKEY rootKey, subkey; DWORD result; int length; Tcl_DString buf; + REGSAM saveMode = mode; /* * Find the parent of the key being deleted and open it. */ keyName = Tcl_GetStringFromObj(keyNameObj, &length); - buffer = ckalloc((unsigned int) length + 1); + buffer = ckalloc(length + 1); strcpy(buffer, keyName); if (ParseKeyName(interp, buffer, &hostName, &rootKey, @@ -461,8 +434,9 @@ DeleteKey( } if (*keyName == '\0') { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "bad key: cannot delete root keys", -1)); + Tcl_SetObjResult(interp, + Tcl_NewStringObj("bad key: cannot delete root keys", -1)); + Tcl_SetErrorCode(interp, "WIN_REG", "DEL_ROOT_KEY", NULL); ckfree(buffer); return TCL_ERROR; } @@ -475,15 +449,15 @@ DeleteKey( keyName = NULL; } - result = OpenSubKey(hostName, rootKey, keyName, - KEY_ENUMERATE_SUB_KEYS | DELETE, 0, &subkey); + mode |= KEY_ENUMERATE_SUB_KEYS | DELETE; + result = OpenSubKey(hostName, rootKey, keyName, mode, 0, &subkey); if (result != ERROR_SUCCESS) { ckfree(buffer); if (result == ERROR_FILE_NOT_FOUND) { return TCL_OK; } - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "unable to delete key: ", -1)); + Tcl_SetObjResult(interp, + Tcl_NewStringObj("unable to delete key: ", -1)); AppendSystemError(interp, result); return TCL_ERROR; } @@ -493,7 +467,7 @@ DeleteKey( */ nativeTail = Tcl_WinUtfToTChar(tail, -1, &buf); - result = RecursiveDeleteKey(subkey, nativeTail); + result = RecursiveDeleteKey(subkey, nativeTail, saveMode); Tcl_DStringFree(&buf); if (result != ERROR_SUCCESS && result != ERROR_FILE_NOT_FOUND) { @@ -530,7 +504,8 @@ static int DeleteValue( Tcl_Interp *interp, /* Current interpreter. */ Tcl_Obj *keyNameObj, /* Name of key. */ - Tcl_Obj *valueNameObj) /* Name of value to delete. */ + Tcl_Obj *valueNameObj, /* Name of value to delete. */ + REGSAM mode) /* Mode flags to pass. */ { HKEY key; char *valueName; @@ -542,19 +517,19 @@ DeleteValue( * Attempt to open the key for deletion. */ - if (OpenKey(interp, keyNameObj, KEY_SET_VALUE, 0, &key) - != TCL_OK) { + mode |= KEY_SET_VALUE; + if (OpenKey(interp, keyNameObj, mode, 0, &key) != TCL_OK) { return TCL_ERROR; } valueName = Tcl_GetStringFromObj(valueNameObj, &length); Tcl_WinUtfToTChar(valueName, length, &ds); - result = (*regWinProcs->regDeleteValueProc)(key, Tcl_DStringValue(&ds)); + result = RegDeleteValue(key, (const TCHAR *)Tcl_DStringValue(&ds)); Tcl_DStringFree(&ds); if (result != ERROR_SUCCESS) { - Tcl_AppendResult(interp, "unable to delete value \"", - Tcl_GetString(valueNameObj), "\" from key \"", - Tcl_GetString(keyNameObj), "\": ", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unable to delete value \"%s\" from key \"%s\": ", + Tcl_GetString(valueNameObj), Tcl_GetString(keyNameObj))); AppendSystemError(interp, result); result = TCL_ERROR; } else { @@ -587,13 +562,13 @@ static int GetKeyNames( Tcl_Interp *interp, /* Current interpreter. */ Tcl_Obj *keyNameObj, /* Key to enumerate. */ - Tcl_Obj *patternObj) /* Optional match pattern. */ + Tcl_Obj *patternObj, /* Optional match pattern. */ + REGSAM mode) /* Mode flags to pass. */ { - char *pattern; /* Pattern being matched against subkeys */ + const char *pattern; /* Pattern being matched against subkeys */ HKEY key; /* Handle to the key being examined */ - DWORD subKeyCount; /* Number of subkeys to list */ - DWORD maxSubKeyLen; /* Maximum string length of any subkey */ - char *buffer; /* Buffer to hold the subkey name */ + TCHAR buffer[MAX_KEY_LENGTH]; + /* Buffer to hold the subkey name */ DWORD bufSize; /* Size of the buffer */ DWORD index; /* Position of the current subkey */ char *name; /* Subkey name */ @@ -607,58 +582,37 @@ GetKeyNames( pattern = NULL; } - /* Attempt to open the key for enumeration. */ - - if (OpenKey(interp, keyNameObj, - KEY_QUERY_VALUE | KEY_ENUMERATE_SUB_KEYS, - 0, &key) != TCL_OK) { - return TCL_ERROR; - } - - /* - * Determine how big a buffer is needed for enumerating subkeys, and - * how many subkeys there are + /* + * Attempt to open the key for enumeration. */ - result = (*regWinProcs->regQueryInfoKeyProc) - (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_GetString(keyNameObj), "\": ", NULL); - AppendSystemError(interp, result); - RegCloseKey(key); + mode |= KEY_QUERY_VALUE | KEY_ENUMERATE_SUB_KEYS; + if (OpenKey(interp, keyNameObj, mode, 0, &key) != TCL_OK) { return TCL_ERROR; } - if (regWinProcs->useWide) { - buffer = ckalloc((maxSubKeyLen+1) * sizeof(WCHAR)); - } else { - buffer = ckalloc(maxSubKeyLen+1); - } - /* Enumerate the subkeys */ + /* + * Enumerate the subkeys. + */ resultPtr = Tcl_NewObj(); - for (index = 0; index < subKeyCount; ++index) { - bufSize = maxSubKeyLen+1; - result = (*regWinProcs->regEnumKeyExProc) - (key, index, buffer, &bufSize, NULL, NULL, NULL, NULL); + for (index = 0;; ++index) { + bufSize = MAX_KEY_LENGTH; + result = RegEnumKeyEx(key, index, buffer, &bufSize, + NULL, NULL, NULL, NULL); if (result != ERROR_SUCCESS) { - Tcl_SetObjResult(interp, Tcl_NewObj()); - Tcl_AppendResult(interp, - "unable to enumerate subkeys of \"", - Tcl_GetString(keyNameObj), - "\": ", NULL); - AppendSystemError(interp, result); - result = TCL_ERROR; + if (result == ERROR_NO_MORE_ITEMS) { + result = TCL_OK; + } else { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unable to enumerate subkeys of \"%s\": ", + Tcl_GetString(keyNameObj))); + AppendSystemError(interp, result); + result = TCL_ERROR; + } break; } - if (regWinProcs->useWide) { - Tcl_WinTCharToUtf((TCHAR *) buffer, bufSize * sizeof(WCHAR), &ds); - } else { - Tcl_WinTCharToUtf((TCHAR *) buffer, bufSize, &ds); - } + Tcl_WinTCharToUtf(buffer, bufSize * sizeof(TCHAR), &ds); name = Tcl_DStringValue(&ds); if (pattern && !Tcl_StringMatch(name, pattern)) { Tcl_DStringFree(&ds); @@ -673,9 +627,10 @@ GetKeyNames( } if (result == TCL_OK) { Tcl_SetObjResult(interp, resultPtr); + } else { + Tcl_DecrRefCount(resultPtr); /* BUGFIX: Don't leak on failure. */ } - ckfree(buffer); RegCloseKey(key); return result; } @@ -701,22 +656,22 @@ static int GetType( Tcl_Interp *interp, /* Current interpreter. */ Tcl_Obj *keyNameObj, /* Name of key. */ - Tcl_Obj *valueNameObj) /* Name of value to get. */ + Tcl_Obj *valueNameObj, /* Name of value to get. */ + REGSAM mode) /* Mode flags to pass. */ { HKEY key; - DWORD result; - DWORD type; + DWORD result, type; Tcl_DString ds; - char *valueName; - CONST char *nativeValue; + const char *valueName; + const TCHAR *nativeValue; int length; /* * Attempt to open the key for reading. */ - if (OpenKey(interp, keyNameObj, KEY_QUERY_VALUE, 0, &key) - != TCL_OK) { + mode |= KEY_QUERY_VALUE; + if (OpenKey(interp, keyNameObj, mode, 0, &key) != TCL_OK) { return TCL_ERROR; } @@ -726,15 +681,15 @@ GetType( valueName = Tcl_GetStringFromObj(valueNameObj, &length); nativeValue = Tcl_WinUtfToTChar(valueName, length, &ds); - result = (*regWinProcs->regQueryValueExProc)(key, nativeValue, NULL, &type, + result = RegQueryValueEx(key, nativeValue, NULL, &type, NULL, NULL); Tcl_DStringFree(&ds); RegCloseKey(key); if (result != ERROR_SUCCESS) { - Tcl_AppendResult(interp, "unable to get type of value \"", - Tcl_GetString(valueNameObj), "\" from key \"", - Tcl_GetString(keyNameObj), "\": ", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unable to get type of value \"%s\" from key \"%s\": ", + Tcl_GetString(valueNameObj), Tcl_GetString(keyNameObj))); AppendSystemError(interp, result); return TCL_ERROR; } @@ -744,7 +699,7 @@ GetType( * know about the type, just use the numeric value. */ - if (type > lastType || type < 0) { + if (type > lastType) { Tcl_SetObjResult(interp, Tcl_NewIntObj((int) type)); } else { Tcl_SetObjResult(interp, Tcl_NewStringObj(typeNames[type], -1)); @@ -773,11 +728,12 @@ static int GetValue( Tcl_Interp *interp, /* Current interpreter. */ Tcl_Obj *keyNameObj, /* Name of key. */ - Tcl_Obj *valueNameObj) /* Name of value to get. */ + Tcl_Obj *valueNameObj, /* Name of value to get. */ + REGSAM mode) /* Mode flags to pass. */ { HKEY key; - char *valueName; - CONST char *nativeValue; + const char *valueName; + const TCHAR *nativeValue; DWORD result, length, type; Tcl_DString data, buf; int nameLen; @@ -786,7 +742,8 @@ GetValue( * Attempt to open the key for reading. */ - if (OpenKey(interp, keyNameObj, KEY_QUERY_VALUE, 0, &key) != TCL_OK) { + mode |= KEY_QUERY_VALUE; + if (OpenKey(interp, keyNameObj, mode, 0, &key) != TCL_OK) { return TCL_ERROR; } @@ -801,13 +758,13 @@ GetValue( */ Tcl_DStringInit(&data); - length = TCL_DSTRING_STATIC_SIZE - 1; - Tcl_DStringSetLength(&data, (int) length); + Tcl_DStringSetLength(&data, TCL_DSTRING_STATIC_SIZE - 1); + length = TCL_DSTRING_STATIC_SIZE/sizeof(TCHAR) - 1; valueName = Tcl_GetStringFromObj(valueNameObj, &nameLen); nativeValue = Tcl_WinUtfToTChar(valueName, nameLen, &buf); - result = (*regWinProcs->regQueryValueExProc)(key, nativeValue, NULL, &type, + result = RegQueryValueEx(key, nativeValue, NULL, &type, (BYTE *) Tcl_DStringValue(&data), &length); while (result == ERROR_MORE_DATA) { /* @@ -816,17 +773,17 @@ GetValue( * HKEY_PERFORMANCE_DATA */ - length *= 2; - Tcl_DStringSetLength(&data, (int) length); - result = (*regWinProcs->regQueryValueExProc)(key, (char *) nativeValue, + length = Tcl_DStringLength(&data) * (2 / sizeof(TCHAR)); + Tcl_DStringSetLength(&data, (int) length * sizeof(TCHAR)); + result = RegQueryValueEx(key, nativeValue, NULL, &type, (BYTE *) Tcl_DStringValue(&data), &length); } Tcl_DStringFree(&buf); RegCloseKey(key); if (result != ERROR_SUCCESS) { - Tcl_AppendResult(interp, "unable to get value \"", - Tcl_GetString(valueNameObj), "\" from key \"", - Tcl_GetString(keyNameObj), "\": ", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unable to get value \"%s\" from key \"%s\": ", + Tcl_GetString(valueNameObj), Tcl_GetString(keyNameObj))); AppendSystemError(interp, result); Tcl_DStringFree(&data); return TCL_ERROR; @@ -841,7 +798,7 @@ GetValue( if (type == REG_DWORD || type == REG_DWORD_BIG_ENDIAN) { Tcl_SetObjResult(interp, Tcl_NewIntObj((int) ConvertDWORD(type, - *((DWORD*) Tcl_DStringValue(&data))))); + *((DWORD *) Tcl_DStringValue(&data))))); } else if (type == REG_MULTI_SZ) { char *p = Tcl_DStringValue(&data); char *end = Tcl_DStringValue(&data) + length; @@ -853,19 +810,17 @@ GetValue( * we get bogus data. */ - while (p < end && ((regWinProcs->useWide) - ? *((Tcl_UniChar *)p) : *p) != 0) { + while ((p < end) && *((Tcl_UniChar *) p) != 0) { + Tcl_UniChar *up; + Tcl_WinTCharToUtf((TCHAR *) p, -1, &buf); Tcl_ListObjAppendElement(interp, resultPtr, Tcl_NewStringObj(Tcl_DStringValue(&buf), Tcl_DStringLength(&buf))); - if (regWinProcs->useWide) { - Tcl_UniChar* up = (Tcl_UniChar*) p; - while (*up++ != 0) {} - p = (char*) up; - } else { - while (*p++ != '\0') {} - } + up = (Tcl_UniChar *) p; + + while (*up++ != 0) {/* empty body */} + p = (char *) up; Tcl_DStringFree(&buf); } Tcl_SetObjResult(interp, resultPtr); @@ -878,7 +833,7 @@ GetValue( */ Tcl_SetObjResult(interp, Tcl_NewByteArrayObj( - Tcl_DStringValue(&data), (int) length)); + (BYTE *) Tcl_DStringValue(&data), (int) length)); } Tcl_DStringFree(&data); return result; @@ -907,44 +862,27 @@ static int GetValueNames( Tcl_Interp *interp, /* Current interpreter. */ Tcl_Obj *keyNameObj, /* Key to enumerate. */ - Tcl_Obj *patternObj) /* Optional match pattern. */ + Tcl_Obj *patternObj, /* Optional match pattern. */ + REGSAM mode) /* Mode flags to pass. */ { HKEY key; Tcl_Obj *resultPtr; - DWORD index, size, maxSize, result; + DWORD index, size, result; Tcl_DString buffer, ds; - char *pattern, *name; + const char *pattern, *name; /* * Attempt to open the key for enumeration. */ - if (OpenKey(interp, keyNameObj, KEY_QUERY_VALUE, 0, &key) - != TCL_OK) { + mode |= KEY_QUERY_VALUE; + if (OpenKey(interp, keyNameObj, mode, 0, &key) != TCL_OK) { return TCL_ERROR; } - /* - * Query the key to determine the appropriate buffer size to hold the - * largest value name plus the terminating null. - */ - - result = (*regWinProcs->regQueryInfoKeyProc)(key, NULL, NULL, NULL, NULL, - NULL, NULL, &index, &maxSize, NULL, NULL, NULL); - if (result != ERROR_SUCCESS) { - Tcl_AppendResult(interp, "unable to query key \"", - Tcl_GetString(keyNameObj), "\": ", NULL); - AppendSystemError(interp, result); - RegCloseKey(key); - result = TCL_ERROR; - goto done; - } - maxSize++; - resultPtr = Tcl_NewObj(); Tcl_DStringInit(&buffer); - Tcl_DStringSetLength(&buffer, - (int) ((regWinProcs->useWide) ? maxSize*2 : maxSize)); + Tcl_DStringSetLength(&buffer, (int) (MAX_KEY_LENGTH * sizeof(TCHAR))); index = 0; result = TCL_OK; @@ -960,14 +898,10 @@ GetValueNames( * each iteration because RegEnumValue smashes the old value. */ - size = maxSize; - while ((*regWinProcs->regEnumValueProc)(key, index, - Tcl_DStringValue(&buffer), &size, NULL, NULL, NULL, NULL) - == ERROR_SUCCESS) { - - if (regWinProcs->useWide) { - size *= 2; - } + size = MAX_KEY_LENGTH; + while (RegEnumValue(key,index, (TCHAR *)Tcl_DStringValue(&buffer), + &size, NULL, NULL, NULL, NULL) == ERROR_SUCCESS) { + size *= sizeof(TCHAR); Tcl_WinTCharToUtf((TCHAR *) Tcl_DStringValue(&buffer), (int) size, &ds); @@ -983,12 +917,10 @@ GetValueNames( Tcl_DStringFree(&ds); index++; - size = maxSize; + size = MAX_KEY_LENGTH; } Tcl_SetObjResult(interp, resultPtr); Tcl_DStringFree(&buffer); - - done: RegCloseKey(key); return result; } @@ -1024,7 +956,7 @@ OpenKey( DWORD result; keyName = Tcl_GetStringFromObj(keyNameObj, &length); - buffer = ckalloc((unsigned int) length + 1); + buffer = ckalloc(length + 1); strcpy(buffer, keyName); result = ParseKeyName(interp, buffer, &hostName, &rootKey, &keyName); @@ -1080,7 +1012,7 @@ OpenSubKey( if (hostName) { hostName = (char *) Tcl_WinUtfToTChar(hostName, -1, &buf); - result = (*regWinProcs->regConnectRegistryProc)(hostName, rootKey, + result = RegConnectRegistry((TCHAR *)hostName, rootKey, &rootKey); Tcl_DStringFree(&buf); if (result != ERROR_SUCCESS) { @@ -1096,17 +1028,19 @@ OpenSubKey( keyName = (char *) Tcl_WinUtfToTChar(keyName, -1, &buf); if (flags & REG_CREATE) { DWORD create; - result = (*regWinProcs->regCreateKeyExProc)(rootKey, keyName, 0, NULL, + + result = RegCreateKeyEx(rootKey, (TCHAR *)keyName, 0, NULL, REG_OPTION_NON_VOLATILE, mode, NULL, keyPtr, &create); } else if (rootKey == HKEY_PERFORMANCE_DATA) { /* * Here we fudge it for this special root key. See MSDN for more info * on HKEY_PERFORMANCE_DATA and the peculiarities surrounding it. */ + *keyPtr = HKEY_PERFORMANCE_DATA; result = ERROR_SUCCESS; } else { - result = (*regWinProcs->regOpenKeyExProc)(rootKey, keyName, 0, mode, + result = RegOpenKeyEx(rootKey, (TCHAR *)keyName, 0, mode, keyPtr); } Tcl_DStringFree(&buf); @@ -1170,8 +1104,9 @@ ParseKeyName( rootName = name; } if (!rootName) { - Tcl_AppendResult(interp, "bad key \"", name, - "\": must start with a valid root", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad key \"%s\": must start with a valid root", name)); + Tcl_SetErrorCode(interp, "WIN_REG", "NO_ROOT_KEY", NULL); return TCL_ERROR; } @@ -1223,12 +1158,16 @@ ParseKeyName( static DWORD RecursiveDeleteKey( HKEY startKey, /* Parent of key to be deleted. */ - CONST char *keyName) /* Name of key to be deleted in external + const TCHAR *keyName, /* Name of key to be deleted in external * encoding, not UTF. */ + REGSAM mode) /* Mode flags to pass. */ { - DWORD result, size, maxSize; + DWORD result, size; Tcl_DString subkey; HKEY hKey; + REGSAM saveMode = mode; + static int checkExProc = 0; + static FARPROC regDeleteKeyExProc = NULL; /* * Do not allow NULL or empty key name. @@ -1238,35 +1177,50 @@ RecursiveDeleteKey( return ERROR_BADKEY; } - result = (*regWinProcs->regOpenKeyExProc)(startKey, keyName, 0, - KEY_ENUMERATE_SUB_KEYS | DELETE | KEY_QUERY_VALUE, &hKey); - if (result != ERROR_SUCCESS) { - return result; - } - result = (*regWinProcs->regQueryInfoKeyProc)(hKey, NULL, NULL, NULL, NULL, - &maxSize, NULL, NULL, NULL, NULL, NULL, NULL); - maxSize++; + mode |= KEY_ENUMERATE_SUB_KEYS | DELETE | KEY_QUERY_VALUE; + result = RegOpenKeyEx(startKey, keyName, 0, mode, &hKey); if (result != ERROR_SUCCESS) { return result; } Tcl_DStringInit(&subkey); - Tcl_DStringSetLength(&subkey, - (int) ((regWinProcs->useWide) ? maxSize * 2 : maxSize)); + Tcl_DStringSetLength(&subkey, (int) (MAX_KEY_LENGTH * sizeof(TCHAR))); + mode = saveMode; while (result == ERROR_SUCCESS) { /* * Always get index 0 because key deletion changes ordering. */ - size = maxSize; - result=(*regWinProcs->regEnumKeyExProc)(hKey, 0, - Tcl_DStringValue(&subkey), &size, NULL, NULL, NULL, NULL); + size = MAX_KEY_LENGTH; + result = RegEnumKeyEx(hKey, 0, (TCHAR *)Tcl_DStringValue(&subkey), + &size, NULL, NULL, NULL, NULL); if (result == ERROR_NO_MORE_ITEMS) { - result = (*regWinProcs->regDeleteKeyProc)(startKey, keyName); + /* + * RegDeleteKeyEx doesn't exist on non-64bit XP platforms, so we + * can't compile with it in. We need to check for it at runtime + * and use it if we find it. + */ + + if (mode && !checkExProc) { + HINSTANCE dllH; + + checkExProc = 1; + dllH = LoadLibrary(TEXT("advapi32.dll")); + if (dllH) { + regDeleteKeyExProc = (FARPROC) + GetProcAddress(dllH, "RegDeleteKeyExW"); + } + } + if (mode && regDeleteKeyExProc) { + result = regDeleteKeyExProc(startKey, keyName, mode, 0); + } else { + result = RegDeleteKey(startKey, keyName); + } break; } else if (result == ERROR_SUCCESS) { - result = RecursiveDeleteKey(hKey, Tcl_DStringValue(&subkey)); + result = RecursiveDeleteKey(hKey, + (const TCHAR *) Tcl_DStringValue(&subkey), mode); } } Tcl_DStringFree(&subkey); @@ -1298,25 +1252,26 @@ SetValue( Tcl_Obj *keyNameObj, /* Name of key. */ Tcl_Obj *valueNameObj, /* Name of value to set. */ Tcl_Obj *dataObj, /* Data to be written. */ - Tcl_Obj *typeObj) /* Type of data to be written. */ + Tcl_Obj *typeObj, /* Type of data to be written. */ + REGSAM mode) /* Mode flags to pass. */ { - int type; + int type, length; DWORD result; HKEY key; - int length; - char *valueName; + const char *valueName; Tcl_DString nameBuf; if (typeObj == NULL) { type = REG_SZ; } else if (Tcl_GetIndexFromObj(interp, typeObj, typeNames, "type", 0, (int *) &type) != TCL_OK) { - if (Tcl_GetIntFromObj(NULL, typeObj, (int*) &type) != TCL_OK) { + if (Tcl_GetIntFromObj(NULL, typeObj, (int *) &type) != TCL_OK) { return TCL_ERROR; } Tcl_ResetResult(interp); } - if (OpenKey(interp, keyNameObj, KEY_ALL_ACCESS, 1, &key) != TCL_OK) { + mode |= KEY_ALL_ACCESS; + if (OpenKey(interp, keyNameObj, mode, 1, &key) != TCL_OK) { return TCL_ERROR; } @@ -1325,16 +1280,16 @@ SetValue( if (type == REG_DWORD || type == REG_DWORD_BIG_ENDIAN) { int value; + if (Tcl_GetIntFromObj(interp, dataObj, &value) != TCL_OK) { RegCloseKey(key); Tcl_DStringFree(&nameBuf); return TCL_ERROR; } - value = ConvertDWORD((DWORD)type, (DWORD)value); - result = (*regWinProcs->regSetValueExProc)(key, valueName, 0, - (DWORD)type, - (BYTE*) &value, sizeof(DWORD)); + value = ConvertDWORD((DWORD) type, (DWORD) value); + result = RegSetValueEx(key, (TCHAR *) valueName, 0, + (DWORD) type, (BYTE *) &value, sizeof(DWORD)); } else if (type == REG_MULTI_SZ) { Tcl_DString data, buf; int objc, i; @@ -1354,29 +1309,27 @@ SetValue( Tcl_DStringInit(&data); for (i = 0; i < objc; i++) { - Tcl_DStringAppend(&data, Tcl_GetString(objv[i]), -1); + const char *bytes = Tcl_GetStringFromObj(objv[i], &length); + + Tcl_DStringAppend(&data, bytes, length); /* - * 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. + * Add a null character to separate this value from the next. */ - Tcl_DStringSetLength(&data, Tcl_DStringLength(&data)+1); + Tcl_DStringAppend(&data, "", 1); /* NUL-terminated string */ } Tcl_WinUtfToTChar(Tcl_DStringValue(&data), Tcl_DStringLength(&data)+1, &buf); - result = (*regWinProcs->regSetValueExProc)(key, valueName, 0, - (DWORD)type, - (BYTE *) Tcl_DStringValue(&buf), + result = RegSetValueEx(key, (TCHAR *) valueName, 0, + (DWORD) type, (BYTE *) Tcl_DStringValue(&buf), (DWORD) Tcl_DStringLength(&buf)); Tcl_DStringFree(&data); Tcl_DStringFree(&buf); } else if (type == REG_SZ || type == REG_EXPAND_SZ) { Tcl_DString buf; - char *data = Tcl_GetStringFromObj(dataObj, &length); + const char *data = Tcl_GetStringFromObj(dataObj, &length); data = (char *) Tcl_WinUtfToTChar(data, length, &buf); @@ -1384,26 +1337,22 @@ SetValue( * Include the null in the length, padding if needed for Unicode. */ - if (regWinProcs->useWide) { - Tcl_DStringSetLength(&buf, Tcl_DStringLength(&buf)+1); - } + Tcl_DStringSetLength(&buf, Tcl_DStringLength(&buf)+1); length = Tcl_DStringLength(&buf) + 1; - result = (*regWinProcs->regSetValueExProc)(key, valueName, 0, - (DWORD)type, - (BYTE*)data, (DWORD) length); + result = RegSetValueEx(key, (TCHAR *) valueName, 0, + (DWORD) type, (BYTE *) data, (DWORD) length); Tcl_DStringFree(&buf); } else { - char *data; + BYTE *data; /* * Store binary data in the registry. */ - data = Tcl_GetByteArrayFromObj(dataObj, &length); - result = (*regWinProcs->regSetValueExProc)(key, valueName, 0, - (DWORD)type, - (BYTE *)data, (DWORD) length); + data = (BYTE *) Tcl_GetByteArrayFromObj(dataObj, &length); + result = RegSetValueEx(key, (TCHAR *) valueName, 0, + (DWORD) type, data, (DWORD) length); } Tcl_DStringFree(&nameBuf); @@ -1439,32 +1388,27 @@ 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, sendResult; + LRESULT result; + DWORD_PTR sendResult; UINT timeout = 3000; int len; - char *str; + const char *str; Tcl_Obj *objPtr; - if ((objc != 3) && (objc != 5)) { - Tcl_WrongNumArgs(interp, 2, objv, "keyName ?-timeout millisecs?"); - return TCL_ERROR; - } - - if (objc > 3) { - str = Tcl_GetStringFromObj(objv[3], &len); + if (objc == 3) { + str = Tcl_GetStringFromObj(objv[1], &len); if ((len < 2) || (*str != '-') || strncmp(str, "-timeout", (size_t) len)) { - Tcl_WrongNumArgs(interp, 2, objv, "keyName ?-timeout millisecs?"); - return TCL_ERROR; + return TCL_BREAK; } - if (Tcl_GetIntFromObj(interp, objv[4], (int *) &timeout) != TCL_OK) { + if (Tcl_GetIntFromObj(interp, objv[2], (int *) &timeout) != TCL_OK) { return TCL_ERROR; } } - str = Tcl_GetStringFromObj(objv[2], &len); + str = Tcl_GetStringFromObj(objv[0], &len); if (len == 0) { str = NULL; } @@ -1473,7 +1417,7 @@ BroadcastValue( * Use the ignore the result. */ - result = SendMessageTimeout(HWND_BROADCAST, WM_SETTINGCHANGE, + result = SendMessageTimeoutA(HWND_BROADCAST, WM_SETTINGCHANGE, (WPARAM) 0, (LPARAM) str, SMTO_ABORTIFHUNG, timeout, &sendResult); objPtr = Tcl_NewObj(); @@ -1507,8 +1451,8 @@ AppendSystemError( DWORD error) /* Result code from error. */ { int length; - WCHAR *wMsgPtr; - char *msg; + TCHAR *tMsgPtr, **tMsgPtrPtr = &tMsgPtr; + const char *msg; char id[TCL_INTEGER_SPACE], msgBuf[24 + TCL_INTEGER_SPACE]; Tcl_DString ds; Tcl_Obj *resultPtr = Tcl_GetObjResult(interp); @@ -1516,52 +1460,34 @@ AppendSystemError( if (Tcl_IsShared(resultPtr)) { resultPtr = Tcl_DuplicateObj(resultPtr); } - length = FormatMessageW(FORMAT_MESSAGE_FROM_SYSTEM + length = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_ALLOCATE_BUFFER, NULL, error, - MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (WCHAR *) &wMsgPtr, + MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (TCHAR *) tMsgPtrPtr, 0, NULL); if (length == 0) { - char *msgPtr; - - length = FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM - | FORMAT_MESSAGE_ALLOCATE_BUFFER, NULL, error, - MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (char *) &msgPtr, - 0, NULL); - if (length > 0) { - wMsgPtr = (WCHAR *) LocalAlloc(LPTR, (length + 1) * sizeof(WCHAR)); - MultiByteToWideChar(CP_ACP, 0, msgPtr, length + 1, wMsgPtr, - length + 1); - LocalFree(msgPtr); - } - } - if (length == 0) { - if (error == ERROR_CALL_NOT_IMPLEMENTED) { - msg = "function not supported under Win32s"; - } else { - sprintf(msgBuf, "unknown error: %ld", error); - msg = msgBuf; - } + sprintf(msgBuf, "unknown error: %ld", error); + msg = msgBuf; } else { - Tcl_Encoding encoding; + char *msgPtr; - encoding = Tcl_GetEncoding(NULL, "unicode"); - Tcl_ExternalToUtfDString(encoding, (char *) wMsgPtr, -1, &ds); - Tcl_FreeEncoding(encoding); - LocalFree(wMsgPtr); + Tcl_WinTCharToUtf(tMsgPtr, -1, &ds); + LocalFree(tMsgPtr); - msg = Tcl_DStringValue(&ds); + msgPtr = Tcl_DStringValue(&ds); length = Tcl_DStringLength(&ds); /* * Trim the trailing CR/LF from the system message. */ - if (msg[length-1] == '\n') { - msg[--length] = 0; + if (msgPtr[length-1] == '\n') { + --length; } - if (msg[length-1] == '\r') { - msg[--length] = 0; + if (msgPtr[length-1] == '\r') { + --length; } + msgPtr[length] = 0; + msg = msgPtr; } sprintf(id, "%ld", error); @@ -1596,15 +1522,16 @@ ConvertDWORD( DWORD type, /* Either REG_DWORD or REG_DWORD_BIG_ENDIAN */ DWORD value) /* The value to be converted. */ { - DWORD order = 1; + const DWORD order = 1; DWORD localType; /* * 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 = (*((const char *) &order) == 1) + ? REG_DWORD : REG_DWORD_BIG_ENDIAN; + return (type != localType) ? (DWORD) SWAPLONG(value) : value; } /* diff --git a/win/tclWinSerial.c b/win/tclWinSerial.c index a2846b3..6487fe4 100644 --- a/win/tclWinSerial.c +++ b/win/tclWinSerial.c @@ -10,16 +10,10 @@ * this file, and for a DISCLAIMER OF ALL WARRANTIES. * * Serial functionality implemented by Rolf.Schroedter@dlr.de - * - * RCS: @(#) $Id: tclWinSerial.c,v 1.34 2006/03/27 18:08:51 andreas_kupries Exp $ */ #include "tclWinInt.h" -#include <fcntl.h> -#include <io.h> -#include <sys/stat.h> - /* * The following variable is used to tell whether this module has been * initialized. @@ -179,16 +173,16 @@ 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); + 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_Interp *interp, const char *optionName, Tcl_DString *dsPtr); static int SerialSetOptionProc(ClientData instanceData, - Tcl_Interp *interp, CONST char *optionName, - CONST char *value); + Tcl_Interp *interp, const char *optionName, + const char *value); static DWORD WINAPI SerialWriterThread(LPVOID arg); static void SerialThreadActionProc(ClientData instanceData, int action); @@ -203,7 +197,7 @@ static int SerialBlockingWrite(SerialInfo *infoPtr, LPVOID buf, * based IO. */ -static Tcl_ChannelType serialChannelType = { +static const Tcl_ChannelType serialChannelType = { "serial", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ SerialCloseProc, /* Close proc. */ @@ -220,7 +214,7 @@ static Tcl_ChannelType serialChannelType = { NULL, /* handler proc. */ NULL, /* wide seek proc */ SerialThreadActionProc, /* thread action proc */ - NULL, /* truncate */ + NULL /* truncate */ }; /* @@ -380,7 +374,7 @@ SerialGetMilliseconds(void) { Tcl_Time time; - TclpGetTime(&time); + Tcl_GetTime(&time); return (time.sec * 1000 + time.usec / 1000); } @@ -533,7 +527,7 @@ SerialCheckProc( if (needEvent) { infoPtr->flags |= SERIAL_PENDING; - evPtr = (SerialEvent *) ckalloc(sizeof(SerialEvent)); + evPtr = ckalloc(sizeof(SerialEvent)); evPtr->header.proc = SerialEventProc; evPtr->infoPtr = infoPtr; Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL); @@ -662,7 +656,6 @@ SerialCloseProc( CloseHandle(serialPtr->writeThread); CloseHandle(serialPtr->osWrite.hEvent); - DeleteCriticalSection(&serialPtr->csWrite); CloseHandle(serialPtr->evWritable); CloseHandle(serialPtr->evStartWriter); CloseHandle(serialPtr->evStopWriter); @@ -672,6 +665,8 @@ SerialCloseProc( } 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 @@ -711,7 +706,7 @@ SerialCloseProc( ckfree(serialPtr->writeBuf); serialPtr->writeBuf = NULL; } - ckfree((char*) serialPtr); + ckfree(serialPtr); if (errorCode == 0) { return result; @@ -937,7 +932,7 @@ SerialInputProc( bufSize = cStat.cbInQue; } } else { - errno = *errorCode = EAGAIN; + errno = *errorCode = EWOULDBLOCK; return -1; } } else { @@ -1001,7 +996,7 @@ SerialInputProc( static int SerialOutputProc( ClientData instanceData, /* Serial state. */ - CONST char *buf, /* The data buffer. */ + const char *buf, /* The data buffer. */ int toWrite, /* How many bytes to write? */ int *errorCode) /* Where to store error code. */ { @@ -1076,7 +1071,7 @@ SerialOutputProc( ckfree(infoPtr->writeBuf); } infoPtr->writeBufLen = toWrite; - infoPtr->writeBuf = ckalloc((unsigned int) toWrite); + infoPtr->writeBuf = ckalloc(toWrite); } memcpy(infoPtr->writeBuf, buf, (size_t) toWrite); infoPtr->toWrite = toWrite; @@ -1415,30 +1410,35 @@ SerialWriterThread( /* *---------------------------------------------------------------------- * - * TclWinSerialReopen -- + * TclWinSerialOpen -- * - * Reopens the serial port with the OVERLAPPED FLAG set + * Opens or 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. + * If an existing channel is specified it is closed and reopened. * * Side effects: - * May close the original handle + * May close/reopen the original handle * *---------------------------------------------------------------------- */ HANDLE -TclWinSerialReopen( +TclWinSerialOpen( HANDLE handle, - CONST TCHAR *name, + const TCHAR *name, DWORD access) { - ThreadSpecificData *tsdPtr; + SerialInit(); + + /* + * If an open channel is specified, close it + */ - tsdPtr = SerialInit(); + if ( handle != INVALID_HANDLE_VALUE && CloseHandle(handle) == FALSE) { + return INVALID_HANDLE_VALUE; + } /* * Multithreaded I/O needs the overlapped flag set otherwise @@ -1446,11 +1446,9 @@ TclWinSerialReopen( * finished */ - if (CloseHandle(handle) == FALSE) { - return INVALID_HANDLE_VALUE; - } - handle = (*tclWinProcs->createFileProc)(name, access, 0, 0, - OPEN_EXISTING, FILE_FLAG_OVERLAPPED, 0); + handle = CreateFile(name, access, 0, 0, OPEN_EXISTING, + FILE_FLAG_OVERLAPPED, 0); + return handle; } @@ -1483,7 +1481,7 @@ TclWinOpenSerialChannel( SerialInit(); - infoPtr = (SerialInfo *) ckalloc((unsigned) sizeof(SerialInfo)); + infoPtr = ckalloc(sizeof(SerialInfo)); memset(infoPtr, 0, sizeof(SerialInfo)); infoPtr->validMask = permissions; @@ -1504,10 +1502,10 @@ TclWinOpenSerialChannel( * are shared between multiple channels (stdin/stdout). */ - wsprintfA(channelName, "file%lx", (int) infoPtr); + sprintf(channelName, "file%" TCL_I_MODIFIER "x", (size_t) infoPtr); infoPtr->channel = Tcl_CreateChannel(&serialChannelType, channelName, - (ClientData) infoPtr, permissions); + infoPtr, permissions); SetupComm(handle, infoPtr->sysBufRead, infoPtr->sysBufWrite); @@ -1520,6 +1518,7 @@ TclWinOpenSerialChannel( SetCommTimeouts(handle, &no_timeout); + InitializeCriticalSection(&infoPtr->csWrite); if (permissions & TCL_READABLE) { infoPtr->osRead.hEvent = CreateEvent(NULL, TRUE, FALSE, NULL); } @@ -1532,7 +1531,6 @@ TclWinOpenSerialChannel( infoPtr->evWritable = CreateEvent(NULL, TRUE, TRUE, NULL); infoPtr->evStartWriter = CreateEvent(NULL, FALSE, FALSE, NULL); infoPtr->evStopWriter = CreateEvent(NULL, FALSE, FALSE, NULL); - InitializeCriticalSection(&infoPtr->csWrite); infoPtr->writeThread = CreateThread(NULL, 256, SerialWriterThread, infoPtr, 0, &id); } @@ -1650,17 +1648,17 @@ static int SerialSetOptionProc( ClientData instanceData, /* File state. */ Tcl_Interp *interp, /* For error reporting - can be NULL. */ - CONST char *optionName, /* Which option to set? */ - CONST char *value) /* New value for option. */ + const char *optionName, /* Which option to set? */ + const char *value) /* New value for option. */ { SerialInfo *infoPtr; DCB dcb; BOOL result, flag; size_t len, vlen; Tcl_DString ds; - CONST TCHAR *native; + const TCHAR *native; int argc; - CONST char **argv; + const char **argv; infoPtr = (SerialInfo *) instanceData; @@ -1678,19 +1676,18 @@ SerialSetOptionProc( if ((len > 2) && (strncmp(optionName, "-mode", len) == 0)) { if (!GetCommState(infoPtr->handle, &dcb)) { - if (interp != NULL) { - Tcl_AppendResult(interp, "can't get comm state", NULL); - } - return TCL_ERROR; + goto getStateFailed; } native = Tcl_WinUtfToTChar(value, -1, &ds); - result = (*tclWinProcs->buildCommDCBProc)(native, &dcb); + result = BuildCommDCB(native, &dcb); Tcl_DStringFree(&ds); if (result == FALSE) { if (interp != NULL) { - Tcl_AppendResult(interp, "bad value \"", value, - "\" for -mode: should be baud,parity,data,stop", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad value \"%s\" for -mode: should be baud,parity,data,stop", + value)); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "SERIALMODE", NULL); } return TCL_ERROR; } @@ -1705,10 +1702,7 @@ SerialSetOptionProc( dcb.fAbortOnError = FALSE; if (!SetCommState(infoPtr->handle, &dcb)) { - if (interp != NULL) { - Tcl_AppendResult(interp, "can't set comm state", NULL); - } - return TCL_ERROR; + goto setStateFailed; } return TCL_OK; } @@ -1719,10 +1713,7 @@ SerialSetOptionProc( if ((len > 1) && (strncmp(optionName, "-handshake", len) == 0)) { if (!GetCommState(infoPtr->handle, &dcb)) { - if (interp != NULL) { - Tcl_AppendResult(interp, "can't get comm state", NULL); - } - return TCL_ERROR; + goto getStateFailed; } /* @@ -1743,32 +1734,30 @@ SerialSetOptionProc( dcb.XonLim = (WORD) (infoPtr->sysBufRead*1/2); dcb.XoffLim = (WORD) (infoPtr->sysBufRead*1/4); - if (strnicmp(value, "NONE", vlen) == 0) { + if (strncasecmp(value, "NONE", vlen) == 0) { /* * Leave all handshake options disabled. */ - } else if (strnicmp(value, "XONXOFF", vlen) == 0) { + } 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 != NULL) { - Tcl_AppendResult(interp, "bad value \"", value, - "\" for -handshake: must be one of xonxoff, rtscts, ", - "dtrdsr or none", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad value \"%s\" for -handshake: must be one of" + " xonxoff, rtscts, dtrdsr or none", value)); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "HANDSHAKE", NULL); } return TCL_ERROR; } if (!SetCommState(infoPtr->handle, &dcb)) { - if (interp != NULL) { - Tcl_AppendResult(interp, "can't set comm state", NULL); - } - return TCL_ERROR; + goto setStateFailed; } return TCL_OK; } @@ -1779,10 +1768,7 @@ SerialSetOptionProc( if ((len > 1) && (strncmp(optionName, "-xchar", len) == 0)) { if (!GetCommState(infoPtr->handle, &dcb)) { - if (interp != NULL) { - Tcl_AppendResult(interp, "can't get comm state", NULL); - } - return TCL_ERROR; + goto getStateFailed; } if (Tcl_SplitList(interp, value, &argc, &argv) == TCL_ERROR) { @@ -1791,11 +1777,12 @@ SerialSetOptionProc( 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); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "bad value for -xchar: should be a list of" + " two elements with each a single character", -1)); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "XCHAR", NULL); } - ckfree((char *) argv); + ckfree(argv); return TCL_ERROR; } @@ -1826,13 +1813,10 @@ SerialSetOptionProc( } dcb.XoffChar = (char) character; } - ckfree((char *) argv); + ckfree(argv); if (!SetCommState(infoPtr->handle, &dcb)) { - if (interp != NULL) { - Tcl_AppendResult(interp, "can't set comm state", NULL); - } - return TCL_ERROR; + goto setStateFailed; } return TCL_OK; } @@ -1849,11 +1833,12 @@ SerialSetOptionProc( } if ((argc % 2) == 1) { if (interp != NULL) { - Tcl_AppendResult(interp, "bad value \"", value, - "\" for -ttycontrol: should be a list of ", - "signal,value pairs", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad value \"%s\" for -ttycontrol: should be " + "a list of signal,value pairs", value)); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "TTYCONTROL", NULL); } - ckfree((char *) argv); + ckfree(argv); return TCL_ERROR; } @@ -1862,37 +1847,48 @@ SerialSetOptionProc( result = TCL_ERROR; break; } - if (strnicmp(argv[i], "DTR", strlen(argv[i])) == 0) { + 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); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't set DTR signal", -1)); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", + "FCONFIGURE", "TTY_SIGNAL", NULL); } result = TCL_ERROR; break; } - } else if (strnicmp(argv[i], "RTS", strlen(argv[i])) == 0) { + } 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); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't set RTS signal", -1)); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", + "FCONFIGURE", "TTY_SIGNAL", NULL); } result = TCL_ERROR; break; } - } else if (strnicmp(argv[i], "BREAK", strlen(argv[i])) == 0) { + } 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); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't set BREAK signal", -1)); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", + "FCONFIGURE", "TTY_SIGNAL", NULL); } result = TCL_ERROR; break; } } else { if (interp != NULL) { - Tcl_AppendResult(interp, "bad signal name \"", argv[i], - "\" for -ttycontrol: must be DTR, RTS or BREAK", + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad signal name \"%s\" for -ttycontrol: must be" + " DTR, RTS or BREAK", argv[i])); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "TTY_SIGNAL", NULL); } result = TCL_ERROR; @@ -1900,7 +1896,7 @@ SerialSetOptionProc( } } - ckfree((char *) argv); + ckfree(argv); return result; } @@ -1926,20 +1922,24 @@ SerialSetOptionProc( inSize = atoi(argv[0]); outSize = atoi(argv[1]); } - ckfree((char *) argv); + ckfree(argv); 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); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad value \"%s\" for -sysbuffer: should be " + "a list of one or two integers > 0", value)); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "SYS_BUFFER", NULL); } return TCL_ERROR; } if (!SetupComm(infoPtr->handle, inSize, outSize)) { if (interp != NULL) { - Tcl_AppendResult(interp, "can't setup comm buffers", NULL); + TclWinConvertError(GetLastError()); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't setup comm buffers: %s", + Tcl_PosixError(interp))); } return TCL_ERROR; } @@ -1952,18 +1952,12 @@ SerialSetOptionProc( */ if (!GetCommState(infoPtr->handle, &dcb)) { - if (interp != NULL) { - Tcl_AppendResult(interp, "can't get comm state", NULL); - } - return TCL_ERROR; + goto getStateFailed; } dcb.XonLim = (WORD) (infoPtr->sysBufRead*1/2); dcb.XoffLim = (WORD) (infoPtr->sysBufRead*1/4); if (!SetCommState(infoPtr->handle, &dcb)) { - if (interp != NULL) { - Tcl_AppendResult(interp, "can't set comm state", NULL); - } - return TCL_ERROR; + goto setStateFailed; } return TCL_OK; } @@ -1993,7 +1987,10 @@ SerialSetOptionProc( tout.ReadTotalTimeoutConstant = msec; if (!SetCommTimeouts(infoPtr->handle, &tout)) { if (interp != NULL) { - Tcl_AppendResult(interp, "can't set comm timeouts", NULL); + TclWinConvertError(GetLastError()); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't set comm timeouts: %s", + Tcl_PosixError(interp))); } return TCL_ERROR; } @@ -2003,6 +2000,22 @@ SerialSetOptionProc( return Tcl_BadChannelOption(interp, optionName, "mode handshake pollinterval sysbuffer timeout ttycontrol xchar"); + + getStateFailed: + if (interp != NULL) { + TclWinConvertError(GetLastError()); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't get comm state: %s", Tcl_PosixError(interp))); + } + return TCL_ERROR; + + setStateFailed: + if (interp != NULL) { + TclWinConvertError(GetLastError()); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't set comm state: %s", Tcl_PosixError(interp))); + } + return TCL_ERROR; } /* @@ -2030,7 +2043,7 @@ static int SerialGetOptionProc( ClientData instanceData, /* File state. */ Tcl_Interp *interp, /* For error reporting - can be NULL. */ - CONST char *optionName, /* Option to get. */ + const char *optionName, /* Option to get. */ Tcl_DString *dsPtr) /* Where to store value(s). */ { SerialInfo *infoPtr; @@ -2055,12 +2068,14 @@ SerialGetOptionProc( } if (len==0 || (len>2 && (strncmp(optionName, "-mode", len) == 0))) { char parity; - char *stop; + const char *stop; char buf[2 * TCL_INTEGER_SPACE + 16]; if (!GetCommState(infoPtr->handle, &dcb)) { if (interp != NULL) { - Tcl_AppendResult(interp, "can't get comm state", NULL); + TclWinConvertError(GetLastError()); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't get comm state: %s", Tcl_PosixError(interp))); } return TCL_ERROR; } @@ -2128,7 +2143,9 @@ SerialGetOptionProc( if (!GetCommState(infoPtr->handle, &dcb)) { if (interp != NULL) { - Tcl_AppendResult(interp, "can't get comm state", NULL); + TclWinConvertError(GetLastError()); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't get comm state: %s", Tcl_PosixError(interp))); } return TCL_ERROR; } @@ -2204,7 +2221,9 @@ SerialGetOptionProc( if (!GetCommModemStatus(infoPtr->handle, &status)) { if (interp != NULL) { - Tcl_AppendResult(interp, "can't get tty status", NULL); + TclWinConvertError(GetLastError()); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't get tty status: %s", Tcl_PosixError(interp))); } return TCL_ERROR; } @@ -2214,10 +2233,9 @@ SerialGetOptionProc( if (valid) { return TCL_OK; - } else { - return Tcl_BadChannelOption(interp, optionName, - "mode pollinterval lasterror queue sysbuffer ttystatus xchar"); } + return Tcl_BadChannelOption(interp, optionName, + "mode pollinterval lasterror queue sysbuffer ttystatus xchar"); } /* diff --git a/win/tclWinSock.c b/win/tclWinSock.c index d46bfc0..3990111 100644 --- a/win/tclWinSock.c +++ b/win/tclWinSock.c @@ -8,11 +8,49 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclWinSock.c,v 1.57 2007/02/20 23:24:07 nijtmans Exp $ + * ----------------------------------------------------------------------- + * + * General information on how this module works. + * + * - Each Tcl-thread with its sockets maintains an internal window to receive + * socket messages from the OS. + * + * - To ensure that message reception is always running this window is + * actually owned and handled by an internal thread. This we call the + * co-thread of Tcl's thread. + * + * - The whole structure is set up by InitSockets() which is called for each + * Tcl thread. The implementation of the co-thread is in SocketThread(), + * and the messages are handled by SocketProc(). The connection between + * both is not directly visible, it is done through a Win32 window class. + * This class is initialized by InitSockets() as well, and used in the + * creation of the message receiver windows. + * + * - An important thing to note is that *both* thread and co-thread have + * access to the list of sockets maintained in the private TSD data of the + * thread. The co-thread was given access to it upon creation through the + * new thread's client-data. + * + * Because of this dual access the TSD data contains an OS mutex, the + * "socketListLock", to mediate exclusion between thread and co-thread. + * + * The co-thread's access is all in SocketProc(). The thread's access is + * through SocketEventProc() (1) and the functions called by it. + * + * (Ad 1) This is the handler function for all queued socket events, which + * all the OS messages are translated to through the EventSource (2) + * driven by the OS messages. + * + * (Ad 2) The main functions for this are SocketSetupProc() and + * SocketCheckProc(). */ #include "tclWinInt.h" +#ifdef _MSC_VER +# pragma comment (lib, "ws2_32") +#endif + /* * Support for control over sockets' KEEPALIVE and NODELAY behavior is * currently disabled. @@ -27,15 +65,16 @@ #undef getservbyname #undef getsockopt -#undef ntohs #undef setsockopt /* * 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 const TCHAR classname[] = TEXT("TclSocket"); TCL_DECLARE_MUTEX(socketMutex) /* @@ -48,111 +87,47 @@ static ProcessGlobalValue hostName = { }; /* - * Mingw, Cygwin and OpenWatcom may not have LPFN_* typedefs. + * The following defines declare the messages used on socket windows. */ -#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 +#define SOCKET_MESSAGE WM_USER+1 +#define SOCKET_SELECT WM_USER+2 +#define SOCKET_TERMINATE WM_USER+3 +#define SELECT TRUE +#define UNSELECT FALSE /* - * 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. + * This is needed to comply with the strict aliasing rules of GCC, but it also + * simplifies casting between the different sockaddr types. */ -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; +typedef union { + struct sockaddr sa; + struct sockaddr_in sa4; + struct sockaddr_in6 sa6; + struct sockaddr_storage sas; +} address; -/* - * The following defines declare the messages used on socket windows. - */ +#ifndef IN6_ARE_ADDR_EQUAL +#define IN6_ARE_ADDR_EQUAL IN6_ADDR_EQUAL +#endif -#define SOCKET_MESSAGE WM_USER+1 -#define SOCKET_SELECT WM_USER+2 -#define SOCKET_TERMINATE WM_USER+3 -#define SELECT TRUE -#define UNSELECT FALSE +typedef struct SocketInfo SocketInfo; + +typedef struct TcpFdList { + SocketInfo *infoPtr; + SOCKET fd; + struct TcpFdList *next; +} TcpFdList; /* * The following structure is used to store the data associated with each * socket. */ -typedef struct SocketInfo { +struct SocketInfo { Tcl_Channel channel; /* Channel associated with this socket. */ - SOCKET socket; /* Windows SOCKET handle. */ + struct TcpFdList *sockets; /* Windows SOCKET handle. */ int flags; /* Bit field comprised of the flags described * below. */ int watchEvents; /* OR'ed combination of FD_READ, FD_WRITE, @@ -173,14 +148,14 @@ typedef struct SocketInfo { 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. */ -typedef struct SocketEvent { +typedef struct { Tcl_Event header; /* Information that is standard for all * events. */ SOCKET socket; /* Socket descriptor that is ready. Used to @@ -208,7 +183,7 @@ typedef struct SocketEvent { #define SOCKET_PENDING (1<<3) /* A message has been sent for this * socket */ -typedef struct ThreadSpecificData { +typedef struct { HWND hwnd; /* Handle to window for socket messages. */ HANDLE socketThread; /* Thread handling the window */ Tcl_ThreadId threadId; /* Parent thread. */ @@ -231,15 +206,13 @@ static WNDCLASS windowClass; 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 void TcpAccept(TcpFdList *fds, SOCKET newSocket, address addr); static int WaitForSocketEvent(SocketInfo *infoPtr, int events, int *errorCodePtr); static DWORD WINAPI SocketThread(LPVOID arg); @@ -251,6 +224,7 @@ static Tcl_EventProc SocketEventProc; static Tcl_EventSetupProc SocketSetupProc; static Tcl_DriverBlockModeProc TcpBlockProc; static Tcl_DriverCloseProc TcpCloseProc; +static Tcl_DriverClose2Proc TcpClose2Proc; static Tcl_DriverSetOptionProc TcpSetOptionProc; static Tcl_DriverGetOptionProc TcpGetOptionProc; static Tcl_DriverInputProc TcpInputProc; @@ -263,7 +237,7 @@ static Tcl_DriverGetHandleProc TcpGetHandleProc; * based IO. */ -static Tcl_ChannelType tcpChannelType = { +static const Tcl_ChannelType tcpChannelType = { "tcp", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ TcpCloseProc, /* Close proc. */ @@ -274,13 +248,13 @@ static Tcl_ChannelType tcpChannelType = { TcpGetOptionProc, /* Get option proc. */ TcpWatchProc, /* Set up notifier to watch this channel. */ TcpGetHandleProc, /* Get an OS handle from channel. */ - NULL, /* close2proc. */ + TcpClose2Proc, /* Close2proc. */ TcpBlockProc, /* Set socket into (non-)blocking mode. */ NULL, /* flush proc. */ NULL, /* handler proc. */ NULL, /* wide seek proc */ TcpThreadActionProc, /* thread action proc */ - NULL, /* truncate */ + NULL /* truncate */ }; /* @@ -288,9 +262,8 @@ static Tcl_ChannelType tcpChannelType = { * * InitSockets -- * - * Initialize the socket module. Attempts to load the wsock32.dll library - * and set up the winSock function table. If successful, registers the - * event window for the socket notifier code. + * Initialize the socket module. If winsock startup is successful, + * registers the event window for the socket notifier code. * * Assumes socketMutex is held. * @@ -298,8 +271,8 @@ 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. * *---------------------------------------------------------------------- */ @@ -308,111 +281,11 @@ static void InitSockets(void) { DWORD id; - WSADATA wsaData; - DWORD err; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) - TclThreadDataKeyGet(&dataKey); + ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey); if (!initialized) { initialized = 1; - Tcl_CreateExitHandler(SocketExitHandler, (ClientData) NULL); - - winSock.hModule = LoadLibraryA("wsock32.dll"); - - if (winSock.hModule == NULL) { - return; - } - - /* - * Initialize the function table. - */ - - 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; - } + TclCreateLateExitHandler(SocketExitHandler, NULL); /* * Create the async notification window with a new class. We must @@ -427,94 +300,68 @@ InitSockets(void) windowClass.hInstance = TclWinGetTclInstance(); windowClass.hbrBackground = NULL; windowClass.lpszMenuName = NULL; - windowClass.lpszClassName = "TclSocket"; + windowClass.lpszClassName = classname; windowClass.lpfnWndProc = SocketProc; windowClass.hIcon = NULL; windowClass.hCursor = NULL; - if (!RegisterClassA(&windowClass)) { + if (!RegisterClass(&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. - */ - -#define WSA_VERSION_MAJOR 1 -#define WSA_VERSION_MINOR 1 -#define WSA_VERSION_REQD MAKEWORD(WSA_VERSION_MAJOR, WSA_VERSION_MINOR) - - err = winSock.WSAStartup((WORD)WSA_VERSION_REQD, &wsaData); - if (err != 0) { - TclWinConvertWSAError(err); - goto unloadLibrary; - } - - /* - * 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; - } - -#undef WSA_VERSION_REQD -#undef WSA_VERSION_MAJOR -#undef WSA_VERSION_MINOR } /* * Check for per-thread initialization. */ - if (tsdPtr == NULL) { - tsdPtr = TCL_TSD_INIT(&dataKey); - tsdPtr->socketList = NULL; - tsdPtr->hwnd = NULL; - tsdPtr->threadId = Tcl_GetCurrentThread(); - tsdPtr->readyEvent = CreateEvent(NULL, FALSE, FALSE, NULL); - if (tsdPtr->readyEvent == NULL) { - goto unloadLibrary; - } - tsdPtr->socketListLock = CreateEvent(NULL, FALSE, TRUE, NULL); - if (tsdPtr->socketListLock == NULL) { - goto unloadLibrary; - } - tsdPtr->socketThread = CreateThread(NULL, 256, SocketThread, tsdPtr, - 0, &id); - if (tsdPtr->socketThread == NULL) { - goto unloadLibrary; - } + if (tsdPtr != NULL) { + return; + } - SetThreadPriority(tsdPtr->socketThread, THREAD_PRIORITY_HIGHEST); + /* + * OK, this thread has never done anything with sockets before. Construct + * a worker thread to handle asynchronous events related to sockets + * assigned to _this_ thread. + */ - /* - * Wait for the thread to signal when the window has been created and - * if it is ready to go. - */ + tsdPtr = TCL_TSD_INIT(&dataKey); + tsdPtr->socketList = NULL; + tsdPtr->hwnd = NULL; + tsdPtr->threadId = Tcl_GetCurrentThread(); + tsdPtr->readyEvent = CreateEvent(NULL, FALSE, FALSE, NULL); + if (tsdPtr->readyEvent == NULL) { + goto initFailure; + } + tsdPtr->socketListLock = CreateEvent(NULL, FALSE, TRUE, NULL); + if (tsdPtr->socketListLock == NULL) { + goto initFailure; + } + tsdPtr->socketThread = CreateThread(NULL, 256, SocketThread, tsdPtr, 0, + &id); + if (tsdPtr->socketThread == NULL) { + goto initFailure; + } - WaitForSingleObject(tsdPtr->readyEvent, INFINITE); + SetThreadPriority(tsdPtr->socketThread, THREAD_PRIORITY_HIGHEST); - if (tsdPtr->hwnd == NULL) { - goto unloadLibrary; /* Trouble creating the window */ - } + /* + * Wait for the thread to signal when the window has been created and if + * it is ready to go. + */ + + WaitForSingleObject(tsdPtr->readyEvent, INFINITE); - Tcl_CreateEventSource(SocketSetupProc, SocketCheckProc, NULL); + if (tsdPtr->hwnd == NULL) { + goto initFailure; /* Trouble creating the window. */ } + + Tcl_CreateEventSource(SocketSetupProc, SocketCheckProc, NULL); return; - unloadLibrary: + initFailure: TclpFinalizeSockets(); - FreeLibrary(winSock.hModule); - winSock.hModule = NULL; + initialized = -1; return; } @@ -523,7 +370,7 @@ InitSockets(void) * * SocketsEnabled -- * - * Check that the WinSock DLL is loaded and ready. + * Check that the WinSock was successfully initialized. * * Results: * 1 if it is. @@ -539,8 +386,9 @@ static int SocketsEnabled(void) { int enabled; + Tcl_MutexLock(&socketMutex); - enabled = (winSock.hModule != NULL); + enabled = (initialized == 1); Tcl_MutexUnlock(&socketMutex); return enabled; } @@ -569,19 +417,14 @@ 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. - */ + /* + * 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; - } + TclpFinalizeSockets(); + UnregisterClass(classname, TclWinGetTclInstance()); initialized = 0; Tcl_MutexUnlock(&socketMutex); } @@ -608,35 +451,40 @@ SocketExitHandler( void TclpFinalizeSockets(void) { - ThreadSpecificData *tsdPtr; + ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey); - tsdPtr = (ThreadSpecificData *) TclThreadDataKeyGet(&dataKey); - if (tsdPtr != NULL) { - if (tsdPtr->socketThread != NULL) { - if (tsdPtr->hwnd != NULL) { - PostMessage(tsdPtr->hwnd, SOCKET_TERMINATE, 0, 0); + /* + * Careful! This is a finalizer! + */ - /* - * Wait for the thread to exit. This ensures that we are - * completely cleaned up before we leave this function. - */ + if (tsdPtr == NULL) { + return; + } - WaitForSingleObject(tsdPtr->readyEvent, INFINITE); - tsdPtr->hwnd = NULL; - } - CloseHandle(tsdPtr->socketThread); - tsdPtr->socketThread = NULL; - } - if (tsdPtr->readyEvent != NULL) { - CloseHandle(tsdPtr->readyEvent); - tsdPtr->readyEvent = NULL; - } - if (tsdPtr->socketListLock != NULL) { - CloseHandle(tsdPtr->socketListLock); - tsdPtr->socketListLock = NULL; + 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; } - Tcl_DeleteEventSource(SocketSetupProc, SocketCheckProc, NULL); + CloseHandle(tsdPtr->socketThread); + tsdPtr->socketThread = NULL; + } + if (tsdPtr->readyEvent != NULL) { + CloseHandle(tsdPtr->readyEvent); + tsdPtr->readyEvent = NULL; + } + if (tsdPtr->socketListLock != NULL) { + CloseHandle(tsdPtr->socketListLock); + tsdPtr->socketListLock = NULL; } + Tcl_DeleteEventSource(SocketSetupProc, SocketCheckProc, NULL); } /* @@ -674,8 +522,8 @@ TclpHasSockets( return TCL_OK; } if (interp != NULL) { - Tcl_AppendResult(interp, "sockets are not available on this system", - NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "sockets are not available on this system", -1)); } return TCL_ERROR; } @@ -767,9 +615,9 @@ SocketCheckProc( if ((infoPtr->readyEvents & infoPtr->watchEvents) && !(infoPtr->flags & SOCKET_PENDING)) { infoPtr->flags |= SOCKET_PENDING; - evPtr = (SocketEvent *) ckalloc(sizeof(SocketEvent)); + evPtr = ckalloc(sizeof(SocketEvent)); evPtr->header.proc = SocketEventProc; - evPtr->socket = infoPtr->socket; + evPtr->socket = infoPtr->sockets->fd; Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL); } } @@ -805,9 +653,12 @@ SocketEventProc( { SocketInfo *infoPtr; SocketEvent *eventPtr = (SocketEvent *) evPtr; - int mask = 0; - int events; + int mask = 0, events; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + TcpFdList *fds; + SOCKET newSocket; + address addr; + int len; if (!(flags & TCL_FILE_EVENTS)) { return 0; @@ -820,17 +671,17 @@ SocketEventProc( WaitForSingleObject(tsdPtr->socketListLock, INFINITE); for (infoPtr = tsdPtr->socketList; infoPtr != NULL; infoPtr = infoPtr->nextPtr) { - if (infoPtr->socket == eventPtr->socket) { + if (infoPtr->sockets->fd == eventPtr->socket) { break; } } - SetEvent(tsdPtr->socketListLock); /* * Discard events that have gone stale. */ if (!infoPtr) { + SetEvent(tsdPtr->socketListLock); return 1; } @@ -841,10 +692,66 @@ SocketEventProc( */ if (infoPtr->readyEvents & FD_ACCEPT) { - TcpAccept(infoPtr); + for (fds = infoPtr->sockets; fds != NULL; fds = fds->next) { + + /* + * Accept the incoming connection request. + */ + len = sizeof(address); + + newSocket = accept(fds->fd, &(addr.sa), &len); + + /* On Tcl server sockets with multiple OS fds we loop over the fds trying + * an accept() on each, so we expect INVALID_SOCKET. There are also other + * network stack conditions that can result in FD_ACCEPT but a subsequent + * failure on accept() by the time we get around to it. + * Access to sockets (acceptEventCount, readyEvents) in socketList + * is still protected by the lock (prevents reintroduction of + * SF Tcl Bug 3056775. + */ + + if (newSocket == INVALID_SOCKET) { + /* int err = WSAGetLastError(); */ + continue; + } + + /* + * It is possible that more than one FD_ACCEPT has been sent, so an extra + * count must be kept. Decrement the count, and reset the readyEvent bit + * if the count is no longer > 0. + */ + infoPtr->acceptEventCount--; + + if (infoPtr->acceptEventCount <= 0) { + infoPtr->readyEvents &= ~(FD_ACCEPT); + } + + SetEvent(tsdPtr->socketListLock); + + /* Caution: TcpAccept() has the side-effect of evaluating the server + * accept script (via AcceptCallbackProc() in tclIOCmd.c), which can + * close the server socket and invalidate infoPtr and fds. + * If TcpAccept() accepts a socket we must return immediately and let + * SocketCheckProc queue additional FD_ACCEPT events. + */ + TcpAccept(fds, newSocket, addr); + return 1; + } + + /* Loop terminated with no sockets accepted; clear the ready mask so + * we can detect the next connection request. Note that connection + * requests are level triggered, so if there is a request already + * pending, a new event will be generated. + */ + infoPtr->acceptEventCount = 0; + infoPtr->readyEvents &= ~(FD_ACCEPT); + + SetEvent(tsdPtr->socketListLock); return 1; } + SetEvent(tsdPtr->socketListLock); + /* * Mask off unwanted events and compute the read/write mask so we can * notify the channel. @@ -864,6 +771,7 @@ SocketEventProc( */ Tcl_Time blockTime = { 0, 0 }; + Tcl_SetMaxBlockTime(&blockTime); mask |= TCL_READABLE|TCL_WRITABLE; } else if (events & FD_READ) { @@ -882,11 +790,11 @@ SocketEventProc( (WPARAM) UNSELECT, (LPARAM) infoPtr); FD_ZERO(&readFds); - FD_SET(infoPtr->socket, &readFds); + FD_SET(infoPtr->sockets->fd, &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); @@ -933,7 +841,7 @@ TcpBlockProc( int mode) /* TCL_MODE_BLOCKING or * TCL_MODE_NONBLOCKING. */ { - SocketInfo *infoPtr = (SocketInfo *) instanceData; + SocketInfo *infoPtr = instanceData; if (mode == TCL_MODE_NONBLOCKING) { infoPtr->flags |= SOCKET_ASYNC; @@ -967,7 +875,7 @@ TcpCloseProc( ClientData instanceData, /* The socket to close. */ Tcl_Interp *interp) /* Unused. */ { - SocketInfo *infoPtr = (SocketInfo *) instanceData; + SocketInfo *infoPtr = instanceData; /* TIP #218 */ int errorCode = 0; /* ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); */ @@ -985,9 +893,15 @@ TcpCloseProc( * background. */ - if (winSock.closesocket(infoPtr->socket) == SOCKET_ERROR) { - TclWinConvertWSAError((DWORD) winSock.WSAGetLastError()); - errorCode = Tcl_GetErrno(); + while ( infoPtr->sockets != NULL ) { + TcpFdList *thisfd = infoPtr->sockets; + infoPtr->sockets = thisfd->next; + + if (closesocket(thisfd->fd) == SOCKET_ERROR) { + TclWinConvertError((DWORD) WSAGetLastError()); + errorCode = Tcl_GetErrno(); + } + ckfree(thisfd); } } @@ -998,13 +912,113 @@ TcpCloseProc( * fear of damaging the list. */ - ckfree((char *) infoPtr); + ckfree(infoPtr); return errorCode; } /* *---------------------------------------------------------------------- * + * TcpClose2Proc -- + * + * This function is called by the generic IO level to perform the channel + * type specific part of a half-close: namely, a shutdown() on a socket. + * + * Results: + * 0 if successful, the value of errno if failed. + * + * Side effects: + * Shuts down one side of the socket. + * + *---------------------------------------------------------------------- + */ + +static int +TcpClose2Proc( + ClientData instanceData, /* The socket to close. */ + Tcl_Interp *interp, /* For error reporting. */ + int flags) /* Flags that indicate which side to close. */ +{ + SocketInfo *infoPtr = instanceData; + int errorCode = 0, sd; + + /* + * Shutdown the OS socket handle. + */ + + switch (flags) { + case TCL_CLOSE_READ: + sd = SD_RECEIVE; + break; + case TCL_CLOSE_WRITE: + sd = SD_SEND; + break; + default: + if (interp) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "Socket close2proc called bidirectionally", -1)); + } + return TCL_ERROR; + } + + /* single fd operation: Tcl_OpenTcpServer() does not set TCL_READABLE or + * TCL_WRITABLE so this should never be called for a server socket. */ + if (shutdown(infoPtr->sockets->fd, sd) == SOCKET_ERROR) { + TclWinConvertError((DWORD) WSAGetLastError()); + errorCode = Tcl_GetErrno(); + } + + return errorCode; +} + +/* + *---------------------------------------------------------------------- + * + * AddSocketInfoFd -- + * + * This function adds a SOCKET file descriptor to the 'sockets' linked + * list of a SocketInfo structure. + * + * Results: + * None. + * + * Side effects: + * None, except for allocation of memory. + * + *---------------------------------------------------------------------- + */ + +static void +AddSocketInfoFd( + SocketInfo *infoPtr, + SOCKET socket) +{ + TcpFdList *fds = infoPtr->sockets; + + if ( fds == NULL ) { + /* Add the first FD */ + infoPtr->sockets = ckalloc(sizeof(TcpFdList)); + fds = infoPtr->sockets; + } else { + /* Find end of list and append FD */ + while ( fds->next != NULL ) { + fds = fds->next; + } + + fds->next = ckalloc(sizeof(TcpFdList)); + fds = fds->next; + } + + /* Populate new FD */ + fds->fd = socket; + fds->infoPtr = infoPtr; + fds->next = NULL; +} + + +/* + *---------------------------------------------------------------------- + * * NewSocketInfo -- * * This function allocates and initializes a new SocketInfo structure. @@ -1022,12 +1036,11 @@ static SocketInfo * NewSocketInfo( SOCKET socket) { - SocketInfo *infoPtr; - /* ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); */ + SocketInfo *infoPtr = ckalloc(sizeof(SocketInfo)); - infoPtr = (SocketInfo *) ckalloc((unsigned) sizeof(SocketInfo)); + /* ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); */ infoPtr->channel = 0; - infoPtr->socket = socket; + infoPtr->sockets = NULL; infoPtr->flags = 0; infoPtr->watchEvents = 0; infoPtr->readyEvents = 0; @@ -1045,6 +1058,8 @@ NewSocketInfo( infoPtr->nextPtr = NULL; + AddSocketInfoFd(infoPtr, socket); + return infoPtr; } @@ -1080,12 +1095,15 @@ CreateSocket( u_long flag = 1; /* Indicates nonblocking mode. */ int asyncConnect = 0; /* Will be 1 if async connect is in * progress. */ - SOCKADDR_IN sockaddr; /* Socket address */ - SOCKADDR_IN mysockaddr; /* Socket address for client */ + unsigned short chosenport = 0; + struct addrinfo *addrlist = NULL, *addrPtr; + /* Socket address to connect to. */ + struct addrinfo *myaddrlist = NULL, *myaddrPtr; + /* Socket address for our side. */ + const char *errorMsg = NULL; SOCKET sock = INVALID_SOCKET; - SocketInfo *infoPtr; /* The returned value. */ - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) - TclThreadDataKeyGet(&dataKey); + SocketInfo *infoPtr = NULL; /* The returned value. */ + ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey); /* * Check that WinSock is initialized; do not call it if not, to prevent @@ -1097,113 +1115,196 @@ CreateSocket( return NULL; } - if (!CreateSocketAddress(&sockaddr, host, port)) { - goto error; - } - if ((myaddr != NULL || myport != 0) && - !CreateSocketAddress(&mysockaddr, myaddr, myport)) { + /* + * Construct the addresses for each end of the socket. + */ + + if (!TclCreateSocketAddress(interp, &addrlist, host, port, server, + &errorMsg)) { goto error; } - - sock = winSock.socket(AF_INET, SOCK_STREAM, 0); - if (sock == INVALID_SOCKET) { + if (!TclCreateSocketAddress(interp, &myaddrlist, myaddr, myport, 1, + &errorMsg)) { goto error; } - /* - * Win-NT has a misfeature that sockets are inherited in child processes - * by default. Turn off the inherit bit. - */ + if (server) { - SetHandleInformation((HANDLE) sock, HANDLE_FLAG_INHERIT, 0); + for (addrPtr = addrlist; addrPtr != NULL; addrPtr = addrPtr->ai_next) { + sock = socket(addrPtr->ai_family, SOCK_STREAM, 0); + if (sock == INVALID_SOCKET) { + TclWinConvertError((DWORD) WSAGetLastError()); + continue; + } - /* - * Set kernel space buffering - */ + /* + * Win-NT has a misfeature that sockets are inherited in child + * processes by default. Turn off the inherit bit. + */ - TclSockMinimumBuffers((int) sock, TCP_BUFFER_SIZE); + SetHandleInformation((HANDLE) sock, HANDLE_FLAG_INHERIT, 0); - if (server) { - /* - * 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. - */ + /* + * Set kernel space buffering + */ - if (winSock.bind(sock, (SOCKADDR *) &sockaddr, - sizeof(SOCKADDR_IN)) == SOCKET_ERROR) { - goto error; - } + TclSockMinimumBuffers((void *)sock, TCP_BUFFER_SIZE); - /* - * 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). - */ + /* + * Make sure we use the same port when opening two server sockets + * for IPv4 and IPv6. + * + * As sockaddr_in6 uses the same offset and size for the port + * member as sockaddr_in, we can handle both through the IPv4 API. + */ - if (winSock.listen(sock, SOMAXCONN) == SOCKET_ERROR) { - goto error; - } + if (port == 0 && chosenport != 0) { + ((struct sockaddr_in *) addrPtr->ai_addr)->sin_port = + htons(chosenport); + } - /* - * Add this socket to the global list of sockets. - */ + /* + * 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. + */ - infoPtr = NewSocketInfo(sock); + if (bind(sock, addrPtr->ai_addr, addrPtr->ai_addrlen) + == SOCKET_ERROR) { + TclWinConvertError((DWORD) WSAGetLastError()); + closesocket(sock); + continue; + } + if (port == 0 && chosenport == 0) { + address sockname; + socklen_t namelen = sizeof(sockname); - /* - * Set up the select mask for connection request events. - */ + /* + * Synchronize port numbers when binding to port 0 of multiple + * addresses. + */ - infoPtr->selectEvents = FD_ACCEPT; - infoPtr->watchEvents |= FD_ACCEPT; + if (getsockname(sock, &sockname.sa, &namelen) >= 0) { + chosenport = ntohs(sockname.sa4.sin_port); + } + } - } else { - /* - * Try to bind to a local port, if specified. - */ + /* + * 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 (myaddr != NULL || myport != 0) { - if (winSock.bind(sock, (SOCKADDR *) &mysockaddr, - sizeof(SOCKADDR_IN)) == SOCKET_ERROR) { - goto error; + if (listen(sock, SOMAXCONN) == SOCKET_ERROR) { + TclWinConvertError((DWORD) WSAGetLastError()); + closesocket(sock); + continue; } - } - /* - * Set the socket into nonblocking mode if the connect should be done - * in the background. - */ + if (infoPtr == NULL) { + /* + * Add this socket to the global list of sockets. + */ + + infoPtr = NewSocketInfo(sock); - if (async) { - if (winSock.ioctlsocket(sock, (long) FIONBIO, - &flag) == SOCKET_ERROR) { - goto error; + /* + * Set up the select mask for connection request events. + */ + + infoPtr->selectEvents = FD_ACCEPT; + infoPtr->watchEvents |= FD_ACCEPT; + + } else { + AddSocketInfoFd( infoPtr, sock ); } } + } else { + for (addrPtr = addrlist; addrPtr != NULL; + addrPtr = addrPtr->ai_next) { + for (myaddrPtr = myaddrlist; myaddrPtr != NULL; + myaddrPtr = myaddrPtr->ai_next) { + /* + * No need to try combinations of local and remote addresses + * of different families. + */ - /* - * Attempt to connect to the remote socket. - */ + if (myaddrPtr->ai_family != addrPtr->ai_family) { + continue; + } - if (winSock.connect(sock, (SOCKADDR *) &sockaddr, - sizeof(SOCKADDR_IN)) == SOCKET_ERROR) { - TclWinConvertWSAError((DWORD) winSock.WSAGetLastError()); - if (Tcl_GetErrno() != EWOULDBLOCK) { - goto error; - } + sock = socket(myaddrPtr->ai_family, SOCK_STREAM, 0); + if (sock == INVALID_SOCKET) { + TclWinConvertError((DWORD) WSAGetLastError()); + continue; + } - /* - * The connection is progressing in the background. - */ + /* + * Win-NT has a misfeature that sockets are inherited in child + * processes by default. Turn off the inherit bit. + */ + + SetHandleInformation((HANDLE) sock, HANDLE_FLAG_INHERIT, 0); + + /* + * Set kernel space buffering + */ + + TclSockMinimumBuffers((void *) sock, TCP_BUFFER_SIZE); + + /* + * Try to bind to a local port. + */ + + if (bind(sock, myaddrPtr->ai_addr, myaddrPtr->ai_addrlen) + == SOCKET_ERROR) { + TclWinConvertError((DWORD) WSAGetLastError()); + goto looperror; + } + /* + * Set the socket into nonblocking mode if the connect should + * be done in the background. + */ + if (async && ioctlsocket(sock, (long) FIONBIO, &flag) + == SOCKET_ERROR) { + TclWinConvertError((DWORD) WSAGetLastError()); + goto looperror; + } - asyncConnect = 1; + /* + * Attempt to connect to the remote socket. + */ + + if (connect(sock, addrPtr->ai_addr, addrPtr->ai_addrlen) + == SOCKET_ERROR) { + DWORD error = (DWORD) WSAGetLastError(); + if (error != WSAEWOULDBLOCK) { + TclWinConvertError(error); + goto looperror; + } + + /* + * The connection is progressing in the background. + */ + + asyncConnect = 1; + } + goto connected; + + looperror: + if (sock != INVALID_SOCKET) { + closesocket(sock); + sock = INVALID_SOCKET; + } + } } + goto error; + connected: /* * Add this socket to the global list of sockets. */ @@ -1222,25 +1323,35 @@ CreateSocket( } } + error: + if (addrlist != NULL) { + freeaddrinfo(addrlist); + } + if (myaddrlist != NULL) { + freeaddrinfo(myaddrlist); + } + /* * 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); + if (infoPtr != NULL) { + ioctlsocket(sock, (long) FIONBIO, &flag); + SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT, + (LPARAM) infoPtr); - return infoPtr; + return infoPtr; + } - error: - TclWinConvertWSAError((DWORD) winSock.WSAGetLastError()); if (interp != NULL) { - Tcl_AppendResult(interp, "couldn't open socket: ", - Tcl_PosixError(interp), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "couldn't open socket: %s", + (errorMsg ? errorMsg : Tcl_PosixError(interp)))); } + if (sock != INVALID_SOCKET) { - winSock.closesocket(sock); + closesocket(sock); } return NULL; } @@ -1248,78 +1359,6 @@ CreateSocket( /* *---------------------------------------------------------------------- * - * CreateSocketAddress -- - * - * 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. - * - * Side effects: - * Fills in the *sockaddrPtr structure. - * - *---------------------------------------------------------------------- - */ - -static int -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 */ - - /* - * 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; - } - - ZeroMemory(sockaddrPtr, sizeof(SOCKADDR_IN)); - sockaddrPtr->sin_family = AF_INET; - sockaddrPtr->sin_port = winSock.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 { -#ifdef EHOSTUNREACH - Tcl_SetErrno(EHOSTUNREACH); -#else -#ifdef ENXIO - Tcl_SetErrno(ENXIO); -#endif -#endif - return 0; /* Error. */ - } - } - } - - /* - * 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. */ -} - -/* - *---------------------------------------------------------------------- - * * WaitForSocketEvent -- * * Waits until one of the specified events occurs on a socket. @@ -1342,8 +1381,7 @@ WaitForSocketEvent( { int result = 1; int oldMode; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) - TclThreadDataKeyGet(&dataKey); + ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey); /* * Be sure to disable event servicing so we are truly modal. @@ -1357,7 +1395,6 @@ WaitForSocketEvent( SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) UNSELECT, (LPARAM) infoPtr); - SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT, (LPARAM) infoPtr); @@ -1428,19 +1465,18 @@ Tcl_OpenTcpClient( return NULL; } - wsprintfA(channelName, "sock%d", infoPtr->socket); + sprintf(channelName, "sock%" TCL_I_MODIFIER "u", (size_t) infoPtr->sockets->fd); infoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName, - (ClientData) infoPtr, (TCL_READABLE | TCL_WRITABLE)); - if (Tcl_SetChannelOption(interp, infoPtr->channel, "-translation", - "auto crlf") == TCL_ERROR) { - Tcl_Close((Tcl_Interp *) NULL, infoPtr->channel); - return (Tcl_Channel) NULL; - } - if (Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "") - == TCL_ERROR) { - Tcl_Close((Tcl_Interp *) NULL, infoPtr->channel); - return (Tcl_Channel) NULL; + infoPtr, (TCL_READABLE | TCL_WRITABLE)); + if (TCL_ERROR == Tcl_SetChannelOption(NULL, infoPtr->channel, + "-translation", "auto crlf")) { + Tcl_Close(NULL, infoPtr->channel); + return NULL; + } else if (TCL_ERROR == Tcl_SetChannelOption(NULL, infoPtr->channel, + "-eofchar", "")) { + Tcl_Close(NULL, infoPtr->channel); + return NULL; } return infoPtr->channel; } @@ -1475,13 +1511,13 @@ Tcl_MakeTcpClientChannel( return NULL; } - tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); + tsdPtr = TclThreadDataKeyGet(&dataKey); /* * Set kernel space buffering and non-blocking. */ - TclSockMinimumBuffers((int) sock, TCP_BUFFER_SIZE); + TclSockMinimumBuffers(sock, TCP_BUFFER_SIZE); infoPtr = NewSocketInfo((SOCKET) sock); @@ -1490,12 +1526,11 @@ Tcl_MakeTcpClientChannel( */ infoPtr->selectEvents = FD_READ | FD_CLOSE | FD_WRITE; - SendMessage(tsdPtr->hwnd, SOCKET_SELECT, - (WPARAM) SELECT, (LPARAM) infoPtr); + SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM)SELECT, (LPARAM)infoPtr); - wsprintfA(channelName, "sock%d", infoPtr->socket); + sprintf(channelName, "sock%" TCL_I_MODIFIER "u", (size_t) infoPtr->sockets->fd); infoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName, - (ClientData) infoPtr, (TCL_READABLE | TCL_WRITABLE)); + infoPtr, (TCL_READABLE | TCL_WRITABLE)); Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto crlf"); return infoPtr->channel; } @@ -1546,14 +1581,14 @@ Tcl_OpenTcpServer( infoPtr->acceptProc = acceptProc; infoPtr->acceptProcData = acceptProcData; - wsprintfA(channelName, "sock%d", infoPtr->socket); + sprintf(channelName, "sock%" TCL_I_MODIFIER "u", (size_t) infoPtr->sockets->fd); infoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName, - (ClientData) infoPtr, 0); + infoPtr, 0); if (Tcl_SetChannelOption(interp, infoPtr->channel, "-eofchar", "") == TCL_ERROR) { - Tcl_Close((Tcl_Interp *) NULL, infoPtr->channel); - return (Tcl_Channel) NULL; + Tcl_Close(NULL, infoPtr->channel); + return NULL; } return infoPtr->channel; @@ -1564,8 +1599,9 @@ Tcl_OpenTcpServer( * * TcpAccept -- * - * Accept a TCP socket connection. This is called by SocketEventProc and - * it in turns calls the registered accept function. + * Creates a channel for a newly accepted socket connection. This is + * called by SocketEventProc and it in turns calls the registered + * accept function. * * Results: * None. @@ -1578,48 +1614,16 @@ Tcl_OpenTcpServer( static void TcpAccept( - SocketInfo *infoPtr) /* Socket to accept. */ + TcpFdList *fds, /* Server socket that accepted newSocket. */ + SOCKET newSocket, /* Newly accepted socket. */ + address addr) /* Address of new socket. */ { - SOCKET newSocket; SocketInfo *newInfoPtr; - SOCKADDR_IN addr; - int len; + SocketInfo *infoPtr = fds->infoPtr; + int len = sizeof(addr); char channelName[16 + TCL_INTEGER_SPACE]; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) - TclThreadDataKeyGet(&dataKey); - - /* - * Accept the incoming connection request. - */ - - len = sizeof(SOCKADDR_IN); - - newSocket = winSock.accept(infoPtr->socket, (SOCKADDR *)&addr, - &len); - - /* - * Clear the ready mask so we can detect the next connection request. Note - * that connection requests are level triggered, so if there is a request - * already pending, a new event will be generated. - */ - - if (newSocket == INVALID_SOCKET) { - infoPtr->acceptEventCount = 0; - infoPtr->readyEvents &= ~(FD_ACCEPT); - return; - } - - /* - * It is possible that more than one FD_ACCEPT has been sent, so an extra - * count must be kept. Decrement the count, and reset the readyEvent bit - * if the count is no longer > 0. - */ - - infoPtr->acceptEventCount--; - - if (infoPtr->acceptEventCount <= 0) { - infoPtr->readyEvents &= ~(FD_ACCEPT); - } + char host[NI_MAXHOST], port[NI_MAXSERV]; + ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey); /* * Win-NT has a misfeature that sockets are inherited in child processes @@ -1639,20 +1643,20 @@ TcpAccept( */ newInfoPtr->selectEvents = (FD_READ | FD_WRITE | FD_CLOSE); - SendMessage(tsdPtr->hwnd, SOCKET_SELECT, - (WPARAM) SELECT, (LPARAM) newInfoPtr); + SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT, + (LPARAM) newInfoPtr); - wsprintfA(channelName, "sock%d", newInfoPtr->socket); + sprintf(channelName, "sock%" TCL_I_MODIFIER "u", (size_t) newInfoPtr->sockets->fd); newInfoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName, - (ClientData) newInfoPtr, (TCL_READABLE | TCL_WRITABLE)); + newInfoPtr, (TCL_READABLE | TCL_WRITABLE)); if (Tcl_SetChannelOption(NULL, newInfoPtr->channel, "-translation", "auto crlf") == TCL_ERROR) { - Tcl_Close((Tcl_Interp *) NULL, newInfoPtr->channel); + Tcl_Close(NULL, newInfoPtr->channel); return; } if (Tcl_SetChannelOption(NULL, newInfoPtr->channel, "-eofchar", "") == TCL_ERROR) { - Tcl_Close((Tcl_Interp *) NULL, newInfoPtr->channel); + Tcl_Close(NULL, newInfoPtr->channel); return; } @@ -1661,9 +1665,10 @@ TcpAccept( */ if (infoPtr->acceptProc != NULL) { - (infoPtr->acceptProc) (infoPtr->acceptProcData, newInfoPtr->channel, - winSock.inet_ntoa(addr.sin_addr), - winSock.ntohs(addr.sin_port)); + getnameinfo(&(addr.sa), len, host, sizeof(host), port, sizeof(port), + NI_NUMERICHOST|NI_NUMERICSERV); + infoPtr->acceptProc(infoPtr->acceptProcData, newInfoPtr->channel, + host, atoi(port)); } } @@ -1691,11 +1696,10 @@ TcpInputProc( int toRead, /* Maximum number of bytes to read. */ int *errorCodePtr) /* Where to store error codes. */ { - SocketInfo *infoPtr = (SocketInfo *) instanceData; + SocketInfo *infoPtr = instanceData; int bytesRead; DWORD error; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) - TclThreadDataKeyGet(&dataKey); + ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey); *errorCodePtr = 0; @@ -1739,7 +1743,8 @@ TcpInputProc( while (1) { SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) UNSELECT, (LPARAM) infoPtr); - bytesRead = winSock.recv(infoPtr->socket, buf, toRead, 0); + /* single fd operation: this proc is only called for a connected socket. */ + bytesRead = recv(infoPtr->sockets->fd, buf, toRead, 0); infoPtr->readyEvents &= ~(FD_READ); /* @@ -1764,13 +1769,25 @@ TcpInputProc( 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. */ - error = winSock.WSAGetLastError(); if ((infoPtr->flags & SOCKET_ASYNC) || (error != WSAEWOULDBLOCK)) { - TclWinConvertWSAError(error); + TclWinConvertError(error); *errorCodePtr = Tcl_GetErrno(); bytesRead = -1; break; @@ -1787,8 +1804,7 @@ TcpInputProc( } } - SendMessage(tsdPtr->hwnd, SOCKET_SELECT, - (WPARAM) SELECT, (LPARAM) infoPtr); + SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM)SELECT, (LPARAM)infoPtr); return bytesRead; } @@ -1817,11 +1833,10 @@ TcpOutputProc( int toWrite, /* Maximum number of bytes to write. */ int *errorCodePtr) /* Where to store error codes. */ { - SocketInfo *infoPtr = (SocketInfo *) instanceData; + SocketInfo *infoPtr = instanceData; int bytesWritten; DWORD error; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) - TclThreadDataKeyGet(&dataKey); + ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey); *errorCodePtr = 0; @@ -1849,7 +1864,8 @@ TcpOutputProc( SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) UNSELECT, (LPARAM) infoPtr); - bytesWritten = winSock.send(infoPtr->socket, buf, toWrite, 0); + /* single fd operation: this proc is only called for a connected socket. */ + bytesWritten = send(infoPtr->sockets->fd, buf, toWrite, 0); if (bytesWritten != SOCKET_ERROR) { /* * Since Windows won't generate a new write event until we hit an @@ -1871,7 +1887,7 @@ TcpOutputProc( * send fails with WSAEWOULDBLOCK. */ - error = winSock.WSAGetLastError(); + error = WSAGetLastError(); if (error == WSAEWOULDBLOCK) { infoPtr->readyEvents &= ~(FD_WRITE); if (infoPtr->flags & SOCKET_ASYNC) { @@ -1880,7 +1896,7 @@ TcpOutputProc( break; } } else { - TclWinConvertWSAError(error); + TclWinConvertError(error); *errorCodePtr = Tcl_GetErrno(); bytesWritten = -1; break; @@ -1897,8 +1913,7 @@ TcpOutputProc( } } - SendMessage(tsdPtr->hwnd, SOCKET_SELECT, - (WPARAM) SELECT, (LPARAM) infoPtr); + SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM)SELECT, (LPARAM)infoPtr); return bytesWritten; } @@ -1926,8 +1941,10 @@ TcpSetOptionProc( const char *optionName, /* Name of the option to set. */ const char *value) /* New value for option. */ { - SocketInfo *infoPtr; +#ifdef TCL_FEATURE_KEEPALIVE_NAGLE + SocketInfo *infoPtr = instanceData; SOCKET sock; +#endif /*TCL_FEATURE_KEEPALIVE_NAGLE*/ /* * Check that WinSock is initialized; do not call it if not, to prevent @@ -1937,16 +1954,17 @@ TcpSetOptionProc( if (!SocketsEnabled()) { if (interp) { - Tcl_AppendResult(interp, "winsock is not initialized", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "winsock is not initialized", -1)); } return TCL_ERROR; } - infoPtr = (SocketInfo *) instanceData; - sock = infoPtr->socket; - #ifdef TCL_FEATURE_KEEPALIVE_NAGLE - if (!stricmp(optionName, "-keepalive")) { + #error "TCL_FEATURE_KEEPALIVE_NAGLE not reviewed for whether to treat infoPtr->sockets as single fd or list" + sock = infoPtr->sockets->fd; + + if (!strcasecmp(optionName, "-keepalive")) { BOOL val = FALSE; int boolVar, rtn; @@ -1956,18 +1974,19 @@ TcpSetOptionProc( if (boolVar) { val = TRUE; } - rtn = winSock.setsockopt(sock, SOL_SOCKET, SO_KEEPALIVE, + rtn = setsockopt(sock, SOL_SOCKET, SO_KEEPALIVE, (const char *) &val, sizeof(BOOL)); if (rtn != 0) { - TclWinConvertWSAError(winSock.WSAGetLastError()); + TclWinConvertError(WSAGetLastError()); if (interp) { - Tcl_AppendResult(interp, "couldn't set socket option: ", - Tcl_PosixError(interp), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "couldn't set socket option: %s", + Tcl_PosixError(interp))); } return TCL_ERROR; } return TCL_OK; - } else if (!stricmp(optionName, "-nagle")) { + } else if (!strcasecmp(optionName, "-nagle")) { BOOL val = FALSE; int boolVar, rtn; @@ -1977,13 +1996,14 @@ TcpSetOptionProc( if (!boolVar) { val = TRUE; } - rtn = winSock.setsockopt(sock, IPPROTO_TCP, TCP_NODELAY, + rtn = setsockopt(sock, IPPROTO_TCP, TCP_NODELAY, (const char *) &val, sizeof(BOOL)); if (rtn != 0) { - TclWinConvertWSAError(winSock.WSAGetLastError()); + TclWinConvertError(WSAGetLastError()); if (interp) { - Tcl_AppendResult(interp, "couldn't set socket option: ", - Tcl_PosixError(interp), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "couldn't set socket option: %s", + Tcl_PosixError(interp))); } return TCL_ERROR; } @@ -2026,14 +2046,12 @@ TcpGetOptionProc( Tcl_DString *dsPtr) /* Where to store the computed value; * initialized by caller. */ { - SocketInfo *infoPtr; - SOCKADDR_IN sockname; - SOCKADDR_IN peername; - struct hostent *hostEntPtr; + SocketInfo *infoPtr = instanceData; + char host[NI_MAXHOST], port[NI_MAXSERV]; SOCKET sock; - int size = sizeof(SOCKADDR_IN); size_t len = 0; - char buf[TCL_INTEGER_SPACE]; + int reverseDNS = 0; +#define SUPPRESS_RDNS_VAR "::tcl::unsupported::noReverseDNS" /* * Check that WinSock is initialized; do not call it if not, to prevent @@ -2043,13 +2061,13 @@ TcpGetOptionProc( if (!SocketsEnabled()) { if (interp) { - Tcl_AppendResult(interp, "winsock is not initialized", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "winsock is not initialized", -1)); } return TCL_ERROR; } - infoPtr = (SocketInfo *) instanceData; - sock = (int) infoPtr->socket; + sock = infoPtr->sockets->fd; if (optionName != NULL) { len = strlen(optionName); } @@ -2061,43 +2079,40 @@ TcpGetOptionProc( int ret; optlen = sizeof(int); - ret = TclWinGetSockOpt((int)sock, SOL_SOCKET, SO_ERROR, + ret = TclWinGetSockOpt(sock, SOL_SOCKET, SO_ERROR, (char *)&err, &optlen); if (ret == SOCKET_ERROR) { - err = winSock.WSAGetLastError(); + err = WSAGetLastError(); } if (err) { - TclWinConvertWSAError(err); + TclWinConvertError(err); Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(Tcl_GetErrno()), -1); } return TCL_OK; } + if (interp != NULL && Tcl_GetVar(interp, SUPPRESS_RDNS_VAR, 0) != NULL) { + reverseDNS = NI_NUMERICHOST; + } + if ((len == 0) || ((len > 1) && (optionName[1] == 'p') && (strncmp(optionName, "-peername", len) == 0))) { - if (winSock.getpeername(sock, (LPSOCKADDR) &peername, &size) == 0) { + address peername; + socklen_t size = sizeof(peername); + + if (getpeername(sock, (LPSOCKADDR) &(peername.sa), &size) == 0) { if (len == 0) { Tcl_DStringAppendElement(dsPtr, "-peername"); Tcl_DStringStartSublist(dsPtr); } - Tcl_DStringAppendElement(dsPtr, - winSock.inet_ntoa(peername.sin_addr)); - if (peername.sin_addr.s_addr == 0) { - hostEntPtr = NULL; - } else { - hostEntPtr = winSock.gethostbyaddr( - (char *) &(peername.sin_addr), - sizeof(peername.sin_addr), AF_INET); - } - if (hostEntPtr != 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); + getnameinfo(&(peername.sa), size, host, sizeof(host), + NULL, 0, NI_NUMERICHOST); + Tcl_DStringAppendElement(dsPtr, host); + getnameinfo(&(peername.sa), size, host, sizeof(host), + port, sizeof(port), reverseDNS | NI_NUMERICSERV); + Tcl_DStringAppendElement(dsPtr, host); + Tcl_DStringAppendElement(dsPtr, port); if (len == 0) { Tcl_DStringEndSublist(dsPtr); } else { @@ -2112,10 +2127,11 @@ TcpGetOptionProc( */ if (len) { - TclWinConvertWSAError((DWORD) winSock.WSAGetLastError()); + TclWinConvertError((DWORD) WSAGetLastError()); if (interp) { - Tcl_AppendResult(interp, "can't get peername: ", - Tcl_PosixError(interp), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't get peername: %s", + Tcl_PosixError(interp))); } return TCL_ERROR; } @@ -2124,28 +2140,53 @@ TcpGetOptionProc( 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)); - if (sockname.sin_addr.s_addr == 0) { - hostEntPtr = NULL; - } else { - hostEntPtr = winSock.gethostbyaddr( - (char *) &(sockname.sin_addr), - sizeof(peername.sin_addr), AF_INET); - } - if (hostEntPtr != NULL) { - Tcl_DStringAppendElement(dsPtr, hostEntPtr->h_name); - } else { - Tcl_DStringAppendElement(dsPtr, - winSock.inet_ntoa(sockname.sin_addr)); + TcpFdList *fds; + address sockname; + socklen_t size; + int found = 0; + + if (len == 0) { + Tcl_DStringAppendElement(dsPtr, "-sockname"); + Tcl_DStringStartSublist(dsPtr); + } + for (fds = infoPtr->sockets; fds != NULL; fds = fds->next) { + sock = fds->fd; + size = sizeof(sockname); + if (getsockname(sock, &(sockname.sa), &size) >= 0) { + int flags = reverseDNS; + + found = 1; + getnameinfo(&sockname.sa, size, host, sizeof(host), + NULL, 0, NI_NUMERICHOST); + Tcl_DStringAppendElement(dsPtr, host); + + /* + * We don't want to resolve INADDR_ANY and sin6addr_any; they + * can sometimes cause problems (and never have a name). + */ + flags |= NI_NUMERICSERV; + if (sockname.sa.sa_family == AF_INET) { + if (sockname.sa4.sin_addr.s_addr == INADDR_ANY) { + flags |= NI_NUMERICHOST; + } + } else if (sockname.sa.sa_family == AF_INET6) { + if ((IN6_ARE_ADDR_EQUAL(&sockname.sa6.sin6_addr, + &in6addr_any)) || + (IN6_IS_ADDR_V4MAPPED(&sockname.sa6.sin6_addr) + && sockname.sa6.sin6_addr.s6_addr[12] == 0 + && sockname.sa6.sin6_addr.s6_addr[13] == 0 + && sockname.sa6.sin6_addr.s6_addr[14] == 0 + && sockname.sa6.sin6_addr.s6_addr[15] == 0)) { + flags |= NI_NUMERICHOST; + } + } + getnameinfo(&sockname.sa, size, host, sizeof(host), + port, sizeof(port), flags); + Tcl_DStringAppendElement(dsPtr, host); + Tcl_DStringAppendElement(dsPtr, port); } - TclFormatInt(buf, winSock.ntohs(sockname.sin_port)); - Tcl_DStringAppendElement(dsPtr, buf); + } + if (found) { if (len == 0) { Tcl_DStringEndSublist(dsPtr); } else { @@ -2153,9 +2194,9 @@ TcpGetOptionProc( } } else { if (interp) { - TclWinConvertWSAError((DWORD) winSock.WSAGetLastError()); - Tcl_AppendResult(interp, "can't get sockname: ", - Tcl_PosixError(interp), NULL); + TclWinConvertError((DWORD) WSAGetLastError()); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't get sockname: %s", Tcl_PosixError(interp))); } return TCL_ERROR; } @@ -2170,8 +2211,7 @@ TcpGetOptionProc( 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 { @@ -2190,8 +2230,7 @@ TcpGetOptionProc( Tcl_DStringAppendElement(dsPtr, "-nagle"); } optlen = sizeof(BOOL); - winSock.getsockopt(sock, IPPROTO_TCP, TCP_NODELAY, (char *)&opt, - &optlen); + getsockopt(sock, IPPROTO_TCP, TCP_NODELAY, (char *)&opt, &optlen); if (opt) { Tcl_DStringAppendElement(dsPtr, "0"); } else { @@ -2240,11 +2279,11 @@ TcpWatchProc( * TCL_READABLE, TCL_WRITABLE and * TCL_EXCEPTION. */ { - SocketInfo *infoPtr = (SocketInfo *) instanceData; + SocketInfo *infoPtr = instanceData; /* * Update the watch events mask. Only if the socket is not a server - * socket. Fix for SF Tcl Bug #557878. + * socket. [Bug 557878] */ if (!infoPtr->acceptProc) { @@ -2263,6 +2302,7 @@ TcpWatchProc( if (infoPtr->readyEvents & infoPtr->watchEvents) { Tcl_Time blockTime = { 0, 0 }; + Tcl_SetMaxBlockTime(&blockTime); } } @@ -2291,9 +2331,9 @@ TcpGetHandleProc( int direction, /* Not used. */ ClientData *handlePtr) /* Where to store the handle. */ { - SocketInfo *statePtr = (SocketInfo *) instanceData; + SocketInfo *statePtr = instanceData; - *handlePtr = (ClientData) statePtr->socket; + *handlePtr = INT2PTR(statePtr->sockets->fd); return TCL_OK; } @@ -2318,14 +2358,14 @@ SocketThread( LPVOID arg) { MSG msg; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *)(arg); + ThreadSpecificData *tsdPtr = arg; /* * Create a dummy window receiving socket events. */ - tsdPtr->hwnd = CreateWindow("TclSocket", "TclSocket", - WS_TILED, 0, 0, 0, 0, NULL, NULL, windowClass.hInstance, arg); + tsdPtr->hwnd = CreateWindow(classname, classname, WS_TILED, 0, 0, 0, 0, + NULL, NULL, windowClass.hInstance, arg); /* * Signalize thread creator that we are done creating the window. @@ -2374,7 +2414,7 @@ SocketThread( * * Side effects: * The flags for the given socket are updated to reflect the event that - * occured. + * occurred. * *---------------------------------------------------------------------- */ @@ -2389,6 +2429,7 @@ SocketProc( int event, error; SOCKET socket; SocketInfo *infoPtr; + TcpFdList *fds = NULL; ThreadSpecificData *tsdPtr = (ThreadSpecificData *) #ifdef _WIN64 GetWindowLongPtr(hwnd, GWLP_USERDATA); @@ -2433,58 +2474,60 @@ SocketProc( 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) { + for (fds = infoPtr->sockets; fds != NULL; fds = fds->next) { + if (fds->fd == socket) { /* - * The socket is now connected, clear the async connect - * flag. + * 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. */ - infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT); + if (event & FD_CLOSE) { + infoPtr->acceptEventCount = 0; + infoPtr->readyEvents &= ~(FD_WRITE|FD_ACCEPT); + } else if (event & FD_ACCEPT) { + infoPtr->acceptEventCount++; + } + + if (event & FD_CONNECT) { + /* + * The socket is now connected, clear the async connect + * flag. + */ - /* - * Remember any error that occurred so we can report - * connection failures. - */ + 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 (error != ERROR_SUCCESS) { + TclWinConvertError((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(); + if (infoPtr->flags & SOCKET_ASYNC_CONNECT) { + infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT); + if (error != ERROR_SUCCESS) { + TclWinConvertError((DWORD) error); + infoPtr->lastError = Tcl_GetErrno(); + } + infoPtr->readyEvents |= FD_WRITE; } - infoPtr->readyEvents |= FD_WRITE; - } - infoPtr->readyEvents |= event; + infoPtr->readyEvents |= event; - /* - * Wake up the Main Thread. - */ + /* + * Wake up the Main Thread. + */ - SetEvent(tsdPtr->readyEvent); - Tcl_ThreadAlert(tsdPtr->threadId); - break; + SetEvent(tsdPtr->readyEvent); + Tcl_ThreadAlert(tsdPtr->threadId); + break; + } } } SetEvent(tsdPtr->socketListLock); @@ -2492,15 +2535,18 @@ SocketProc( case SOCKET_SELECT: infoPtr = (SocketInfo *) lParam; - if (wParam == SELECT) { - winSock.WSAAsyncSelect(infoPtr->socket, hwnd, - SOCKET_MESSAGE, infoPtr->selectEvents); - } else { - /* - * Clear the selection mask - */ + for (fds = infoPtr->sockets; fds != NULL; fds = fds->next) { + infoPtr = (SocketInfo *) lParam; + if (wParam == SELECT) { + WSAAsyncSelect(fds->fd, hwnd, + SOCKET_MESSAGE, infoPtr->selectEvents); + } else { + /* + * Clear the selection mask + */ - winSock.WSAAsyncSelect(infoPtr->socket, hwnd, 0, 0); + WSAAsyncSelect(fds->fd, hwnd, 0, 0); + } } break; @@ -2555,40 +2601,41 @@ InitializeHostName( int *lengthPtr, Tcl_Encoding *encodingPtr) { - WCHAR wbuf[MAX_COMPUTERNAME_LENGTH + 1]; - DWORD length = sizeof(wbuf) / sizeof(WCHAR); + TCHAR tbuf[MAX_COMPUTERNAME_LENGTH + 1]; + DWORD length = MAX_COMPUTERNAME_LENGTH + 1; Tcl_DString ds; - if ((*tclWinProcs->getComputerNameProc)(wbuf, &length) != 0) { + if (GetComputerName(tbuf, &length) != 0) { /* * Convert string from native to UTF then change to lowercase. */ - Tcl_UtfToLower(Tcl_WinTCharToUtf((TCHAR *) wbuf, -1, &ds)); + Tcl_UtfToLower(Tcl_WinTCharToUtf(tbuf, -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. + * The buffer size of 256 is recommended by the MSDN page that + * documents gethostname() as being always adequate. */ - Tcl_DStringSetLength(&ds, 255); - if (winSock.gethostname(Tcl_DStringValue(&ds), - Tcl_DStringLength(&ds)) == 0) { - Tcl_DStringSetLength(&ds, 0); - } else { - Tcl_DStringSetLength(&ds, strlen(Tcl_DStringValue(&ds))); + Tcl_DString inDs; + + Tcl_DStringInit(&inDs); + Tcl_DStringSetLength(&inDs, 256); + if (gethostname(Tcl_DStringValue(&inDs), + Tcl_DStringLength(&inDs)) == 0) { + Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(&inDs), -1, + &ds); } + Tcl_DStringFree(&inDs); } } *encodingPtr = Tcl_GetEncoding(NULL, "utf-8"); *lengthPtr = Tcl_DStringLength(&ds); - *valuePtr = ckalloc((unsigned int) (*lengthPtr)+1); + *valuePtr = ckalloc((*lengthPtr) + 1); memcpy(*valuePtr, Tcl_DStringValue(&ds), (size_t)(*lengthPtr)+1); Tcl_DStringFree(&ds); } @@ -2612,81 +2659,45 @@ InitializeHostName( *---------------------------------------------------------------------- */ +#undef TclWinGetSockOpt int TclWinGetSockOpt( - int s, + SOCKET s, int level, int optname, - char * optval, - int FAR *optlen) + 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. - */ - - if (!SocketsEnabled()) { - return SOCKET_ERROR; - } - - return winSock.getsockopt((SOCKET)s, level, optname, optval, optlen); + return getsockopt(s, level, optname, optval, optlen); } +#undef TclWinSetSockOpt int TclWinSetSockOpt( - int s, + SOCKET s, int level, int optname, - const char * optval, + 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. - */ - - if (!SocketsEnabled()) { - return SOCKET_ERROR; - } - - return winSock.setsockopt((SOCKET)s, level, optname, optval, optlen); + return setsockopt(s, level, optname, optval, optlen); } -u_short -TclWinNToHS( - u_short netshort) +#undef TclpInetNtoa +char * +TclpInetNtoa( + struct in_addr addr) { - /* - * 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 winSock.ntohs(netshort); + return inet_ntoa(addr); } +#undef TclWinGetServByName struct servent * 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. - */ - - if (!SocketsEnabled()) { - return NULL; - } - - return winSock.getservbyname(name, proto); + return getservbyname(name, proto); } /* @@ -2711,7 +2722,7 @@ TcpThreadActionProc( int action) { ThreadSpecificData *tsdPtr; - SocketInfo *infoPtr = (SocketInfo *) instanceData; + SocketInfo *infoPtr = instanceData; int notifyCmd; if (action == TCL_CHANNEL_THREAD_INSERT) { diff --git a/win/tclWinTest.c b/win/tclWinTest.c index aa8e819..6027e32 100644 --- a/win/tclWinTest.c +++ b/win/tclWinTest.c @@ -7,16 +7,17 @@ * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. - * - * RCS: @(#) $Id: tclWinTest.c,v 1.18 2007/03/08 00:27:12 nijtmans Exp $ */ +#ifndef USE_TCL_STUBS +# define USE_TCL_STUBS +#endif #include "tclInt.h" /* * For TestplatformChmod on Windows */ -#ifdef __WIN32__ +#ifdef _WIN32 #include <aclapi.h> #endif @@ -31,7 +32,6 @@ * Forward declarations of functions defined later in this file: */ -int TclplatformtestInit(Tcl_Interp *interp); static int TesteventloopCmd(ClientData dummy, Tcl_Interp *interp, int argc, const char **argv); static int TestvolumetypeCmd(ClientData dummy, @@ -42,8 +42,6 @@ static int TestwinclockCmd(ClientData dummy, Tcl_Interp* interp, 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); @@ -73,18 +71,12 @@ TclplatformtestInit( * Add commands for platform specific tests for Windows here. */ - Tcl_CreateCommand(interp, "testchmod", TestchmodCmd, - (ClientData) 0, NULL); - Tcl_CreateCommand(interp, "testeventloop", TesteventloopCmd, - (ClientData) 0, NULL); + Tcl_CreateCommand(interp, "testchmod", TestchmodCmd, NULL, NULL); + Tcl_CreateCommand(interp, "testeventloop", TesteventloopCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testvolumetype", TestvolumetypeCmd, - (ClientData) 0, NULL); - Tcl_CreateObjCommand(interp, "testwinclock", TestwinclockCmd, - (ClientData) 0, NULL); - Tcl_CreateObjCommand(interp, "testwincpuid", TestwincpuidCmd, - (ClientData) 0, NULL); - Tcl_CreateObjCommand(interp, "testwinsleep", TestwinsleepCmd, - (ClientData) 0, NULL); + NULL, NULL); + Tcl_CreateObjCommand(interp, "testwinclock", TestwinclockCmd, NULL, NULL); + Tcl_CreateObjCommand(interp, "testwinsleep", TestwinsleepCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testexcept", TestExceptionCmd, NULL, NULL); return TCL_OK; } @@ -112,23 +104,21 @@ TesteventloopCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ + const char **argv) /* Argument strings. */ { 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 ... \"", 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); /* @@ -139,19 +129,21 @@ TesteventloopCmd( 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); @@ -194,23 +186,24 @@ TestvolumetypeCmd( #define VOL_BUF_SIZE 32 int found; char volType[VOL_BUF_SIZE]; - char *path; + const char *path; 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 \"", @@ -218,7 +211,7 @@ TestvolumetypeCmd( TclWinConvertError(GetLastError()); return TCL_ERROR; } - Tcl_SetResult(interp, volType, TCL_VOLATILE); + Tcl_AppendResult(interp, volType, NULL); return TCL_OK; #undef VOL_BUF_SIZE } @@ -228,9 +221,9 @@ TestvolumetypeCmd( * * 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 @@ -239,9 +232,9 @@ TestvolumetypeCmd( * 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. @@ -261,7 +254,7 @@ TestwinclockCmd( * 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; @@ -298,85 +291,6 @@ TestwinclockCmd( return TCL_OK; } -/* - *---------------------------------------------------------------------- - * - * TestwincpuidCmd -- - * - * Retrieves CPU ID information. - * - * Usage: - * testwincpuid <eax> - * - * Parameters: - * 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. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -static int -TestwincpuidCmd( - ClientData dummy, - Tcl_Interp* interp, /* Tcl interpreter */ - int objc, /* Parameter count */ - Tcl_Obj *const * objv) /* Parameter vector */ -{ - int status; - int index; - unsigned int regs[4]; - Tcl_Obj * regsObjs[4]; - int i; - - if (objc != 2) { - Tcl_WrongNumArgs(interp, 1, objv, "eax"); - return TCL_ERROR; - } - 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)); - return status; - } - for (i=0 ; i<4 ; ++i) { - regsObjs[i] = Tcl_NewIntObj((int) regs[i]); - } - Tcl_SetObjResult(interp, Tcl_NewListObj(4, regsObjs)); - return TCL_OK; -} - -/* - *---------------------------------------------------------------------- - * - * TestwinsleepCmd -- - * - * Causes this process to wait for the given number of milliseconds by - * means of a direct call to Sleep. - * - * Usage: - * testwinsleep <n> - * - * Parameters: - * n - the number of milliseconds to sleep - * - * Results: - * None. - * - * Side effects: - * Sleeps for the requisite number of milliseconds. - * - *---------------------------------------------------------------------- - */ - static int TestwinsleepCmd( ClientData clientData, /* Unused */ @@ -385,6 +299,7 @@ TestwinsleepCmd( Tcl_Obj *const * objv) /* Parameter vector */ { int ms; + if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "ms"); return TCL_ERROR; @@ -426,52 +341,26 @@ TestExceptionCmd( int objc, /* Argument count */ Tcl_Obj *const objv[]) /* Argument vector */ { - static const char *cmds[] = { - "access_violation", - "datatype_misalignment", - "array_bounds", - "float_denormal", - "float_divbyzero", - "float_inexact", - "float_invalidop", - "float_overflow", - "float_stack", - "float_underflow", - "int_divbyzero", - "int_overflow", - "private_instruction", - "inpageerror", - "illegal_instruction", - "noncontinue", - "stack_overflow", - "invalid_disp", - "guard_page", - "invalid_handle", - "ctrl+c", - NULL + static const char *const cmds[] = { + "access_violation", "datatype_misalignment", "array_bounds", + "float_denormal", "float_divbyzero", "float_inexact", + "float_invalidop", "float_overflow", "float_stack", "float_underflow", + "int_divbyzero", "int_overflow", "private_instruction", "inpageerror", + "illegal_instruction", "noncontinue", "stack_overflow", + "invalid_disp", "guard_page", "invalid_handle", "ctrl+c", + NULL }; - static 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 + static const DWORD exceptions[] = { + EXCEPTION_ACCESS_VIOLATION, EXCEPTION_DATATYPE_MISALIGNMENT, + EXCEPTION_ARRAY_BOUNDS_EXCEEDED, EXCEPTION_FLT_DENORMAL_OPERAND, + EXCEPTION_FLT_DIVIDE_BY_ZERO, EXCEPTION_FLT_INEXACT_RESULT, + EXCEPTION_FLT_INVALID_OPERATION, EXCEPTION_FLT_OVERFLOW, + EXCEPTION_FLT_STACK_CHECK, EXCEPTION_FLT_UNDERFLOW, + EXCEPTION_INT_DIVIDE_BY_ZERO, EXCEPTION_INT_OVERFLOW, + EXCEPTION_PRIV_INSTRUCTION, EXCEPTION_IN_PAGE_ERROR, + EXCEPTION_ILLEGAL_INSTRUCTION, EXCEPTION_NONCONTINUABLE_EXCEPTION, + EXCEPTION_STACK_OVERFLOW, EXCEPTION_INVALID_DISPOSITION, + EXCEPTION_GUARD_PAGE, EXCEPTION_INVALID_HANDLE, CONTROL_C_EXIT }; int cmd; @@ -504,255 +393,210 @@ 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 ); - - 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; + 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; - BYTE *secDesc = 0; - DWORD secDescLen; + /* + * References to security functions (only available on NT and later). + */ const BOOL set_readOnly = !(pmode & 0222); - BOOL acl_readOnly_found = FALSE; - + 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; - BOOL curAclPresent, curAclDefaulted; - PACL curAcl; - PACL newAcl = 0; - DWORD newAclSize; - + PACL curAcl, newAcl = 0; WORD j; - SID *userSid = 0; - TCHAR *userDomain = 0; - - DWORD attr; - + char *userDomain = 0; int res = 0; /* - * One time initialization, dynamically load Windows NT features + * Process the chmod request. */ - 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; - static equalSidDef equalSidProc; - static addAccessDeniedAceDef addAccessDeniedAceProc; - static initializeAclDef initializeAclProc; - static getLengthSidDef getLengthSidProc; - static getAclInformationDef getAclInformationProc; - static getSecurityDescriptorDaclDef getSecurityDescriptorDaclProc; - static lookupAccountNameADef lookupAccountNameProc; - static getFileSecurityADef getFileSecurityProc; - - static int initialized = 0; - if (!initialized) { - TCL_DECLARE_MUTEX(initializeMutex) - Tcl_MutexLock(&initializeMutex); - if (!initialized) { - HINSTANCE hInstance = LoadLibrary("Advapi32"); - if (hInstance != NULL) { - setNamedSecurityInfoProc = (setNamedSecurityInfoADef) - GetProcAddress(hInstance, "SetNamedSecurityInfoA"); - getFileSecurityProc = (getFileSecurityADef) - GetProcAddress(hInstance, "GetFileSecurityA"); - getAceProc = (getAceDef) - GetProcAddress(hInstance, "GetAce"); - addAceProc = (addAceDef) - GetProcAddress(hInstance, "AddAce"); - equalSidProc = (equalSidDef) - GetProcAddress(hInstance, "EqualSid"); - addAccessDeniedAceProc = (addAccessDeniedAceDef) - GetProcAddress(hInstance, "AddAccessDeniedAce"); - initializeAclProc = (initializeAclDef) - GetProcAddress(hInstance, "InitializeAcl"); - getLengthSidProc = (getLengthSidDef) - GetProcAddress(hInstance, "GetLengthSid"); - getAclInformationProc = (getAclInformationDef) - GetProcAddress(hInstance, "GetAclInformation"); - getSecurityDescriptorDaclProc = (getSecurityDescriptorDaclDef) - GetProcAddress(hInstance, "GetSecurityDescriptorDacl"); - lookupAccountNameProc = (lookupAccountNameADef) - GetProcAddress(hInstance, "LookupAccountNameA"); - getSidLengthRequiredProc = (getSidLengthRequiredDef) - GetProcAddress(hInstance, "GetSidLengthRequired"); - initializeSidProc = (initializeSidDef) - GetProcAddress(hInstance, "InitializeSid"); - getSidSubAuthorityProc = (getSidSubAuthorityDef) - GetProcAddress(hInstance, "GetSidSubAuthority"); - if (setNamedSecurityInfoProc && getAceProc - && addAceProc && equalSidProc && addAccessDeniedAceProc - && initializeAclProc && getLengthSidProc - && getAclInformationProc && getSecurityDescriptorDaclProc - && lookupAccountNameProc && getFileSecurityProc - && getSidLengthRequiredProc && initializeSidProc - && getSidSubAuthorityProc) - initialized = 1; - } - if (!initialized) - initialized = -1; - } - Tcl_MutexUnlock(&initializeMutex); - } - /* Process the chmod request */ - attr = GetFileAttributes(nativePath); + attr = GetFileAttributesA(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 nativePath is not a directory, there is no special handling. */ - if (initialized < 0 || !(attr & FILE_ATTRIBUTE_DIRECTORY)) { + + if (!(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 = (BYTE *) ckalloc(secDescLen); - if (!getFileSecurityProc(nativePath, infoBits, - (PSECURITY_DESCRIPTOR)secDesc, - secDescLen, &secDescLen2) + + if (!GetFileSecurityA(nativePath, infoBits, NULL, 0, &secDescLen)) { + DWORD secDescLen2 = 0; + + if (GetLastError() != ERROR_INSUFFICIENT_BUFFER) { + goto done; + } + + secDesc = ckalloc(secDescLen); + if (!GetFileSecurityA(nativePath, infoBits, + (PSECURITY_DESCRIPTOR) secDesc, secDescLen, &secDescLen2) || (secDescLen < secDescLen2)) { - goto done; - } - } else { goto done; } } - /* Get the World SID */ - userSid = (SID*) ckalloc(getSidLengthRequiredProc((UCHAR)1)); - initializeSidProc( userSid, &userSidAuthority, (BYTE)1); - *(getSidSubAuthorityProc( userSid, 0)) = SECURITY_WORLD_RID; + /* + * Get the World SID. + */ - /* If curAclPresent == false then curAcl and curAclDefaulted not valid */ - if (!getSecurityDescriptorDaclProc(secDesc, &curAclPresent, - &curAcl, &curAclDefaulted)) - goto done; + userSid = ckalloc(GetSidLengthRequired((UCHAR) 1)); + InitializeSid(userSid, &userSidAuthority, (BYTE) 1); + *(GetSidSubAuthority(userSid, 0)) = SECURITY_WORLD_RID; + /* + * If curAclPresent == false then curAcl and curAclDefaulted not valid. + */ + + if (!GetSecurityDescriptorDacl((PSECURITY_DESCRIPTOR) secDesc, + &curAclPresent, &curAcl, &curAclDefaulted)) { + goto done; + } if (!curAclPresent || !curAcl) { ACLSize.AclBytesInUse = 0; ACLSize.AceCount = 0; - } else if (!getAclInformationProc(curAcl, &ACLSize, sizeof(ACLSize), - AclSizeInformation)) + } else if (!GetAclInformation(curAcl, &ACLSize, sizeof(ACLSize), + AclSizeInformation)) { goto done; + } + + /* + * Allocate memory for the new ACL. + */ + + newAclSize = ACLSize.AclBytesInUse + sizeof(ACCESS_DENIED_ACE) + + GetLengthSid(userSid) - sizeof(DWORD); + newAcl = ckalloc(newAclSize); + + /* + * Initialize the new ACL. + */ - /* 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)) { + if (!InitializeAcl(newAcl, newAclSize, ACL_REVISION)) { goto done; } - - /* Add denied to make readonly, this will be known as a "read-only tag" */ - if (set_readOnly && !addAccessDeniedAceProc(newAcl, ACL_REVISION, - readOnlyMask, userSid)) { + + /* + * Add denied to make readonly, this will be known as a "read-only tag". + */ + + if (set_readOnly && !AddAccessDeniedAce(newAcl, ACL_REVISION, + readOnlyMask, userSid)) { goto done; } - + acl_readOnly_found = FALSE; for (j = 0; j < ACLSize.AceCount; j++) { - PACL *pACE2; + LPVOID pACE2; ACE_HEADER *phACE2; - if (! getAceProc (curAcl, j, (LPVOID*) &pACE2)) { + + if (!GetAce(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 + && EqualSid(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 (!AddAce(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 || SetNamedSecurityInfoA( + (LPSTR) nativePath, SE_FILE_OBJECT, DACL_SECURITY_INFORMATION, + NULL, NULL, newAcl, NULL) == ERROR_SUCCESS) { res = 0; } - done: - if (secDesc) ckfree(secDesc); - if (newAcl) ckfree((char *)newAcl); - if (userSid) ckfree((char *)userSid); - if (userDomain) ckfree(userDomain); + done: + if (secDesc) { + ckfree(secDesc); + } + if (newAcl) { + ckfree(newAcl); + } + if (userSid) { + ckfree(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); } @@ -761,10 +605,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. @@ -776,17 +620,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. */ - const 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; @@ -814,3 +658,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 98137c4..1c9d483 100644 --- a/win/tclWinThrd.c +++ b/win/tclWinThrd.c @@ -5,18 +5,23 @@ * * Copyright (c) 1998 by Sun Microsystems, Inc. * Copyright (c) 1999 by Scriptics Corporation + * Copyright (c) 2008 by George Peter Staplin * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. - * - * RCS: @(#) $Id: tclWinThrd.c,v 1.42 2006/08/10 12:15:32 dkf Exp $ */ #include "tclWinInt.h" -#include <fcntl.h> -#include <io.h> -#include <sys/stat.h> +#include <float.h> + +/* Workaround for mingw versions which don't provide this in float.h */ +#ifndef _MCW_EM +# define _MCW_EM 0x0008001F /* Error masks */ +# define _MCW_RC 0x00000300 /* Rounding */ +# define _MCW_PC 0x00030000 /* Precision */ +_CRTIMP unsigned int __cdecl _controlfp (unsigned int unNew, unsigned int unMask); +#endif /* * This is the master lock used to serialize access to other serialization @@ -43,8 +48,10 @@ static CRITICAL_SECTION initLock; #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 */ @@ -92,13 +99,11 @@ static Tcl_ThreadDataKey dataKey; * ThreadSpecificData is created. * WIN_THREAD_RUNNING Running, not waiting. * WIN_THREAD_BLOCKED Waiting, or trying to wait. - * WIN_THREAD_DEAD Dying - no per-thread event anymore. */ #define WIN_THREAD_UNINIT 0x0 #define WIN_THREAD_RUNNING 0x1 #define WIN_THREAD_BLOCKED 0x2 -#define WIN_THREAD_DEAD 0x4 /* * The per condition queue pointers and the Mutex used to serialize access to @@ -127,6 +132,66 @@ typedef struct allocMutex { #endif /* USE_THREAD_ALLOC */ /* + * The per thread data passed from TclpThreadCreate + * to TclWinThreadStart. + */ + +typedef struct WinThread { + LPTHREAD_START_ROUTINE lpStartAddress; /* Original startup routine */ + LPVOID lpParameter; /* Original startup data */ + unsigned int fpControl; /* Floating point control word from the + * main thread */ +} WinThread; + + +/* + *---------------------------------------------------------------------- + * + * TclWinThreadStart -- + * + * This procedure is the entry point for all new threads created + * by Tcl on Windows. + * + * Results: + * Various, depending on the result of the wrapped thread start + * routine. + * + * Side effects: + * Arbitrary, since user code is executed. + * + *---------------------------------------------------------------------- + */ + +static DWORD WINAPI +TclWinThreadStart( + LPVOID lpParameter) /* The WinThread structure pointer passed + * from TclpThreadCreate */ +{ + WinThread *winThreadPtr = (WinThread *) lpParameter; + unsigned int fpmask; + LPTHREAD_START_ROUTINE lpOrigStartAddress; + LPVOID lpOrigParameter; + + if (!winThreadPtr) { + return TCL_ERROR; + } + + fpmask = _MCW_EM | _MCW_RC | _MCW_PC; + +#if defined(_MSC_VER) && _MSC_VER >= 1200 + fpmask |= _MCW_DN; +#endif + + _controlfp(winThreadPtr->fpControl, fpmask); + + lpOrigStartAddress = winThreadPtr->lpStartAddress; + lpOrigParameter = winThreadPtr->lpParameter; + + ckfree((char *)winThreadPtr); + return lpOrigStartAddress(lpOrigParameter); +} + +/* *---------------------------------------------------------------------- * * TclpThreadCreate -- @@ -146,23 +211,33 @@ typedef struct allocMutex { int TclpThreadCreate( Tcl_ThreadId *idPtr, /* Return, the ID of the thread. */ - Tcl_ThreadCreateProc proc, /* Main() function of the thread. */ + Tcl_ThreadCreateProc *proc, /* Main() function of the thread. */ ClientData clientData, /* The one argument to Main(). */ int stackSize, /* Size of stack for the new thread. */ int flags) /* Flags controlling behaviour of the new * thread. */ { + WinThread *winThreadPtr; /* Per-thread startup info */ HANDLE tHandle; + winThreadPtr = (WinThread *)ckalloc(sizeof(WinThread)); + winThreadPtr->lpStartAddress = (LPTHREAD_START_ROUTINE) proc; + winThreadPtr->lpParameter = clientData; + winThreadPtr->fpControl = _controlfp(0, 0); + EnterCriticalSection(&joinLock); + *idPtr = 0; /* must initialize as Tcl_Thread is a pointer and + * on WIN64 sizeof void* != sizeof unsigned + */ + #if defined(_MSC_VER) || defined(__MSVCRT__) || defined(__BORLANDC__) - tHandle = (HANDLE) _beginthreadex(NULL, (unsigned) stackSize, proc, - clientData, 0, (unsigned *)idPtr); + tHandle = (HANDLE) _beginthreadex(NULL, (unsigned) stackSize, + (Tcl_ThreadCreateProc*) TclWinThreadStart, winThreadPtr, + 0, (unsigned *)idPtr); #else tHandle = CreateThread(NULL, (DWORD) stackSize, - (LPTHREAD_START_ROUTINE) proc, (LPVOID) clientData, - (DWORD) 0, (LPDWORD)idPtr); + TclWinThreadStart, winThreadPtr, 0, (LPDWORD)idPtr); #endif if (tHandle == NULL) { @@ -260,7 +335,7 @@ TclpThreadExit( Tcl_ThreadId Tcl_GetCurrentThread(void) { - return (Tcl_ThreadId) GetCurrentThreadId(); + return (Tcl_ThreadId)(size_t)GetCurrentThreadId(); } /* @@ -410,7 +485,7 @@ Tcl_GetAllocMutex(void) { #ifdef TCL_THREADS if (!allocOnce) { - InitializeCriticalSection(&allocLock); + InitializeCriticalSection(&allocLock.crit); allocOnce = 1; } return &allocLockPtr; @@ -452,7 +527,7 @@ TclFinalizeLock(void) #ifdef TCL_THREADS if (allocOnce) { - DeleteCriticalSection(&allocLock); + DeleteCriticalSection(&allocLock.crit); allocOnce = 0; } #endif @@ -493,6 +568,7 @@ Tcl_MutexLock( Tcl_Mutex *mutexPtr) /* The lock */ { CRITICAL_SECTION *csPtr; + if (*mutexPtr == NULL) { MASTER_LOCK; @@ -501,7 +577,7 @@ Tcl_MutexLock( */ if (*mutexPtr == NULL) { - csPtr = (CRITICAL_SECTION *) ckalloc(sizeof(CRITICAL_SECTION)); + csPtr = ckalloc(sizeof(CRITICAL_SECTION)); InitializeCriticalSection(csPtr); *mutexPtr = (Tcl_Mutex)csPtr; TclRememberMutex(mutexPtr); @@ -533,6 +609,7 @@ Tcl_MutexUnlock( Tcl_Mutex *mutexPtr) /* The lock */ { CRITICAL_SECTION *csPtr = *((CRITICAL_SECTION **)mutexPtr); + LeaveCriticalSection(csPtr); } @@ -558,9 +635,10 @@ TclpFinalizeMutex( Tcl_Mutex *mutexPtr) { CRITICAL_SECTION *csPtr = *(CRITICAL_SECTION **)mutexPtr; + if (csPtr != NULL) { DeleteCriticalSection(csPtr); - ckfree((char *) csPtr); + ckfree(csPtr); *mutexPtr = NULL; } } @@ -591,7 +669,7 @@ void Tcl_ConditionWait( Tcl_Condition *condPtr, /* Really (WinCondition **) */ Tcl_Mutex *mutexPtr, /* Really (CRITICAL_SECTION **) */ - Tcl_Time *timePtr) /* Timeout on waiting period */ + const Tcl_Time *timePtr) /* Timeout on waiting period */ { WinCondition *winCondPtr; /* Per-condition queue head */ CRITICAL_SECTION *csPtr; /* Caller's Mutex, after casting */ @@ -600,14 +678,6 @@ Tcl_ConditionWait( int doExit = 0; /* True if we need to do exit setup */ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - if (tsdPtr->flags & WIN_THREAD_DEAD) { - /* - * No more per-thread event on which to wait. - */ - - return; - } - /* * Self initialize the two parts of the condition. The per-condition and * per-thread parts need to be handled independently. @@ -638,8 +708,7 @@ Tcl_ConditionWait( * and initializing that may drop back into the Master Lock. */ - Tcl_CreateThreadExitHandler(FinalizeConditionEvent, - (ClientData) tsdPtr); + Tcl_CreateThreadExitHandler(FinalizeConditionEvent, tsdPtr); } } @@ -651,11 +720,11 @@ Tcl_ConditionWait( */ if (*condPtr == NULL) { - winCondPtr = (WinCondition *)ckalloc(sizeof(WinCondition)); + winCondPtr = ckalloc(sizeof(WinCondition)); InitializeCriticalSection(&winCondPtr->condLock); winCondPtr->firstPtr = NULL; winCondPtr->lastPtr = NULL; - *condPtr = (Tcl_Condition)winCondPtr; + *condPtr = (Tcl_Condition) winCondPtr; TclRememberCondition(condPtr); } MASTER_UNLOCK; @@ -700,7 +769,8 @@ Tcl_ConditionWait( while (!timeout && (tsdPtr->flags & WIN_THREAD_BLOCKED)) { ResetEvent(tsdPtr->condEvent); LeaveCriticalSection(&winCondPtr->condLock); - if (WaitForSingleObject(tsdPtr->condEvent, wtime) == WAIT_TIMEOUT) { + if (WaitForSingleObjectEx(tsdPtr->condEvent, wtime, + TRUE) == WAIT_TIMEOUT) { timeout = 1; } EnterCriticalSection(&winCondPtr->condLock); @@ -765,9 +835,14 @@ Tcl_ConditionNotify( { WinCondition *winCondPtr; ThreadSpecificData *tsdPtr; + if (*condPtr != NULL) { winCondPtr = *((WinCondition **)condPtr); + if (winCondPtr == NULL) { + return; + } + /* * Loop through all the threads waiting on the condition and notify * them (i.e., broadcast semantics). The queue manipulation is guarded @@ -817,7 +892,8 @@ FinalizeConditionEvent( ClientData data) { ThreadSpecificData *tsdPtr = (ThreadSpecificData *) data; - tsdPtr->flags = WIN_THREAD_DEAD; + + tsdPtr->flags = WIN_THREAD_UNINIT; CloseHandle(tsdPtr->condEvent); } @@ -855,11 +931,14 @@ TclpFinalizeCondition( if (winCondPtr != NULL) { DeleteCriticalSection(&winCondPtr->condLock); - ckfree((char *) winCondPtr); + ckfree(winCondPtr); *condPtr = NULL; } } + + + /* * Additions by AOL for specialized thread memory allocator. */ @@ -895,7 +974,7 @@ TclpFreeAllocMutex( void * TclpGetAllocCache(void) { - VOID *result; + void *result; if (!once) { /* @@ -960,6 +1039,61 @@ TclpFreeAllocCache( } #endif /* USE_THREAD_ALLOC */ + + +void * +TclpThreadCreateKey(void) +{ + DWORD *key; + + key = TclpSysAlloc(sizeof *key, 0); + if (key == NULL) { + Tcl_Panic("unable to allocate thread key!"); + } + + *key = TlsAlloc(); + + if (*key == TLS_OUT_OF_INDEXES) { + Tcl_Panic("unable to allocate thread-local storage"); + } + + return key; +} + +void +TclpThreadDeleteKey( + void *keyPtr) +{ + DWORD *key = keyPtr; + + if (!TlsFree(*key)) { + Tcl_Panic("unable to delete key"); + } + + TclpSysFree(keyPtr); +} + +void +TclpThreadSetMasterTSD( + void *tsdKeyPtr, + void *ptr) +{ + DWORD *key = tsdKeyPtr; + + if (!TlsSetValue(*key, ptr)) { + Tcl_Panic("unable to set master TSD value"); + } +} + +void * +TclpThreadGetMasterTSD( + void *tsdKeyPtr) +{ + DWORD *key = tsdKeyPtr; + + return TlsGetValue(*key); +} + #endif /* TCL_THREADS */ /* diff --git a/win/tclWinThrd.h b/win/tclWinThrd.h deleted file mode 100644 index 2572d1b..0000000 --- a/win/tclWinThrd.h +++ /dev/null @@ -1,21 +0,0 @@ -/* - * tclWinThrd.h -- - * - * This header file defines things for thread support. - * - * Copyright (c) 1998 Sun Microsystems, Inc. - * - * See the file "license.terms" for information on usage and redistribution - * of this file, and for a DISCLAIMER OF ALL WARRANTIES. - * - * SCCS: @(#) tclWinThrd.h 1.2 98/01/27 11:48:05 - */ - -#ifndef _TCLWINTHRD -#define _TCLWINTHRD - -#ifdef TCL_THREADS - -#endif /* TCL_THREADS */ - -#endif /* _TCLWINTHRD */ diff --git a/win/tclWinTime.c b/win/tclWinTime.c index c1e2b6e..7045c72 100644 --- a/win/tclWinTime.c +++ b/win/tclWinTime.c @@ -8,8 +8,6 @@ * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. - * - * RCS: @(#) $Id: tclWinTime.c,v 1.33 2005/11/04 00:06:51 dkf Exp $ */ #include "tclInt.h" @@ -29,11 +27,11 @@ * month, where index 1 is January. */ -static int normalDays[] = { +static const int normalDays[] = { -1, 30, 58, 89, 119, 150, 180, 211, 242, 272, 303, 333, 364 }; -static int leapDays[] = { +static const int leapDays[] = { -1, 30, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334, 365 }; @@ -89,7 +87,7 @@ typedef struct TimeInfo { } TimeInfo; static TimeInfo timeInfo = { - { NULL }, + { NULL, 0, 0, NULL, NULL, 0 }, 0, 0, (HANDLE) NULL, @@ -158,7 +156,7 @@ TclpGetSeconds(void) { Tcl_Time t; - (*tclGetTimeProcPtr) (&t, tclTimeClientData); /* Tcl_GetTime inlined. */ + tclGetTimeProcPtr(&t, tclTimeClientData); /* Tcl_GetTime inlined. */ return t.sec; } @@ -192,7 +190,7 @@ TclpGetClicks(void) Tcl_Time now; /* Current Tcl time */ unsigned long retval; /* Value to return */ - (*tclGetTimeProcPtr) (&now, tclTimeClientData); /* Tcl_GetTime inlined */ + tclGetTimeProcPtr(&now, tclTimeClientData); /* Tcl_GetTime inlined */ retval = (now.sec * 1000000) + now.usec; return retval; @@ -202,35 +200,6 @@ TclpGetClicks(void) /* *---------------------------------------------------------------------- * - * TclpGetTimeZone -- - * - * Determines the current timezone. The method varies wildly between - * different Platform implementations, so its hidden in this function. - * - * Results: - * Minutes west of GMT. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -int -TclpGetTimeZone( - unsigned long currentTime) -{ - int timeZone; - - tzset(); - timeZone = timezone / 60; - - return timeZone; -} - -/* - *---------------------------------------------------------------------- - * * Tcl_GetTime -- * * Gets the current system time in seconds and microseconds since the @@ -254,7 +223,7 @@ void Tcl_GetTime( Tcl_Time *timePtr) /* Location to store time information. */ { - (*tclGetTimeProcPtr) (timePtr, tclTimeClientData); + tclGetTimeProcPtr(timePtr, tclTimeClientData); } /* @@ -311,7 +280,7 @@ NativeGetTime( Tcl_Time *timePtr, ClientData clientData) { - struct timeb t; + struct _timeb t; int useFtime = 1; /* Flag == TRUE if we need to fall back on * ftime rather than using the perf counter. */ @@ -416,7 +385,7 @@ NativeGetTime( WaitForSingleObject(timeInfo.readyEvent, INFINITE); CloseHandle(timeInfo.readyEvent); - Tcl_CreateExitHandler(StopCalibration, (ClientData) NULL); + Tcl_CreateExitHandler(StopCalibration, NULL); } timeInfo.initialized = TRUE; } @@ -477,7 +446,7 @@ NativeGetTime( * High resolution timer is not available. Just use ftime. */ - ftime(&t); + _ftime(&t); timePtr->sec = (long)t.time; timePtr->usec = t.millitm * 1000; } @@ -520,93 +489,6 @@ StopCalibration( /* *---------------------------------------------------------------------- * - * TclpGetTZName -- - * - * Gets the current timezone string. - * - * Results: - * Returns a pointer to a static string, or NULL on failure. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -char * -TclpGetTZName( - int dst) -{ - int len; - char *zone, *p; - TIME_ZONE_INFORMATION tz; - Tcl_Encoding encoding; - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - char *name = tsdPtr->tzName; - - /* - * tzset() under Borland doesn't seem to set up tzname[] at all. - * tzset() under MSVC has the following weird observed behavior: - * First time we call "clock format [clock seconds] -format %Z -gmt 1" - * we get "GMT", but on all subsequent calls we get the current time - * ezone string, even though env(TZ) is GMT and the variable _timezone - * is 0. - */ - - name[0] = '\0'; - - zone = getenv("TZ"); - if (zone != NULL) { - /* - * TZ is of form "NST-4:30NDT", where "NST" would be the name of the - * standard time zone for this area, "-4:30" is the offset from GMT in - * hours, and "NDT is the name of the daylight savings time zone in - * this area. The offset and DST strings are optional. - */ - - len = strlen(zone); - if (len > 3) { - len = 3; - } - if (dst != 0) { - /* - * Skip the offset string and get the DST string. - */ - - p = zone + len; - p += strspn(p, "+-:0123456789"); - if (*p != '\0') { - zone = p; - len = strlen(zone); - if (len > 3) { - len = 3; - } - } - } - Tcl_ExternalToUtf(NULL, NULL, zone, len, 0, NULL, name, - sizeof(tsdPtr->tzName), NULL, NULL, NULL); - } - if (name[0] == '\0') { - if (GetTimeZoneInformation(&tz) == TIME_ZONE_ID_UNKNOWN) { - /* - * MSDN: On NT this is returned if DST is not used in the current - * TZ - */ - - dst = 0; - } - encoding = Tcl_GetEncoding(NULL, "unicode"); - Tcl_ExternalToUtf(NULL, encoding, - (char *) ((dst) ? tz.DaylightName : tz.StandardName), -1, - 0, NULL, name, sizeof(tsdPtr->tzName), NULL, NULL, NULL); - Tcl_FreeEncoding(encoding); - } - return name; -} - -/* - *---------------------------------------------------------------------- - * * TclpGetDate -- * * This function converts between seconds and struct tm. If useGMT is @@ -624,7 +506,7 @@ TclpGetTZName( struct tm * TclpGetDate( - CONST time_t *t, + const time_t *t, int useGMT) { struct tm *tmPtr; @@ -736,7 +618,7 @@ ComputeGMT( struct tm *tmPtr; long tmp, rem; int isLeap; - int *days; + const int *days; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); tmPtr = &tsdPtr->tm; @@ -1170,7 +1052,7 @@ AccumulateSample( struct tm * TclpGmtime( - CONST time_t *timePtr) /* Pointer to the number of seconds since the + const time_t *timePtr) /* Pointer to the number of seconds since the * local system's epoch */ { /* @@ -1201,9 +1083,8 @@ TclpGmtime( struct tm * TclpLocaltime( - CONST time_t *timePtr) /* Pointer to the number of seconds since the + const time_t *timePtr) /* Pointer to the number of seconds since the * local system's epoch */ - { /* * The MS implementation of localtime is thread safe because it returns diff --git a/win/tclooConfig.sh b/win/tclooConfig.sh new file mode 100644 index 0000000..08cc4c5 --- /dev/null +++ b/win/tclooConfig.sh @@ -0,0 +1,19 @@ +# tclooConfig.sh -- +# +# This shell script (for sh) is generated automatically by TclOO's configure +# script, or would be except it has no values that we substitute. It will +# create shell variables for most of the configuration options discovered by +# the configure script. This script is intended to be included by TEA-based +# configure scripts for TclOO extensions so that they don't have to figure +# this all out for themselves. +# +# The information in this file is specific to a single platform. + +# These are mostly empty because no special steps are ever needed from Tcl 8.6 +# onwards; all libraries and include files are just part of Tcl. +TCLOO_LIB_SPEC="" +TCLOO_STUB_LIB_SPEC="" +TCLOO_INCLUDE_SPEC="" +TCLOO_PRIVATE_INCLUDE_SPEC="" +TCLOO_CFLAGS="" +TCLOO_VERSION=1.0.1 diff --git a/win/tclsh.exe.manifest.in b/win/tclsh.exe.manifest.in new file mode 100644 index 0000000..aaa34e1 --- /dev/null +++ b/win/tclsh.exe.manifest.in @@ -0,0 +1,33 @@ +<?xml version="1.0" encoding="UTF-8" standalone="yes"?> +<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0" + xmlns:asmv3="urn:schemas-microsoft-com:asm.v3"> + <assemblyIdentity + version="@TCL_WIN_VERSION@" + processorArchitecture="@MACHINE@" + name="Tcl.tclsh" + type="win32" + /> + <description>Tcl command line shell (tclsh)</description> + <trustInfo xmlns="urn:schemas-microsoft-com:asm.v3"> + <security> + <requestedPrivileges> + <requestedExecutionLevel + level="asInvoker" + uiAccess="false" + /> + </requestedPrivileges> + </security> + </trustInfo> + <compatibility xmlns="urn:schemas-microsoft-com:compatibility.v1"> + <application> + <!-- Windows 8.1 --> + <supportedOS Id="{1f676c76-80e1-4239-95bb-83d0f6d0da78}"/> + <!-- Windows 8 --> + <supportedOS Id="{4a2f28e3-53b9-4441-ba9c-d69d4a4a6e38}"/> + <!-- Windows 7 --> + <supportedOS Id="{35138b9a-5d96-4fbd-8e2d-a2440225f93a}"/> + <!-- Windows Vista --> + <supportedOS Id="{e2011457-1546-43c5-a5fe-008deee3d3f0}"/> + </application> + </compatibility> +</assembly> diff --git a/win/tclsh.ico b/win/tclsh.ico Binary files differindex 8bcaf48..e254318 100644 --- a/win/tclsh.ico +++ b/win/tclsh.ico diff --git a/win/tclsh.rc b/win/tclsh.rc index dd781da..161da50 100644 --- a/win/tclsh.rc +++ b/win/tclsh.rc @@ -1,4 +1,3 @@ -// RCS: @(#) $Id: tclsh.rc,v 1.11 2004/02/07 21:47:19 davygrvy Exp $ // // Version Resource Script // @@ -69,3 +68,15 @@ END // tclsh ICON DISCARDABLE "tclsh.ico" + +// +// This is needed for Windows 8.1 onwards. +// + +#ifndef RT_MANIFEST +#define RT_MANIFEST 24 +#endif +#ifndef CREATEPROCESS_MANIFEST_RESOURCE_ID +#define CREATEPROCESS_MANIFEST_RESOURCE_ID 1 +#endif +CREATEPROCESS_MANIFEST_RESOURCE_ID RT_MANIFEST "tclsh.exe.manifest" |