diff options
Diffstat (limited to 'win')
43 files changed, 9640 insertions, 9189 deletions
diff --git a/win/Makefile.in b/win/Makefile.in index 6b9685d..ada9448 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -22,6 +22,7 @@ exec_prefix = @exec_prefix@ bindir = @bindir@ libdir = @libdir@ includedir = @includedir@ +datarootdir = @datarootdir@ mandir = @mandir@ # The following definition can be set to non-null for special systems like AFS @@ -80,7 +81,7 @@ CFLAGS_OPTIMIZE = @CFLAGS_OPTIMIZE@ #CFLAGS = $(CFLAGS_DEBUG) #CFLAGS = $(CFLAGS_OPTIMIZE) #CFLAGS = $(CFLAGS_DEBUG) $(CFLAGS_OPTIMIZE) -CFLAGS = @CFLAGS@ @CFLAGS_DEFAULT@ -DUNICODE -D_UNICODE +CFLAGS = @CFLAGS@ @CFLAGS_DEFAULT@ # To enable compilation debugging reverse the comment characters on one of the # following lines. @@ -88,23 +89,28 @@ COMPILE_DEBUG_FLAGS = #COMPILE_DEBUG_FLAGS = -DTCL_COMPILE_DEBUG #COMPILE_DEBUG_FLAGS = -DTCL_COMPILE_DEBUG -DTCL_COMPILE_STATS +# Special compiler flags to use when building man2tcl on Windows. +MAN2TCLFLAGS = @MAN2TCLFLAGS@ + SRC_DIR = @srcdir@ ROOT_DIR = @srcdir@/.. -TOP_DIR = $(shell cd @srcdir@/..; pwd -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 +GENERIC_DIR = @srcdir@/../generic +TOMMATH_DIR = @srcdir@/../libtommath +WIN_DIR = @srcdir@ +COMPAT_DIR = @srcdir@/../compat # Converts a POSIX path to a Windows native path. CYGPATH = @CYGPATH@ -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') +libdir_native = $(shell $(CYGPATH) '$(libdir)') +bindir_native = $(shell $(CYGPATH) '$(bindir)') +includedir_native = $(shell $(CYGPATH) '$(includedir)') +mandir_native = $(shell $(CYGPATH) '$(mandir)') +TCL_LIBRARY_NATIVE = $(shell $(CYGPATH) '$(TCL_LIBRARY)') +GENERIC_DIR_NATIVE = $(shell $(CYGPATH) '$(GENERIC_DIR)') +TOMMATH_DIR_NATIVE = $(shell $(CYGPATH) '$(TOMMATH_DIR)') +WIN_DIR_NATIVE = $(shell $(CYGPATH) '$(WIN_DIR)') +ROOT_DIR_NATIVE = $(shell $(CYGPATH) '$(ROOT_DIR)') #GENERIC_DIR_NATIVE = $(GENERIC_DIR) #TOMMATH_DIR_NATIVE = $(TOMMATH_DIR) #WIN_DIR_NATIVE = $(WIN_DIR) @@ -112,8 +118,8 @@ ROOT_DIR_NATIVE = $(shell $(CYGPATH) '$(ROOT_DIR)' | sed 's!\\!/!g') # Fully qualify library path so that `make test` # does not depend on the current directory. -LIBRARY_DIR1 = $(shell cd '$(ROOT_DIR_NATIVE)/library' ; pwd -P) -LIBRARY_DIR = $(shell $(CYGPATH) '$(LIBRARY_DIR1)' | sed 's!\\!/!g') +LIBRARY_DIR1 = $(shell cd '$(ROOT_DIR_NATIVE)/library' ; pwd) +LIBRARY_DIR = $(shell $(CYGPATH) '$(LIBRARY_DIR1)') DLLSUFFIX = @DLLSUFFIX@ LIBSUFFIX = @LIBSUFFIX@ EXESUFFIX = @EXESUFFIX@ @@ -129,33 +135,37 @@ TCL_STUB_LIB_FILE = @TCL_STUB_LIB_FILE@ TCL_DLL_FILE = @TCL_DLL_FILE@ TCL_LIB_FILE = @TCL_LIB_FILE@ DDE_DLL_FILE = tcldde$(DDEVER)${DLLSUFFIX} -DDE_LIB_FILE = @LIBPREFIX@tcldde$(DDEVER)${LIBSUFFIX} +DDE_LIB_FILE = tcldde$(DDEVER)${LIBSUFFIX} REG_DLL_FILE = tclreg$(REGVER)${DLLSUFFIX} -REG_LIB_FILE = @LIBPREFIX@tclreg$(REGVER)${LIBSUFFIX} -TEST_DLL_FILE = tcltest$(VER)${DLLSUFFIX} -TEST_LIB_FILE = @LIBPREFIX@tcltest$(VER)${LIBSUFFIX} -ZLIB_DLL_FILE = zlib1.dll +REG_LIB_FILE = tclreg$(REGVER)${LIBSUFFIX} +PIPE_DLL_FILE = tclpip$(VER)${DLLSUFFIX} + +SHARED_LIBRARIES = $(TCL_DLL_FILE) $(TCL_STUB_LIB_FILE) \ + $(DDE_DLL_FILE) $(REG_DLL_FILE) $(PIPE_DLL_FILE) +STATIC_LIBRARIES = $(TCL_LIB_FILE) $(REG_LIB_FILE) $(DDE_LIB_FILE) -SHARED_LIBRARIES = $(TCL_DLL_FILE) @ZLIB_DLL_FILE@ -STATIC_LIBRARIES = $(TCL_LIB_FILE) +# To compile without backward compatibility and deprecated code +# uncomment the following +NO_DEPRECATED_FLAGS = +#NO_DEPRECATED_FLAGS = -DTCL_NO_DEPRECATED + +# TCL_EXE is the name of a tclsh executable that is available *BEFORE* running +# make for the first time. Certain build targets (make genstubs) need it to be +# available on the PATH. This executable should *NOT* be required just to do a +# normal build although it can be required to run make dist. +TCL_EXE = tclsh TCLSH = tclsh$(VER)${EXESUFFIX} +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):$(ZLIB_DIR) +VPATH = $(GENERIC_DIR):$(TOMMATH_DIR):$(WIN_DIR):$(COMPAT_DIR) AR = @AR@ RANLIB = @RANLIB@ @@ -173,10 +183,10 @@ EXEEXT = @EXEEXT@ OBJEXT = @OBJEXT@ STLIB_LD = @STLIB_LD@ SHLIB_LD = @SHLIB_LD@ -SHLIB_LD_LIBS = @SHLIB_LD_LIBS@ +SHLIB_LD_LIBS = @SHLIB_LD_LIBS@ $(LIBS) SHLIB_CFLAGS = @SHLIB_CFLAGS@ SHLIB_SUFFIX = @SHLIB_SUFFIX@ -LIBS = @LIBS@ @ZLIB_LIBS@ +LIBS = @LIBS@ RMDIR = rm -rf MKDIR = mkdir -p @@ -184,10 +194,10 @@ SHELL = @SHELL@ RM = rm -f COPY = cp -CC_SWITCHES = ${CFLAGS} ${CFLAGS_WARNING} ${TCL_SHLIB_CFLAGS} -I"${ZLIB_DIR}" \ +CC_SWITCHES = ${CFLAGS} ${CFLAGS_WARNING} ${TCL_SHLIB_CFLAGS} \ -I"${GENERIC_DIR_NATIVE}" -DTCL_TOMMATH -DMP_PREC=4 -I"${TOMMATH_DIR_NATIVE}" \ -I"${WIN_DIR_NATIVE}" ${AC_FLAGS} \ -${COMPILE_DEBUG_FLAGS} +${COMPILE_DEBUG_FLAGS} ${NO_DEPRECATED_FLAGS} CC_OBJNAME = @CC_OBJNAME@ CC_EXENAME = @CC_EXENAME@ @@ -202,7 +212,8 @@ TCLTEST_OBJS = \ tclTestObj.$(OBJEXT) \ tclTestProcBodyObj.$(OBJEXT) \ tclThreadTest.$(OBJEXT) \ - tclWinTest.$(OBJEXT) + tclWinTest.$(OBJEXT) \ + testMain.$(OBJEXT) GENERIC_OBJS = \ regcomp.$(OBJEXT) \ @@ -210,7 +221,6 @@ GENERIC_OBJS = \ regfree.$(OBJEXT) \ regerror.$(OBJEXT) \ tclAlloc.$(OBJEXT) \ - tclAssembly.$(OBJEXT) \ tclAsync.$(OBJEXT) \ tclBasic.$(OBJEXT) \ tclBinary.$(OBJEXT) \ @@ -220,14 +230,12 @@ GENERIC_OBJS = \ tclCmdIL.$(OBJEXT) \ tclCmdMZ.$(OBJEXT) \ tclCompCmds.$(OBJEXT) \ - tclCompCmdsSZ.$(OBJEXT) \ tclCompExpr.$(OBJEXT) \ tclCompile.$(OBJEXT) \ tclConfig.$(OBJEXT) \ tclDate.$(OBJEXT) \ tclDictObj.$(OBJEXT) \ tclEncoding.$(OBJEXT) \ - tclEnsemble.$(OBJEXT) \ tclEnv.$(OBJEXT) \ tclEvent.$(OBJEXT) \ tclExecute.$(OBJEXT) \ @@ -242,7 +250,6 @@ GENERIC_OBJS = \ tclIOCmd.$(OBJEXT) \ tclIOGT.$(OBJEXT) \ tclIORChan.$(OBJEXT) \ - tclIORTrans.$(OBJEXT) \ tclIOSock.$(OBJEXT) \ tclIOUtil.$(OBJEXT) \ tclLink.$(OBJEXT) \ @@ -250,16 +257,8 @@ GENERIC_OBJS = \ tclListObj.$(OBJEXT) \ tclLoad.$(OBJEXT) \ tclMain.$(OBJEXT) \ - tclMain2.$(OBJEXT) \ tclNamesp.$(OBJEXT) \ tclNotify.$(OBJEXT) \ - tclOO.$(OBJEXT) \ - tclOOBasic.$(OBJEXT) \ - tclOOCall.$(OBJEXT) \ - tclOODefineCmds.$(OBJEXT) \ - tclOOInfo.$(OBJEXT) \ - tclOOMethod.$(OBJEXT) \ - tclOOStubInit.$(OBJEXT) \ tclObj.$(OBJEXT) \ tclPanic.$(OBJEXT) \ tclParse.$(OBJEXT) \ @@ -277,6 +276,7 @@ GENERIC_OBJS = \ tclStringObj.$(OBJEXT) \ tclStrToD.$(OBJEXT) \ tclStubInit.$(OBJEXT) \ + tclStubLib.$(OBJEXT) \ tclThread.$(OBJEXT) \ tclThreadAlloc.$(OBJEXT) \ tclThreadJoin.$(OBJEXT) \ @@ -286,8 +286,7 @@ GENERIC_OBJS = \ tclTrace.$(OBJEXT) \ tclUtf.$(OBJEXT) \ tclUtil.$(OBJEXT) \ - tclVar.$(OBJEXT) \ - tclZlib.$(OBJEXT) + tclVar.$(OBJEXT) TOMMATH_OBJS = \ bncore.${OBJEXT} \ @@ -372,47 +371,47 @@ WIN_OBJS = \ tclWinThrd.$(OBJEXT) \ tclWinTime.$(OBJEXT) +PIPE_OBJS = stub16.$(OBJEXT) + DDE_OBJS = tclWinDde.$(OBJEXT) REG_OBJS = tclWinReg.$(OBJEXT) -STUB_OBJS = \ - tclStubLib.$(OBJEXT) \ - tclStubLibCompat.$(OBJEXT) \ - tclTomMathStubLib.$(OBJEXT) \ - tclOOStubLib.$(OBJEXT) +STUB_OBJS = tclStubLib.$(OBJEXT) TCLSH_OBJS = tclAppInit.$(OBJEXT) -ZLIB_OBJS = \ - adler32.$(OBJEXT) \ - compress.$(OBJEXT) \ - crc32.$(OBJEXT) \ - deflate.$(OBJEXT) \ - infback.$(OBJEXT) \ - inffast.$(OBJEXT) \ - inflate.$(OBJEXT) \ - inftrees.$(OBJEXT) \ - trees.$(OBJEXT) \ - uncompr.$(OBJEXT) \ - zutil.$(OBJEXT) - -TCL_OBJS = ${GENERIC_OBJS} $(TOMMATH_OBJS) ${WIN_OBJS} @ZLIB_OBJS@ +TCL_OBJS = ${GENERIC_OBJS} $(TOMMATH_OBJS) ${WIN_OBJS} TCL_DOCS = "$(ROOT_DIR_NATIVE)"/doc/*.[13n] -all: binaries libraries doc packages +all: binaries libraries doc -tcltest: $(TCLSH) $(TEST_DLL_FILE) +tcltest: $(TCLTEST) -binaries: $(TCL_STUB_LIB_FILE) @LIBRARIES@ $(DDE_DLL_FILE) $(REG_DLL_FILE) $(TCLSH) +binaries: @LIBRARIES@ $(TCLSH) libraries: doc: -$(TCLSH): $(TCLSH_OBJS) @LIBRARIES@ $(TCL_STUB_LIB_FILE) tclsh.$(RES) - $(CC) $(CFLAGS) $(TCLSH_OBJS) $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE) $(LIBS) \ +winhelp: $(ROOT_DIR)/tools/man2help.tcl $(MAN2TCL) + TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \ + ./$(TCLSH) "$(ROOT_DIR_NATIVE)"/tools/man2help.tcl tcl "$(VER)" $(TCL_DOCS) + hcw /c /e tcl.hpj + +winextensions: ${DDE_DLL_FILE} ${REG_DLL_FILE} + +$(MAN2TCL): $(ROOT_DIR)/tools/man2tcl.c + $(CC) $(CFLAGS_OPTIMIZE) $(MAN2TCLFLAGS) -o $(MAN2TCL) "$(ROOT_DIR_NATIVE)"/tools/man2tcl.c + +$(TCLSH): $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE) $(TCLSH_OBJS) tclsh.$(RES) + $(CC) $(CFLAGS) $(TCLSH_OBJS) $(TCL_LIB_FILE) $(LIBS) \ + tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE) + @VC_MANIFEST_EMBED_EXE@ + +$(TCLTEST): $(TCL_LIB_FILE) $(TCLTEST_OBJS) $(CAT32) tclsh.$(RES) + $(CC) $(CFLAGS) $(TCLTEST_OBJS) $(TCL_LIB_FILE) $(LIBS) \ tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE) @VC_MANIFEST_EMBED_EXE@ @@ -427,36 +426,40 @@ $(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) @ZLIB_DLL_FILE@ - @$(RM) ${TCL_DLL_FILE} $(TCL_LIB_FILE) +${TCL_DLL_FILE}: ${TCL_OBJS} tcl.$(RES) + @$(RM) ${TCL_DLL_FILE} @MAKE_DLL@ ${TCL_OBJS} tcl.$(RES) $(SHLIB_LD_LIBS) @VC_MANIFEST_EMBED_DLL@ -${TCL_LIB_FILE}: ${TCL_OBJS} ${DDE_OBJS} ${REG_OBJS} +${TCL_LIB_FILE}: ${TCL_OBJS} @$(RM) ${TCL_LIB_FILE} - @MAKE_LIB@ ${TCL_OBJS} ${DDE_OBJS} ${REG_OBJS} + @MAKE_LIB@ ${TCL_OBJS} @POST_MAKE_LIB@ ${DDE_DLL_FILE}: ${DDE_OBJS} ${TCL_STUB_LIB_FILE} + @$(RM) ${DDE_DLL_FILE} @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} @MAKE_DLL@ ${REG_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS) -${TEST_DLL_FILE}: ${TCLTEST_OBJS} ${TCL_STUB_LIB_FILE} - @$(RM) ${TEST_DLL_FILE} ${TEST_LIB_FILE} - @MAKE_DLL@ ${TCLTEST_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} -# use pre-built zlib1.dll -${ZLIB_DLL_FILE}: ${TCL_STUB_LIB_FILE} - @if test "@ZLIB_LIBS@set" == "${ZLIB_DIR}/win64/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; +# PIPE_DLL_FILE is actually an executable, don't build it like a DLL. + +${PIPE_DLL_FILE}: ${PIPE_OBJS} + @$(RM) ${PIPE_DLL_FILE} + @MAKE_EXE@ $(CFLAGS) ${PIPE_OBJS} $(LIBS) $(LDFLAGS_CONSOLE) # Add the object extension to the implicit rules. By default .obj is not # automatically added. @@ -471,13 +474,31 @@ tclWinInit.${OBJEXT}: tclWinInit.c $(CC) -c $(CC_SWITCHES) -DBUILD_tcl $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME) tclWinPipe.${OBJEXT}: tclWinPipe.c - $(CC) -c $(CC_SWITCHES) -DBUILD_tcl $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME) + $(CC) -c $(CC_SWITCHES) -DBUILD_tcl -DTCL_PIPE_DLL=\"$(PIPE_DLL_FILE)\" \ + $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME) testMain.${OBJEXT}: tclAppInit.c $(CC) -c $(CC_SWITCHES) -DTCL_TEST @DEPARG@ $(CC_OBJNAME) -tclMain2.${OBJEXT}: tclMain.c - $(CC) -c $(CC_SWITCHES) -DBUILD_tcl -DTCL_ASCII_MAIN @DEPARG@ $(CC_OBJNAME) +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) # TIP #59, embedding of configuration information into the binary library. # @@ -489,34 +510,26 @@ tclMain2.${OBJEXT}: tclMain.c tclPkgConfig.${OBJEXT}: tclPkgConfig.c $(CC) -c $(CC_SWITCHES) \ - -DCFG_INSTALL_LIBDIR=\"$(LIB_INSTALL_DIR)\" \ - -DCFG_INSTALL_BINDIR=\"$(BIN_INSTALL_DIR)\" \ - -DCFG_INSTALL_SCRDIR=\"$(SCRIPT_INSTALL_DIR)\" \ - -DCFG_INSTALL_INCDIR=\"$(INCLUDE_INSTALL_DIR)\" \ + -DCFG_INSTALL_LIBDIR=\"$(LIB_INSTALL_DIR_NATIVE)\" \ + -DCFG_INSTALL_BINDIR=\"$(BIN_INSTALL_DIR_NATIVE)\" \ + -DCFG_INSTALL_SCRDIR=\"$(SCRIPT_INSTALL_DIR_NATIVE)\" \ + -DCFG_INSTALL_INCDIR=\"$(INCLUDE_INSTALL_DIR_NATIVE)\" \ -DCFG_INSTALL_DOCDIR=\"$(MAN_INSTALL_DIR)\" \ \ - -DCFG_RUNTIME_LIBDIR=\"$(libdir)\" \ - -DCFG_RUNTIME_BINDIR=\"$(bindir)\" \ - -DCFG_RUNTIME_SCRDIR=\"$(TCL_LIBRARY)\" \ - -DCFG_RUNTIME_INCDIR=\"$(includedir)\" \ - -DCFG_RUNTIME_DOCDIR=\"$(mandir)\" \ + -DCFG_RUNTIME_LIBDIR=\"$(libdir_native)\" \ + -DCFG_RUNTIME_BINDIR=\"$(bindir_native)\" \ + -DCFG_RUNTIME_SCRDIR=\"$(TCL_LIBRARY_NATIVE)\" \ + -DCFG_RUNTIME_INCDIR=\"$(includedir_native)\" \ + -DCFG_RUNTIME_DOCDIR=\"$(mandir_native)\" \ -DBUILD_tcl \ @DEPARG@ $(CC_OBJNAME) # The following objects are part of the stub library and should not be built # as DLL objects but none of the symbols should be exported -tclStubLibCompat.${OBJEXT}: tclStubLibCompat.c - $(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD @DEPARG@ $(CC_OBJNAME) - 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 @@ -542,11 +555,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-packages +install: all install-binaries install-libraries install-doc install-binaries: binaries @for i in "$(LIB_INSTALL_DIR)" "$(BIN_INSTALL_DIR)" ; \ @@ -558,7 +571,7 @@ install-binaries: binaries else true; \ fi; \ done; - @for i in dde${DDEDOTVER} reg${REGDOTVER}; \ + @for i in dde$(DDEDOTVER) reg$(REGDOTVER); \ do \ if [ ! -d $(LIB_INSTALL_DIR)/$$i ] ; then \ echo "Making directory $(LIB_INSTALL_DIR)/$$i"; \ @@ -566,14 +579,14 @@ install-binaries: binaries else true; \ fi; \ done; - @for i in $(TCL_DLL_FILE) $(ZLIB_DLL_FILE) $(TCLSH); \ + @for i in $(TCL_DLL_FILE) $(TCLSH) $(PIPE_DLL_FILE); \ do \ if [ -f $$i ]; then \ echo "Installing $$i to $(BIN_INSTALL_DIR)/"; \ $(COPY) $$i "$(BIN_INSTALL_DIR)"; \ fi; \ done - @for i in tclConfig.sh tclooConfig.sh $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE); \ + @for i in tclConfig.sh $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE); \ do \ if [ -f $$i ]; then \ echo "Installing $$i to $(LIB_INSTALL_DIR)/"; \ @@ -581,24 +594,24 @@ install-binaries: binaries fi; \ done @if [ -f $(DDE_DLL_FILE) ]; then \ - echo installing $(DDE_DLL_FILE); \ - $(COPY) $(DDE_DLL_FILE) $(LIB_INSTALL_DIR)/dde${DDEDOTVER}; \ + echo Installing $(DDE_DLL_FILE); \ + $(COPY) $(DDE_DLL_FILE) $(LIB_INSTALL_DIR)/dde$(DDEDOTVER); \ $(COPY) $(ROOT_DIR)/library/dde/pkgIndex.tcl \ - $(LIB_INSTALL_DIR)/dde${DDEDOTVER}; \ + $(LIB_INSTALL_DIR)/dde$(DDEDOTVER); \ fi @if [ -f $(DDE_LIB_FILE) ]; then \ - echo installing $(DDE_LIB_FILE); \ - $(COPY) $(DDE_LIB_FILE) $(LIB_INSTALL_DIR)/dde${DDEDOTVER}; \ + echo Installing $(DDE_LIB_FILE); \ + $(COPY) $(DDE_LIB_FILE) $(LIB_INSTALL_DIR)/dde$(DDEDOTVER); \ fi @if [ -f $(REG_DLL_FILE) ]; then \ - echo installing $(REG_DLL_FILE); \ - $(COPY) $(REG_DLL_FILE) $(LIB_INSTALL_DIR)/reg${REGDOTVER}; \ + echo Installing $(REG_DLL_FILE); \ + $(COPY) $(REG_DLL_FILE) $(LIB_INSTALL_DIR)/reg$(REGDOTVER); \ $(COPY) $(ROOT_DIR)/library/reg/pkgIndex.tcl \ - $(LIB_INSTALL_DIR)/reg${REGDOTVER}; \ + $(LIB_INSTALL_DIR)/reg$(REGDOTVER); \ fi @if [ -f $(REG_LIB_FILE) ]; then \ - echo installing $(REG_LIB_FILE); \ - $(COPY) $(REG_LIB_FILE) $(LIB_INSTALL_DIR)/reg${REGDOTVER}; \ + echo Installing $(REG_LIB_FILE); \ + $(COPY) $(REG_LIB_FILE) $(LIB_INSTALL_DIR)/reg$(REGDOTVER); \ fi install-libraries: libraries install-tzdata install-msgs @@ -611,7 +624,7 @@ install-libraries: libraries install-tzdata install-msgs else true; \ fi; \ done; - @for i in http1.0 opt0.4 encoding ../tcl8 ../tcl8/8.4 ../tcl8/8.4/platform ../tcl8/8.5 ../tcl8/8.6; \ + @for i in http1.0 opt0.4 encoding ../tcl8 ../tcl8/8.4 ../tcl8/8.4/platform ../tcl8/8.5; \ do \ if [ ! -d $(SCRIPT_INSTALL_DIR)/$$i ] ; then \ echo "Making directory $(SCRIPT_INSTALL_DIR)/$$i"; \ @@ -621,7 +634,6 @@ 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"; \ @@ -638,19 +650,19 @@ install-libraries: libraries install-tzdata install-msgs do \ $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/http1.0"; \ done; - @echo "Installing package http 2.8.5 as a Tcl Module"; - @$(COPY) $(ROOT_DIR)/library/http/http.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.6/http-2.8.5.tm; + @echo "Installing package http 2.7.13 as a Tcl Module"; + @$(COPY) $(ROOT_DIR)/library/http/http.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/http-2.7.13.tm; @echo "Installing library opt0.4 directory"; @for j in $(ROOT_DIR)/library/opt/*.tcl; \ do \ $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/opt0.4"; \ done; - @echo "Installing package msgcat 1.5.0 as a Tcl Module"; - @$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/msgcat-1.5.0.tm; - @echo "Installing package tcltest 2.3.4 as a Tcl Module"; - @$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/tcltest-2.3.4.tm; - @echo "Installing package platform 1.0.10 as a Tcl Module"; - @$(COPY) $(ROOT_DIR)/library/platform/platform.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/platform-1.0.10.tm; + @echo "Installing package msgcat 1.5.2 as a Tcl Module"; + @$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/msgcat-1.5.2.tm; + @echo "Installing package tcltest 2.3.8 as a Tcl Module"; + @$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/tcltest-2.3.8.tm; + @echo "Installing package platform 1.0.14 as a Tcl Module"; + @$(COPY) $(ROOT_DIR)/library/platform/platform.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/platform-1.0.14.tm; @echo "Installing package platform::shell 1.1.4 as a Tcl Module"; @$(COPY) $(ROOT_DIR)/library/platform/shell.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/platform/shell-1.1.4.tm; @echo "Installing encodings"; @@ -660,12 +672,14 @@ install-libraries: libraries install-tzdata install-msgs install-tzdata: @echo "Installing time zone data" - @$(TCL_EXE) "$(ROOT_DIR)/tools/installData.tcl" \ + @TCL_LIBRARY="${LIBRARY_DIR}"; export TCL_LIBRARY; \ + ./$(TCLSH) "$(ROOT_DIR)/tools/installData.tcl" \ "$(ROOT_DIR)/library/tzdata" "$(SCRIPT_INSTALL_DIR)/tzdata" install-msgs: @echo "Installing message catalogs" - @$(TCL_EXE) "$(ROOT_DIR)/tools/installData.tcl" \ + @TCL_LIBRARY="${LIBRARY_DIR}"; export TCL_LIBRARY; \ + ./$(TCLSH) "$(ROOT_DIR)/tools/installData.tcl" \ "$(ROOT_DIR)/library/msgs" "$(SCRIPT_INSTALL_DIR)/msgs" install-doc: doc @@ -683,7 +697,6 @@ install-private-headers: libraries @echo "Installing private header files"; @for i in "$(GENERIC_DIR)/tclInt.h" "$(GENERIC_DIR)/tclIntDecls.h" \ "$(GENERIC_DIR)/tclIntPlatDecls.h" "$(GENERIC_DIR)/tclPort.h" \ - "$(GENERIC_DIR)/tclOOInt.h" "$(GENERIC_DIR)/tclOOIntDecls.h" \ "$(WIN_DIR)/tclWinPort.h" ; \ do \ $(COPY) "$$i" "$(PRIVATE_INCLUDE_INSTALL_DIR)"; \ @@ -693,21 +706,17 @@ install-private-headers: libraries # tcltest, i.e.: # % make test TESTFLAGS="-verbose bps -file fileName.test" -test: test-tcl test-packages - -test-tcl: binaries $(TCLSH) $(CAT32) $(TEST_DLL_FILE) +test: binaries $(TCLTEST) TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \ - ./$(TCLSH) "$(ROOT_DIR_NATIVE)/tests/all.tcl" $(TESTFLAGS) \ - -load "package ifneeded Tcltest ${VERSION}@TCL_PATCH_LEVEL@ [list load [file normalize ${TEST_DLL_FILE}] Tcltest]; \ - package ifneeded dde 1.4.0 [list load [file normalize ${DDE_DLL_FILE}] dde]; \ - package ifneeded registry 1.3.0 [list load [file normalize ${REG_DLL_FILE}] registry]" | ./$(CAT32) + ./$(TCLTEST) "$(ROOT_DIR_NATIVE)/tests/all.tcl" $(TESTFLAGS) \ + -load "package ifneeded dde 1.3.3 [list load [file normalize ${DDE_DLL_FILE}] dde]; \ + package ifneeded registry 1.2.2 [list load [file normalize ${REG_DLL_FILE}] registry]" | ./$(CAT32) -# Useful target to launch a built tclsh with the proper path,... -runtest: binaries $(TCLSH) $(TEST_DLL_FILE) +# Useful target to launch a built tcltest with the proper path,... +runtest: binaries $(TCLTEST) @TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \ - ./$(TCLSH) $(TESTFLAGS) -load "package ifneeded Tcltest ${VERSION}@TCL_PATCH_LEVEL@ [list load [file normalize ${TEST_DLL_FILE}] Tcltest]; \ - package ifneeded dde 1.4.0 [list load [file normalize ${DDE_DLL_FILE}] dde]; \ - package ifneeded registry 1.3.0 [list load [file normalize ${REG_DLL_FILE}] registry]" $(SCRIPT) + ./$(TCLTEST) $(TESTFLAGS) -load "package ifneeded dde 1.3.3 [list load [file normalize ${DDE_DLL_FILE}] dde]; \ + package ifneeded registry 1.2.2 [list load [file normalize ${REG_DLL_FILE}] registry]" $(SCRIPT) # This target can be used to run tclsh from the build directory via # `make shell SCRIPT=foo.tcl` @@ -729,94 +738,16 @@ Makefile: $(SRC_DIR)/Makefile.in cleanhelp: $(RM) *.hlp *.cnt *.GID *.rtf man2tcl.exe -clean: cleanhelp clean-packages +clean: cleanhelp $(RM) *.lib *.a *.exp *.dll *.$(RES) *.${OBJEXT} *~ \#* TAGS a.out - $(RM) $(TCLSH) $(CAT32) + $(RM) $(TCLSH) $(TCLTEST) $(CAT32) $(RM) *.pch *.ilk *.pdb -distclean: distclean-packages clean +distclean: 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=$(PWD) --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. # @@ -830,27 +761,8 @@ genstubs: $(TCL_EXE) "$(ROOT_DIR_NATIVE)/tools/genStubs.tcl" \ "$(GENERIC_DIR_NATIVE)" \ "$(GENERIC_DIR_NATIVE)/tcl.decls" \ - "$(GENERIC_DIR_NATIVE)/tclInt.decls" \ + "$(GENERIC_DIR_NATIVE)/tclInt.decls" \ "$(GENERIC_DIR_NATIVE)/tclTomMath.decls" - $(TCL_EXE) "$(ROOT_DIR_NATIVE)/tools/genStubs.tcl" \ - "$(GENERIC_DIR_NATIVE)" \ - "$(GENERIC_DIR_NATIVE)/tclOO.decls" - -# -# This target creates the HTML folder for Tcl & Tk and places it in -# DISTDIR/html. It uses the tcltk-man2html.tcl tool from the Tcl group's tool -# workspace. It depends on the Tcl & Tk being in directories called tcl8.* & -# tk8.* up two directories from the TOOL_DIR. -# - -TOOL_DIR=$(ROOT_DIR)/tools -HTML_INSTALL_DIR=$(ROOT_DIR)/html -html: - $(MAKE) shell SCRIPT="$(TOOL_DIR)/tcltk-man2html.tcl --htmldir=$(HTML_INSTALL_DIR) --srcdir=$(ROOT_DIR)/.. $(BUILD_HTML_FLAGS)" -html-tcl: $(TCLSH) - $(MAKE) shell SCRIPT="$(TOOL_DIR)/tcltk-man2html.tcl --htmldir=$(HTML_INSTALL_DIR) --srcdir=$(ROOT_DIR)/.. $(BUILD_HTML_FLAGS) --tcl" -html-tk: $(TCLSH) - $(MAKE) shell SCRIPT="$(TOOL_DIR)/tcltk-man2html.tcl --htmldir=$(HTML_INSTALL_DIR) --srcdir=$(ROOT_DIR)/.. $(BUILD_HTML_FLAGS) --tk" # # The list of all the targets that do not correspond to real files. This stops @@ -1,4 +1,4 @@ -Tcl 9.0 for Windows +Tcl 8.5 for Windows 1. Introduction --------------- @@ -16,7 +16,7 @@ The information in this file is maintained on the web at: In order to compile Tcl for Windows, you need the following: - Tcl 9.0 Source Distribution (plus any patches) + Tcl 8.5 Source Distribution (plus any patches) and @@ -81,7 +81,7 @@ structure. 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. +tclsh85.exe. Note: Tcl no longer provides support for Win32s. @@ -91,9 +91,9 @@ Note: Tcl no longer provides support for Win32s. 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 +you can manage to our tracker: - http://tcl.sourceforge.net/ + 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 e4f0a30..1a0f36d 100755..100644 --- a/win/buildall.vc.bat +++ b/win/buildall.vc.bat @@ -1,103 +1,103 @@ -@echo off - -:: This is an example batchfile for building everything. Please -:: edit this (or make your own) for your needs and wants using -:: the instructions for calling makefile.vc found in makefile.vc - -set SYMBOLS= - -:OPTIONS -if "%1" == "/?" goto help -if /i "%1" == "/help" goto help -if %1.==symbols. goto SYMBOLS -if %1.==debug. goto SYMBOLS -goto OPTIONS_DONE - -:SYMBOLS - set SYMBOLS=symbols - shift - goto OPTIONS - -:OPTIONS_DONE - -:: reset errorlevel -cd > nul - -:: You might have installed your developer studio to add itself to the -:: path or have already run vcvars32.bat. Testing these envars proves -:: cl.exe and friends are in your path. -:: -if defined VCINSTALLDIR (goto :startBuilding) -if defined MSDEVDIR (goto :startBuilding) -if defined MSVCDIR (goto :startBuilding) -if defined MSSDK (goto :startBuilding) -if defined WINDOWSSDKDIR (goto :startBuilding) - -:: We need to run the development environment batch script that comes -:: with developer studio (v4,5,6,7,etc...) All have it. This path -:: might not be correct. You should call it yourself prior to running -:: this batchfile. -:: -call "C:\Program Files\Microsoft Developer Studio\vc98\bin\vcvars32.bat" -if errorlevel 1 (goto no_vcvars) - -:startBuilding - -echo. -echo Sit back and have a cup of coffee while this grinds through ;) -echo You asked for *everything*, remember? -echo. -title Building Tcl, please wait... - - -:: makefile.vc uses this for its default anyways, but show its use here -:: just to be explicit and convey understanding to the user. Setting -:: the INSTALLDIR envar prior to running this batchfile affects all builds. -:: -if "%INSTALLDIR%" == "" set INSTALLDIR=C:\Program Files\Tcl - - -:: Build the normal stuff along with the help file. -:: -set OPTS=none -if not %SYMBOLS%.==. set OPTS=symbols -nmake -nologo -f makefile.vc release htmlhelp OPTS=%OPTS% %1 -if errorlevel 1 goto error - -:: Build the static core and shell. -:: -set OPTS=static,msvcrt -if not %SYMBOLS%.==. set OPTS=symbols,static,msvcrt -nmake -nologo -f makefile.vc shell OPTS=%OPTS% %1 -if errorlevel 1 goto error - -set OPTS= -set SYMBOLS= -goto end - -:error -echo *** BOOM! *** -goto end - -:no_vcvars -echo vcvars32.bat was not run prior to this batchfile, nor are the MS tools in your path. -goto out - -:help -title buildall.vc.bat help message -echo usage: -echo %0 : builds Tcl for all build types (do this first) -echo %0 install : installs all the release builds (do this second) -echo %0 symbols : builds Tcl for all debugging build types -echo %0 symbols install : install all the debug builds. -echo. -goto out - -:end -title Building Tcl, please wait... DONE! -echo DONE! -goto out - -:out -pause -title Command Prompt +@echo off
+
+:: This is an example batchfile for building everything. Please
+:: edit this (or make your own) for your needs and wants using
+:: the instructions for calling makefile.vc found in makefile.vc
+
+set SYMBOLS=
+
+:OPTIONS
+if "%1" == "/?" goto help
+if /i "%1" == "/help" goto help
+if %1.==symbols. goto SYMBOLS
+if %1.==debug. goto SYMBOLS
+goto OPTIONS_DONE
+
+:SYMBOLS
+ set SYMBOLS=symbols
+ shift
+ goto OPTIONS
+
+:OPTIONS_DONE
+
+:: reset errorlevel
+cd > nul
+
+:: You might have installed your developer studio to add itself to the
+:: path or have already run vcvars32.bat. Testing these envars proves
+:: cl.exe and friends are in your path.
+::
+if defined VCINSTALLDIR (goto :startBuilding)
+if defined MSDEVDIR (goto :startBuilding)
+if defined MSVCDIR (goto :startBuilding)
+if defined MSSDK (goto :startBuilding)
+if defined WINDOWSSDKDIR (goto :startBuilding)
+
+:: We need to run the development environment batch script that comes
+:: with developer studio (v4,5,6,7,etc...) All have it. This path
+:: might not be correct. You should call it yourself prior to running
+:: this batchfile.
+::
+call "C:\Program Files\Microsoft Developer Studio\vc98\bin\vcvars32.bat"
+if errorlevel 1 (goto no_vcvars)
+
+:startBuilding
+
+echo.
+echo Sit back and have a cup of coffee while this grinds through ;)
+echo You asked for *everything*, remember?
+echo.
+title Building Tcl, please wait...
+
+
+:: makefile.vc uses this for its default anyways, but show its use here
+:: just to be explicit and convey understanding to the user. Setting
+:: the INSTALLDIR envar prior to running this batchfile affects all builds.
+::
+if "%INSTALLDIR%" == "" set INSTALLDIR=C:\Program Files\Tcl
+
+
+:: Build the normal stuff along with the help file.
+::
+set OPTS=threads
+if not %SYMBOLS%.==. set OPTS=symbols,threads
+nmake -nologo -f makefile.vc release winhelp OPTS=%OPTS% %1
+if errorlevel 1 goto error
+
+:: Build the static core and shell.
+::
+set OPTS=static,msvcrt,threads
+if not %SYMBOLS%.==. set OPTS=symbols,static,msvcrt,threads
+nmake -nologo -f makefile.vc shell OPTS=%OPTS% %1
+if errorlevel 1 goto error
+
+set OPTS=
+set SYMBOLS=
+goto end
+
+:error
+echo *** BOOM! ***
+goto end
+
+:no_vcvars
+echo vcvars32.bat was not run prior to this batchfile, nor are the MS tools in your path.
+goto out
+
+:help
+title buildall.vc.bat help message
+echo usage:
+echo %0 : builds Tcl for all build types (do this first)
+echo %0 install : installs all the release builds (do this second)
+echo %0 symbols : builds Tcl for all debugging build types
+echo %0 symbols install : install all the debug builds.
+echo.
+goto out
+
+:end
+title Building Tcl, please wait... DONE!
+echo DONE!
+goto out
+
+:out
+pause
+title Command Prompt
@@ -9,19 +9,12 @@ * of this file, and for a DISCLAIMER OF ALL WARRANTIES. */ -#ifdef TCL_BROKEN_MAINARGS -/* On mingw32 and cygwin this doesn't work */ -# undef UNICODE -# undef _UNICODE -#endif - #include <stdio.h> #include <io.h> #include <string.h> -#include <tchar.h> int -_tmain(void) +main(void) { char buf[1024]; int n; diff --git a/win/coffbase.txt b/win/coffbase.txt index bdf5506..0ebe18a 100644 --- a/win/coffbase.txt +++ b/win/coffbase.txt @@ -1,42 +1,42 @@ -; -; This file defines the virtual base addresses for the Dynamic Link Libraries -; that are part of the Tcl system. The first token on a line is the key (or name -; of the DLL) and the second token is the virtual base address, in hexidecimal. -; The third token is the maximum size of the DLL image file, including symbols. -; -; Using a specified "prefered load address" should speed loading time by avoiding -; relocations (NT supported only). It is assumed extension authors will contribute -; their modules to this grand-master list. You can use the dumpbin utility with -; the /headers option to get the "size of image" data (already in hex). If the -; maximum size is too small a linker warning will occur. Modules can overlap when -; they're mutually exclusive. This info is placed in the DLL's PE header by the -; linker with the `-base:@$(TCLDIR)\win\coffbase.txt,<key>` option. - -tcl 0x10000000 0x00200000 -tcldde 0x10200000 0x00010000 -tclreg 0x10210000 0x00010000 -tk 0x10220000 0x00200000 -expect 0x10480000 0x00080000 -itcl 0x10500000 0x00080000 -itk 0x10580000 0x00080000 -bltlite 0x10600000 0x00080000 -blt 0x10680000 0x00080000 -iocpsock 0x10700000 0x00080000 -tls 0x10780000 0x00100000 -winico 0x10880000 0x00010000 -sample 0x108B0000 0x00010000 -tile 0x10900000 0x00080000 -memchan 0x109D0000 0x00010000 -tdom 0x109E0000 0x00080000 -tclvfs 0x10A70000 0x00010000 -tkvideo 0x10B00000 0x00010000 -tclsdl 0x10B20000 0x00080000 -vqtcl 0x10C00000 0x00010000 -tdbc 0x10C40000 0x00010000 -thread 0x10C80000 0x00020000 -; -; insert new packages here -; -snack 0x1E000000 0x00400000 -sound 0x1E400000 0x00400000 -snackogg 0x1E800000 0x00200000 +;
+; This file defines the virtual base addresses for the Dynamic Link Libraries
+; that are part of the Tcl system. The first token on a line is the key (or name
+; of the DLL) and the second token is the virtual base address, in hexidecimal.
+; The third token is the maximum size of the DLL image file, including symbols.
+;
+; Using a specified "prefered load address" should speed loading time by avoiding
+; relocations (NT supported only). It is assumed extension authors will contribute
+; their modules to this grand-master list. You can use the dumpbin utility with
+; the /headers option to get the "size of image" data (already in hex). If the
+; maximum size is too small a linker warning will occur. Modules can overlap when
+; they're mutually exclusive. This info is placed in the DLL's PE header by the
+; linker with the `-base:@$(TCLDIR)\win\coffbase.txt,<key>` option.
+
+tcl 0x10000000 0x00200000
+tcldde 0x10200000 0x00010000
+tclreg 0x10210000 0x00010000
+tk 0x10220000 0x00200000
+expect 0x10480000 0x00080000
+itcl 0x10500000 0x00080000
+itk 0x10580000 0x00080000
+bltlite 0x10600000 0x00080000
+blt 0x10680000 0x00080000
+iocpsock 0x10700000 0x00080000
+tls 0x10780000 0x00100000
+winico 0x10880000 0x00010000
+sample 0x108B0000 0x00010000
+tile 0x10900000 0x00080000
+memchan 0x109D0000 0x00010000
+tdom 0x109E0000 0x00080000
+tclvfs 0x10A70000 0x00010000
+tkvideo 0x10B00000 0x00010000
+tclsdl 0x10B20000 0x00080000
+vqtcl 0x10C00000 0x00010000
+tdbc 0x10C40000 0x00010000
+thread 0x10C80000 0x00020000
+;
+; insert new packages here
+;
+snack 0x1E000000 0x00400000
+sound 0x1E400000 0x00400000
+snackogg 0x1E800000 0x00200000
diff --git a/win/configure b/win/configure index ba10113..090feaa 100755 --- a/win/configure +++ b/win/configure @@ -309,7 +309,7 @@ ac_includes_default="\ # 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_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 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_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT CPP EGREP AR ac_ct_AR RANLIB ac_ct_RANLIB RC ac_ct_RC SET_MAKE TCL_THREADS CYGPATH CELIB_DIR DL_LIBS CFLAGS_DEBUG CFLAGS_OPTIMIZE CFLAGS_WARNING CFLAGS_DEFAULT LDFLAGS_DEFAULT VC_MANIFEST_EMBED_DLL VC_MANIFEST_EMBED_EXE TCL_WIN_VERSION MACHINE TCL_VERSION TCL_MAJOR_VERSION TCL_MINOR_VERSION TCL_PATCH_LEVEL TCL_LIB_FILE TCL_LIB_FLAG TCL_LIB_SPEC TCL_STUB_LIB_FILE TCL_STUB_LIB_FLAG TCL_STUB_LIB_SPEC TCL_STUB_LIB_PATH TCL_INCLUDE_SPEC TCL_BUILD_STUB_LIB_SPEC TCL_BUILD_STUB_LIB_PATH TCL_DLL_FILE TCL_SRC_DIR TCL_BIN_DIR TCL_DBGX CFG_TCL_SHARED_LIB_SUFFIX CFG_TCL_UNSHARED_LIB_SUFFIX CFG_TCL_EXPORT_FILE_SUFFIX EXTRA_CFLAGS DEPARG CC_OBJNAME CC_EXENAME LDFLAGS_DEBUG LDFLAGS_OPTIMIZE LDFLAGS_CONSOLE LDFLAGS_WINDOW STLIB_LD SHLIB_LD SHLIB_LD_LIBS SHLIB_CFLAGS SHLIB_SUFFIX TCL_SHARED_BUILD LIBS_GUI DLLSUFFIX LIBPREFIX LIBSUFFIX EXESUFFIX LIBRARIES MAKE_LIB MAKE_STUB_LIB POST_MAKE_LIB MAKE_DLL MAKE_EXE TCL_BUILD_LIB_SPEC TCL_LD_SEARCH_FLAGS TCL_NEEDS_EXP_FILE TCL_BUILD_EXP_FILE TCL_EXP_FILE TCL_LIB_VERSIONS_OK TCL_PACKAGE_PATH TCL_DDE_VERSION TCL_DDE_MAJOR_VERSION TCL_DDE_MINOR_VERSION TCL_REG_VERSION TCL_REG_MAJOR_VERSION TCL_REG_MINOR_VERSION RC_OUT RC_TYPE RC_INCLUDE RC_DEFINE RC_DEFINES RES LIBOBJS LTLIBOBJS' ac_subst_files='' # Initialize some variables set by options. @@ -840,7 +840,7 @@ 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 (default: on) + --enable-threads build with threads (default: off) --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) @@ -1308,29 +1308,22 @@ 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=9.0 -TCL_MAJOR_VERSION=9 -TCL_MINOR_VERSION=0 -TCL_PATCH_LEVEL="a0" +TCL_VERSION=8.5 +TCL_MAJOR_VERSION=8 +TCL_MINOR_VERSION=5 +TCL_PATCH_LEVEL=".18" VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION -TCL_DDE_VERSION=1.4 +TCL_DDE_VERSION=1.3 TCL_DDE_MAJOR_VERSION=1 -TCL_DDE_MINOR_VERSION=4 +TCL_DDE_MINOR_VERSION=3 DDEVER=$TCL_DDE_MAJOR_VERSION$TCL_DDE_MINOR_VERSION -TCL_REG_VERSION=1.3 +TCL_REG_VERSION=1.2 TCL_REG_MAJOR_VERSION=1 -TCL_REG_MINOR_VERSION=3 +TCL_REG_MINOR_VERSION=2 REGVER=$TCL_REG_MAJOR_VERSION$TCL_REG_MINOR_VERSION -PKG_CFG_ARGS=$@ - -#------------------------------------------------------------------------ -# Empty slate for bundled packages, to avoid stale configuration -#------------------------------------------------------------------------ -rm -Rf pkgs - #------------------------------------------------------------------------ # Handle the --prefix=... option #------------------------------------------------------------------------ @@ -3064,12 +3057,12 @@ if test "${enable_threads+set}" = set; then enableval="$enable_threads" tcl_ok=$enableval else - tcl_ok=yes + tcl_ok=no fi; if test "$tcl_ok" = "yes"; then - echo "$as_me:$LINENO: result: yes (default)" >&5 -echo "${ECHO_T}yes (default)" >&6 + echo "$as_me:$LINENO: result: yes" >&5 +echo "${ECHO_T}yes" >&6 TCL_THREADS=1 cat >>confdefs.h <<\_ACEOF #define TCL_THREADS 1 @@ -3083,8 +3076,8 @@ _ACEOF else TCL_THREADS=0 - echo "$as_me:$LINENO: result: no" >&5 -echo "${ECHO_T}no" >&6 + echo "$as_me:$LINENO: result: no (default)" >&5 +echo "${ECHO_T}no (default)" >&6 fi @@ -3146,7 +3139,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 @@ -3277,11 +3271,6 @@ 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 @@ -3299,7 +3288,7 @@ do test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then - ac_cv_prog_CYGPATH="cygpath -w" + ac_cv_prog_CYGPATH="cygpath -m" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi @@ -3448,6 +3437,8 @@ 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 @@ -3511,80 +3502,14 @@ echo "${ECHO_T}$ac_cv_win32" >&6 echo "$as_me: error: ${CC} cannot produce win32 executables." >&2;} { (exit 1); exit 1; }; } fi - - hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -mwindows -municode -Dmain=xxmain" - echo "$as_me:$LINENO: checking for working -municode linker flag" >&5 -echo $ECHO_N "checking for working -municode linker flag... $ECHO_C" >&6 -if test "${ac_cv_municode+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -else - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ - - #include <windows.h> - int APIENTRY wWinMain(HINSTANCE a, HINSTANCE b, LPWSTR c, int d) {return 0;} - -int -main () -{ - - ; - return 0; -} -_ACEOF -rm -f conftest.$ac_objext conftest$ac_exeext -if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 - (eval $ac_link) 2>conftest.er1 - ac_status=$? - grep -v '^ *+' conftest.er1 >conftest.err - rm -f conftest.er1 - cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 - (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" - || test ! -s conftest.err' - { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 - (eval $ac_try) 2>&5 - ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 - (exit $ac_status); }; } && - { ac_try='test -s conftest$ac_exeext' - { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 - (eval $ac_try) 2>&5 - ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 - (exit $ac_status); }; }; then - ac_cv_municode=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -ac_cv_municode=no -fi -rm -f conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext - -fi -echo "$as_me:$LINENO: result: $ac_cv_municode" >&5 -echo "${ECHO_T}$ac_cv_municode" >&6 - CFLAGS=$hold_cflags - if test "$ac_cv_municode" = "yes" ; then - extra_ldflags="$extra_ldflags -municode" - else - extra_cflags="$extra_cflags -DTCL_BROKEN_MAINARGS" - fi fi echo "$as_me:$LINENO: checking compiler flags" >&5 echo $ECHO_N "checking compiler flags... $ECHO_C" >&6 if test "${GCC}" = "yes" ; then SHLIB_LD="" - SHLIB_LD_LIBS='${LIBS}' - LIBS="-lnetapi32 -lkernel32 -luser32 -ladvapi32 -lws2_32" + SHLIB_LD_LIBS="" + LIBS="-lws2_32" # mingw needs to link ole32 and oleaut32 for [send], but MSVC doesn't LIBS_GUI="-lgdi32 -lcomdlg32 -limm32 -lcomctl32 -lshell32 -luuid -lole32 -loleaut32" STLIB_LD='${AR} cr' @@ -3594,18 +3519,19 @@ echo $ECHO_N "checking compiler flags... $ECHO_C" >&6 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" - extra_cflags="$extra_cflags -pipe" - extra_ldflags="$extra_ldflags -pipe" - 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 @@ -3623,30 +3549,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. + SHLIB_LD='${CC} -shared' + SHLIB_LD_LIBS='${LIBS}' # Add SHLIB_LD_LIBS to the Make rule, not here. + MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -o \$@ ${extra_ldflags} \ + -Wl,--out-implib,\$(patsubst %.dll,lib%.a,\$@)" + 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. Make sure CFLAGS is - # included so -mno-cygwin passed the correct libs to the linker. - SHLIB_LD='${CC} -shared ${CFLAGS}' - SHLIB_LD_LIBS='${LIBS}' - MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -o \$@ ${extra_ldflags} \ - -Wl,--out-implib,\$(patsubst %.dll,lib%.a,\$@)" # DLLSUFFIX is separate because it is the building block for # users of tclConfig.sh that may build shared or static. DLLSUFFIX="\${DBGX}.dll" - LIBSUFFIX="\${DBGX}.a" - LIBFLAGSUFFIX="\${DBGX}" SHLIB_SUFFIX=.dll EXTRA_CFLAGS="${extra_cflags}" CFLAGS_DEBUG=-g CFLAGS_OPTIMIZE="-O2 -fomit-frame-pointer" - CFLAGS_WARNING="-Wall -Wdeclaration-after-statement" + CFLAGS_WARNING="-Wall" LDFLAGS_DEBUG= LDFLAGS_OPTIMIZE= @@ -3747,23 +3672,35 @@ echo "${ECHO_T} Using 64-bit $MACHINE mode" >&6 echo "$as_me:$LINENO: result: using static flags" >&5 echo "${ECHO_T}using static flags" >&6 runtime=-MT + MAKE_DLL="echo " + LIBSUFFIX="s\${DBGX}.lib" + LIBFLAGSUFFIX="s\${DBGX}" LIBRARIES="\${STATIC_LIBRARIES}" EXESUFFIX="s\${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. - LIBRARIES="\${SHARED_LIBRARIES}" + MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -out:\$@" + LIBSUFFIX="\${DBGX}.lib" + LIBFLAGSUFFIX="\${DBGX}" EXESUFFIX="\${DBGX}.exe" + LIBRARIES="\${SHARED_LIBRARIES}" + SHLIB_LD_LIBS='${LIBS}' + case "x`echo \${VisualStudioVersion}`" in + x1[4-9]*) + lflags="${lflags} -nodefaultlib:libucrt.lib" + ;; + *) + ;; + esac fi - MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -out:\$@" # DLLSUFFIX is separate because it is the building block for # users of tclConfig.sh that may build shared or static. DLLSUFFIX="\${DBGX}.dll" - LIBSUFFIX="\${DBGX}.lib" - LIBFLAGSUFFIX="\${DBGX}" # This is a 2-stage check to make sure we have the 64-bit SDK # We have to know where the SDK is installed. @@ -3785,18 +3722,23 @@ echo "${ECHO_T}using shared flags" >&6 ;; esac if test ! -d "${PATH64}" ; then - { echo "$as_me:$LINENO: WARNING: Could not find 64-bit $MACHINE SDK to enable 64bit mode" >&5 -echo "$as_me: WARNING: Could not find 64-bit $MACHINE SDK to enable 64bit mode" >&2;} - { echo "$as_me:$LINENO: WARNING: Ensure latest Platform SDK is installed" >&5 -echo "$as_me: WARNING: Ensure latest Platform SDK is installed" >&2;} - do64bit="no" - else - echo "$as_me:$LINENO: result: Using 64-bit $MACHINE mode" >&5 -echo "${ECHO_T} Using 64-bit $MACHINE mode" >&6 + { echo "$as_me:$LINENO: WARNING: Could not find 64-bit $MACHINE SDK" >&5 +echo "$as_me: WARNING: Could not find 64-bit $MACHINE SDK" >&2;} fi + echo "$as_me:$LINENO: result: Using 64-bit $MACHINE mode" >&5 +echo "${ECHO_T} Using 64-bit $MACHINE mode" >&6 fi - LIBS="netapi32.lib kernel32.lib user32.lib advapi32.lib ws2_32.lib" + LIBS="user32.lib advapi32.lib ws2_32.lib" + + case "x`echo \${VisualStudioVersion}`" in + x1[4-9]*) + LIBS="$LIBS ucrt.lib" + ;; + *) + ;; + esac + if test "$do64bit" != "no" ; then # The space-based-path will work for the Makefile, but will # not work if AC_TRY_COMPILE is called. TEA has the @@ -3871,7 +3813,7 @@ fi CFLAGS_DEBUG="-nologo -Zi -Od ${runtime}d" # Do not use -O2 for Win64 - this has proved buggy in code gen. CFLAGS_OPTIMIZE="-nologo -O1 ${runtime}" - lflags="-nologo -MACHINE:${MACHINE} -LIBPATH:\"${MSSDK}/Lib/${MACHINE}\"" + lflags="${lflags} -nologo -MACHINE:${MACHINE} -LIBPATH:\"${MSSDK}/Lib/${MACHINE}\"" LINKBIN="\"${PATH64}/link.exe\"" # Avoid 'unresolved external symbol __security_cookie' errors. # c.f. http://support.microsoft.com/?id=894573 @@ -3883,7 +3825,7 @@ fi CFLAGS_DEBUG="-nologo -Z7 -Od -WX ${runtime}d" # -O2 - create fast code (/Og /Oi /Ot /Oy /Ob2 /Gs /GF /Gy) CFLAGS_OPTIMIZE="-nologo -O2 ${runtime}" - lflags="-nologo" + lflags="${lflags} -nologo" LINKBIN="link" fi @@ -3994,7 +3936,6 @@ _ACEOF 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 @@ -4003,6 +3944,7 @@ _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="" @@ -4329,66 +4271,6 @@ _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 - - ZLIB_LIBS=\${ZLIB_DIR}/win64/zdll.lib - - -else - - ZLIB_LIBS=\${ZLIB_DIR}/win32/zdll.lib - - -fi - - -else - - ZLIB_OBJS=\${ZLIB_OBJS} - - cat >>confdefs.h <<_ACEOF -#define NO_VIZ 1 -_ACEOF - - -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 @@ -4660,7 +4542,6 @@ _ACEOF fi - #-------------------------------------------------------------------- # Perform additinal compiler tests. #-------------------------------------------------------------------- @@ -4738,217 +4619,6 @@ _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 @@ -5101,21 +4771,23 @@ TCL_SHARED_LIB_SUFFIX="\${NODOT_VERSION}${DLLSUFFIX}" TCL_UNSHARED_LIB_SUFFIX="\${NODOT_VERSION}${LIBSUFFIX}" TCL_EXPORT_FILE_SUFFIX="\${NODOT_VERSION}${LIBSUFFIX}" -eval "TCL_SRC_DIR=\"`cd $srcdir/..; pwd`\"" +eval "TCL_SRC_DIR=\"`cd $srcdir/..; $CYGPATH $(pwd)`\"" eval "TCL_DLL_FILE=tcl${VER}${DLLSUFFIX}" +eval "TCL_LIB_FILE=${LIBPREFIX}tcl$VER${LIBSUFFIX}" + +eval "TCL_LIB_FLAG=\"-ltcl${VER}${LIBFLAGSUFFIX}\"" +eval "TCL_BUILD_LIB_SPEC=\"-L`$CYGPATH $(pwd)` ${TCL_LIB_FLAG}\"" +eval "TCL_LIB_SPEC=\"-L${libdir} ${TCL_LIB_FLAG}\"" + eval "TCL_STUB_LIB_FILE=\"${LIBPREFIX}tclstub${VER}${LIBSUFFIX}\"" eval "TCL_STUB_LIB_FLAG=\"-ltclstub${VER}${LIBFLAGSUFFIX}\"" -eval "TCL_BUILD_STUB_LIB_SPEC=\"-L`pwd` ${TCL_STUB_LIB_FLAG}\"" +eval "TCL_BUILD_STUB_LIB_SPEC=\"-L`$CYGPATH $(pwd)` ${TCL_STUB_LIB_FLAG}\"" eval "TCL_STUB_LIB_SPEC=\"-L${libdir} ${TCL_STUB_LIB_FLAG}\"" -eval "TCL_BUILD_STUB_LIB_PATH=\"`pwd`/${TCL_STUB_LIB_FILE}\"" +eval "TCL_BUILD_STUB_LIB_PATH=\"`$CYGPATH $(pwd)`/${TCL_STUB_LIB_FILE}\"" eval "TCL_STUB_LIB_PATH=\"${libdir}/${TCL_STUB_LIB_FILE}\"" -eval "TCL_LIB_FILE=\"${LIBPREFIX}tcl${VER}${LIBSUFFIX}\"" -eval "TCL_BUILD_LIB_SPEC=\"-L`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}\"" @@ -5161,10 +4833,17 @@ 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 @@ -5228,6 +4907,7 @@ fi + # empty on win, but needs sub'ing @@ -5254,7 +4934,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 @@ -5808,6 +5488,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; }; };; @@ -5914,25 +5595,18 @@ 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 @@ -5969,6 +5643,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 diff --git a/win/configure.in b/win/configure.in index e74a745..6b30162 100644 --- a/win/configure.in +++ b/win/configure.in @@ -11,29 +11,22 @@ AC_PREREQ(2.59) # /bin/sh. The bash shell seems to suffer from some strange failures. SHELL=/bin/sh -TCL_VERSION=9.0 -TCL_MAJOR_VERSION=9 -TCL_MINOR_VERSION=0 -TCL_PATCH_LEVEL="a0" +TCL_VERSION=8.5 +TCL_MAJOR_VERSION=8 +TCL_MINOR_VERSION=5 +TCL_PATCH_LEVEL=".18" VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION -TCL_DDE_VERSION=1.4 +TCL_DDE_VERSION=1.3 TCL_DDE_MAJOR_VERSION=1 -TCL_DDE_MINOR_VERSION=4 +TCL_DDE_MINOR_VERSION=3 DDEVER=$TCL_DDE_MAJOR_VERSION$TCL_DDE_MINOR_VERSION -TCL_REG_VERSION=1.3 +TCL_REG_VERSION=1.2 TCL_REG_MAJOR_VERSION=1 -TCL_REG_MINOR_VERSION=3 +TCL_REG_MINOR_VERSION=2 REGVER=$TCL_REG_MAJOR_VERSION$TCL_REG_MINOR_VERSION -PKG_CFG_ARGS=$@ - -#------------------------------------------------------------------------ -# Empty slate for bundled packages, to avoid stale configuration -#------------------------------------------------------------------------ -rm -Rf pkgs - #------------------------------------------------------------------------ # Handle the --prefix=... option #------------------------------------------------------------------------ @@ -105,40 +98,6 @@ SC_ENABLE_SHARED 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"], [ - 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_UNQUOTED(NO_VIZ, 1) -]) -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, [ @@ -170,7 +129,6 @@ AC_CHECK_TYPE([uintptr_t], [ type wide enough to hold a pointer.]) fi ]) - #-------------------------------------------------------------------- # Perform additinal compiler tests. #-------------------------------------------------------------------- @@ -198,65 +156,6 @@ if test "$tcl_cv_findex_enums" = "no"; then [Defined when enums are missing from winbase.h]) fi -# See if the compiler supports intrinsics. - -AC_CACHE_CHECK(for intrinsics support in compiler, - tcl_cv_intrinsics, -AC_TRY_LINK([ -#define WIN32_LEAN_AND_MEAN -#include <windows.h> -#undef WIN32_LEAN_AND_MEAN -#include <intrin.h> -], -[ - __cpuidex(0,0,0); -], - tcl_cv_intrinsics=yes, - tcl_cv_intrinsics=no) -) -if test "$tcl_cv_intrinsics" = "yes"; then - AC_DEFINE(HAVE_INTRIN_H, 1, - [Defined when the compilers supports intrinsics]) -fi - -# See if the <wspiapi.h> header file is present - -AC_CACHE_CHECK(for wspiapi.h, - tcl_cv_wspiapi_h, -AC_TRY_COMPILE([ -#include <wspiapi.h> -], [], - tcl_cv_wspiapi_h=yes, - tcl_cv_wspiapi_h=no) -) -if test "$tcl_cv_wspiapi_h" = "yes"; then - AC_DEFINE(HAVE_WSPIAPI_H, 1, - [Defined when wspiapi.h exists]) -fi - -# See if declarations like FINDEX_INFO_LEVELS are -# missing from winbase.h. This is known to be -# a problem with VC++ 5.2. - -AC_CACHE_CHECK(for FINDEX_INFO_LEVELS in winbase.h, - tcl_cv_findex_enums, -AC_TRY_COMPILE([ -#define WIN32_LEAN_AND_MEAN -#include <windows.h> -#undef WIN32_LEAN_AND_MEAN -], -[ - FINDEX_INFO_LEVELS i; - FINDEX_SEARCH_OPS j; -], - tcl_cv_findex_enums=yes, - tcl_cv_findex_enums=no) -) -if test "$tcl_cv_findex_enums" = "no"; then - AC_DEFINE(HAVE_NO_FINDEX_ENUMS, 1, - [Defined when enums are missing from winbase.h]) -fi - #-------------------------------------------------------------------- # Set the default compiler switches based on the --enable-symbols # option. This macro depends on C flags, and should be called @@ -287,21 +186,23 @@ TCL_SHARED_LIB_SUFFIX="\${NODOT_VERSION}${DLLSUFFIX}" TCL_UNSHARED_LIB_SUFFIX="\${NODOT_VERSION}${LIBSUFFIX}" TCL_EXPORT_FILE_SUFFIX="\${NODOT_VERSION}${LIBSUFFIX}" -eval "TCL_SRC_DIR=\"`cd $srcdir/..; pwd`\"" +eval "TCL_SRC_DIR=\"`cd $srcdir/..; $CYGPATH $(pwd)`\"" eval "TCL_DLL_FILE=tcl${VER}${DLLSUFFIX}" +eval "TCL_LIB_FILE=${LIBPREFIX}tcl$VER${LIBSUFFIX}" + +eval "TCL_LIB_FLAG=\"-ltcl${VER}${LIBFLAGSUFFIX}\"" +eval "TCL_BUILD_LIB_SPEC=\"-L`$CYGPATH $(pwd)` ${TCL_LIB_FLAG}\"" +eval "TCL_LIB_SPEC=\"-L${libdir} ${TCL_LIB_FLAG}\"" + eval "TCL_STUB_LIB_FILE=\"${LIBPREFIX}tclstub${VER}${LIBSUFFIX}\"" eval "TCL_STUB_LIB_FLAG=\"-ltclstub${VER}${LIBFLAGSUFFIX}\"" -eval "TCL_BUILD_STUB_LIB_SPEC=\"-L`pwd` ${TCL_STUB_LIB_FLAG}\"" +eval "TCL_BUILD_STUB_LIB_SPEC=\"-L`$CYGPATH $(pwd)` ${TCL_STUB_LIB_FLAG}\"" eval "TCL_STUB_LIB_SPEC=\"-L${libdir} ${TCL_STUB_LIB_FLAG}\"" -eval "TCL_BUILD_STUB_LIB_PATH=\"`pwd`/${TCL_STUB_LIB_FILE}\"" +eval "TCL_BUILD_STUB_LIB_PATH=\"`$CYGPATH $(pwd)`/${TCL_STUB_LIB_FILE}\"" eval "TCL_STUB_LIB_PATH=\"${libdir}/${TCL_STUB_LIB_FILE}\"" -eval "TCL_LIB_FILE=\"${LIBPREFIX}tcl${VER}${LIBSUFFIX}\"" -eval "TCL_BUILD_LIB_SPEC=\"-L`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}\"" @@ -347,19 +248,26 @@ 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) @@ -410,6 +318,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) @@ -440,7 +349,7 @@ 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; diff --git a/win/makefile.bc b/win/makefile.bc index bd71169..6421682 100644 --- a/win/makefile.bc +++ b/win/makefile.bc @@ -1,587 +1,597 @@ -# -# Makefile for Borland C++ 5.5 (or C++ Builder 5), adapted from the makefile -# for Visual C++ that came with tcl 8.3.3 -# -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# Copyright (c) 1995-1996 Sun Microsystems, Inc. -# Copyright (c) 1998-1999 by Scriptics Corporation. - -# TIP #59 information. -# -# This makefile does not set the following configuration cpp -# defines. Behind the defines are the makefile variables listed to set -# to -D... when that feature is enabled. -# -# - TCL_CFG_PROFILED PROFDEFINES -# - TCL_CFG_OPTIMIZED OPTDEFINES -# - TCL_CFG_DO64BIT SIXFOURDEFINES - -# Have a look at the complete description on how to build and test Tcl with -# the current Borland compilers at www.ratiosoft.com/tcl/borland. -# -# Usage: -# - Adapt the paths below to match your compiler's location -# - Make sure the compiler's bin directory is on your path -# - Open a console -# - To make a debug version enter -# make -fmakefile.bc -DNODEBUG=0 xxx -# where 'xxx' is the target you want (e.g. 'all', 'test', ...) -# Please note: I omitted the 'd' suffix for debug versions because Tcl -# will always call tclpip83.dll and not tclpip83d.dll, causing an error. -# ^ -# Besides, the debug version goes into a separate directory, so there -# should be no problem having DLLs and EXEs with the same name. -# If you prefer your debug version having the 'd' suffix just uncomment -# the line -# #DBGX = d -# -# - To make a 'normal' version enter -# make -fmakefile.bc xxx -# where 'xxx' is the target you want (e.g. 'all', 'test', ...) -# -# DISCLAIMER: -# This makefile has an experimental status - that is those targets which -# have been modified do in fact compile and link with Borland's C++ -# Builder 5 and with the free Borland compiler (Borland C++ 5.5). -# However the author assumes no responsiblity for any effect which the use of -# this makefile or of the resulting programs might have on your system. -# -# Not yet modified: -# - The 'plug-in-DLL' and the associated shell. -# -# Suggestions and / or improvements are always welcome. -# -# May 2001, H. Giese (hgiese@ratiosoft.com) -# - -# Does not depend on the presence of any environment variables in -# order to compile tcl; all needed information is derived from -# location of the compiler directories. - -# -# Project directories -# -# ROOT = top of source tree -# -# TOOLS32 = location of Borland development tools. -# -# INSTALLDIR = where the install-targets should copy the binaries and -# support files -# - -ROOT = .. -INSTALLDIR = c:\program files\tcl - -# If you have C++ Builder 5 or the free Borland C++ 5.5 compiler -# adapt the following paths as appropriate for your system -TOOLS32 = c:\dev\bcc55 -TOOLS32_rc = c:\dev\bcc55 -#TOOLS32 = c:\bc55 -#TOOLS32_rc = c:\bc55 - -cc32 = "$(TOOLS32)\bin\bcc32.exe" -link32 = "$(TOOLS32)\bin\ilink32.exe" -lib32 = "$(TOOLS32)\bin\tlib.exe" -rc32 = "$(TOOLS32_rc)\bin\brcc32.exe" -include32 = -I"$(TOOLS32)\include" -libpath32 = -L"$(TOOLS32)\lib" - -# Uncomment the following line to compile with thread support -#THREADDEFINES = -DTCL_THREADS=1 - -# Allow definition of NDEBUG via command line -# Set NODEBUG to 0 to compile with symbols -!if !defined(NODEBUG) -NODEBUG = 1 -!endif - -# CFG_ENCODING=encoding -# name of encoding for configuration information. Defaults -# to cp1252 -!if !defined(CFG_ENCODING) -CFG_ENCODING = \"cp1252\" -!endif - -# The following defines can be used to control the amount of debugging -# code that is added to the compilation. -# -# -DTCL_MEM_DEBUG Enables the debugging memory allocator. -# -DTCL_COMPILE_DEBUG Enables byte compilation logging. -# -DTCL_COMPILE_STATS Enables byte compilation statistics gathering. -# -DUSE_TCLALLOC=0 Disables the Tcl memory allocator in favor -# of the native malloc implementation. This is -# needed when using Purify. -# -#DEBUGDEFINES = -DTCL_MEM_DEBUG -DTCL_COMPILE_DEBUG -DTCL_COMPILE_STATS -#DEBUGDEFINES = -DUSE_TCLALLOC=0 - -###################################################################### -# Do not modify below this line -###################################################################### - -NAMEPREFIX = tcl -STUBPREFIX = $(NAMEPREFIX)stub -DOTVERSION = 9.0 -VERSION = 90 - -DDEVERSION = 14 -DDEDOTVERSION = 1.4 - -REGVERSION = 13 -REGDOTVERSION = 1.3 - -BINROOT = .. -!IF "$(NODEBUG)" == "1" -TMPDIRNAME = Release -DBGX = -SYMDEFINES = -DNDEBUG -!ELSE -TMPDIRNAME = Debug -#DBGX = d -DBGX = -SYMDEFINES = -DTCL_CFG_DEBUG -!ENDIF -TMPDIR = $(BINROOT)\$(TMPDIRNAME) -OUTDIRNAME = $(TMPDIRNAME) -OUTDIR = $(TMPDIR) - -TCLLIB = $(OUTDIR)\$(NAMEPREFIX)$(VERSION)$(DBGX).lib -TCLDLLNAME = $(NAMEPREFIX)$(VERSION)$(DBGX).dll -TCLDLL = $(OUTDIR)\$(TCLDLLNAME) - -TCLSTUBLIBNAME = $(STUBPREFIX)$(VERSION)$(DBGX).lib -TCLSTUBLIB = $(OUTDIR)\$(TCLSTUBLIBNAME) - -TCLPLUGINLIB = $(OUTDIR)\$(NAMEPREFIX)$(VERSION)p$(DBGX).lib -TCLPLUGINDLLNAME = $(NAMEPREFIX)$(VERSION)p$(DBGX).dll -TCLPLUGINDLL = $(OUTDIR)\$(TCLPLUGINDLLNAME) -TCLSH = $(OUTDIR)\$(NAMEPREFIX)sh$(VERSION)$(DBGX).exe -TCLSHP = $(OUTDIR)\$(NAMEPREFIX)shp$(VERSION)$(DBGX).exe -TCLREGDLLNAME = $(NAMEPREFIX)reg$(REGVERSION)$(DBGX).dll -TCLREGDLL = $(OUTDIR)\$(TCLREGDLLNAME) -TCLDDEDLLNAME = $(NAMEPREFIX)dde$(DDEVERSION)$(DBGX).dll -TCLDDEDLL = $(OUTDIR)\$(TCLDDEDLLNAME) -TCLTEST = $(OUTDIR)\$(NAMEPREFIX)test.exe -CAT32 = $(TMPDIR)\cat32.exe -RMDIR = .\rmd.bat -MKDIR = .\mkd.bat -RM = del - -LIB_INSTALL_DIR = $(INSTALLDIR)\lib -BIN_INSTALL_DIR = $(INSTALLDIR)\bin -SCRIPT_INSTALL_DIR = $(INSTALLDIR)\lib\tcl$(DOTVERSION) -INCLUDE_INSTALL_DIR = $(INSTALLDIR)\include - -TCLSHOBJS = \ - $(TMPDIR)\tclAppInit.obj - -TCLTESTOBJS = \ - $(TMPDIR)\tclTest.obj \ - $(TMPDIR)\tclTestObj.obj \ - $(TMPDIR)\tclTestProcBodyObj.obj \ - $(TMPDIR)\tclThreadTest.obj \ - $(TMPDIR)\tclWinTest.obj \ - $(TMPDIR)\testMain.obj - -TCLOBJS = \ - $(TMPDIR)\regcomp.obj \ - $(TMPDIR)\regexec.obj \ - $(TMPDIR)\regfree.obj \ - $(TMPDIR)\regerror.obj \ - $(TMPDIR)\tclAlloc.obj \ - $(TMPDIR)\tclAsync.obj \ - $(TMPDIR)\tclBasic.obj \ - $(TMPDIR)\tclBinary.obj \ - $(TMPDIR)\tclCkalloc.obj \ - $(TMPDIR)\tclClock.obj \ - $(TMPDIR)\tclCmdAH.obj \ - $(TMPDIR)\tclCmdIL.obj \ - $(TMPDIR)\tclCmdMZ.obj \ - $(TMPDIR)\tclCompCmds.obj \ - $(TMPDIR)\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 \ - $(TMPDIR)\tclFCmd.obj \ - $(TMPDIR)\tclFileName.obj \ - $(TMPDIR)\tclGet.obj \ - $(TMPDIR)\tclHash.obj \ - $(TMPDIR)\tclHistory.obj \ - $(TMPDIR)\tclIndexObj.obj \ - $(TMPDIR)\tclInterp.obj \ - $(TMPDIR)\tclIO.obj \ - $(TMPDIR)\tclIOCmd.obj \ - $(TMPDIR)\tclIOGT.obj \ - $(TMPDIR)\tclIOSock.obj \ - $(TMPDIR)\tclIOUtil.obj \ - $(TMPDIR)\tclLink.obj \ - $(TMPDIR)\tclLiteral.obj \ - $(TMPDIR)\tclListObj.obj \ - $(TMPDIR)\tclLoad.obj \ - $(TMPDIR)\tclMain.obj \ - $(TMPDIR)\tclNamesp.obj \ - $(TMPDIR)\tclNotify.obj \ - $(TMPDIR)\tclOO.obj \ - $(TMPDIR)\tclOOBasic.obj \ - $(TMPDIR)\tclOOCall.obj \ - $(TMPDIR)\tclOODefineCmds.obj \ - $(TMPDIR)\tclOOInfo.obj \ - $(TMPDIR)\tclOOMethod.obj \ - $(TMPDIR)\tclOOStubInit.obj \ - $(TMPDIR)\tclObj.obj \ - $(TMPDIR)\tclPanic.obj \ - $(TMPDIR)\tclParse.obj \ - $(TMPDIR)\tclPipe.obj \ - $(TMPDIR)\tclPkg.obj \ - $(TMPDIR)\tclPkgConfig.obj \ - $(TMPDIR)\tclPosixStr.obj \ - $(TMPDIR)\tclPreserve.obj \ - $(TMPDIR)\tclProc.obj \ - $(TMPDIR)\tclRegexp.obj \ - $(TMPDIR)\tclResolve.obj \ - $(TMPDIR)\tclResult.obj \ - $(TMPDIR)\tclScan.obj \ - $(TMPDIR)\tclStringObj.obj \ - $(TMPDIR)\tclStubInit.obj \ - $(TMPDIR)\tclThread.obj \ - $(TMPDIR)\tclThreadJoin.obj \ - $(TMPDIR)\tclTimer.obj \ - $(TMPDIR)\tclTrace.obj \ - $(TMPDIR)\tclUtf.obj \ - $(TMPDIR)\tclUtil.obj \ - $(TMPDIR)\tclVar.obj \ - $(TMPDIR)\tclWin32Dll.obj \ - $(TMPDIR)\tclWinChan.obj \ - $(TMPDIR)\tclWinConsole.obj \ - $(TMPDIR)\tclWinSerial.obj \ - $(TMPDIR)\tclWinError.obj \ - $(TMPDIR)\tclWinFCmd.obj \ - $(TMPDIR)\tclWinFile.obj \ - $(TMPDIR)\tclWinInit.obj \ - $(TMPDIR)\tclWinLoad.obj \ - $(TMPDIR)\tclWinNotify.obj \ - $(TMPDIR)\tclWinPipe.obj \ - $(TMPDIR)\tclWinSock.obj \ - $(TMPDIR)\tclWinThrd.obj \ - $(TMPDIR)\tclWinTime.obj \ - $(TMPDIR)\tclZlib.obj - -TCLSTUBOBJS = \ - $(TMPDIR)\tclStubLib.obj \ - $(TMPDIR)\tclTomMathStubLib.obj \ - $(TMPDIR)\tclOOStubLib.obj - -WINDIR = $(ROOT)\win -GENERICDIR = $(ROOT)\generic - -TCL_INCLUDES = -I"$(WINDIR)" -I"$(GENERICDIR)" -TCL_DEFINES = $(DEBUGDEFINES) $(THREADDEFINES) $(SYMDEFINES) \ - $(PROFDEFINES) $(OPTDEFINES) $(SIXFOURDEFINES) \ - -DTCL_CFGVAL_ENCODING=${CFG_ENCODING} -### TODO: Add -DHAVE_ZLIB=1 - -###################################################################### -# Compiler flags -###################################################################### - -!IF "$(NODEBUG)" == "1" -# these macros cause maximum optimization and no symbols -cdebug = -v- -vi- -O2 -D_DEBUG -!ELSE -# these macros enable debugging -cdebug = -k -Od -r- -v -vi- -y -!ENDIF - -SYSDEFINES = _MT;NO_STRICT;_NO_VCL - -# declarations common to all compiler options -cbase = -c -q -3 -a4 -g0 -tWM -Ve -Vx -X- -WARNINGS = -w-rch -w-pch -w-par -w-dup -w-pro -w-dpu - -ccons = -tWC - -INCLUDEPATH = $(include32) $(TCL_INCLUDES) - -CFLAGS = $(cdebug) $(cbase) $(INCLUDEPATH) $(WARNINGS) -D$(SYSDEFINES) -TCL_CFLAGS = $(CFLAGS) $(TCL_DEFINES) -CONS_CFLAGS = $(CFLAGS) $(TCL_DEFINES) $(ccons) - -###################################################################### -# Linker flags -###################################################################### - -!IF "$(NODEBUG)" == "1" -ldebug = -!ELSE -ldebug = -v -!ENDIF - -# declarations common to all linker options -LNFLAGS = -D"" -Gn -I$(TMPDIR) -x $(ldebug) $(libpath32) -# -Gi: create lib file (is -Gl in doc) -# -aa: Windows app, -ap: Windows console app -LNFLAGS_DLL = -ap -Gi -Tpd -LNFLAGS_CONS = -ap -Tpe - -LNLIBS = import32 cw32mt - - -###################################################################### -# Project specific targets -###################################################################### - -release: setup $(TCLSH) dlls -dlls: setup $(TCLREGDLL) $(TCLDDEDLL) -all: setup $(TCLSH) dlls $(CAT32) -tcltest: setup $(TCLTEST) dlls $(CAT32) -plugin: setup $(TCLPLUGINDLL) $(TCLSHP) -install: install-binaries install-libraries - -test: setup $(TCLTEST) dlls $(CAT32) - set TCL_LIBRARY=$(ROOT)/library - $(TCLTEST) $(ROOT)/tests/all.tcl - -setup: - @if not exist $(OUT_DIR)\nul mkdir $(OUT_DIR) &\ - echo *** Created directory '$(OUT_DIR)' - @if not exist $(TMP_DIR)\nul mkdir $(TMP_DIR) &\ - echo *** Created directory '$(TMP_DIR)' - - -$(TCLLIB): $(TCLDLL) - -$(TCLDLL): $(TCLOBJS) $(TMPDIR)\$(NAMEPREFIX).res - $(link32) $(ldebug) $(LNFLAGS) $(LNFLAGS_DLL) $(TOOLS32)\lib\c0d32 @&&! - $(TCLOBJS), $@, -x, $(LNLIBS),, $(TMPDIR)\$(NAMEPREFIX).res -! - -$(TCLSTUBLIB): $(TCLSTUBOBJS) - $(lib32) /u $@ $(TCLSTUBOBJS) - -$(TCLPLUGINLIB): $(TCLPLUGINDLL) - -$(TCLPLUGINDLL): $(TCLOBJS) $(TMPDIR)\tcl.res - $(link32) $(ldebug) $(dlllflags) \ - -out:$@ $(TMPDIR)\tcl.res $(guilibsdll) @&&! -$(TCLOBJS) -! - -$(TCLSH): $(TCLSHOBJS) $(TCLLIB) $(TMPDIR)\$(NAMEPREFIX)sh.res - $(link32) $(ldebug) -S:2400000 $(LNFLAGS) $(LNFLAGS_CONS) $(TOOLS32)\lib\c0x32 @&&! - $(TCLSHOBJS), $@, -x, $(LNLIBS) $(TCLLIB),, $(TMPDIR)\$(NAMEPREFIX)sh.res -! - -$(TCLSHP): $(TCLSHOBJS) $(TCLPLUGINLIB) $(TMPDIR)\tclsh.res - $(link32) $(ldebug) $(conlflags) $(TMPDIR)\tclsh.res -stack:2300000 \ - -out:$@ $(conlibsdll) $(TCLPLUGINLIB) $(TCLSHOBJS) - -$(TCLTEST): $(TCLTESTOBJS) $(TCLLIB) $(TMPDIR)\$(NAMEPREFIX)sh.res - $(link32) $(ldebug) -S:2400000 $(LNFLAGS) $(LNFLAGS_CONS) $(TOOLS32)\lib\c0x32 @&&! - $(TCLTESTOBJS), $@, -x, $(LNLIBS) $(TCLLIB),, $(TMPDIR)\$(NAMEPREFIX)sh.res -! - -$(TCLDDEDLL): $(TMPDIR)\tclWinDde.obj $(TCLSTUBLIB) - $(link32) $(ldebug) $(LNFLAGS) $(LNFLAGS_DLL) $(TOOLS32)\lib\c0d32 \ - $(TMPDIR)\tclWinDde.obj, $@, -x, $(LNLIBS) $(TCLSTUBLIB),, \ - $(TMPDIR)\$(NAMEPREFIX).res - -$(TCLREGDLL): $(TMPDIR)\tclWinReg.obj $(TCLSTUBLIB) - $(link32) $(ldebug) $(LNFLAGS) $(LNFLAGS_DLL) $(TOOLS32)\lib\c0d32 \ - $(TMPDIR)\tclWinReg.obj, $@, -x, $(LNLIBS) $(TCLSTUBLIB),, \ - $(TMPDIR)\$(NAMEPREFIX).res - -$(CAT32): $(WINDIR)\cat.c - $(cc32) $(CONS_CFLAGS) -o$(TMPDIR)\cat.obj $? - $(link32) $(ldebug) $(LNFLAGS) $(LNFLAGS_CONS) $(TOOLS32)\lib\c0x32 \ - $(TMPDIR)\cat.obj, $@, -x, $(LNLIBS),, - -install-binaries: $(TCLSH) - $(MKDIR) "$(BIN_INSTALL_DIR)" - $(MKDIR) "$(LIB_INSTALL_DIR)" - @echo installing $(TCLDLLNAME) - @copy "$(TCLDLL)" "$(BIN_INSTALL_DIR)" - @copy "$(TCLLIB)" "$(LIB_INSTALL_DIR)" - @echo installing "$(TCLSH)" - @copy "$(TCLSH)" "$(BIN_INSTALL_DIR)" - @echo installing $(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 - -@$(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.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.5 - -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\msgcat1.5" - -@copy "$(ROOT)\library\msgcat\msgcat.tcl" "$(SCRIPT_INSTALL_DIR)\msgcat1.5" - -@copy "$(ROOT)\library\msgcat\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\msgcat1.5" - @echo installing tcltest2.3 - -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\tcltest2.3" - -@copy "$(ROOT)\library\tcltest\tcltest.tcl" "$(SCRIPT_INSTALL_DIR)\tcltest2.3" - -@copy "$(ROOT)\library\tcltest\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\tcltest2.3" - @echo installing platform1.0 - -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\platform1.0" - -@copy "$(ROOT)\library\platform\platform.tcl" "$(SCRIPT_INSTALL_DIR)\platform1.0" - -@copy "$(ROOT)\library\platform\shell.tcl" "$(SCRIPT_INSTALL_DIR)\platform1.0" - -@copy "$(ROOT)\library\platform\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\platform1.0" - @echo installing $(TCLDDEDLLNAME) - -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\dde1.3" - -@copy "$(TCLDDEDLL)" "$(SCRIPT_INSTALL_DIR)\dde1.3" - -@copy "$(ROOT)\library\dde\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\dde1.3" - @echo installing $(TCLREGDLLNAME) - -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\reg1.2" - -@copy "$(TCLREGDLL)" "$(SCRIPT_INSTALL_DIR)\reg1.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 - -@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)" - -@copy "$(ROOT)\library\parray.tcl" "$(SCRIPT_INSTALL_DIR)" - -@copy "$(ROOT)\library\safe.tcl" "$(SCRIPT_INSTALL_DIR)" - -@copy "$(ROOT)\library\tclIndex" "$(SCRIPT_INSTALL_DIR)" - -@copy "$(ROOT)\library\package.tcl" "$(SCRIPT_INSTALL_DIR)" - -@copy "$(ROOT)\library\word.tcl" "$(SCRIPT_INSTALL_DIR)" - -@copy "$(ROOT)\library\auto.tcl" "$(SCRIPT_INSTALL_DIR)" - -# -# Regenerate the stubs files. -# - -genstubs: - tclsh$(VERSION) $(ROOT)\tools\genStubs.tcl $(GENERICDIR) \ - $(GENERICDIR)\tcl.decls $(GENERICDIR)\tclInt.decls - -# -# Special case object file targets -# -$(TMPDIR)\tclWinInit.obj: $(WINDIR)\tclWinInit.c - $(cc32) -DBUILD_tcl $(TCL_CFLAGS) -o$(TMPDIR)\$@ $? - -$(TMPDIR)\testMain.obj: $(WINDIR)\tclAppInit.c - $(cc32) $(TCL_CFLAGS) -DTCL_TEST -o$(TMPDIR)\testMain.obj $? - -$(TMPDIR)\tclTest.obj: $(GENERICDIR)\tclTest.c - $(cc32) $(TCL_CFLAGS) -o$(TMPDIR)\$@ $? - -$(TMPDIR)\tclTestObj.obj: $(GENERICDIR)\tclTestObj.c - $(cc32) $(TCL_CFLAGS) -o$(TMPDIR)\$@ $? - -$(TMPDIR)\tclWinTest.obj: $(WINDIR)\tclWinTest.c - $(cc32) $(TCL_CFLAGS) -o$(TMPDIR)\$@ $? - -$(TMP_DIR)\tclPkgConfig.obj: $(GENERICDIR)\tclPkgConfig.c - $(cc32) $(TCL_CFLAGS) \ - -DCFG_INSTALL_EXEC_PREFIX=\"$(INSTALL_EXEC_PREFIX)\" \ - -DCFG_INSTALL_PREFIX=\"$(INSTALL_PREFIX)\" \ - -DCFG_RUNTIME_EXEC_PREFIX=\"$(RUNTIME_EXEC_PREFIX)\" \ - -DCFG_RUNTIME_PREFIX=\"$(RUNTIME_PREFIX)\" \ - -o$(TMPDIR)\$@ $? - -$(TMPDIR)\tclAppInit.obj : $(WINDIR)\tclAppInit.c - $(cc32) $(TCL_CFLAGS) -o$(TMPDIR)\$@ $? - -# The following objects should be built using the stub interfaces - -# tclWinReg: Produces errors in ANSI mode -$(TMPDIR)\tclWinReg.obj : $(WINDIR)\tclWinReg.c - $(cc32) $(TCL_CFLAGS) -DUSE_TCL_STUBS -o$(TMPDIR)\$@ $? - -# tclWinDde: Produces errors in ANSI mode -$(TMPDIR)\tclWinDde.obj : $(WINDIR)\tclWinDde.c - $(cc32) $(TCL_CFLAGS) -DUSE_TCL_STUBS -o$(TMPDIR)\$@ $? - - -# The following objects are part of the stub library and should not -# be built as DLL objects but none of the symbols should be exported - -$(TMPDIR)\tclStubLib.obj : $(GENERICDIR)\tclStubLib.c - $(cc32) $(TCL_CFLAGS) -DSTATIC_BUILD -o$(TMPDIR)\$@ $? - -$(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 - -$(GENERICDIR)\regcomp.c: \ - $(GENERICDIR)\regguts.h \ - $(GENERICDIR)\regc_lex.c \ - $(GENERICDIR)\regc_color.c \ - $(GENERICDIR)\regc_nfa.c \ - $(GENERICDIR)\regc_cvec.c \ - $(GENERICDIR)\regc_locale.c - -$(GENERICDIR)\regcustom.h: \ - $(GENERICDIR)\tclInt.h \ - $(GENERICDIR)\tclPort.h \ - $(GENERICDIR)\regex.h - -$(GENERICDIR)\regexec.c: \ - $(GENERICDIR)\rege_dfa.c \ - $(GENERICDIR)\regguts.h - -$(GENERICDIR)\regerror.c: $(GENERICDIR)\regguts.h -$(GENERICDIR)\regfree.c: $(GENERICDIR)\regguts.h -$(GENERICDIR)\regfronts.c: $(GENERICDIR)\regguts.h -$(GENERICDIR)\regguts.h: $(GENERICDIR)\regcustom.h - -# -# Implicit rules -# - -{$(WINDIR)}.c{$(TMPDIR)}.obj: - $(cc32) -DBUILD_tcl $(TCL_CFLAGS) -o$@ $< - -{$(GENERICDIR)}.c{$(TMPDIR)}.obj: - $(cc32) -DBUILD_tcl $(TCL_CFLAGS) -o$@ $< - -{$(ROOT)\compat}.c{$(TMPDIR)}.obj: - $(cc32) -DBUILD_tcl $(TCL_CFLAGS) -o$@ $< - -{$(WINDIR)}.rc{$(TMPDIR)}.res: - $(rc32) $(INCLUDEPATH) -D$(USERDEFINES);$(SYSDEFINES) -fo$@ $< - -clean: - -@$(RM) $(OUTDIR)\*.exp - -@$(RM) $(OUTDIR)\*.lib - -@$(RM) $(OUTDIR)\*.dll - -@$(RM) $(OUTDIR)\*.exe - -@$(RM) $(OUTDIR)\*.pdb - -@$(RM) $(TMPDIR)\*.pch - -@$(RM) $(TMPDIR)\*.obj - -@$(RM) $(TMPDIR)\*.res - -@$(RM) $(TMPDIR)\*.exe - -@$(RMDIR) $(OUTDIR) - -@$(RMDIR) $(TMPDIR) +#
+# Makefile for Borland C++ 5.5 (or C++ Builder 5), adapted from the makefile
+# for Visual C++ that came with tcl 8.3.3
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# Copyright (c) 1995-1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+
+# TIP #59 information.
+#
+# This makefile does not set the following configuration cpp
+# defines. Behind the defines are the makefile variables listed to set
+# to -D... when that feature is enabled.
+#
+# - TCL_CFG_PROFILED PROFDEFINES
+# - TCL_CFG_OPTIMIZED OPTDEFINES
+# - TCL_CFG_DO64BIT SIXFOURDEFINES
+
+# Have a look at the complete description on how to build and test Tcl with
+# the current Borland compilers at www.ratiosoft.com/tcl/borland.
+#
+# Usage:
+# - Adapt the paths below to match your compiler's location
+# - Make sure the compiler's bin directory is on your path
+# - Open a console
+# - To make a debug version enter
+# make -fmakefile.bc -DNODEBUG=0 xxx
+# where 'xxx' is the target you want (e.g. 'all', 'test', ...)
+# Please note: I omitted the 'd' suffix for debug versions because Tcl
+# will always call tclpip83.dll and not tclpip83d.dll, causing an error.
+# ^
+# Besides, the debug version goes into a separate directory, so there
+# should be no problem having DLLs and EXEs with the same name.
+# If you prefer your debug version having the 'd' suffix just uncomment
+# the line
+# #DBGX = d
+#
+# - To make a 'normal' version enter
+# make -fmakefile.bc xxx
+# where 'xxx' is the target you want (e.g. 'all', 'test', ...)
+#
+# DISCLAIMER:
+# This makefile has an experimental status - that is those targets which
+# have been modified do in fact compile and link with Borland's C++
+# Builder 5 and with the free Borland compiler (Borland C++ 5.5).
+# However the author assumes no responsiblity for any effect which the use of
+# this makefile or of the resulting programs might have on your system.
+#
+# Not yet modified:
+# - The 'plug-in-DLL' and the associated shell.
+# - The programs to create the windows help files.
+#
+# Suggestions and / or improvements are always welcome.
+#
+# May 2001, H. Giese (hgiese@ratiosoft.com)
+#
+
+# Does not depend on the presence of any environment variables in
+# order to compile tcl; all needed information is derived from
+# location of the compiler directories.
+
+#
+# Project directories
+#
+# ROOT = top of source tree
+#
+# TOOLS32 = location of Borland development tools.
+#
+# INSTALLDIR = where the install-targets should copy the binaries and
+# support files
+#
+
+ROOT = ..
+INSTALLDIR = c:\program files\tcl
+
+# If you have C++ Builder 5 or the free Borland C++ 5.5 compiler
+# adapt the following paths as appropriate for your system
+TOOLS32 = c:\dev\bcc55
+TOOLS32_rc = c:\dev\bcc55
+#TOOLS32 = c:\bc55
+#TOOLS32_rc = c:\bc55
+
+cc32 = "$(TOOLS32)\bin\bcc32.exe"
+link32 = "$(TOOLS32)\bin\ilink32.exe"
+lib32 = "$(TOOLS32)\bin\tlib.exe"
+rc32 = "$(TOOLS32_rc)\bin\brcc32.exe"
+include32 = -I"$(TOOLS32)\include"
+libpath32 = -L"$(TOOLS32)\lib"
+
+# Uncomment the following line to compile with thread support
+#THREADDEFINES = -DTCL_THREADS=1
+
+# Allow definition of NDEBUG via command line
+# Set NODEBUG to 0 to compile with symbols
+!if !defined(NODEBUG)
+NODEBUG = 1
+!endif
+
+# CFG_ENCODING=encoding
+# name of encoding for configuration information. Defaults
+# to cp1252
+!if !defined(CFG_ENCODING)
+CFG_ENCODING = \"cp1252\"
+!endif
+
+# The following defines can be used to control the amount of debugging
+# code that is added to the compilation.
+#
+# -DTCL_MEM_DEBUG Enables the debugging memory allocator.
+# -DTCL_COMPILE_DEBUG Enables byte compilation logging.
+# -DTCL_COMPILE_STATS Enables byte compilation statistics gathering.
+# -DUSE_TCLALLOC=0 Disables the Tcl memory allocator in favor
+# of the native malloc implementation. This is
+# needed when using Purify.
+#
+#DEBUGDEFINES = -DTCL_MEM_DEBUG -DTCL_COMPILE_DEBUG -DTCL_COMPILE_STATS
+#DEBUGDEFINES = -DUSE_TCLALLOC=0
+
+######################################################################
+# Do not modify below this line
+######################################################################
+
+NAMEPREFIX = tcl
+STUBPREFIX = $(NAMEPREFIX)stub
+DOTVERSION = 8.5
+VERSION = 85
+
+DDEVERSION = 13
+DDEDOTVERSION = 1.3
+
+REGVERSION = 12
+REGDOTVERSION = 1.2
+
+BINROOT = ..
+!IF "$(NODEBUG)" == "1"
+TMPDIRNAME = Release
+DBGX =
+SYMDEFINES = -DNDEBUG
+!ELSE
+TMPDIRNAME = Debug
+#DBGX = d
+DBGX =
+SYMDEFINES = -DTCL_CFG_DEBUG
+!ENDIF
+TMPDIR = $(BINROOT)\$(TMPDIRNAME)
+OUTDIRNAME = $(TMPDIRNAME)
+OUTDIR = $(TMPDIR)
+
+TCLLIB = $(OUTDIR)\$(NAMEPREFIX)$(VERSION)$(DBGX).lib
+TCLDLLNAME = $(NAMEPREFIX)$(VERSION)$(DBGX).dll
+TCLDLL = $(OUTDIR)\$(TCLDLLNAME)
+
+TCLSTUBLIBNAME = $(STUBPREFIX)$(VERSION)$(DBGX).lib
+TCLSTUBLIB = $(OUTDIR)\$(TCLSTUBLIBNAME)
+
+TCLPLUGINLIB = $(OUTDIR)\$(NAMEPREFIX)$(VERSION)p$(DBGX).lib
+TCLPLUGINDLLNAME = $(NAMEPREFIX)$(VERSION)p$(DBGX).dll
+TCLPLUGINDLL = $(OUTDIR)\$(TCLPLUGINDLLNAME)
+TCLSH = $(OUTDIR)\$(NAMEPREFIX)sh$(VERSION)$(DBGX).exe
+TCLSHP = $(OUTDIR)\$(NAMEPREFIX)shp$(VERSION)$(DBGX).exe
+TCLPIPEDLLNAME = $(NAMEPREFIX)pip$(VERSION)$(DBGX).dll
+TCLPIPEDLL = $(OUTDIR)\$(TCLPIPEDLLNAME)
+TCLREGDLLNAME = $(NAMEPREFIX)reg$(REGVERSION)$(DBGX).dll
+TCLREGDLL = $(OUTDIR)\$(TCLREGDLLNAME)
+TCLDDEDLLNAME = $(NAMEPREFIX)dde$(DDEVERSION)$(DBGX).dll
+TCLDDEDLL = $(OUTDIR)\$(TCLDDEDLLNAME)
+TCLTEST = $(OUTDIR)\$(NAMEPREFIX)test.exe
+CAT32 = $(TMPDIR)\cat32.exe
+RMDIR = .\rmd.bat
+MKDIR = .\mkd.bat
+RM = del
+
+LIB_INSTALL_DIR = $(INSTALLDIR)\lib
+BIN_INSTALL_DIR = $(INSTALLDIR)\bin
+SCRIPT_INSTALL_DIR = $(INSTALLDIR)\lib\tcl$(DOTVERSION)
+INCLUDE_INSTALL_DIR = $(INSTALLDIR)\include
+
+TCLSHOBJS = \
+ $(TMPDIR)\tclAppInit.obj
+
+TCLTESTOBJS = \
+ $(TMPDIR)\tclTest.obj \
+ $(TMPDIR)\tclTestObj.obj \
+ $(TMPDIR)\tclTestProcBodyObj.obj \
+ $(TMPDIR)\tclThreadTest.obj \
+ $(TMPDIR)\tclWinTest.obj \
+ $(TMPDIR)\testMain.obj
+
+TCLOBJS = \
+ $(TMPDIR)\regcomp.obj \
+ $(TMPDIR)\regexec.obj \
+ $(TMPDIR)\regfree.obj \
+ $(TMPDIR)\regerror.obj \
+ $(TMPDIR)\tclAlloc.obj \
+ $(TMPDIR)\tclAsync.obj \
+ $(TMPDIR)\tclBasic.obj \
+ $(TMPDIR)\tclBinary.obj \
+ $(TMPDIR)\tclCkalloc.obj \
+ $(TMPDIR)\tclClock.obj \
+ $(TMPDIR)\tclCmdAH.obj \
+ $(TMPDIR)\tclCmdIL.obj \
+ $(TMPDIR)\tclCmdMZ.obj \
+ $(TMPDIR)\tclCompCmds.obj \
+ $(TMPDIR)\tclCompExpr.obj \
+ $(TMPDIR)\tclCompile.obj \
+ $(TMPDIR)\tclConfig.obj \
+ $(TMPDIR)\tclDate.obj \
+ $(TMPDIR)\tclDictObj.obj \
+ $(TMPDIR)\tclEncoding.obj \
+ $(TMPDIR)\tclEnv.obj \
+ $(TMPDIR)\tclEvent.obj \
+ $(TMPDIR)\tclExecute.obj \
+ $(TMPDIR)\tclFCmd.obj \
+ $(TMPDIR)\tclFileName.obj \
+ $(TMPDIR)\tclGet.obj \
+ $(TMPDIR)\tclHash.obj \
+ $(TMPDIR)\tclHistory.obj \
+ $(TMPDIR)\tclIndexObj.obj \
+ $(TMPDIR)\tclInterp.obj \
+ $(TMPDIR)\tclIO.obj \
+ $(TMPDIR)\tclIOCmd.obj \
+ $(TMPDIR)\tclIOGT.obj \
+ $(TMPDIR)\tclIOSock.obj \
+ $(TMPDIR)\tclIOUtil.obj \
+ $(TMPDIR)\tclLink.obj \
+ $(TMPDIR)\tclLiteral.obj \
+ $(TMPDIR)\tclListObj.obj \
+ $(TMPDIR)\tclLoad.obj \
+ $(TMPDIR)\tclMain.obj \
+ $(TMPDIR)\tclNamesp.obj \
+ $(TMPDIR)\tclNotify.obj \
+ $(TMPDIR)\tclObj.obj \
+ $(TMPDIR)\tclPanic.obj \
+ $(TMPDIR)\tclParse.obj \
+ $(TMPDIR)\tclPipe.obj \
+ $(TMPDIR)\tclPkg.obj \
+ $(TMPDIR)\tclPkgConfig.obj \
+ $(TMPDIR)\tclPosixStr.obj \
+ $(TMPDIR)\tclPreserve.obj \
+ $(TMPDIR)\tclProc.obj \
+ $(TMPDIR)\tclRegexp.obj \
+ $(TMPDIR)\tclResolve.obj \
+ $(TMPDIR)\tclResult.obj \
+ $(TMPDIR)\tclScan.obj \
+ $(TMPDIR)\tclStringObj.obj \
+ $(TMPDIR)\tclStubInit.obj \
+ $(TMPDIR)\tclStubLib.obj \
+ $(TMPDIR)\tclThread.obj \
+ $(TMPDIR)\tclThreadJoin.obj \
+ $(TMPDIR)\tclTimer.obj \
+ $(TMPDIR)\tclTrace.obj \
+ $(TMPDIR)\tclUtf.obj \
+ $(TMPDIR)\tclUtil.obj \
+ $(TMPDIR)\tclVar.obj \
+ $(TMPDIR)\tclWin32Dll.obj \
+ $(TMPDIR)\tclWinChan.obj \
+ $(TMPDIR)\tclWinConsole.obj \
+ $(TMPDIR)\tclWinSerial.obj \
+ $(TMPDIR)\tclWinError.obj \
+ $(TMPDIR)\tclWinFCmd.obj \
+ $(TMPDIR)\tclWinFile.obj \
+ $(TMPDIR)\tclWinInit.obj \
+ $(TMPDIR)\tclWinLoad.obj \
+ $(TMPDIR)\tclWinNotify.obj \
+ $(TMPDIR)\tclWinPipe.obj \
+ $(TMPDIR)\tclWinSock.obj \
+ $(TMPDIR)\tclWinThrd.obj \
+ $(TMPDIR)\tclWinTime.obj
+
+TCLSTUBOBJS = $(TMPDIR)\tclStubLib.obj
+
+WINDIR = $(ROOT)\win
+GENERICDIR = $(ROOT)\generic
+
+TCL_INCLUDES = -I"$(WINDIR)" -I"$(GENERICDIR)"
+TCL_DEFINES = $(DEBUGDEFINES) $(THREADDEFINES) $(SYMDEFINES) \
+ $(PROFDEFINES) $(OPTDEFINES) $(SIXFOURDEFINES) \
+ -DTCL_CFGVAL_ENCODING=${CFG_ENCODING}
+
+######################################################################
+# Compiler flags
+######################################################################
+
+!IF "$(NODEBUG)" == "1"
+# these macros cause maximum optimization and no symbols
+cdebug = -v- -vi- -O2 -D_DEBUG
+!ELSE
+# these macros enable debugging
+cdebug = -k -Od -r- -v -vi- -y
+!ENDIF
+
+SYSDEFINES = _MT;NO_STRICT;_NO_VCL
+
+# declarations common to all compiler options
+cbase = -c -q -3 -a4 -g0 -tWM -Ve -Vx -X-
+WARNINGS = -w-rch -w-pch -w-par -w-dup -w-pro -w-dpu
+
+ccons = -tWC
+
+INCLUDEPATH = $(include32) $(TCL_INCLUDES)
+
+CFLAGS = $(cdebug) $(cbase) $(INCLUDEPATH) $(WARNINGS) -D$(SYSDEFINES)
+TCL_CFLAGS = $(CFLAGS) $(TCL_DEFINES)
+CONS_CFLAGS = $(CFLAGS) $(TCL_DEFINES) $(ccons)
+
+######################################################################
+# Linker flags
+######################################################################
+
+!IF "$(NODEBUG)" == "1"
+ldebug =
+!ELSE
+ldebug = -v
+!ENDIF
+
+# declarations common to all linker options
+LNFLAGS = -D"" -Gn -I$(TMPDIR) -x $(ldebug) $(libpath32)
+# -Gi: create lib file (is -Gl in doc)
+# -aa: Windows app, -ap: Windows console app
+LNFLAGS_DLL = -ap -Gi -Tpd
+LNFLAGS_CONS = -ap -Tpe
+
+LNLIBS = import32 cw32mt
+
+
+######################################################################
+# Project specific targets
+######################################################################
+
+release: setup $(TCLSH) dlls
+dlls: setup $(TCLPIPEDLL) $(TCLREGDLL) $(TCLDDEDLL)
+all: setup $(TCLSH) dlls $(CAT32)
+tcltest: setup $(TCLTEST) dlls $(CAT32)
+plugin: setup $(TCLPLUGINDLL) $(TCLSHP)
+install: install-binaries install-libraries
+
+test: setup $(TCLTEST) dlls $(CAT32)
+ set TCL_LIBRARY=$(ROOT)/library
+ $(TCLTEST) $(ROOT)/tests/all.tcl
+
+setup:
+ @if not exist $(OUT_DIR)\nul mkdir $(OUT_DIR) &\
+ echo *** Created directory '$(OUT_DIR)'
+ @if not exist $(TMP_DIR)\nul mkdir $(TMP_DIR) &\
+ echo *** Created directory '$(TMP_DIR)'
+
+
+$(TCLLIB): $(TCLDLL)
+
+$(TCLDLL): $(TCLOBJS) $(TMPDIR)\$(NAMEPREFIX).res
+ $(link32) $(ldebug) $(LNFLAGS) $(LNFLAGS_DLL) $(TOOLS32)\lib\c0d32 @&&!
+ $(TCLOBJS), $@, -x, $(LNLIBS),, $(TMPDIR)\$(NAMEPREFIX).res
+!
+
+$(TCLSTUBLIB): $(TCLSTUBOBJS)
+ $(lib32) /u $@ $(TCLSTUBOBJS)
+
+$(TCLPLUGINLIB): $(TCLPLUGINDLL)
+
+$(TCLPLUGINDLL): $(TCLOBJS) $(TMPDIR)\tcl.res
+ $(link32) $(ldebug) $(dlllflags) \
+ -out:$@ $(TMPDIR)\tcl.res $(guilibsdll) @&&!
+$(TCLOBJS)
+!
+
+$(TCLSH): $(TCLSHOBJS) $(TCLLIB) $(TMPDIR)\$(NAMEPREFIX)sh.res
+ $(link32) $(ldebug) -S:2400000 $(LNFLAGS) $(LNFLAGS_CONS) $(TOOLS32)\lib\c0x32 @&&!
+ $(TCLSHOBJS), $@, -x, $(LNLIBS) $(TCLLIB),, $(TMPDIR)\$(NAMEPREFIX)sh.res
+!
+
+$(TCLSHP): $(TCLSHOBJS) $(TCLPLUGINLIB) $(TMPDIR)\tclsh.res
+ $(link32) $(ldebug) $(conlflags) $(TMPDIR)\tclsh.res -stack:2300000 \
+ -out:$@ $(conlibsdll) $(TCLPLUGINLIB) $(TCLSHOBJS)
+
+$(TCLTEST): $(TCLTESTOBJS) $(TCLLIB) $(TMPDIR)\$(NAMEPREFIX)sh.res
+ $(link32) $(ldebug) -S:2400000 $(LNFLAGS) $(LNFLAGS_CONS) $(TOOLS32)\lib\c0x32 @&&!
+ $(TCLTESTOBJS), $@, -x, $(LNLIBS) $(TCLLIB),, $(TMPDIR)\$(NAMEPREFIX)sh.res
+!
+
+$(TCLPIPEDLL): $(WINDIR)\stub16.c
+ $(cc32) $(CFLAGS) -o$(TMPDIR)\stub16.obj $(WINDIR)\stub16.c
+ $(link32) $(ldebug) $(LNFLAGS) $(LNFLAGS_CONS) $(TOOLS32)\lib\c0x32 \
+ $(TMPDIR)\stub16.obj, $@, -x, $(LNLIBS),, $(TMPDIR)\$(NAMEPREFIX).res
+
+$(TCLDDEDLL): $(TMPDIR)\tclWinDde.obj $(TCLSTUBLIB)
+ $(link32) $(ldebug) $(LNFLAGS) $(LNFLAGS_DLL) $(TOOLS32)\lib\c0d32 \
+ $(TMPDIR)\tclWinDde.obj, $@, -x, $(LNLIBS) $(TCLSTUBLIB),, \
+ $(TMPDIR)\$(NAMEPREFIX).res
+
+$(TCLREGDLL): $(TMPDIR)\tclWinReg.obj $(TCLSTUBLIB)
+ $(link32) $(ldebug) $(LNFLAGS) $(LNFLAGS_DLL) $(TOOLS32)\lib\c0d32 \
+ $(TMPDIR)\tclWinReg.obj, $@, -x, $(LNLIBS) $(TCLSTUBLIB),, \
+ $(TMPDIR)\$(NAMEPREFIX).res
+
+$(CAT32): $(WINDIR)\cat.c
+ $(cc32) $(CONS_CFLAGS) -o$(TMPDIR)\cat.obj $?
+ $(link32) $(ldebug) $(LNFLAGS) $(LNFLAGS_CONS) $(TOOLS32)\lib\c0x32 \
+ $(TMPDIR)\cat.obj, $@, -x, $(LNLIBS),,
+
+install-binaries: $(TCLSH)
+ $(MKDIR) "$(BIN_INSTALL_DIR)"
+ $(MKDIR) "$(LIB_INSTALL_DIR)"
+ @echo Installing $(TCLDLLNAME)
+ @copy "$(TCLDLL)" "$(BIN_INSTALL_DIR)"
+ @copy "$(TCLLIB)" "$(LIB_INSTALL_DIR)"
+ @echo Installing "$(TCLSH)"
+ @copy "$(TCLSH)" "$(BIN_INSTALL_DIR)"
+ @echo Installing $(TCLPIPEDLLNAME)
+ @copy "$(TCLPIPEDLL)" "$(BIN_INSTALL_DIR)"
+ @echo Installing $(TCLSTUBLIBNAME)
+ @copy "$(TCLSTUBLIB)" "$(LIB_INSTALL_DIR)"
+
+install-libraries:
+ -@$(MKDIR) "$(LIB_INSTALL_DIR)"
+ -@$(MKDIR) "$(INCLUDE_INSTALL_DIR)"
+ -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)"
+ @echo Installing http1.0
+ -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\http1.0"
+ -@copy "$(ROOT)\library\http1.0\http.tcl" "$(SCRIPT_INSTALL_DIR)\http1.0"
+ -@copy "$(ROOT)\library\http1.0\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\http1.0"
+ @echo Installing http2.7
+ -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\http2.7"
+ -@copy "$(ROOT)\library\http\http.tcl" "$(SCRIPT_INSTALL_DIR)\http2.7"
+ -@copy "$(ROOT)\library\http\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\http2.7"
+ @echo Installing opt0.4
+ -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\opt0.4"
+ -@copy "$(ROOT)\library\opt\optparse.tcl" "$(SCRIPT_INSTALL_DIR)\opt0.4"
+ -@copy "$(ROOT)\library\opt\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\opt0.4"
+ @echo Installing msgcat1.5
+ -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\msgcat1.5"
+ -@copy "$(ROOT)\library\msgcat\msgcat.tcl" "$(SCRIPT_INSTALL_DIR)\msgcat1.5"
+ -@copy "$(ROOT)\library\msgcat\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\msgcat1.5"
+ @echo Installing tcltest2.3
+ -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\tcltest2.3"
+ -@copy "$(ROOT)\library\tcltest\tcltest.tcl" "$(SCRIPT_INSTALL_DIR)\tcltest2.3"
+ -@copy "$(ROOT)\library\tcltest\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\tcltest2.3"
+ @echo Installing platform1.0
+ -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\platform1.0"
+ -@copy "$(ROOT)\library\platform\platform.tcl" "$(SCRIPT_INSTALL_DIR)\platform1.0"
+ -@copy "$(ROOT)\library\platform\shell.tcl" "$(SCRIPT_INSTALL_DIR)\platform1.0"
+ -@copy "$(ROOT)\library\platform\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\platform1.0"
+ @echo Installing $(TCLDDEDLLNAME)
+ -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\dde1.3"
+ -@copy "$(TCLDDEDLL)" "$(SCRIPT_INSTALL_DIR)\dde1.3"
+ -@copy "$(ROOT)\library\dde\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\dde1.3"
+ @echo Installing $(TCLREGDLLNAME)
+ -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\reg1.2"
+ -@copy "$(TCLREGDLL)" "$(SCRIPT_INSTALL_DIR)\reg1.2"
+ -@copy "$(ROOT)\library\reg\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\reg1.2"
+ @echo Installing encoding files
+ -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\encoding"
+ -@copy "$(ROOT)\library\encoding\*.enc" "$(SCRIPT_INSTALL_DIR)\encoding"
+ @echo Installing library files
+ -@copy "$(GENERICDIR)\tcl.h" "$(INCLUDE_INSTALL_DIR)"
+ -@copy "$(GENERICDIR)\tclDecls.h" "$(INCLUDE_INSTALL_DIR)"
+ -@copy "$(GENERICDIR)\tclPlatDecls.h" "$(INCLUDE_INSTALL_DIR)"
+ -@copy "$(ROOT)\library\history.tcl" "$(SCRIPT_INSTALL_DIR)"
+ -@copy "$(ROOT)\library\init.tcl" "$(SCRIPT_INSTALL_DIR)"
+ -@copy "$(ROOT)\library\parray.tcl" "$(SCRIPT_INSTALL_DIR)"
+ -@copy "$(ROOT)\library\safe.tcl" "$(SCRIPT_INSTALL_DIR)"
+ -@copy "$(ROOT)\library\tclIndex" "$(SCRIPT_INSTALL_DIR)"
+ -@copy "$(ROOT)\library\package.tcl" "$(SCRIPT_INSTALL_DIR)"
+ -@copy "$(ROOT)\library\word.tcl" "$(SCRIPT_INSTALL_DIR)"
+ -@copy "$(ROOT)\library\auto.tcl" "$(SCRIPT_INSTALL_DIR)"
+
+#
+# Regenerate the stubs files.
+#
+
+genstubs:
+ tclsh$(VERSION) $(ROOT)\tools\genStubs.tcl $(GENERICDIR) \
+ $(GENERICDIR)\tcl.decls $(GENERICDIR)\tclInt.decls
+
+#
+# Regenerate the windows help files.
+#
+
+TCLTOOLS = $(ROOT)/tools
+MAN2TCL = $(TCLTOOLS)/man2tcl
+TCLRTF = $(TCLTOOLS)/tcl.rtf
+TCLHPJ = $(TCLTOOLS)/tcl.hpj
+MAN2HELP = $(TCLTOOLS)/man2help.tcl
+HCRTF = $(TOOLS32)/bin/hcrtf.exe
+
+winhelp: $(TCLRTF)
+ cd $(TCLTOOLS)
+ start /wait $(HCRTF) -xn $(TCLHPJ)
+
+$(MAN2TCL).exe: $(MAN2TCL).obj
+ cd $(TCLTOOLS)
+ $(cc32) /nologo /G4 /ML /O2 $(MAN2TCL).c
+
+$(TCLRTF): $(MAN2TCL).exe $(TCLSH)
+ cd $(TCLTOOLS)
+ ..\win\$(TCLSH) $(MAN2HELP) $(NAMEPREFIX) $(VERSION) $(ROOT)/doc ../../tk$(DOTVERSION)/doc
+
+#
+# Special case object file targets
+#
+$(TMPDIR)\tclWinInit.obj: $(WINDIR)\tclWinInit.c
+ $(cc32) -DBUILD_tcl $(TCL_CFLAGS) -o$(TMPDIR)\$@ $?
+
+$(TMPDIR)\testMain.obj: $(WINDIR)\tclAppInit.c
+ $(cc32) $(TCL_CFLAGS) -DTCL_TEST -o$(TMPDIR)\testMain.obj $?
+
+$(TMPDIR)\tclTest.obj: $(GENERICDIR)\tclTest.c
+ $(cc32) $(TCL_CFLAGS) -o$(TMPDIR)\$@ $?
+
+$(TMPDIR)\tclTestObj.obj: $(GENERICDIR)\tclTestObj.c
+ $(cc32) $(TCL_CFLAGS) -o$(TMPDIR)\$@ $?
+
+$(TMPDIR)\tclWinTest.obj: $(WINDIR)\tclWinTest.c
+ $(cc32) $(TCL_CFLAGS) -o$(TMPDIR)\$@ $?
+
+$(TMP_DIR)\tclPkgConfig.obj: $(GENERICDIR)\tclPkgConfig.c
+ $(cc32) $(TCL_CFLAGS) \
+ -DCFG_INSTALL_EXEC_PREFIX=\"$(INSTALL_EXEC_PREFIX)\" \
+ -DCFG_INSTALL_PREFIX=\"$(INSTALL_PREFIX)\" \
+ -DCFG_RUNTIME_EXEC_PREFIX=\"$(RUNTIME_EXEC_PREFIX)\" \
+ -DCFG_RUNTIME_PREFIX=\"$(RUNTIME_PREFIX)\" \
+ -o$(TMPDIR)\$@ $?
+
+$(TMPDIR)\tclAppInit.obj : $(WINDIR)\tclAppInit.c
+ $(cc32) $(TCL_CFLAGS) -o$(TMPDIR)\$@ $?
+
+# The following objects should be built using the stub interfaces
+
+# tclWinReg: Produces errors in ANSI mode
+$(TMPDIR)\tclWinReg.obj : $(WINDIR)\tclWinReg.c
+ $(cc32) $(TCL_CFLAGS) -DUSE_TCL_STUBS -o$(TMPDIR)\$@ $?
+
+# tclWinDde: Produces errors in ANSI mode
+$(TMPDIR)\tclWinDde.obj : $(WINDIR)\tclWinDde.c
+ $(cc32) $(TCL_CFLAGS) -DUSE_TCL_STUBS -o$(TMPDIR)\$@ $?
+
+
+# The following objects are part of the stub library and should not
+# be built as DLL objects but none of the symbols should be exported
+
+$(TMPDIR)\tclStubLib.obj : $(GENERICDIR)\tclStubLib.c
+ $(cc32) $(TCL_CFLAGS) -DSTATIC_BUILD -o$(TMPDIR)\$@ $?
+
+
+# Dedependency rules
+
+$(GENERICDIR)\regcomp.c: \
+ $(GENERICDIR)\regguts.h \
+ $(GENERICDIR)\regc_lex.c \
+ $(GENERICDIR)\regc_color.c \
+ $(GENERICDIR)\regc_nfa.c \
+ $(GENERICDIR)\regc_cvec.c \
+ $(GENERICDIR)\regc_locale.c
+
+$(GENERICDIR)\regcustom.h: \
+ $(GENERICDIR)\tclInt.h \
+ $(GENERICDIR)\tclPort.h \
+ $(GENERICDIR)\regex.h
+
+$(GENERICDIR)\regexec.c: \
+ $(GENERICDIR)\rege_dfa.c \
+ $(GENERICDIR)\regguts.h
+
+$(GENERICDIR)\regerror.c: $(GENERICDIR)\regguts.h
+$(GENERICDIR)\regfree.c: $(GENERICDIR)\regguts.h
+$(GENERICDIR)\regfronts.c: $(GENERICDIR)\regguts.h
+$(GENERICDIR)\regguts.h: $(GENERICDIR)\regcustom.h
+
+#
+# Implicit rules
+#
+
+{$(WINDIR)}.c{$(TMPDIR)}.obj:
+ $(cc32) -DBUILD_tcl $(TCL_CFLAGS) -o$@ $<
+
+{$(GENERICDIR)}.c{$(TMPDIR)}.obj:
+ $(cc32) -DBUILD_tcl $(TCL_CFLAGS) -o$@ $<
+
+{$(ROOT)\compat}.c{$(TMPDIR)}.obj:
+ $(cc32) -DBUILD_tcl $(TCL_CFLAGS) -o$@ $<
+
+{$(WINDIR)}.rc{$(TMPDIR)}.res:
+ $(rc32) $(INCLUDEPATH) -D$(USERDEFINES);$(SYSDEFINES) -fo$@ $<
+
+clean:
+ -@$(RM) $(OUTDIR)\*.exp
+ -@$(RM) $(OUTDIR)\*.lib
+ -@$(RM) $(OUTDIR)\*.dll
+ -@$(RM) $(OUTDIR)\*.exe
+ -@$(RM) $(OUTDIR)\*.pdb
+ -@$(RM) $(TMPDIR)\*.pch
+ -@$(RM) $(TMPDIR)\*.obj
+ -@$(RM) $(TMPDIR)\*.res
+ -@$(RM) $(TMPDIR)\*.exe
+ -@$(RMDIR) $(OUTDIR)
+ -@$(RMDIR) $(TMPDIR)
diff --git a/win/makefile.vc b/win/makefile.vc index 823142f..8c8ecdf 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -1,1222 +1,1140 @@ -#------------------------------------------------------------- -*- 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. -# Copyright (c) 2003-2008 Pat Thoyts. -#------------------------------------------------------------------------------ - -# Check to see we are configured to build with MSVC (MSDEVDIR, MSVCDIR or -# VCINSTALLDIR) or with the MS Platform SDK (MSSDK or WindowsSDKDir) -!if !defined(MSDEVDIR) && !defined(MSVCDIR) && !defined(VCINSTALLDIR) && !defined(MSSDK) && !defined(WINDOWSSDKDIR) -MSG = ^ -You need to run vcvars32.bat from Developer Studio or setenv.bat from the^ -Platform SDK first to setup the environment. Jump to this line to read^ -the build instructions. -!error $(MSG) -!endif - -#------------------------------------------------------------------------------ -# HOW TO USE this makefile: -# -# 1) It is now necessary to have MSVCDir, MSDevDir or MSSDK set in the -# environment. This is used as a check to see if vcvars32.bat had been -# run prior to running nmake or during the installation of Microsoft -# Visual C++, MSVCDir had been set globally and the PATH adjusted. -# Either way is valid. -# -# You'll need to run vcvars32.bat contained in the MsDev's vc(98)/bin -# directory to setup the proper environment, if needed, for your -# current setup. This is a needed bootstrap requirement and allows the -# swapping of different environments to be easier. -# -# 2) To use the Platform SDK (not expressly needed), run setenv.bat after -# vcvars32.bat according to the instructions for it. This can also -# turn on the 64-bit compiler, if your SDK has it. -# -# 3) Targets are: -# release -- Builds the core, the shell and the dlls. (default) -# dlls -- Just builds the windows extensions -# shell -- Just builds the shell and the core. -# core -- Only builds the core [tclXX.(dll|lib)]. -# all -- Builds everything. -# test -- Builds and runs the test suite. -# tcltest -- Just builds the test shell. -# install -- Installs the built binaries and libraries to $(INSTALLDIR) -# as the root of the install tree. -# tidy/clean/hose -- varying levels of cleaning. -# genstubs -- Rebuilds the Stubs table and support files (dev only). -# depend -- Generates an accurate set of source dependancies for this -# makefile. Helpful to avoid problems when the sources are -# refreshed and you rebuild, but can "overbuild" when common -# headers like tclInt.h just get small changes. -# htmlhelp -- Builds a Windows .chm help file for Tcl and Tk from the -# troff manual pages found in $(ROOT)\doc. You need to -# have installed the HTML Help Compiler package from Microsoft -# to produce the .chm file. -# 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=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. -# -# 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. -# 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. -# 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=compdbg,memdbg,none -# Sets optional memory and bytecode compiler debugging code added -# to the core. The default is for none. Any combination of the -# above may be used (comma separated). 'none' will over-ride -# everything to nothing. -# -# compdbg = Enables byte compilation logging. -# memdbg = Enables the debugging memory allocator. -# -# CHECKS=64bit,fullwarn,nodep,none -# Sets special macros for checking compatability. -# -# 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=(ALPHA|AMD64|IA64|IX86) -# Set the machine type used for the compiler, linker, and -# resource compiler. This hook is needed to tell the tools -# when alternate platforms are requested. IX86 is the default -# when not specified. If the CPU environment variable has been -# set (ie: recent Platform SDK) then MACHINE is set from CPU. -# -# TMP_DIR=<path> -# OUT_DIR=<path> -# Hooks to allow the intermediate and output directories to be -# changed. $(OUT_DIR) is assumed to be -# $(BINROOT)\(Release|Debug) based on if symbols are requested. -# $(TMP_DIR) will de $(OUT_DIR)\<buildtype> by default. -# -# TESTPAT=<file> -# Reads the tests requested to be run from this file. -# -# CFG_ENCODING=encoding -# name of encoding for configuration information. Defaults -# to cp1252 -# -# 5) Examples: -# -# Basic syntax of calling nmake looks like this: -# nmake [-nologo] -f makefile.vc [target|macrodef [target|macrodef] [...]] -# -# Standard (no frills) -# c:\tcl_src\win\>c:\progra~1\micros~1\vc98\bin\vcvars32.bat -# Setting environment for using Microsoft Visual C++ tools. -# c:\tcl_src\win\>nmake -f makefile.vc release -# c:\tcl_src\win\>nmake -f makefile.vc install INSTALLDIR=c:\progra~1\tcl -# -# Building for Win64 -# c:\tcl_src\win\>c:\progra~1\micros~1\vc98\bin\vcvars32.bat -# Setting environment for using Microsoft Visual C++ tools. -# c:\tcl_src\win\>c:\progra~1\platfo~1\setenv.bat /pre64 /RETAIL -# Targeting Windows pre64 RETAIL -# c:\tcl_src\win\>nmake -f makefile.vc MACHINE=IA64 -# -#------------------------------------------------------------------------------ -#============================================================================== -############################################################################### - - -# //==================================================================\\ -# >>[ -> Do not modify below this line. <- ]<< -# >>[ Please, use the commandline macros to modify how Tcl is built. ]<< -# >>[ If you need more features, send us a patch for more macros. ]<< -# \\==================================================================// - - -############################################################################### -#============================================================================== -#------------------------------------------------------------------------------ - -!if !exist("makefile.vc") -MSG = ^ -You must run this makefile only from the directory it is in.^ -Please `cd` to its location first. -!error $(MSG) -!endif - -PROJECT = tcl -!include "rules.vc" - -STUBPREFIX = $(PROJECT)stub -DOTVERSION = $(TCL_MAJOR_VERSION).$(TCL_MINOR_VERSION) -VERSION = $(TCL_MAJOR_VERSION)$(TCL_MINOR_VERSION) - -DDEDOTVERSION = 1.4 -DDEVERSION = $(DDEDOTVERSION:.=) - -REGDOTVERSION = 1.3 -REGVERSION = $(REGDOTVERSION:.=) - -BINROOT = $(MAKEDIR) # originally . -ROOT = $(MAKEDIR)\.. # originally .. - -TCLIMPLIB = $(OUT_DIR)\$(PROJECT)$(VERSION)$(SUFX).lib -TCLLIBNAME = $(PROJECT)$(VERSION)$(SUFX).$(EXT) -TCLLIB = $(OUT_DIR)\$(TCLLIBNAME) - -TCLSTUBLIBNAME = $(STUBPREFIX)$(VERSION).lib -TCLSTUBLIB = $(OUT_DIR)\$(TCLSTUBLIBNAME) - -TCLSHNAME = $(PROJECT)sh$(VERSION)$(SUFX).exe -TCLSH = $(OUT_DIR)\$(TCLSHNAME) - -TCLREGLIBNAME = $(PROJECT)reg$(REGVERSION)$(SUFX:t=).$(EXT) -TCLREGLIB = $(OUT_DIR)\$(TCLREGLIBNAME) - -TCLDDELIBNAME = $(PROJECT)dde$(DDEVERSION)$(SUFX:t=).$(EXT) -TCLDDELIB = $(OUT_DIR)\$(TCLDDELIBNAME) - -TCLTEST = $(OUT_DIR)\$(PROJECT)test.exe -CAT32 = $(OUT_DIR)\cat32.exe - -# Can we run what we build? IX86 runs on all architectures. -!ifndef TCLSH_NATIVE -!if "$(MACHINE)" == "IX86" || "$(MACHINE)" == "$(NATIVE_ARCH)" -TCLSH_NATIVE = $(TCLSH) -!else -!error You must explicitly set TCLSH_NATIVE for cross-compilation -!endif -!endif - -### Make sure we use backslash only. -LIB_INSTALL_DIR = $(_INSTALLDIR)\lib -BIN_INSTALL_DIR = $(_INSTALLDIR)\bin -DOC_INSTALL_DIR = $(_INSTALLDIR)\doc -SCRIPT_INSTALL_DIR = $(_INSTALLDIR)\lib\tcl$(DOTVERSION) -INCLUDE_INSTALL_DIR = $(_INSTALLDIR)\include - -TCLSHOBJS = \ - $(TMP_DIR)\tclAppInit.obj \ -!if !$(STATIC_BUILD) -!if $(TCL_USE_STATIC_PACKAGES) - $(TMP_DIR)\tclWinReg.obj \ - $(TMP_DIR)\tclWinDde.obj \ -!endif -!endif - $(TMP_DIR)\tclsh.res - -TCLTESTOBJS = \ - $(TMP_DIR)\tclTest.obj \ - $(TMP_DIR)\tclTestObj.obj \ - $(TMP_DIR)\tclTestProcBodyObj.obj \ - $(TMP_DIR)\tclThreadTest.obj \ - $(TMP_DIR)\tclWinTest.obj \ -!if !$(STATIC_BUILD) -!if $(TCL_USE_STATIC_PACKAGES) - $(TMP_DIR)\tclWinReg.obj \ - $(TMP_DIR)\tclWinDde.obj \ -!endif -!endif - $(TMP_DIR)\testMain.obj - -COREOBJS = \ - $(TMP_DIR)\regcomp.obj \ - $(TMP_DIR)\regerror.obj \ - $(TMP_DIR)\regexec.obj \ - $(TMP_DIR)\regfree.obj \ - $(TMP_DIR)\tclAlloc.obj \ - $(TMP_DIR)\tclAssembly.obj \ - $(TMP_DIR)\tclAsync.obj \ - $(TMP_DIR)\tclBasic.obj \ - $(TMP_DIR)\tclBinary.obj \ - $(TMP_DIR)\tclCkalloc.obj \ - $(TMP_DIR)\tclClock.obj \ - $(TMP_DIR)\tclCmdAH.obj \ - $(TMP_DIR)\tclCmdIL.obj \ - $(TMP_DIR)\tclCmdMZ.obj \ - $(TMP_DIR)\tclCompCmds.obj \ - $(TMP_DIR)\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 \ - $(TMP_DIR)\tclFCmd.obj \ - $(TMP_DIR)\tclFileName.obj \ - $(TMP_DIR)\tclGet.obj \ - $(TMP_DIR)\tclHash.obj \ - $(TMP_DIR)\tclHistory.obj \ - $(TMP_DIR)\tclIndexObj.obj \ - $(TMP_DIR)\tclInterp.obj \ - $(TMP_DIR)\tclIO.obj \ - $(TMP_DIR)\tclIOCmd.obj \ - $(TMP_DIR)\tclIOGT.obj \ - $(TMP_DIR)\tclIOSock.obj \ - $(TMP_DIR)\tclIOUtil.obj \ - $(TMP_DIR)\tclIORChan.obj \ - $(TMP_DIR)\tclIORTrans.obj \ - $(TMP_DIR)\tclLink.obj \ - $(TMP_DIR)\tclListObj.obj \ - $(TMP_DIR)\tclLiteral.obj \ - $(TMP_DIR)\tclLoad.obj \ - $(TMP_DIR)\tclMain.obj \ - $(TMP_DIR)\tclMain2.obj \ - $(TMP_DIR)\tclNamesp.obj \ - $(TMP_DIR)\tclNotify.obj \ - $(TMP_DIR)\tclOO.obj \ - $(TMP_DIR)\tclOOBasic.obj \ - $(TMP_DIR)\tclOOCall.obj \ - $(TMP_DIR)\tclOODefineCmds.obj \ - $(TMP_DIR)\tclOOInfo.obj \ - $(TMP_DIR)\tclOOMethod.obj \ - $(TMP_DIR)\tclOOStubInit.obj \ - $(TMP_DIR)\tclObj.obj \ - $(TMP_DIR)\tclPanic.obj \ - $(TMP_DIR)\tclParse.obj \ - $(TMP_DIR)\tclPathObj.obj \ - $(TMP_DIR)\tclPipe.obj \ - $(TMP_DIR)\tclPkg.obj \ - $(TMP_DIR)\tclPkgConfig.obj \ - $(TMP_DIR)\tclPosixStr.obj \ - $(TMP_DIR)\tclPreserve.obj \ - $(TMP_DIR)\tclProc.obj \ - $(TMP_DIR)\tclRegexp.obj \ - $(TMP_DIR)\tclResolve.obj \ - $(TMP_DIR)\tclResult.obj \ - $(TMP_DIR)\tclScan.obj \ - $(TMP_DIR)\tclStringObj.obj \ - $(TMP_DIR)\tclStrToD.obj \ - $(TMP_DIR)\tclStubInit.obj \ - $(TMP_DIR)\tclThread.obj \ - $(TMP_DIR)\tclThreadAlloc.obj \ - $(TMP_DIR)\tclThreadJoin.obj \ - $(TMP_DIR)\tclThreadStorage.obj \ - $(TMP_DIR)\tclTimer.obj \ - $(TMP_DIR)\tclTomMathInterface.obj \ - $(TMP_DIR)\tclTrace.obj \ - $(TMP_DIR)\tclUtf.obj \ - $(TMP_DIR)\tclUtil.obj \ - $(TMP_DIR)\tclVar.obj \ - $(TMP_DIR)\tclZlib.obj - -ZLIBOBJS = \ - $(TMP_DIR)\adler32.obj \ - $(TMP_DIR)\compress.obj \ - $(TMP_DIR)\crc32.obj \ - $(TMP_DIR)\deflate.obj \ - $(TMP_DIR)\infback.obj \ - $(TMP_DIR)\inffast.obj \ - $(TMP_DIR)\inflate.obj \ - $(TMP_DIR)\inftrees.obj \ - $(TMP_DIR)\trees.obj \ - $(TMP_DIR)\uncompr.obj \ - $(TMP_DIR)\zutil.obj - -TOMMATHOBJS = \ - $(TMP_DIR)\bncore.obj \ - $(TMP_DIR)\bn_reverse.obj \ - $(TMP_DIR)\bn_fast_s_mp_mul_digs.obj \ - $(TMP_DIR)\bn_fast_s_mp_sqr.obj \ - $(TMP_DIR)\bn_mp_add.obj \ - $(TMP_DIR)\bn_mp_add_d.obj \ - $(TMP_DIR)\bn_mp_and.obj \ - $(TMP_DIR)\bn_mp_clamp.obj \ - $(TMP_DIR)\bn_mp_clear.obj \ - $(TMP_DIR)\bn_mp_clear_multi.obj \ - $(TMP_DIR)\bn_mp_cmp.obj \ - $(TMP_DIR)\bn_mp_cmp_d.obj \ - $(TMP_DIR)\bn_mp_cmp_mag.obj \ - $(TMP_DIR)\bn_mp_cnt_lsb.obj \ - $(TMP_DIR)\bn_mp_copy.obj \ - $(TMP_DIR)\bn_mp_count_bits.obj \ - $(TMP_DIR)\bn_mp_div.obj \ - $(TMP_DIR)\bn_mp_div_d.obj \ - $(TMP_DIR)\bn_mp_div_2.obj \ - $(TMP_DIR)\bn_mp_div_2d.obj \ - $(TMP_DIR)\bn_mp_div_3.obj \ - $(TMP_DIR)\bn_mp_exch.obj \ - $(TMP_DIR)\bn_mp_expt_d.obj \ - $(TMP_DIR)\bn_mp_grow.obj \ - $(TMP_DIR)\bn_mp_init.obj \ - $(TMP_DIR)\bn_mp_init_copy.obj \ - $(TMP_DIR)\bn_mp_init_multi.obj \ - $(TMP_DIR)\bn_mp_init_set.obj \ - $(TMP_DIR)\bn_mp_init_set_int.obj \ - $(TMP_DIR)\bn_mp_init_size.obj \ - $(TMP_DIR)\bn_mp_karatsuba_mul.obj \ - $(TMP_DIR)\bn_mp_karatsuba_sqr.obj \ - $(TMP_DIR)\bn_mp_lshd.obj \ - $(TMP_DIR)\bn_mp_mod.obj \ - $(TMP_DIR)\bn_mp_mod_2d.obj \ - $(TMP_DIR)\bn_mp_mul.obj \ - $(TMP_DIR)\bn_mp_mul_2.obj \ - $(TMP_DIR)\bn_mp_mul_2d.obj \ - $(TMP_DIR)\bn_mp_mul_d.obj \ - $(TMP_DIR)\bn_mp_neg.obj \ - $(TMP_DIR)\bn_mp_or.obj \ - $(TMP_DIR)\bn_mp_radix_size.obj \ - $(TMP_DIR)\bn_mp_radix_smap.obj \ - $(TMP_DIR)\bn_mp_read_radix.obj \ - $(TMP_DIR)\bn_mp_rshd.obj \ - $(TMP_DIR)\bn_mp_set.obj \ - $(TMP_DIR)\bn_mp_set_int.obj \ - $(TMP_DIR)\bn_mp_shrink.obj \ - $(TMP_DIR)\bn_mp_sqr.obj \ - $(TMP_DIR)\bn_mp_sqrt.obj \ - $(TMP_DIR)\bn_mp_sub.obj \ - $(TMP_DIR)\bn_mp_sub_d.obj \ - $(TMP_DIR)\bn_mp_to_unsigned_bin.obj \ - $(TMP_DIR)\bn_mp_to_unsigned_bin_n.obj \ - $(TMP_DIR)\bn_mp_toom_mul.obj \ - $(TMP_DIR)\bn_mp_toom_sqr.obj \ - $(TMP_DIR)\bn_mp_toradix_n.obj \ - $(TMP_DIR)\bn_mp_unsigned_bin_size.obj \ - $(TMP_DIR)\bn_mp_xor.obj \ - $(TMP_DIR)\bn_mp_zero.obj \ - $(TMP_DIR)\bn_s_mp_add.obj \ - $(TMP_DIR)\bn_s_mp_mul_digs.obj \ - $(TMP_DIR)\bn_s_mp_sqr.obj \ - $(TMP_DIR)\bn_s_mp_sub.obj - -PLATFORMOBJS = \ - $(TMP_DIR)\tclWin32Dll.obj \ - $(TMP_DIR)\tclWinChan.obj \ - $(TMP_DIR)\tclWinConsole.obj \ - $(TMP_DIR)\tclWinError.obj \ - $(TMP_DIR)\tclWinFCmd.obj \ - $(TMP_DIR)\tclWinFile.obj \ - $(TMP_DIR)\tclWinInit.obj \ - $(TMP_DIR)\tclWinLoad.obj \ - $(TMP_DIR)\tclWinNotify.obj \ - $(TMP_DIR)\tclWinPipe.obj \ - $(TMP_DIR)\tclWinSerial.obj \ - $(TMP_DIR)\tclWinSock.obj \ - $(TMP_DIR)\tclWinThrd.obj \ - $(TMP_DIR)\tclWinTime.obj \ -!if $(STATIC_BUILD) - $(TMP_DIR)\tclWinReg.obj \ - $(TMP_DIR)\tclWinDde.obj \ -!else - $(TMP_DIR)\tcl.res -!endif - -TCLOBJS = $(COREOBJS) $(ZLIBOBJS) $(TOMMATHOBJS) $(PLATFORMOBJS) - -TCLSTUBOBJS = \ - $(TMP_DIR)\tclStubLib.obj \ - $(TMP_DIR)\tclStubLibCompat.obj \ - $(TMP_DIR)\tclTomMathStubLib.obj \ - $(TMP_DIR)\tclOOStubLib.obj - -### The following paths CANNOT have spaces in them. -COMPATDIR = $(ROOT)\compat -DOCDIR = $(ROOT)\doc -GENERICDIR = $(ROOT)\generic -TOMMATHDIR = $(ROOT)\libtommath -TOOLSDIR = $(ROOT)\tools -WINDIR = $(ROOT)\win -PKGSDIR = $(ROOT)\pkgs - -#--------------------------------------------------------------------- -# Compile flags -#--------------------------------------------------------------------- - -!if !$(DEBUG) -!if $(OPTIMIZING) -### This cranks the optimization level to maximize speed -cdebug = -O2 $(OPTIMIZATIONS) -!else -cdebug = -!endif -!if $(SYMBOLS) -cdebug = $(cdebug) -Zi -!endif -!else if "$(MACHINE)" == "IA64" || "$(MACHINE)" == "AMD64" -### Warnings are too many, can't support warnings into errors. -cdebug = -Zi -Od $(DEBUGFLAGS) -!else -cdebug = -Zi -WX $(DEBUGFLAGS) -!endif - -### Declarations common to all compiler options -cwarn = $(WARNINGS) -D _CRT_SECURE_NO_DEPRECATE -D _CRT_NONSTDC_NO_DEPRECATE -cflags = -nologo -c $(COMPILERFLAGS) $(cwarn) -Fp$(TMP_DIR)^\ - -!if $(MSVCRT) -!if $(DEBUG) && !$(UNCHECKED) -crt = -MDd -!else -crt = -MD -!endif -!else -!if $(DEBUG) && !$(UNCHECKED) -crt = -MTd -!else -crt = -MT -!endif -!endif - -TCL_INCLUDES = -I"$(WINDIR)" -I"$(GENERICDIR)" -I"$(TOMMATHDIR)" -TCL_DEFINES = -DTCL_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) - - -#--------------------------------------------------------------------- -# Link flags -#--------------------------------------------------------------------- - -!if $(DEBUG) -ldebug = -debug -debugtype:cv -!else -ldebug = -release -opt:ref -opt:icf,3 -!if $(SYMBOLS) -ldebug = $(ldebug) -debug -debugtype:cv -!endif -!endif - -### Declarations common to all linker options -lflags = -nologo -machine:$(MACHINE) $(LINKERFLAGS) $(ldebug) - -!if $(PROFILE) -lflags = $(lflags) -profile -!endif - -!if $(ALIGN98_HACK) && !$(STATIC_BUILD) -### Align sections for PE size savings. -lflags = $(lflags) -opt:nowin98 -!else if !$(ALIGN98_HACK) && $(STATIC_BUILD) -### Align sections for speed in loading by choosing the virtual page size. -lflags = $(lflags) -align:4096 -!endif - -!if $(LOIMPACT) -lflags = $(lflags) -ws:aggressive -!endif - -dlllflags = $(lflags) -dll -conlflags = $(lflags) -subsystem:console -guilflags = $(lflags) -subsystem:windows - -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 -#--------------------------------------------------------------------- - -!if "$(TESTPAT)" != "" -TESTFLAGS = $(TESTFLAGS) -file $(TESTPAT) -!endif - - -#--------------------------------------------------------------------- -# Project specific targets -#--------------------------------------------------------------------- - -release: setup $(TCLSH) $(TCLSTUBLIB) dlls pkgs -core: setup $(TCLLIB) $(TCLSTUBLIB) -shell: setup $(TCLSH) -dlls: setup $(TCLREGLIB) $(TCLDDELIB) -all: setup $(TCLSH) $(TCLSTUBLIB) dlls $(CAT32) pkgs -tcltest: setup $(TCLTEST) dlls $(CAT32) -install: install-binaries install-libraries install-docs install-pkgs - -test: test-core test-pkgs -test-core: setup $(TCLTEST) dlls $(CAT32) - set TCL_LIBRARY=$(ROOT:\=/)/library -!if "$(OS)" == "Windows_NT" || "$(MSVCDIR)" == "IDE" - $(DEBUGGER) $(TCLTEST) "$(ROOT:\=/)/tests/all.tcl" $(TESTFLAGS) -loadfile << - package ifneeded dde 1.4.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 - 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 - $(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) - @if not exist $(TMP_DIR)\nul mkdir $(TMP_DIR) - -!if !$(STATIC_BUILD) -$(TCLIMPLIB): $(TCLLIB) -!endif - -$(TCLLIB): $(TCLOBJS) -!if $(STATIC_BUILD) - $(lib32) -nologo $(LINKERFLAGS) -out:$@ @<< -$** -<< -!else - $(link32) $(dlllflags) -base:@$(WINDIR)\coffbase.txt,tcl -out:$@ \ - $(baselibs) @<< -$** -<< - $(_VC_MANIFEST_EMBED_DLL) -!endif - -$(TCLSTUBLIB): $(TCLSTUBOBJS) - $(lib32) -nologo $(LINKERFLAGS) -out:$@ $(TCLSTUBOBJS) - -$(TCLSH): $(TCLSHOBJS) $(TCLSTUBLIB) $(TCLIMPLIB) - $(link32) $(conlflags) -stack:2300000 -out:$@ $(baselibs) $** - $(_VC_MANIFEST_EMBED_EXE) - -$(TCLTEST): $(TCLTESTOBJS) $(TCLSTUBLIB) $(TCLIMPLIB) - $(link32) $(conlflags) -stack:2300000 -out:$@ $(baselibs) $** - $(_VC_MANIFEST_EMBED_EXE) - -!if $(STATIC_BUILD) -$(TCLDDELIB): $(TMP_DIR)\tclWinDde.obj - $(lib32) -nologo $(LINKERFLAGS) -out:$@ $** -!else -$(TCLDDELIB): $(TMP_DIR)\tclWinDde.obj $(TCLSTUBLIB) - $(link32) $(dlllflags) -base:@$(WINDIR)\coffbase.txt,tcldde -out:$@ \ - $** $(baselibs) - $(_VC_MANIFEST_EMBED_DLL) -!endif - -!if $(STATIC_BUILD) -$(TCLREGLIB): $(TMP_DIR)\tclWinReg.obj - $(lib32) -nologo $(LINKERFLAGS) -out:$@ $** -!else -$(TCLREGLIB): $(TMP_DIR)\tclWinReg.obj $(TCLSTUBLIB) - $(link32) $(dlllflags) -base:@$(WINDIR)\coffbase.txt,tclreg -out:$@ \ - $** $(baselibs) - $(_VC_MANIFEST_EMBED_DLL) -!endif - -pkgs: - @for /d %d in ($(PKGSDIR)\*) do \ - @if exist "%~fd\win\makefile.vc" ( \ - pushd "%~fd\win" & \ - $(MAKE) -$(MAKEFLAGS) -f makefile.vc TCLDIR=$(ROOT) &\ - popd \ - ) - -test-pkgs: - @for /d %d in ($(PKGSDIR)\*) do \ - @if exist "%~fd\win\makefile.vc" ( \ - pushd "%~fd\win" & \ - $(MAKE) -$(MAKEFLAGS) -f makefile.vc TCLDIR=$(ROOT) test &\ - popd \ - ) - -install-pkgs: - @for /d %d in ($(PKGSDIR)\*) do \ - @if exist "%~fd\win\makefile.vc" ( \ - pushd "%~fd\win" & \ - $(MAKE) -$(MAKEFLAGS) -f makefile.vc TCLDIR=$(ROOT) install &\ - popd \ - ) - -clean-pkgs: - @for /d %d in ($(PKGSDIR)\*) do \ - @if exist "%~fd\win\makefile.vc" ( \ - pushd "%~fd\win" & \ - $(MAKE) -$(MAKEFLAGS) -f makefile.vc TCLDIR=$(ROOT) clean &\ - popd \ - ) - -$(CAT32): $(WINDIR)\cat.c - $(cc32) $(CON_CFLAGS) -Fo$(TMP_DIR)\ $? - $(link32) $(conlflags) -out:$@ -stack:16384 $(TMP_DIR)\cat.obj \ - $(baselibs) - $(_VC_MANIFEST_EMBED_EXE) - -#--------------------------------------------------------------------- -# Regenerate the stubs files. [Development use only] -#--------------------------------------------------------------------- - -genstubs: -!if !exist($(TCLSH)) - @echo Build tclsh first! -!else - $(TCLSH) $(TOOLSDIR:\=/)/genStubs.tcl $(GENERICDIR:\=/) \ - $(GENERICDIR:\=/)/tcl.decls $(GENERICDIR:\=/)/tclInt.decls \ - $(GENERICDIR:\=/)/tclTomMath.decls - $(TCLSH) $(TOOLSDIR:\=/)/genStubs.tcl $(GENERICDIR:\=/) \ - $(GENERICDIR:\=/)/tclOO.decls -!endif - - -#---------------------------------------------------------------------- -# The following target generates the file generic/tclTomMath.h. -# It needs to be run (and the results checked) after updating -# to a new release of libtommath. -#---------------------------------------------------------------------- - -gentommath_h: -!if !exist($(TCLSH)) - @echo Build tclsh first! -!else - $(TCLSH) "$(TOOLSDIR:\=/)/fix_tommath_h.tcl" \ - "$(TOMMATHDIR:\=/)/tommath.h" \ - > "$(GENERICDIR)\tclTomMath.h" -!endif - -#--------------------------------------------------------------------- -# Build the Windows HTML help file. -#--------------------------------------------------------------------- - -# NOTE: you can define HHC on the command-line to override this -!ifndef HHC -HHC=""%ProgramFiles%\HTML Help Workshop\hhc.exe"" -!endif -HTMLDIR=$(ROOT)\html -HTMLBASE=TclTk$(VERSION) -HHPFILE=$(HTMLDIR)\$(HTMLBASE).hhp -CHMFILE=$(HTMLDIR)\$(HTMLBASE).chm - -htmlhelp: chmsetup $(CHMFILE) - -$(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 -HELPCNT = $(OUT_DIR)\$(TCLHLPBASE).cnt -DOCTMP_DIR = $(OUT_DIR)\$(PROJECT)_docs -HELPRTF = $(DOCTMP_DIR)\$(PROJECT).rtf -MAN2HELP = $(DOCTMP_DIR)\man2help.tcl -MAN2HELP2 = $(DOCTMP_DIR)\man2help2.tcl -INDEX = $(DOCTMP_DIR)\index.tcl -BMP = $(DOCTMP_DIR)\feather.bmp -BMP_NOPATH = feather.bmp -MAN2TCL = $(DOCTMP_DIR)\man2tcl.exe - -winhelp: docsetup $(HELPFILE) - -docsetup: - @if not exist $(DOCTMP_DIR)\nul mkdir $(DOCTMP_DIR) - -$(MAN2HELP) $(MAN2HELP2) $(INDEX) $(BMP): $(TOOLSDIR)\$$(@F) - @$(CPY) $(TOOLSDIR)\$(@F) $(@D) - -$(HELPFILE): $(HELPRTF) $(BMP) - cd $(DOCTMP_DIR) - start /wait hcrtf.exe -x <<$(PROJECT).hpj -[OPTIONS] -COMPRESS=12 Hall Zeck -LCID=0x409 0x0 0x0 ; English (United States) -TITLE=Tcl/Tk Reference Manual -BMROOT=. -CNT=$(@B).cnt -HLP=$(@B).hlp - -[FILES] -$(PROJECT).rtf - -[WINDOWS] -main="Tcl/Tk Reference Manual",,27648,(r15263976),(r65535) - -[CONFIG] -BrowseButtons() -CreateButton(1, "Web", ExecFile("http://www.tcl.tk")) -CreateButton(2, "SF", ExecFile("http://sf.net/projects/tcl")) -CreateButton(3, "Wiki", ExecFile("http://wiki.tcl.tk")) -CreateButton(4, "FAQ", ExecFile("http://www.purl.org/NET/Tcl-FAQ/")) -<< - cd $(MAKEDIR) - @$(CPY) "$(DOCTMP_DIR)\$(@B).hlp" "$(OUT_DIR)" - @$(CPY) "$(DOCTMP_DIR)\$(@B).cnt" "$(OUT_DIR)" - -$(MAN2TCL): $(TOOLSDIR)\$$(@B).c - $(cc32) $(TCL_CFLAGS) -Fo$(@D)\ $(TOOLSDIR)\$(@B).c - $(link32) $(conlflags) -out:$@ -stack:16384 $(@D)\man2tcl.obj - $(_VC_MANIFEST_EMBED_EXE) - -$(HELPRTF): $(MAN2TCL) $(MAN2HELP) $(MAN2HELP2) $(INDEX) $(DOCDIR)\* - $(TCLSH) $(MAN2HELP) -bitmap $(BMP_NOPATH) $(PROJECT) $(VERSION) $(DOCDIR:\=/) - -install-docs: -!if exist("$(CHMFILE)") - @echo Installing compiled HTML help - @$(CPY) "$(CHMFILE)" "$(DOC_INSTALL_DIR)\" -!endif -!if exist("$(HELPFILE)") - @echo Installing Windows help - @$(CPY) "$(HELPFILE)" "$(DOC_INSTALL_DIR)\" - @$(CPY) "$(HELPCNT)" "$(DOC_INSTALL_DIR)\" -!endif - -#--------------------------------------------------------------------- -# Build tclConfig.sh for the TEA build system. -#--------------------------------------------------------------------- - -tclConfig: $(OUT_DIR)\tclConfig.sh - -$(OUT_DIR)\tclConfig.sh: $(WINDIR)\tclConfig.sh.in - @echo Creating tclConfig.sh - @nmakehlp -s << $** >$@ -@TCL_DLL_FILE@ $(TCLLIBNAME) -@TCL_VERSION@ $(DOTVERSION) -@TCL_MAJOR_VERSION@ $(TCL_MAJOR_VERSION) -@TCL_MINOR_VERSION@ $(TCL_MINOR_VERSION) -@TCL_PATCH_LEVEL@ $(TCL_PATCH_LEVEL) -@CC@ $(CC) -@DEFS@ $(TCL_CFLAGS) -@CFLAGS_DEBUG@ -nologo -c -W3 -YX -Fp$(TMP_DIR)\ -MDd -@CFLAGS_OPTIMIZE@ -nologo -c -W3 -YX -Fp$(TMP_DIR)\ -MD -@LDFLAGS_DEBUG@ -nologo -machine:$(MACHINE) -debug -debugtype:cv -@LDFLAGS_OPTIMIZE@ -nologo -machine:$(MACHINE) -release -opt:ref -opt:icf,3 -@TCL_DBGX@ $(SUFX) -@TCL_LIB_FILE@ $(PROJECT)$(VERSION)$(SUFX).lib -@TCL_NEEDS_EXP_FILE@ -@LIBS@ $(baselibs) -@prefix@ $(_INSTALLDIR) -@exec_prefix@ $(BIN_INSTALL_DIR) -@SHLIB_CFLAGS@ -@STLIB_CFLAGS@ -@CFLAGS_WARNING@ -W3 -@EXTRA_CFLAGS@ -YX -@SHLIB_LD@ $(link32) $(dlllflags) -@STLIB_LD@ $(lib32) -nologo -@SHLIB_LD_LIBS@ $(baselibs) -@SHLIB_SUFFIX@ .dll -@DL_LIBS@ -@LDFLAGS@ -@TCL_LD_SEARCH_FLAGS@ -@LIBOBJS@ -@RANLIB@ -@TCL_LIB_FLAG@ -@TCL_BUILD_LIB_SPEC@ -@TCL_LIB_SPEC@ $(LIB_INSTALL_DIR)\$(PROJECT)$(VERSION)$(SUFX).lib -@TCL_INCLUDE_SPEC@ -I$(INCLUDE_INSTALL_DIR) -@TCL_LIB_VERSIONS_OK@ -@TCL_SRC_DIR@ $(ROOT) -@TCL_PACKAGE_PATH@ -@TCL_STUB_LIB_FILE@ $(TCLSTUBLIBNAME) -@TCL_STUB_LIB_FLAG@ $(TCLSTUBLIBNAME) -@TCL_STUB_LIB_SPEC@ -L$(LIB_INSTALL_DIR) $(TCLSTUBLIBNAME) -@TCL_THREADS@ $(TCL_THREADS) -@TCL_BUILD_STUB_LIB_SPEC@ -L$(OUT_DIR) $(TCLSTUBLIBNAME) -@TCL_BUILD_STUB_LIB_PATH@ $(TCLSTUBLIB) -@TCL_STUB_LIB_PATH@ $(LIB_INSTALL_DIR)\$(TCLSTUBLIBNAME) -@CFG_TCL_EXPORT_FILE_SUFFIX@ $(VERSION)$(SUFX).lib -@CFG_TCL_SHARED_LIB_SUFFIX@ $(VERSION)$(SUFX).dll -@CFG_TCL_UNSHARED_LIB_SUFFIX@ $(VERSION)$(SUFX).lib -!if $(STATIC_BUILD) -@TCL_SHARED_BUILD@ 0 -!else -@TCL_SHARED_BUILD@ 1 -!endif -<< - - -#--------------------------------------------------------------------- -# The following target generates the file generic/tclDate.c -# from the yacc grammar found in generic/tclGetDate.y. This is -# only run by hand as yacc is not available in all environments. -# The name of the .c file is different than the name of the .y file -# so that make doesn't try to automatically regenerate the .c file. -#--------------------------------------------------------------------- - -gendate: - bison --output-file=$(GENERICDIR)/tclDate.c \ - --name-prefix=TclDate \ - $(GENERICDIR)/tclGetDate.y - -#--------------------------------------------------------------------- -# Special case object file targets -#--------------------------------------------------------------------- - -$(TMP_DIR)\testMain.obj: $(WINDIR)\tclAppInit.c - $(cc32) $(TCL_CFLAGS) -DTCL_TEST \ - -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$@ $? - -$(TMP_DIR)\tclTestObj.obj: $(GENERICDIR)\tclTestObj.c - $(cc32) $(TCL_CFLAGS) -Fo$@ $? - -$(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:\=\\)\"" \ - -DCFG_INSTALL_BINDIR="\"$(BIN_INSTALL_DIR:\=\\)\"" \ - -DCFG_INSTALL_SCRDIR="\"$(SCRIPT_INSTALL_DIR:\=\\)\"" \ - -DCFG_INSTALL_INCDIR="\"$(INCLUDE_INSTALL_DIR:\=\\)\"" \ - -DCFG_INSTALL_DOCDIR="\"$(DOC_INSTALL_DIR:\=\\)\"" \ - -DCFG_RUNTIME_LIBDIR="\"$(LIB_INSTALL_DIR:\=\\)\"" \ - -DCFG_RUNTIME_BINDIR="\"$(BIN_INSTALL_DIR:\=\\)\"" \ - -DCFG_RUNTIME_SCRDIR="\"$(SCRIPT_INSTALL_DIR:\=\\)\"" \ - -DCFG_RUNTIME_INCDIR="\"$(INCLUDE_INSTALL_DIR:\=\\)\"" \ - -DCFG_RUNTIME_DOCDIR="\"$(DOC_INSTALL_DIR:\=\\)\"" \ - -Fo$@ $? - -$(TMP_DIR)\tclAppInit.obj: $(WINDIR)\tclAppInit.c - $(cc32) $(TCL_CFLAGS) \ - -DTCL_USE_STATIC_PACKAGES=$(TCL_USE_STATIC_PACKAGES) \ - -Fo$@ $? - -### The following objects should be built using the stub interfaces -### *ALL* extensions need to built with -DTCL_THREADS=1 - -$(TMP_DIR)\tclWinReg.obj: $(WINDIR)\tclWinReg.c -!if $(STATIC_BUILD) - $(cc32) $(TCL_CFLAGS) -DTCL_THREADS=1 -DSTATIC_BUILD -Fo$@ $? -!else - $(cc32) $(TCL_CFLAGS) -DTCL_THREADS=1 -DUSE_TCL_STUBS -Fo$@ $? -!endif - - -$(TMP_DIR)\tclWinDde.obj: $(WINDIR)\tclWinDde.c -!if $(STATIC_BUILD) - $(cc32) $(TCL_CFLAGS) -DTCL_THREADS=1 -DSTATIC_BUILD -Fo$@ $? -!else - $(cc32) $(TCL_CFLAGS) -DTCL_THREADS=1 -DUSE_TCL_STUBS -Fo$@ $? -!endif - - -### The following objects are part of the stub library and should not -### 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$@ $? - -#--------------------------------------------------------------------- -# Generate the source dependencies. Having dependency rules will -# improve incremental build accuracy without having to resort to a -# full rebuild just because some non-global header file like -# tclCompile.h was changed. These rules aren't needed when building -# from scratch. -#--------------------------------------------------------------------- - -depend: -!if !exist($(TCLSH)) - @echo Build tclsh first! -!else - $(TCLSH) $(TOOLSDIR:\=/)/mkdepend.tcl -vc32 -out:"$(OUT_DIR)\depend.mk" \ - -passthru:"-DBUILD_tcl $(TCL_INCLUDES)" $(GENERICDIR),$$(GENERICDIR) \ - $(COMPATDIR),$$(COMPATDIR) $(TOMMATHDIR),$$(TOMMATHDIR) $(WINDIR),$$(WINDIR) @<< -$(TCLOBJS) -<< -!endif - -#--------------------------------------------------------------------- -# Dependency rules -#--------------------------------------------------------------------- - -!if exist("$(OUT_DIR)\depend.mk") -!include "$(OUT_DIR)\depend.mk" -!message *** Dependency rules in use. -!else -!message *** Dependency rules are not being used. -!endif - -### add a spacer in the output -!message - - -#--------------------------------------------------------------------- -# Implicit rules. 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:: - $(cc32) $(TCL_CFLAGS) -DBUILD_tcl -Fo$(TMP_DIR)\ @<< -$< -<< - -{$(TOMMATHDIR)}.c{$(TMP_DIR)}.obj:: - $(cc32) $(TCL_CFLAGS) -DBUILD_tcl -Fo$(TMP_DIR)\ @<< -$< -<< - -{$(GENERICDIR)}.c{$(TMP_DIR)}.obj:: - $(cc32) $(TCL_CFLAGS) -DBUILD_tcl -Fo$(TMP_DIR)\ @<< -$< -<< - -{$(COMPATDIR)}.c{$(TMP_DIR)}.obj:: - $(cc32) $(TCL_CFLAGS) -DBUILD_tcl -Fo$(TMP_DIR)\ @<< -$< -<< - -{$(COMPATDIR)\zlib}.c{$(TMP_DIR)}.obj:: - $(cc32) $(TCL_CFLAGS) -DBUILD_tcl -Fo$(TMP_DIR)\ @<< -$< -<< - -{$(WINDIR)}.rc{$(TMP_DIR)}.res: - $(rc32) -fo $@ -r -i "$(GENERICDIR)" \ - -d DEBUG=$(DEBUG) -d UNCHECKED=$(UNCHECKED) \ - -d TCL_THREADS=$(TCL_THREADS) \ - -d STATIC_BUILD=$(STATIC_BUILD) \ - $< - -.SUFFIXES: -.SUFFIXES:.c .rc - - -#--------------------------------------------------------------------- -# Installation. -#--------------------------------------------------------------------- - -install-binaries: - @echo Installing to '$(_INSTALLDIR)' - @echo Installing $(TCLLIBNAME) -!if "$(TCLLIB)" != "$(TCLIMPLIB)" - @$(CPY) "$(TCLLIB)" "$(BIN_INSTALL_DIR)\" -!endif - @$(CPY) "$(TCLIMPLIB)" "$(LIB_INSTALL_DIR)\" -!if exist($(TCLSH)) - @echo Installing $(TCLSHNAME) - @$(CPY) "$(TCLSH)" "$(BIN_INSTALL_DIR)\" -!endif - @echo Installing $(TCLSTUBLIBNAME) - @$(CPY) "$(TCLSTUBLIB)" "$(LIB_INSTALL_DIR)\" - -#" emacs fix - -install-libraries: tclConfig install-msgs install-tzdata - @if not exist "$(SCRIPT_INSTALL_DIR)$(NULL)" \ - $(MKDIR) "$(SCRIPT_INSTALL_DIR)" - @if not exist "$(SCRIPT_INSTALL_DIR)\..\tcl8$(NULL)" \ - $(MKDIR) "$(SCRIPT_INSTALL_DIR)\..\tcl8" - @if not exist "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.2$(NULL)" \ - $(MKDIR) "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.2" - @if not exist "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.3$(NULL)" \ - $(MKDIR) "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.3" - @if not exist "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.4$(NULL)" \ - $(MKDIR) "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.4" - @if not exist "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.4\platform$(NULL)" \ - $(MKDIR) "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.4\platform" - @if not exist "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.5$(NULL)" \ - $(MKDIR) "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.5" - @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)\" - @$(CPY) "$(TOMMATHDIR)\tommath_class.h" "$(INCLUDE_INSTALL_DIR)\" - @$(CPY) "$(TOMMATHDIR)\tommath_superclass.h" "$(INCLUDE_INSTALL_DIR)\" - @echo Installing library files to $(SCRIPT_INSTALL_DIR) - @$(CPY) "$(ROOT)\library\history.tcl" "$(SCRIPT_INSTALL_DIR)\" - @$(CPY) "$(ROOT)\library\init.tcl" "$(SCRIPT_INSTALL_DIR)\" - @$(CPY) "$(ROOT)\library\clock.tcl" "$(SCRIPT_INSTALL_DIR)\" - @$(CPY) "$(ROOT)\library\tm.tcl" "$(SCRIPT_INSTALL_DIR)\" - @$(CPY) "$(ROOT)\library\parray.tcl" "$(SCRIPT_INSTALL_DIR)\" - @$(CPY) "$(ROOT)\library\safe.tcl" "$(SCRIPT_INSTALL_DIR)\" - @$(CPY) "$(ROOT)\library\tclIndex" "$(SCRIPT_INSTALL_DIR)\" - @$(CPY) "$(ROOT)\library\package.tcl" "$(SCRIPT_INSTALL_DIR)\" - @$(CPY) "$(ROOT)\library\word.tcl" "$(SCRIPT_INSTALL_DIR)\" - @$(CPY) "$(ROOT)\library\auto.tcl" "$(SCRIPT_INSTALL_DIR)\" - @$(CPY) "$(OUT_DIR)\tclConfig.sh" "$(LIB_INSTALL_DIR)\" - @$(CPY) "$(WINDIR)\tclooConfig.sh" "$(LIB_INSTALL_DIR)\" - @echo Installing library http1.0 directory - @$(CPY) "$(ROOT)\library\http1.0\*.tcl" \ - "$(SCRIPT_INSTALL_DIR)\http1.0\" - @echo Installing library opt0.4 directory - @$(CPY) "$(ROOT)\library\opt\*.tcl" \ - "$(SCRIPT_INSTALL_DIR)\opt0.4\" - @echo Installing package http $(PKG_HTTP_VER) as a Tcl Module - @$(COPY) "$(ROOT)\library\http\http.tcl" \ - "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.6\http-$(PKG_HTTP_VER).tm" - @echo Installing package msgcat $(PKG_MSGCAT_VER) as a Tcl Module - @$(COPY) "$(ROOT)\library\msgcat\msgcat.tcl" \ - "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.5\msgcat-$(PKG_MSGCAT_VER).tm" - @echo Installing package tcltest $(PKG_TCLTEST_VER) as a Tcl Module - @$(COPY) "$(ROOT)\library\tcltest\tcltest.tcl" \ - "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.5\tcltest-$(PKG_TCLTEST_VER).tm" - @echo Installing package platform $(PKG_PLATFORM_VER) as a Tcl Module - @$(COPY) "$(ROOT)\library\platform\platform.tcl" \ - "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.4\platform-$(PKG_PLATFORM_VER).tm" - @echo Installing package platform::shell $(PKG_SHELL_VER) as a Tcl Module - @$(COPY) "$(ROOT)\library\platform\shell.tcl" \ - "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.4\platform\shell-$(PKG_SHELL_VER).tm" - @echo Installing $(TCLDDELIBNAME) -!if $(STATIC_BUILD) -!if !$(TCL_USE_STATIC_PACKAGES) - @$(CPY) "$(TCLDDELIB)" "$(LIB_INSTALL_DIR)\" -!endif -!else - @$(CPY) "$(TCLDDELIB)" "$(LIB_INSTALL_DIR)\dde$(DDEDOTVERSION)\" - @$(CPY) "$(ROOT)\library\dde\pkgIndex.tcl" \ - "$(LIB_INSTALL_DIR)\dde$(DDEDOTVERSION)\" -!endif - @echo Installing $(TCLREGLIBNAME) -!if $(STATIC_BUILD) -!if !$(TCL_USE_STATIC_PACKAGES) - @$(CPY) "$(TCLREGLIB)" "$(LIB_INSTALL_DIR)\" -!endif -!else - @$(CPY) "$(TCLREGLIB)" "$(LIB_INSTALL_DIR)\reg$(REGDOTVERSION)\" - @$(CPY) "$(ROOT)\library\reg\pkgIndex.tcl" \ - "$(LIB_INSTALL_DIR)\reg$(REGDOTVERSION)\" -!endif - @echo Installing encodings - @$(CPY) "$(ROOT)\library\encoding\*.enc" \ - "$(SCRIPT_INSTALL_DIR)\encoding\" - -#" emacs fix - -install-tzdata: - @echo Installing time zone data - @set TCL_LIBRARY=$(ROOT:\=/)/library - @$(TCLSH_NATIVE) "$(ROOT:\=/)/tools/installData.tcl" \ - "$(ROOT:\=/)/library/tzdata" "$(SCRIPT_INSTALL_DIR)/tzdata" - -install-msgs: - @echo Installing message catalogs - @set TCL_LIBRARY=$(ROOT:\=/)/library - @$(TCLSH_NATIVE) "$(ROOT:\=/)/tools/installData.tcl" \ - "$(ROOT:\=/)/library/msgs" "$(SCRIPT_INSTALL_DIR)/msgs" - -#--------------------------------------------------------------------- -# Clean up -#--------------------------------------------------------------------- - -tidy: -!if "$(TCLLIB)" != "$(TCLIMPLIB)" - @echo Removing $(TCLLIB) ... - @if exist $(TCLLIB) del $(TCLLIB) -!endif - @echo Removing $(TCLIMPLIB) ... - @if exist $(TCLIMPLIB) del $(TCLIMPLIB) - @echo Removing $(TCLSH) ... - @if exist $(TCLSH) del $(TCLSH) - @echo Removing $(TCLTEST) ... - @if exist $(TCLTEST) del $(TCLTEST) - @echo Removing $(TCLDDELIB) ... - @if exist $(TCLDDELIB) del $(TCLDDELIB) - @echo Removing $(TCLREGLIB) ... - @if exist $(TCLREGLIB) del $(TCLREGLIB) - -clean: clean-pkgs - @echo Cleaning $(TMP_DIR)\* ... - @if exist $(TMP_DIR)\nul $(RMDIR) $(TMP_DIR) - @echo Cleaning $(WINDIR)\nmakehlp.obj ... - @if exist $(WINDIR)\nmakehlp.obj del $(WINDIR)\nmakehlp.obj - @echo Cleaning $(WINDIR)\nmakehlp.exe ... - @if exist $(WINDIR)\nmakehlp.exe del $(WINDIR)\nmakehlp.exe - @echo Cleaning $(WINDIR)\_junk.pch ... - @if exist $(WINDIR)\_junk.pch del $(WINDIR)\_junk.pch - @echo Cleaning $(WINDIR)\vercl.x ... - @if exist $(WINDIR)\vercl.x del $(WINDIR)\vercl.x - @echo Cleaning $(WINDIR)\vercl.i ... - @if exist $(WINDIR)\vercl.i del $(WINDIR)\vercl.i - @echo Cleaning $(WINDIR)\versions.vc ... - @if exist $(WINDIR)\versions.vc del $(WINDIR)\versions.vc - -realclean: hose - -hose: - @echo Hosing $(OUT_DIR)\* ... - @if exist $(OUT_DIR)\nul $(RMDIR) $(OUT_DIR) +#------------------------------------------------------------- -*- 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.
+# Copyright (c) 2003-2008 Pat Thoyts.
+#------------------------------------------------------------------------------
+
+# Check to see we are configured to build with MSVC (MSDEVDIR, MSVCDIR or
+# VCINSTALLDIR) or with the MS Platform SDK (MSSDK or WindowsSDKDir)
+!if !defined(MSDEVDIR) && !defined(MSVCDIR) && !defined(VCINSTALLDIR) && !defined(MSSDK) && !defined(WINDOWSSDKDIR)
+MSG = ^
+You need to run vcvars32.bat from Developer Studio or setenv.bat from the^
+Platform SDK first to setup the environment. Jump to this line to read^
+the build instructions.
+!error $(MSG)
+!endif
+
+#------------------------------------------------------------------------------
+# HOW TO USE this makefile:
+#
+# 1) It is now necessary to have MSVCDir, MSDevDir or MSSDK set in the
+# environment. This is used as a check to see if vcvars32.bat had been
+# run prior to running nmake or during the installation of Microsoft
+# Visual C++, MSVCDir had been set globally and the PATH adjusted.
+# Either way is valid.
+#
+# You'll need to run vcvars32.bat contained in the MsDev's vc(98)/bin
+# directory to setup the proper environment, if needed, for your
+# current setup. This is a needed bootstrap requirement and allows the
+# swapping of different environments to be easier.
+#
+# 2) To use the Platform SDK (not expressly needed), run setenv.bat after
+# vcvars32.bat according to the instructions for it. This can also
+# turn on the 64-bit compiler, if your SDK has it.
+#
+# 3) Targets are:
+# release -- Builds the core, the shell and the dlls. (default)
+# dlls -- Just builds the windows extensions and the 16-bit DOS
+# pipe/thunk helper app.
+# shell -- Just builds the shell and the core.
+# core -- Only builds the core [tclXX.(dll|lib)].
+# all -- Builds everything.
+# test -- Builds and runs the test suite.
+# tcltest -- Just builds the test shell.
+# install -- Installs the built binaries and libraries to $(INSTALLDIR)
+# as the root of the install tree.
+# tidy/clean/hose -- varying levels of cleaning.
+# genstubs -- Rebuilds the Stubs table and support files (dev only).
+# depend -- Generates an accurate set of source dependancies for this
+# makefile. Helpful to avoid problems when the sources are
+# refreshed and you rebuild, but can "overbuild" when common
+# headers like tclInt.h just get small changes.
+# htmlhelp -- Builds a Windows .chm help file for Tcl and Tk from the
+# troff manual pages found in $(ROOT)\doc. You need to
+# have installed the HTML Help Compiler package from Microsoft
+# to produce the .chm file.
+# winhelp -- Builds the windows .hlp file for Tcl from the troff man
+# files found in $(ROOT)\doc.
+#
+# 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=loimpact,msvcrt,static,staticpkg,symbols,threads,profile,unchecked,none
+# Sets special options for the core. The default is for none.
+# Any combination of the above may be used (comma separated).
+# 'none' will over-ride everything to nothing.
+#
+# loimpact = Adds a flag for how NT treats the heap to keep memory
+# in use, low. This is said to impact alloc performance.
+# msvcrt = Affects the static option only to switch it from
+# using libcmt(d) as the C runtime [by default] to
+# msvcrt(d). This is useful for static embedding
+# support.
+# static = Builds a static library of the core instead of a
+# dll. The shell will be static (and large), as well.
+# staticpkg= Affects the static option only to switch
+# tclshXX.exe to have the dde and reg extension linked
+# inside it.
+# threads = Turns on full multithreading support.
+# thrdalloc = Use the thread allocator (shared global free pool).
+# thrdstorage = Use the generic thread storage support.
+# symbols = Adds symbols for step debugging.
+# profile = Adds profiling hooks. Map file is assumed.
+# unchecked = Allows a symbols build to not use the debug
+# enabled runtime (msvcrt.dll not msvcrtd.dll
+# or libcmt.lib not libcmtd.lib).
+#
+# STATS=compdbg,memdbg,none
+# Sets optional memory and bytecode compiler debugging code added
+# to the core. The default is for none. Any combination of the
+# above may be used (comma separated). 'none' will over-ride
+# everything to nothing.
+#
+# compdbg = Enables byte compilation logging.
+# memdbg = Enables the debugging memory allocator.
+#
+# CHECKS=64bit,fullwarn,nodep,none
+# Sets special macros for checking compatability.
+#
+# 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=(ALPHA|AMD64|IA64|IX86)
+# Set the machine type used for the compiler, linker, and
+# resource compiler. This hook is needed to tell the tools
+# when alternate platforms are requested. IX86 is the default
+# when not specified. If the CPU environment variable has been
+# set (ie: recent Platform SDK) then MACHINE is set from CPU.
+#
+# TMP_DIR=<path>
+# OUT_DIR=<path>
+# Hooks to allow the intermediate and output directories to be
+# changed. $(OUT_DIR) is assumed to be
+# $(BINROOT)\(Release|Debug) based on if symbols are requested.
+# $(TMP_DIR) will de $(OUT_DIR)\<buildtype> by default.
+#
+# TESTPAT=<file>
+# Reads the tests requested to be run from this file.
+#
+# CFG_ENCODING=encoding
+# name of encoding for configuration information. Defaults
+# to cp1252
+#
+# 5) Examples:
+#
+# Basic syntax of calling nmake looks like this:
+# nmake [-nologo] -f makefile.vc [target|macrodef [target|macrodef] [...]]
+#
+# Standard (no frills)
+# c:\tcl_src\win\>c:\progra~1\micros~1\vc98\bin\vcvars32.bat
+# Setting environment for using Microsoft Visual C++ tools.
+# c:\tcl_src\win\>nmake -f makefile.vc release
+# c:\tcl_src\win\>nmake -f makefile.vc install INSTALLDIR=c:\progra~1\tcl
+#
+# Building for Win64
+# c:\tcl_src\win\>c:\progra~1\micros~1\vc98\bin\vcvars32.bat
+# Setting environment for using Microsoft Visual C++ tools.
+# c:\tcl_src\win\>c:\progra~1\platfo~1\setenv.bat /pre64 /RETAIL
+# Targeting Windows pre64 RETAIL
+# c:\tcl_src\win\>nmake -f makefile.vc MACHINE=IA64
+#
+#------------------------------------------------------------------------------
+#==============================================================================
+###############################################################################
+
+
+# //==================================================================\\
+# >>[ -> Do not modify below this line. <- ]<<
+# >>[ Please, use the commandline macros to modify how Tcl is built. ]<<
+# >>[ If you need more features, send us a patch for more macros. ]<<
+# \\==================================================================//
+
+
+###############################################################################
+#==============================================================================
+#------------------------------------------------------------------------------
+
+!if !exist("makefile.vc")
+MSG = ^
+You must run this makefile only from the directory it is in.^
+Please `cd` to its location first.
+!error $(MSG)
+!endif
+
+PROJECT = tcl
+!include "rules.vc"
+
+STUBPREFIX = $(PROJECT)stub
+DOTVERSION = $(TCL_MAJOR_VERSION).$(TCL_MINOR_VERSION)
+VERSION = $(TCL_MAJOR_VERSION)$(TCL_MINOR_VERSION)
+
+DDEDOTVERSION = 1.3
+DDEVERSION = $(DDEDOTVERSION:.=)
+
+REGDOTVERSION = 1.2
+REGVERSION = $(REGDOTVERSION:.=)
+
+BINROOT = .
+ROOT = ..
+
+TCLIMPLIB = $(OUT_DIR)\$(PROJECT)$(VERSION)$(SUFX).lib
+TCLLIBNAME = $(PROJECT)$(VERSION)$(SUFX).$(EXT)
+TCLLIB = $(OUT_DIR)\$(TCLLIBNAME)
+
+TCLSTUBLIBNAME = $(STUBPREFIX)$(VERSION).lib
+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)
+
+TCLDDELIBNAME = $(PROJECT)dde$(DDEVERSION)$(SUFX:t=).$(EXT)
+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
+DOC_INSTALL_DIR = $(_INSTALLDIR)\doc
+SCRIPT_INSTALL_DIR = $(_INSTALLDIR)\lib\tcl$(DOTVERSION)
+INCLUDE_INSTALL_DIR = $(_INSTALLDIR)\include
+
+TCLSHOBJS = \
+ $(TMP_DIR)\tclAppInit.obj \
+!if $(TCL_USE_STATIC_PACKAGES)
+ $(TMP_DIR)\tclWinReg.obj \
+ $(TMP_DIR)\tclWinDde.obj \
+!endif
+ $(TMP_DIR)\tclsh.res
+
+TCLTESTOBJS = \
+ $(TMP_DIR)\tclTest.obj \
+ $(TMP_DIR)\tclTestObj.obj \
+ $(TMP_DIR)\tclTestProcBodyObj.obj \
+ $(TMP_DIR)\tclThreadTest.obj \
+ $(TMP_DIR)\tclWinTest.obj \
+!if $(TCL_USE_STATIC_PACKAGES)
+ $(TMP_DIR)\tclWinReg.obj \
+ $(TMP_DIR)\tclWinDde.obj \
+!endif
+ $(TMP_DIR)\testMain.obj
+
+TCLOBJS = \
+ $(TMP_DIR)\regcomp.obj \
+ $(TMP_DIR)\regerror.obj \
+ $(TMP_DIR)\regexec.obj \
+ $(TMP_DIR)\regfree.obj \
+ $(TMP_DIR)\tclAlloc.obj \
+ $(TMP_DIR)\tclAsync.obj \
+ $(TMP_DIR)\tclBasic.obj \
+ $(TMP_DIR)\tclBinary.obj \
+ $(TMP_DIR)\tclCkalloc.obj \
+ $(TMP_DIR)\tclClock.obj \
+ $(TMP_DIR)\tclCmdAH.obj \
+ $(TMP_DIR)\tclCmdIL.obj \
+ $(TMP_DIR)\tclCmdMZ.obj \
+ $(TMP_DIR)\tclCompCmds.obj \
+ $(TMP_DIR)\tclCompExpr.obj \
+ $(TMP_DIR)\tclCompile.obj \
+ $(TMP_DIR)\tclConfig.obj \
+ $(TMP_DIR)\tclDate.obj \
+ $(TMP_DIR)\tclDictObj.obj \
+ $(TMP_DIR)\tclEncoding.obj \
+ $(TMP_DIR)\tclEnv.obj \
+ $(TMP_DIR)\tclEvent.obj \
+ $(TMP_DIR)\tclExecute.obj \
+ $(TMP_DIR)\tclFCmd.obj \
+ $(TMP_DIR)\tclFileName.obj \
+ $(TMP_DIR)\tclGet.obj \
+ $(TMP_DIR)\tclHash.obj \
+ $(TMP_DIR)\tclHistory.obj \
+ $(TMP_DIR)\tclIndexObj.obj \
+ $(TMP_DIR)\tclInterp.obj \
+ $(TMP_DIR)\tclIO.obj \
+ $(TMP_DIR)\tclIOCmd.obj \
+ $(TMP_DIR)\tclIOGT.obj \
+ $(TMP_DIR)\tclIOSock.obj \
+ $(TMP_DIR)\tclIOUtil.obj \
+ $(TMP_DIR)\tclIORChan.obj \
+ $(TMP_DIR)\tclLink.obj \
+ $(TMP_DIR)\tclListObj.obj \
+ $(TMP_DIR)\tclLiteral.obj \
+ $(TMP_DIR)\tclLoad.obj \
+ $(TMP_DIR)\tclMain.obj \
+ $(TMP_DIR)\tclNamesp.obj \
+ $(TMP_DIR)\tclNotify.obj \
+ $(TMP_DIR)\tclObj.obj \
+ $(TMP_DIR)\tclPanic.obj \
+ $(TMP_DIR)\tclParse.obj \
+ $(TMP_DIR)\tclPathObj.obj \
+ $(TMP_DIR)\tclPipe.obj \
+ $(TMP_DIR)\tclPkg.obj \
+ $(TMP_DIR)\tclPkgConfig.obj \
+ $(TMP_DIR)\tclPosixStr.obj \
+ $(TMP_DIR)\tclPreserve.obj \
+ $(TMP_DIR)\tclProc.obj \
+ $(TMP_DIR)\tclRegexp.obj \
+ $(TMP_DIR)\tclResolve.obj \
+ $(TMP_DIR)\tclResult.obj \
+ $(TMP_DIR)\tclScan.obj \
+ $(TMP_DIR)\tclStringObj.obj \
+ $(TMP_DIR)\tclStrToD.obj \
+ $(TMP_DIR)\tclStubInit.obj \
+ $(TMP_DIR)\tclStubLib.obj \
+ $(TMP_DIR)\tclThread.obj \
+ $(TMP_DIR)\tclThreadAlloc.obj \
+ $(TMP_DIR)\tclThreadJoin.obj \
+ $(TMP_DIR)\tclThreadStorage.obj \
+ $(TMP_DIR)\tclTimer.obj \
+ $(TMP_DIR)\tclTomMathInterface.obj \
+ $(TMP_DIR)\tclTrace.obj \
+ $(TMP_DIR)\tclUtf.obj \
+ $(TMP_DIR)\tclUtil.obj \
+ $(TMP_DIR)\tclVar.obj \
+ $(TMP_DIR)\tclWin32Dll.obj \
+ $(TMP_DIR)\tclWinChan.obj \
+ $(TMP_DIR)\tclWinConsole.obj \
+ $(TMP_DIR)\tclWinSerial.obj \
+ $(TMP_DIR)\tclWinError.obj \
+ $(TMP_DIR)\tclWinFCmd.obj \
+ $(TMP_DIR)\tclWinFile.obj \
+ $(TMP_DIR)\tclWinInit.obj \
+ $(TMP_DIR)\tclWinLoad.obj \
+ $(TMP_DIR)\tclWinNotify.obj \
+ $(TMP_DIR)\tclWinPipe.obj \
+ $(TMP_DIR)\tclWinSock.obj \
+ $(TMP_DIR)\tclWinThrd.obj \
+ $(TMP_DIR)\tclWinTime.obj \
+ $(TMP_DIR)\bncore.obj \
+ $(TMP_DIR)\bn_reverse.obj \
+ $(TMP_DIR)\bn_fast_s_mp_mul_digs.obj \
+ $(TMP_DIR)\bn_fast_s_mp_sqr.obj \
+ $(TMP_DIR)\bn_mp_add.obj \
+ $(TMP_DIR)\bn_mp_add_d.obj \
+ $(TMP_DIR)\bn_mp_and.obj \
+ $(TMP_DIR)\bn_mp_clamp.obj \
+ $(TMP_DIR)\bn_mp_clear.obj \
+ $(TMP_DIR)\bn_mp_clear_multi.obj \
+ $(TMP_DIR)\bn_mp_cmp.obj \
+ $(TMP_DIR)\bn_mp_cmp_d.obj \
+ $(TMP_DIR)\bn_mp_cmp_mag.obj \
+ $(TMP_DIR)\bn_mp_cnt_lsb.obj \
+ $(TMP_DIR)\bn_mp_copy.obj \
+ $(TMP_DIR)\bn_mp_count_bits.obj \
+ $(TMP_DIR)\bn_mp_div.obj \
+ $(TMP_DIR)\bn_mp_div_d.obj \
+ $(TMP_DIR)\bn_mp_div_2.obj \
+ $(TMP_DIR)\bn_mp_div_2d.obj \
+ $(TMP_DIR)\bn_mp_div_3.obj \
+ $(TMP_DIR)\bn_mp_exch.obj \
+ $(TMP_DIR)\bn_mp_expt_d.obj \
+ $(TMP_DIR)\bn_mp_grow.obj \
+ $(TMP_DIR)\bn_mp_init.obj \
+ $(TMP_DIR)\bn_mp_init_copy.obj \
+ $(TMP_DIR)\bn_mp_init_multi.obj \
+ $(TMP_DIR)\bn_mp_init_set.obj \
+ $(TMP_DIR)\bn_mp_init_set_int.obj \
+ $(TMP_DIR)\bn_mp_init_size.obj \
+ $(TMP_DIR)\bn_mp_karatsuba_mul.obj \
+ $(TMP_DIR)\bn_mp_karatsuba_sqr.obj \
+ $(TMP_DIR)\bn_mp_lshd.obj \
+ $(TMP_DIR)\bn_mp_mod.obj \
+ $(TMP_DIR)\bn_mp_mod_2d.obj \
+ $(TMP_DIR)\bn_mp_mul.obj \
+ $(TMP_DIR)\bn_mp_mul_2.obj \
+ $(TMP_DIR)\bn_mp_mul_2d.obj \
+ $(TMP_DIR)\bn_mp_mul_d.obj \
+ $(TMP_DIR)\bn_mp_neg.obj \
+ $(TMP_DIR)\bn_mp_or.obj \
+ $(TMP_DIR)\bn_mp_radix_size.obj \
+ $(TMP_DIR)\bn_mp_radix_smap.obj \
+ $(TMP_DIR)\bn_mp_read_radix.obj \
+ $(TMP_DIR)\bn_mp_rshd.obj \
+ $(TMP_DIR)\bn_mp_set.obj \
+ $(TMP_DIR)\bn_mp_set_int.obj \
+ $(TMP_DIR)\bn_mp_shrink.obj \
+ $(TMP_DIR)\bn_mp_sqr.obj \
+ $(TMP_DIR)\bn_mp_sqrt.obj \
+ $(TMP_DIR)\bn_mp_sub.obj \
+ $(TMP_DIR)\bn_mp_sub_d.obj \
+ $(TMP_DIR)\bn_mp_to_unsigned_bin.obj \
+ $(TMP_DIR)\bn_mp_to_unsigned_bin_n.obj \
+ $(TMP_DIR)\bn_mp_toom_mul.obj \
+ $(TMP_DIR)\bn_mp_toom_sqr.obj \
+ $(TMP_DIR)\bn_mp_toradix_n.obj \
+ $(TMP_DIR)\bn_mp_unsigned_bin_size.obj \
+ $(TMP_DIR)\bn_mp_xor.obj \
+ $(TMP_DIR)\bn_mp_zero.obj \
+ $(TMP_DIR)\bn_s_mp_add.obj \
+ $(TMP_DIR)\bn_s_mp_mul_digs.obj \
+ $(TMP_DIR)\bn_s_mp_sqr.obj \
+ $(TMP_DIR)\bn_s_mp_sub.obj \
+!if !$(STATIC_BUILD)
+ $(TMP_DIR)\tcl.res
+!endif
+
+TCLSTUBOBJS = \
+ $(TMP_DIR)\tclStubLib.obj
+
+### The following paths CANNOT have spaces in them.
+COMPATDIR = $(ROOT)\compat
+DOCDIR = $(ROOT)\doc
+GENERICDIR = $(ROOT)\generic
+TOMMATHDIR = $(ROOT)\libtommath
+TOOLSDIR = $(ROOT)\tools
+WINDIR = $(ROOT)\win
+
+#---------------------------------------------------------------------
+# Compile flags
+#---------------------------------------------------------------------
+
+!if !$(DEBUG)
+!if $(OPTIMIZING)
+### This cranks the optimization level to maximize speed
+cdebug = -O2 $(OPTIMIZATIONS)
+!else
+cdebug =
+!endif
+!if $(SYMBOLS)
+cdebug = $(cdebug) -Zi
+!endif
+!else if "$(MACHINE)" == "IA64" || "$(MACHINE)" == "AMD64"
+### Warnings are too many, can't support warnings into errors.
+cdebug = -Zi -Od $(DEBUGFLAGS)
+!else
+cdebug = -Zi -WX $(DEBUGFLAGS)
+!endif
+
+### Declarations common to all compiler options
+cwarn = $(WARNINGS) -D _CRT_SECURE_NO_DEPRECATE -D _CRT_NONSTDC_NO_DEPRECATE
+cflags = -nologo -c $(COMPILERFLAGS) $(cwarn) -Fp$(TMP_DIR)^\
+
+!if $(MSVCRT)
+!if $(DEBUG) && !$(UNCHECKED)
+crt = -MDd
+!else
+crt = -MD
+!endif
+!else
+!if $(DEBUG) && !$(UNCHECKED)
+crt = -MTd
+!else
+crt = -MT
+!endif
+!endif
+
+TCL_INCLUDES = -I"$(WINDIR)" -I"$(GENERICDIR)" -I"$(TOMMATHDIR)"
+TCL_DEFINES = -DTCL_PIPE_DLL=\"$(TCLPIPEDLLNAME)\" -DTCL_TOMMATH -DMP_PREC=4 -Dinline=__inline
+BASE_CFLAGS = $(cflags) $(cdebug) $(crt) $(TCL_INCLUDES) $(TCL_DEFINES)
+CON_CFLAGS = $(cflags) $(cdebug) $(crt) -DCONSOLE
+TCL_CFLAGS = $(BASE_CFLAGS) $(OPTDEFINES)
+STUB_CFLAGS = $(cflags) $(cdebug) $(OPTDEFINES)
+
+
+#---------------------------------------------------------------------
+# Link flags
+#---------------------------------------------------------------------
+
+!if $(DEBUG)
+ldebug = -debug -debugtype:cv
+!else
+ldebug = -release -opt:ref -opt:icf,3
+!if $(SYMBOLS)
+ldebug = $(ldebug) -debug -debugtype:cv
+!endif
+!endif
+
+### Declarations common to all linker options
+lflags = -nologo -machine:$(MACHINE) $(LINKERFLAGS) $(ldebug)
+
+!if $(PROFILE)
+lflags = $(lflags) -profile
+!endif
+
+!if $(MSVCRT) && !($(DEBUG) && !$(UNCHECKED)) && $(VCVERSION) >= 1900
+lflags = $(lflags) -nodefaultlib:libucrt.lib
+!endif
+
+!if $(ALIGN98_HACK) && !$(STATIC_BUILD)
+### Align sections for PE size savings.
+lflags = $(lflags) -opt:nowin98
+!else if !$(ALIGN98_HACK) && $(STATIC_BUILD)
+### Align sections for speed in loading by choosing the virtual page size.
+lflags = $(lflags) -align:4096
+!endif
+
+!if $(LOIMPACT)
+lflags = $(lflags) -ws:aggressive
+!endif
+
+dlllflags = $(lflags) -dll
+conlflags = $(lflags) -subsystem:console
+guilflags = $(lflags) -subsystem:windows
+
+baselibs = kernel32.lib user32.lib ws2_32.lib
+# Avoid 'unresolved external symbol __security_cookie' errors.
+# c.f. http://support.microsoft.com/?id=894573
+!if "$(MACHINE)" == "IA64" || "$(MACHINE)" == "AMD64"
+!if $(VCVERSION) > 1399 && $(VCVERSION) < 1500
+baselibs = $(baselibs) bufferoverflowU.lib
+!endif
+!endif
+!if $(MSVCRT) && !($(DEBUG) && !$(UNCHECKED)) && $(VCVERSION) >= 1900
+baselibs = $(baselibs) ucrt.lib
+!endif
+
+#---------------------------------------------------------------------
+# TclTest flags
+#---------------------------------------------------------------------
+
+!if "$(TESTPAT)" != ""
+TESTFLAGS = $(TESTFLAGS) -file $(TESTPAT)
+!endif
+
+
+#---------------------------------------------------------------------
+# Project specific targets
+#---------------------------------------------------------------------
+
+release: setup $(TCLSH) $(TCLSTUBLIB) dlls
+core: setup $(TCLLIB) $(TCLSTUBLIB)
+shell: setup $(TCLSH)
+dlls: setup $(TCLPIPEDLL) $(TCLREGLIB) $(TCLDDELIB)
+all: setup $(TCLSH) $(TCLSTUBLIB) dlls $(CAT32)
+tcltest: setup $(TCLTEST) dlls $(CAT32)
+install: install-binaries install-libraries install-docs
+
+test: test-core
+test-core: setup $(TCLTEST) dlls $(CAT32)
+ set TCL_LIBRARY=$(ROOT:\=/)/library
+!if "$(OS)" == "Windows_NT" || "$(MSVCDIR)" == "IDE"
+ $(DEBUGGER) $(TCLTEST) "$(ROOT:\=/)/tests/all.tcl" $(TESTFLAGS) -loadfile <<
+ package ifneeded dde 1.3.3 [list load "$(TCLDDELIB:\=/)" dde]
+ package ifneeded registry 1.2.2 [list load "$(TCLREGLIB:\=/)" registry]
+<<
+!else
+ @echo Please wait while the tests are collected...
+ $(TCLTEST) "$(ROOT:\=/)/tests/all.tcl" $(TESTFLAGS) -loadfile << > tests.log
+ package ifneeded dde 1.3.3 "$(TCLDDELIB:\=/)" dde]
+ package ifneeded registry 1.2.2 "$(TCLREGLIB:\=/)" registry]
+<<
+ type tests.log | more
+!endif
+
+runtest: setup $(TCLTEST) dlls $(CAT32)
+ 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)
+ @if not exist $(TMP_DIR)\nul mkdir $(TMP_DIR)
+
+!if !$(STATIC_BUILD)
+$(TCLIMPLIB): $(TCLLIB)
+!endif
+
+$(TCLLIB): $(TCLOBJS)
+!if $(STATIC_BUILD)
+ $(lib32) -nologo $(LINKERFLAGS) -out:$@ @<<
+$**
+<<
+!else
+ $(link32) $(dlllflags) -base:@$(WINDIR)\coffbase.txt,tcl -out:$@ \
+ $(baselibs) @<<
+$**
+<<
+ $(_VC_MANIFEST_EMBED_DLL)
+ -@del $*.exp
+!endif
+
+$(TCLSTUBLIB): $(TCLSTUBOBJS)
+ $(lib32) -nologo $(LINKERFLAGS) -nodefaultlib -out:$@ $(TCLSTUBOBJS)
+
+$(TCLSH): $(TCLSHOBJS) $(TCLSTUBLIB) $(TCLIMPLIB)
+ $(link32) $(conlflags) -stack:2300000 -out:$@ $(baselibs) $**
+ $(_VC_MANIFEST_EMBED_EXE)
+
+$(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)
+$(TCLDDELIB): $(TMP_DIR)\tclWinDde.obj
+ $(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)
+$(TCLREGLIB): $(TMP_DIR)\tclWinReg.obj
+ $(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
+
+$(CAT32): $(WINDIR)\cat.c
+ $(cc32) $(CON_CFLAGS) -Fo$(TMP_DIR)\ $?
+ $(link32) $(conlflags) -out:$@ -stack:16384 $(TMP_DIR)\cat.obj \
+ $(baselibs)
+ $(_VC_MANIFEST_EMBED_EXE)
+
+#---------------------------------------------------------------------
+# Regenerate the stubs files. [Development use only]
+#---------------------------------------------------------------------
+
+genstubs:
+!if !exist($(TCLSH))
+ @echo Build tclsh first!
+!else
+ $(TCLSH) $(TOOLSDIR:\=/)/genStubs.tcl $(GENERICDIR:\=/) \
+ $(GENERICDIR:\=/)/tcl.decls $(GENERICDIR:\=/)/tclInt.decls \
+ $(GENERICDIR:\=/)/tclTomMath.decls
+!endif
+
+
+#----------------------------------------------------------------------
+# The following target generates the file generic/tclTomMath.h.
+# It needs to be run (and the results checked) after updating
+# to a new release of libtommath.
+#----------------------------------------------------------------------
+
+gentommath_h:
+!if !exist($(TCLSH))
+ @echo Build tclsh first!
+!else
+ $(TCLSH) "$(TOOLSDIR:\=/)/fix_tommath_h.tcl" \
+ "$(TOMMATHDIR:\=/)/tommath.h" \
+ > "$(GENERICDIR)\tclTomMath.h"
+!endif
+
+#---------------------------------------------------------------------
+# Build the Windows HTML help file.
+#---------------------------------------------------------------------
+
+# NOTE: you can define HHC on the command-line to override this
+!ifndef HHC
+HHC=""%ProgramFiles%\HTML Help Workshop\hhc.exe""
+!endif
+HTMLDIR=$(ROOT)\html
+HTMLBASE=TclTk$(VERSION)
+HHPFILE=$(HTMLDIR)\$(HTMLBASE).hhp
+CHMFILE=$(HTMLDIR)\$(HTMLBASE).chm
+
+htmlhelp: chmsetup $(CHMFILE)
+
+$(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
+HELPCNT = $(OUT_DIR)\$(TCLHLPBASE).cnt
+DOCTMP_DIR = $(OUT_DIR)\$(PROJECT)_docs
+HELPRTF = $(DOCTMP_DIR)\$(PROJECT).rtf
+MAN2HELP = $(DOCTMP_DIR)\man2help.tcl
+MAN2HELP2 = $(DOCTMP_DIR)\man2help2.tcl
+INDEX = $(DOCTMP_DIR)\index.tcl
+BMP = $(DOCTMP_DIR)\feather.bmp
+BMP_NOPATH = feather.bmp
+MAN2TCL = $(DOCTMP_DIR)\man2tcl.exe
+
+winhelp: docsetup $(HELPFILE)
+
+docsetup:
+ @if not exist $(DOCTMP_DIR)\nul mkdir $(DOCTMP_DIR)
+
+$(MAN2HELP) $(MAN2HELP2) $(INDEX) $(BMP): $(TOOLSDIR)\$$(@F)
+ @$(CPY) $(TOOLSDIR)\$(@F) $(@D)
+
+$(HELPFILE): $(HELPRTF) $(BMP)
+ cd $(DOCTMP_DIR)
+ start /wait hcrtf.exe -x <<$(PROJECT).hpj
+[OPTIONS]
+COMPRESS=12 Hall Zeck
+LCID=0x409 0x0 0x0 ; English (United States)
+TITLE=Tcl/Tk Reference Manual
+BMROOT=.
+CNT=$(@B).cnt
+HLP=$(@B).hlp
+
+[FILES]
+$(PROJECT).rtf
+
+[WINDOWS]
+main="Tcl/Tk Reference Manual",,27648,(r15263976),(r65535)
+
+[CONFIG]
+BrowseButtons()
+CreateButton(1, "Web", ExecFile("http://www.tcl.tk"))
+CreateButton(2, "SF", ExecFile("http://sf.net/projects/tcl"))
+CreateButton(3, "Wiki", ExecFile("http://wiki.tcl.tk"))
+CreateButton(4, "FAQ", ExecFile("http://www.purl.org/NET/Tcl-FAQ/"))
+<<
+ cd $(MAKEDIR)
+ @$(CPY) "$(DOCTMP_DIR)\$(@B).hlp" "$(OUT_DIR)"
+ @$(CPY) "$(DOCTMP_DIR)\$(@B).cnt" "$(OUT_DIR)"
+
+$(MAN2TCL): $(TOOLSDIR)\$$(@B).c
+ $(cc32) $(TCL_CFLAGS) -Fo$(@D)\ $(TOOLSDIR)\$(@B).c
+ $(link32) $(conlflags) -out:$@ -stack:16384 $(@D)\man2tcl.obj
+ $(_VC_MANIFEST_EMBED_EXE)
+
+$(HELPRTF): $(MAN2TCL) $(MAN2HELP) $(MAN2HELP2) $(INDEX) $(DOCDIR)\*
+ $(TCLSH) $(MAN2HELP) -bitmap $(BMP_NOPATH) $(PROJECT) $(VERSION) $(DOCDIR:\=/)
+
+install-docs:
+!if exist("$(CHMFILE)")
+ @echo Installing compiled HTML help
+ @$(CPY) "$(CHMFILE)" "$(DOC_INSTALL_DIR)\"
+!endif
+!if exist("$(HELPFILE)")
+ @echo Installing Windows help
+ @$(CPY) "$(HELPFILE)" "$(DOC_INSTALL_DIR)\"
+ @$(CPY) "$(HELPCNT)" "$(DOC_INSTALL_DIR)\"
+!endif
+
+#---------------------------------------------------------------------
+# Build tclConfig.sh for the TEA build system.
+#---------------------------------------------------------------------
+
+tclConfig: $(OUT_DIR)\tclConfig.sh
+
+$(OUT_DIR)\tclConfig.sh: $(WINDIR)\tclConfig.sh.in
+ @echo Creating tclConfig.sh
+ @nmakehlp -s << $** >$@
+@TCL_DLL_FILE@ $(TCLLIBNAME)
+@TCL_VERSION@ $(DOTVERSION)
+@TCL_MAJOR_VERSION@ $(TCL_MAJOR_VERSION)
+@TCL_MINOR_VERSION@ $(TCL_MINOR_VERSION)
+@TCL_PATCH_LEVEL@ $(TCL_PATCH_LEVEL)
+@CC@ $(CC)
+@DEFS@ $(TCL_CFLAGS)
+@CFLAGS_DEBUG@ -nologo -c -W3 -YX -Fp$(TMP_DIR)\ -MDd
+@CFLAGS_OPTIMIZE@ -nologo -c -W3 -YX -Fp$(TMP_DIR)\ -MD
+@LDFLAGS_DEBUG@ -nologo -machine:$(MACHINE) -debug -debugtype:cv
+@LDFLAGS_OPTIMIZE@ -nologo -machine:$(MACHINE) -release -opt:ref -opt:icf,3
+@TCL_DBGX@ $(SUFX)
+@TCL_LIB_FILE@ $(PROJECT)$(VERSION)$(SUFX).lib
+@TCL_NEEDS_EXP_FILE@
+@LIBS@ $(baselibs)
+@prefix@ $(_INSTALLDIR)
+@exec_prefix@ $(BIN_INSTALL_DIR)
+@SHLIB_CFLAGS@
+@STLIB_CFLAGS@
+@CFLAGS_WARNING@ -W3
+@EXTRA_CFLAGS@ -YX
+@SHLIB_LD@ $(link32) $(dlllflags)
+@STLIB_LD@ $(lib32) -nologo
+@SHLIB_LD_LIBS@ $(baselibs)
+@SHLIB_SUFFIX@ .dll
+@DL_LIBS@
+@LDFLAGS@
+@TCL_LD_SEARCH_FLAGS@
+@LIBOBJS@
+@RANLIB@
+@TCL_LIB_FLAG@
+@TCL_BUILD_LIB_SPEC@
+@TCL_LIB_SPEC@ $(LIB_INSTALL_DIR)\$(PROJECT)$(VERSION)$(SUFX).lib
+@TCL_INCLUDE_SPEC@ -I$(INCLUDE_INSTALL_DIR)
+@TCL_LIB_VERSIONS_OK@
+@TCL_SRC_DIR@ $(ROOT)
+@TCL_PACKAGE_PATH@
+@TCL_STUB_LIB_FILE@ $(TCLSTUBLIBNAME)
+@TCL_STUB_LIB_FLAG@ $(TCLSTUBLIBNAME)
+@TCL_STUB_LIB_SPEC@ -L$(LIB_INSTALL_DIR) $(TCLSTUBLIBNAME)
+@TCL_THREADS@ $(TCL_THREADS)
+@TCL_BUILD_STUB_LIB_SPEC@ -L$(OUT_DIR) $(TCLSTUBLIBNAME)
+@TCL_BUILD_STUB_LIB_PATH@ $(TCLSTUBLIB)
+@TCL_STUB_LIB_PATH@ $(LIB_INSTALL_DIR)\$(TCLSTUBLIBNAME)
+@CFG_TCL_EXPORT_FILE_SUFFIX@ $(VERSION)$(SUFX).lib
+@CFG_TCL_SHARED_LIB_SUFFIX@ $(VERSION)$(SUFX).dll
+@CFG_TCL_UNSHARED_LIB_SUFFIX@ $(VERSION)$(SUFX).lib
+!if $(STATIC_BUILD)
+@TCL_SHARED_BUILD@ 0
+!else
+@TCL_SHARED_BUILD@ 1
+!endif
+<<
+
+
+#---------------------------------------------------------------------
+# The following target generates the file generic/tclDate.c
+# from the yacc grammar found in generic/tclGetDate.y. This is
+# only run by hand as yacc is not available in all environments.
+# The name of the .c file is different than the name of the .y file
+# so that make doesn't try to automatically regenerate the .c file.
+#---------------------------------------------------------------------
+
+gendate:
+ bison --output-file=$(GENERICDIR)/tclDate.c \
+ --name-prefix=TclDate \
+ $(GENERICDIR)/tclGetDate.y
+
+#---------------------------------------------------------------------
+# Special case object file targets
+#---------------------------------------------------------------------
+
+$(TMP_DIR)\testMain.obj: $(WINDIR)\tclAppInit.c
+ $(cc32) $(TCL_CFLAGS) -DTCL_TEST \
+ -DTCL_USE_STATIC_PACKAGES=$(TCL_USE_STATIC_PACKAGES) \
+ -Fo$@ $?
+
+$(TMP_DIR)\tclTest.obj: $(GENERICDIR)\tclTest.c
+ $(cc32) $(TCL_CFLAGS) -Fo$@ $?
+
+$(TMP_DIR)\tclTestObj.obj: $(GENERICDIR)\tclTestObj.c
+ $(cc32) $(TCL_CFLAGS) -Fo$@ $?
+
+$(TMP_DIR)\tclWinTest.obj: $(WINDIR)\tclWinTest.c
+ $(cc32) $(TCL_CFLAGS) -Fo$@ $?
+
+$(TMP_DIR)\tclPkgConfig.obj: $(GENERICDIR)\tclPkgConfig.c
+ $(cc32) -DBUILD_tcl $(TCL_CFLAGS) \
+ -DCFG_INSTALL_LIBDIR="\"$(LIB_INSTALL_DIR:\=\\)\"" \
+ -DCFG_INSTALL_BINDIR="\"$(BIN_INSTALL_DIR:\=\\)\"" \
+ -DCFG_INSTALL_SCRDIR="\"$(SCRIPT_INSTALL_DIR:\=\\)\"" \
+ -DCFG_INSTALL_INCDIR="\"$(INCLUDE_INSTALL_DIR:\=\\)\"" \
+ -DCFG_INSTALL_DOCDIR="\"$(DOC_INSTALL_DIR:\=\\)\"" \
+ -DCFG_RUNTIME_LIBDIR="\"$(LIB_INSTALL_DIR:\=\\)\"" \
+ -DCFG_RUNTIME_BINDIR="\"$(BIN_INSTALL_DIR:\=\\)\"" \
+ -DCFG_RUNTIME_SCRDIR="\"$(SCRIPT_INSTALL_DIR:\=\\)\"" \
+ -DCFG_RUNTIME_INCDIR="\"$(INCLUDE_INSTALL_DIR:\=\\)\"" \
+ -DCFG_RUNTIME_DOCDIR="\"$(DOC_INSTALL_DIR:\=\\)\"" \
+ -Fo$@ $?
+
+$(TMP_DIR)\tclAppInit.obj: $(WINDIR)\tclAppInit.c
+ $(cc32) $(TCL_CFLAGS) \
+ -DTCL_USE_STATIC_PACKAGES=$(TCL_USE_STATIC_PACKAGES) \
+ -Fo$@ $?
+
+### The following objects should be built using the stub interfaces
+### *ALL* extensions need to built with -DTCL_THREADS=1
+
+$(TMP_DIR)\tclWinReg.obj: $(WINDIR)\tclWinReg.c
+!if $(STATIC_BUILD)
+ $(cc32) $(TCL_CFLAGS) -DTCL_THREADS=1 -DSTATIC_BUILD -Fo$@ $?
+!else
+ $(cc32) $(TCL_CFLAGS) -DTCL_THREADS=1 -DUSE_TCL_STUBS -Fo$@ $?
+!endif
+
+
+$(TMP_DIR)\tclWinDde.obj: $(WINDIR)\tclWinDde.c
+!if $(STATIC_BUILD)
+ $(cc32) $(TCL_CFLAGS) -DTCL_THREADS=1 -DSTATIC_BUILD -Fo$@ $?
+!else
+ $(cc32) $(TCL_CFLAGS) -DTCL_THREADS=1 -DUSE_TCL_STUBS -Fo$@ $?
+!endif
+
+
+### The following objects are part of the stub library and should not
+### 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)\tclsh.exe.manifest: $(WINDIR)\tclsh.exe.manifest.in
+ @nmakehlp -s << $** >$@
+@MACHINE@ $(MACHINE:IX86=X86)
+@TCL_WIN_VERSION@ $(DOTVERSION).0.0
+<<
+
+#---------------------------------------------------------------------
+# Generate the source dependencies. Having dependency rules will
+# improve incremental build accuracy without having to resort to a
+# full rebuild just because some non-global header file like
+# tclCompile.h was changed. These rules aren't needed when building
+# from scratch.
+#---------------------------------------------------------------------
+
+depend:
+!if !exist($(TCLSH))
+ @echo Build tclsh first!
+!else
+ $(TCLSH) $(TOOLSDIR:\=/)/mkdepend.tcl -vc32 -out:"$(OUT_DIR)\depend.mk" \
+ -passthru:"-DBUILD_tcl $(TCL_INCLUDES)" $(GENERICDIR),$$(GENERICDIR) \
+ $(COMPATDIR),$$(COMPATDIR) $(TOMMATHDIR),$$(TOMMATHDIR) $(WINDIR),$$(WINDIR) @<<
+$(TCLOBJS)
+<<
+!endif
+
+#---------------------------------------------------------------------
+# Dependency rules
+#---------------------------------------------------------------------
+
+!if exist("$(OUT_DIR)\depend.mk")
+!include "$(OUT_DIR)\depend.mk"
+!message *** Dependency rules in use.
+!else
+!message *** Dependency rules are not being used.
+!endif
+
+### add a spacer in the output
+!message
+
+
+#---------------------------------------------------------------------
+# Implicit rules
+#---------------------------------------------------------------------
+
+{$(WINDIR)}.c{$(TMP_DIR)}.obj::
+ $(cc32) $(TCL_CFLAGS) -DBUILD_tcl -Fo$(TMP_DIR)\ @<<
+$<
+<<
+
+{$(TOMMATHDIR)}.c{$(TMP_DIR)}.obj::
+ $(cc32) $(TCL_CFLAGS) -DBUILD_tcl -Fo$(TMP_DIR)\ @<<
+$<
+<<
+
+{$(GENERICDIR)}.c{$(TMP_DIR)}.obj::
+ $(cc32) $(TCL_CFLAGS) -DBUILD_tcl -Fo$(TMP_DIR)\ @<<
+$<
+<<
+
+{$(COMPATDIR)}.c{$(TMP_DIR)}.obj::
+ $(cc32) $(TCL_CFLAGS) -DBUILD_tcl -Fo$(TMP_DIR)\ @<<
+$<
+<<
+
+{$(WINDIR)}.rc{$(TMP_DIR)}.res:
+ $(rc32) -fo $@ -r -i "$(GENERICDIR)" -i "$(TMP_DIR)" \
+ -d DEBUG=$(DEBUG) -d UNCHECKED=$(UNCHECKED) \
+ -d TCL_THREADS=$(TCL_THREADS) \
+ -d STATIC_BUILD=$(STATIC_BUILD) \
+ $<
+
+$(TMP_DIR)\tclsh.res: $(TMP_DIR)\tclsh.exe.manifest
+
+.SUFFIXES:
+.SUFFIXES:.c .rc
+
+
+#---------------------------------------------------------------------
+# Installation.
+#---------------------------------------------------------------------
+
+install-binaries:
+ @echo Installing to '$(_INSTALLDIR)'
+ @echo Installing $(TCLLIBNAME)
+!if "$(TCLLIB)" != "$(TCLIMPLIB)"
+ @$(CPY) "$(TCLLIB)" "$(BIN_INSTALL_DIR)\"
+!endif
+ @$(CPY) "$(TCLIMPLIB)" "$(LIB_INSTALL_DIR)\"
+!if exist($(TCLSH))
+ @echo Installing $(TCLSHNAME)
+ @$(CPY) "$(TCLSH)" "$(BIN_INSTALL_DIR)\"
+!endif
+!if exist($(TCLPIPEDLL))
+ @echo Installing $(TCLPIPEDLLNAME)
+ @$(CPY) "$(TCLPIPEDLL)" "$(BIN_INSTALL_DIR)\"
+!endif
+ @echo Installing $(TCLSTUBLIBNAME)
+ @$(CPY) "$(TCLSTUBLIB)" "$(LIB_INSTALL_DIR)\"
+
+#" emacs fix
+
+install-libraries: tclConfig install-msgs install-tzdata
+ @if not exist "$(SCRIPT_INSTALL_DIR)$(NULL)" \
+ $(MKDIR) "$(SCRIPT_INSTALL_DIR)"
+ @if not exist "$(SCRIPT_INSTALL_DIR)\..\tcl8$(NULL)" \
+ $(MKDIR) "$(SCRIPT_INSTALL_DIR)\..\tcl8"
+ @if not exist "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.4$(NULL)" \
+ $(MKDIR) "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.4"
+ @if not exist "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.4\platform$(NULL)" \
+ $(MKDIR) "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.4\platform"
+ @if not exist "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.5$(NULL)" \
+ $(MKDIR) "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.5"
+ @echo Installing header files
+ @$(CPY) "$(GENERICDIR)\tcl.h" "$(INCLUDE_INSTALL_DIR)\"
+ @$(CPY) "$(GENERICDIR)\tclDecls.h" "$(INCLUDE_INSTALL_DIR)\"
+ @$(CPY) "$(GENERICDIR)\tclPlatDecls.h" "$(INCLUDE_INSTALL_DIR)\"
+ @$(CPY) "$(GENERICDIR)\tclTomMath.h" "$(INCLUDE_INSTALL_DIR)\"
+ @$(CPY) "$(GENERICDIR)\tclTomMathDecls.h" "$(INCLUDE_INSTALL_DIR)\"
+ @$(CPY) "$(TOMMATHDIR)\tommath_class.h" "$(INCLUDE_INSTALL_DIR)\"
+ @$(CPY) "$(TOMMATHDIR)\tommath_superclass.h" "$(INCLUDE_INSTALL_DIR)\"
+ @echo Installing library files to $(SCRIPT_INSTALL_DIR)
+ @$(CPY) "$(ROOT)\library\history.tcl" "$(SCRIPT_INSTALL_DIR)\"
+ @$(CPY) "$(ROOT)\library\init.tcl" "$(SCRIPT_INSTALL_DIR)\"
+ @$(CPY) "$(ROOT)\library\clock.tcl" "$(SCRIPT_INSTALL_DIR)\"
+ @$(CPY) "$(ROOT)\library\tm.tcl" "$(SCRIPT_INSTALL_DIR)\"
+ @$(CPY) "$(ROOT)\library\parray.tcl" "$(SCRIPT_INSTALL_DIR)\"
+ @$(CPY) "$(ROOT)\library\safe.tcl" "$(SCRIPT_INSTALL_DIR)\"
+ @$(CPY) "$(ROOT)\library\tclIndex" "$(SCRIPT_INSTALL_DIR)\"
+ @$(CPY) "$(ROOT)\library\package.tcl" "$(SCRIPT_INSTALL_DIR)\"
+ @$(CPY) "$(ROOT)\library\word.tcl" "$(SCRIPT_INSTALL_DIR)\"
+ @$(CPY) "$(ROOT)\library\auto.tcl" "$(SCRIPT_INSTALL_DIR)\"
+ @$(CPY) "$(OUT_DIR)\tclConfig.sh" "$(LIB_INSTALL_DIR)\"
+ @echo Installing library http1.0 directory
+ @$(CPY) "$(ROOT)\library\http1.0\*.tcl" \
+ "$(SCRIPT_INSTALL_DIR)\http1.0\"
+ @echo Installing library opt0.4 directory
+ @$(CPY) "$(ROOT)\library\opt\*.tcl" \
+ "$(SCRIPT_INSTALL_DIR)\opt0.4\"
+ @echo Installing package http $(PKG_HTTP_VER) as a Tcl Module
+ @$(COPY) "$(ROOT)\library\http\http.tcl" \
+ "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.4\http-$(PKG_HTTP_VER).tm"
+ @echo Installing package msgcat $(PKG_MSGCAT_VER) as a Tcl Module
+ @$(COPY) "$(ROOT)\library\msgcat\msgcat.tcl" \
+ "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.5\msgcat-$(PKG_MSGCAT_VER).tm"
+ @echo Installing package tcltest $(PKG_TCLTEST_VER) as a Tcl Module
+ @$(COPY) "$(ROOT)\library\tcltest\tcltest.tcl" \
+ "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.5\tcltest-$(PKG_TCLTEST_VER).tm"
+ @echo Installing package platform $(PKG_PLATFORM_VER) as a Tcl Module
+ @$(COPY) "$(ROOT)\library\platform\platform.tcl" \
+ "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.4\platform-$(PKG_PLATFORM_VER).tm"
+ @echo Installing package platform::shell $(PKG_SHELL_VER) as a Tcl Module
+ @$(COPY) "$(ROOT)\library\platform\shell.tcl" \
+ "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.4\platform\shell-$(PKG_SHELL_VER).tm"
+ @echo Installing $(TCLDDELIBNAME)
+!if $(STATIC_BUILD)
+!if !$(TCL_USE_STATIC_PACKAGES)
+ @$(CPY) "$(TCLDDELIB)" "$(LIB_INSTALL_DIR)\"
+!endif
+!else
+ @$(CPY) "$(TCLDDELIB)" "$(LIB_INSTALL_DIR)\dde$(DDEDOTVERSION)\"
+ @$(CPY) "$(ROOT)\library\dde\pkgIndex.tcl" \
+ "$(LIB_INSTALL_DIR)\dde$(DDEDOTVERSION)\"
+!endif
+ @echo Installing $(TCLREGLIBNAME)
+!if $(STATIC_BUILD)
+!if !$(TCL_USE_STATIC_PACKAGES)
+ @$(CPY) "$(TCLREGLIB)" "$(LIB_INSTALL_DIR)\"
+!endif
+!else
+ @$(CPY) "$(TCLREGLIB)" "$(LIB_INSTALL_DIR)\reg$(REGDOTVERSION)\"
+ @$(CPY) "$(ROOT)\library\reg\pkgIndex.tcl" \
+ "$(LIB_INSTALL_DIR)\reg$(REGDOTVERSION)\"
+!endif
+ @echo Installing encodings
+ @$(CPY) "$(ROOT)\library\encoding\*.enc" \
+ "$(SCRIPT_INSTALL_DIR)\encoding\"
+
+#" emacs fix
+
+install-tzdata:
+ @echo Installing time zone data
+ @set TCL_LIBRARY=$(ROOT:\=/)/library
+ @$(TCLSH_NATIVE) "$(ROOT:\=/)/tools/installData.tcl" \
+ "$(ROOT:\=/)/library/tzdata" "$(SCRIPT_INSTALL_DIR)/tzdata"
+
+install-msgs:
+ @echo Installing message catalogs
+ @set TCL_LIBRARY=$(ROOT:\=/)/library
+ @$(TCLSH_NATIVE) "$(ROOT:\=/)/tools/installData.tcl" \
+ "$(ROOT:\=/)/library/msgs" "$(SCRIPT_INSTALL_DIR)/msgs"
+
+#---------------------------------------------------------------------
+# Clean up
+#---------------------------------------------------------------------
+
+tidy:
+!if "$(TCLLIB)" != "$(TCLIMPLIB)"
+ @echo Removing $(TCLLIB) ...
+ @if exist $(TCLLIB) del $(TCLLIB)
+!endif
+ @echo Removing $(TCLIMPLIB) ...
+ @if exist $(TCLIMPLIB) del $(TCLIMPLIB)
+ @echo Removing $(TCLSH) ...
+ @if exist $(TCLSH) del $(TCLSH)
+ @echo Removing $(TCLTEST) ...
+ @if exist $(TCLTEST) del $(TCLTEST)
+ @echo Removing $(TCLDDELIB) ...
+ @if exist $(TCLDDELIB) del $(TCLDDELIB)
+ @echo Removing $(TCLREGLIB) ...
+ @if exist $(TCLREGLIB) del $(TCLREGLIB)
+
+clean:
+ @echo Cleaning $(TMP_DIR)\* ...
+ @if exist $(TMP_DIR)\nul $(RMDIR) $(TMP_DIR)
+ @echo Cleaning $(WINDIR)\nmakehlp.obj ...
+ @if exist $(WINDIR)\nmakehlp.obj del $(WINDIR)\nmakehlp.obj
+ @echo Cleaning $(WINDIR)\nmakehlp.exe ...
+ @if exist $(WINDIR)\nmakehlp.exe del $(WINDIR)\nmakehlp.exe
+ @echo Cleaning $(WINDIR)\_junk.pch ...
+ @if exist $(WINDIR)\_junk.pch del $(WINDIR)\_junk.pch
+ @echo Cleaning $(WINDIR)\vercl.x ...
+ @if exist $(WINDIR)\vercl.x del $(WINDIR)\vercl.x
+ @echo Cleaning $(WINDIR)\vercl.i ...
+ @if exist $(WINDIR)\vercl.i del $(WINDIR)\vercl.i
+ @echo Cleaning $(WINDIR)\versions.vc ...
+ @if exist $(WINDIR)\versions.vc del $(WINDIR)\versions.vc
+
+realclean: hose
+
+hose:
+ @echo Hosing $(OUT_DIR)\* ...
+ @if exist $(OUT_DIR)\nul $(RMDIR) $(OUT_DIR)
diff --git a/win/nmakehlp.c b/win/nmakehlp.c index b1a1517..84cf75c 100644 --- a/win/nmakehlp.c +++ b/win/nmakehlp.c @@ -606,8 +606,8 @@ SubstituteFile( sp = fopen(substitutions, "rt"); if (sp != NULL) { while (fgets(szBuffer, cbBuffer, sp) != NULL) { - char *ks, *ke, *vs, *ve; - ks = szBuffer; + unsigned char *ks, *ke, *vs, *ve; + ks = (unsigned char*)szBuffer; while (ks && *ks && isspace(*ks)) ++ks; ke = ks; while (ke && *ke && !isspace(*ke)) ++ke; @@ -616,7 +616,7 @@ SubstituteFile( ve = vs; while (ve && *ve && !(*ve == '\r' || *ve == '\n')) ++ve; *ke = 0, *ve = 0; - list_insert(&substPtr, ks, vs); + list_insert(&substPtr, (char*)ks, (char*)vs); } fclose(sp); } diff --git a/win/rules.vc b/win/rules.vc index 1513198..78a167a 100644 --- a/win/rules.vc +++ b/win/rules.vc @@ -1,698 +1,698 @@ -#------------------------------------------------------------------------------ -# rules.vc -- -# -# Microsoft Visual C++ makefile include for decoding the commandline -# macros. This file does not need editing to build Tcl. -# -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# Copyright (c) 2001-2003 David Gravereaux. -# Copyright (c) 2003-2008 Patrick Thoyts -#------------------------------------------------------------------------------ - -!ifndef _RULES_VC -_RULES_VC = 1 - -cc32 = $(CC) # built-in default. -link32 = link -lib32 = lib -rc32 = $(RC) # built-in default. - -!ifndef INSTALLDIR -### Assume the normal default. -_INSTALLDIR = C:\Program Files\Tcl -!else -### Fix the path separators. -_INSTALLDIR = $(INSTALLDIR:/=\) -!endif - -#---------------------------------------------------------- -# Set the proper copy method to avoid overwrite questions -# to the user when copying files and selecting the right -# "delete all" method. -#---------------------------------------------------------- - -!if "$(OS)" == "Windows_NT" -RMDIR = rmdir /S /Q -ERRNULL = 2>NUL -!if ![ver | find "4.0" > nul] -CPY = echo y | xcopy /i >NUL -COPY = copy >NUL -!else -CPY = xcopy /i /y >NUL -COPY = copy /y >NUL -!endif -!else # "$(OS)" != "Windows_NT" -CPY = xcopy /i >_JUNK.OUT # On Win98 NUL does not work here. -COPY = copy >_JUNK.OUT # On Win98 NUL does not work here. -RMDIR = deltree /Y -NULL = \NUL # Used in testing directory existence -ERRNULL = >NUL # Win9x shell cannot redirect stderr -!endif -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 =============================================================================== - -#---------------------------------------------------------- -# build the helper app we need to overcome nmake's limiting -# environment. -#---------------------------------------------------------- - -!if !exist(nmakehlp.exe) -!if [$(cc32) -nologo nmakehlp.c -link -subsystem:console > nul] -!endif -!endif - -#---------------------------------------------------------- -# Test for compiler features -#---------------------------------------------------------- - -### test for optimizations -!if [nmakehlp -c -Ot] -!message *** Compiler has 'Optimizations' -OPTIMIZING = 1 -!else -!message *** Compiler does not have 'Optimizations' -OPTIMIZING = 0 -!endif - -OPTIMIZATIONS = - -!if [nmakehlp -c -Ot] -OPTIMIZATIONS = $(OPTIMIZATIONS) -Ot -!endif - -!if [nmakehlp -c -Oi] -OPTIMIZATIONS = $(OPTIMIZATIONS) -Oi -!endif - -!if [nmakehlp -c -Op] -OPTIMIZATIONS = $(OPTIMIZATIONS) -Op -!endif - -!if [nmakehlp -c -fp:strict] -OPTIMIZATIONS = $(OPTIMIZATIONS) -fp:strict -!endif - -!if [nmakehlp -c -Gs] -OPTIMIZATIONS = $(OPTIMIZATIONS) -Gs -!endif - -!if [nmakehlp -c -GS] -OPTIMIZATIONS = $(OPTIMIZATIONS) -GS -!endif - -!if [nmakehlp -c -GL] -OPTIMIZATIONS = $(OPTIMIZATIONS) -GL -!endif - -DEBUGFLAGS = - -!if [nmakehlp -c -RTC1] -DEBUGFLAGS = $(DEBUGFLAGS) -RTC1 -!elseif [nmakehlp -c -GZ] -DEBUGFLAGS = $(DEBUGFLAGS) -GZ -!endif - -COMPILERFLAGS =-W3 -DUNICODE -D_UNICODE - -# In v13 -GL and -YX are incompatible. -!if [nmakehlp -c -YX] -!if ![nmakehlp -c -GL] -OPTIMIZATIONS = $(OPTIMIZATIONS) -YX -!endif -!endif - -!if "$(MACHINE)" == "IX86" -### test for pentium errata -!if [nmakehlp -c -QI0f] -!message *** Compiler has 'Pentium 0x0f fix' -COMPILERFLAGS = $(COMPILERFLAGS) -QI0f -!else -!message *** Compiler does not have 'Pentium 0x0f fix' -!endif -!endif - -!if "$(MACHINE)" == "IA64" -### test for Itanium errata -!if [nmakehlp -c -QIA64_Bx] -!message *** Compiler has 'B-stepping errata workarounds' -COMPILERFLAGS = $(COMPILERFLAGS) -QIA64_Bx -!else -!message *** Compiler does not have 'B-stepping errata workarounds' -!endif -!endif - -!if "$(MACHINE)" == "IX86" -### test for -align:4096, when align:512 will do. -!if [nmakehlp -l -opt:nowin98] -!message *** Linker has 'Win98 alignment problem' -ALIGN98_HACK = 1 -!else -!message *** Linker does not have 'Win98 alignment problem' -ALIGN98_HACK = 0 -!endif -!else -ALIGN98_HACK = 0 -!endif - -LINKERFLAGS = - -!if [nmakehlp -l -ltcg] -LINKERFLAGS =-ltcg -!endif - -#---------------------------------------------------------- -# Decode the options requested. -#---------------------------------------------------------- - -!if "$(OPTS)" == "" || [nmakehlp -f "$(OPTS)" "none"] -STATIC_BUILD = 0 -TCL_THREADS = 1 -DEBUG = 0 -SYMBOLS = 0 -PROFILE = 0 -PGO = 0 -MSVCRT = 1 -LOIMPACT = 0 -TCL_USE_STATIC_PACKAGES = 0 -USE_THREAD_ALLOC = 1 -UNCHECKED = 0 -!else -!if [nmakehlp -f $(OPTS) "static"] -!message *** Doing static -STATIC_BUILD = 1 -!else -STATIC_BUILD = 0 -!endif -!if [nmakehlp -f $(OPTS) "msvcrt"] -!message *** Doing msvcrt -MSVCRT = 1 -!else -!if !$(STATIC_BUILD) -MSVCRT = 1 -!else -MSVCRT = 0 -!endif -!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) "nothreads"] -!message *** Compile explicitly for non-threaded tcl -TCL_THREADS = 0 -USE_THREAD_ALLOC= 0 -!else -TCL_THREADS = 1 -USE_THREAD_ALLOC= 1 -!endif -!if [nmakehlp -f $(OPTS) "symbols"] -!message *** Doing symbols -DEBUG = 1 -!else -DEBUG = 0 -!endif -!if [nmakehlp -f $(OPTS) "pdbs"] -!message *** Doing pdbs -SYMBOLS = 1 -!else -SYMBOLS = 0 -!endif -!if [nmakehlp -f $(OPTS) "profile"] -!message *** Doing profile -PROFILE = 1 -!else -PROFILE = 0 -!endif -!if [nmakehlp -f $(OPTS) "pgi"] -!message *** Doing profile guided optimization instrumentation -PGO = 1 -!elseif [nmakehlp -f $(OPTS) "pgo"] -!message *** Doing profile guided optimization -PGO = 2 -!else -PGO = 0 -!endif -!if [nmakehlp -f $(OPTS) "loimpact"] -!message *** Doing loimpact -LOIMPACT = 1 -!else -LOIMPACT = 0 -!endif -!if [nmakehlp -f $(OPTS) "thrdalloc"] -!message *** Doing thrdalloc -USE_THREAD_ALLOC = 1 -!endif -!if [nmakehlp -f $(OPTS) "tclalloc"] -!message *** Doing tclalloc -USE_THREAD_ALLOC = 0 -!endif -!if [nmakehlp -f $(OPTS) "unchecked"] -!message *** Doing unchecked -UNCHECKED = 1 -!else -UNCHECKED = 0 -!endif -!endif - -#---------------------------------------------------------- -# Figure-out how to name our intermediate and output directories. -# We wouldn't want different builds to use the same .obj files -# by accident. -#---------------------------------------------------------- - -#---------------------------------------- -# Naming convention: -# t = full thread support. -# s = static library (as opposed to an -# import library) -# g = linked to the debug enabled C -# run-time. -# x = special static build when it -# links to the dynamic C run-time. -#---------------------------------------- -SUFX = tsgx - -!if $(DEBUG) -BUILDDIRTOP = Debug -!else -BUILDDIRTOP = Release -!endif - -!if "$(MACHINE)" != "IX86" -BUILDDIRTOP =$(BUILDDIRTOP)_$(MACHINE) -!endif -!if $(VCVER) > 6 -BUILDDIRTOP =$(BUILDDIRTOP)_VC$(VCVER) -!endif - -!if !$(DEBUG) || $(DEBUG) && $(UNCHECKED) -SUFX = $(SUFX:g=) -!endif - -TMP_DIRFULL = .\$(BUILDDIRTOP)\$(PROJECT)_ThreadedDynamicStaticX - -!if !$(STATIC_BUILD) -TMP_DIRFULL = $(TMP_DIRFULL:Static=) -SUFX = $(SUFX:s=) -EXT = dll -TMP_DIRFULL = $(TMP_DIRFULL:X=) -SUFX = $(SUFX:x=) -!else -TMP_DIRFULL = $(TMP_DIRFULL:Dynamic=) -EXT = lib -!if !$(MSVCRT) -TMP_DIRFULL = $(TMP_DIRFULL:X=) -SUFX = $(SUFX:x=) -!endif -!endif - -!if !$(TCL_THREADS) -TMP_DIRFULL = $(TMP_DIRFULL:Threaded=) -SUFX = $(SUFX:t=) -!endif - -!ifndef TMP_DIR -TMP_DIR = $(TMP_DIRFULL) -!ifndef OUT_DIR -OUT_DIR = .\$(BUILDDIRTOP) -!endif -!else -!ifndef OUT_DIR -OUT_DIR = $(TMP_DIR) -!endif -!endif - - -#---------------------------------------------------------- -# Decode the statistics requested. -#---------------------------------------------------------- - -!if "$(STATS)" == "" || [nmakehlp -f "$(STATS)" "none"] -TCL_MEM_DEBUG = 0 -TCL_COMPILE_DEBUG = 0 -!else -!if [nmakehlp -f $(STATS) "memdbg"] -!message *** Doing memdbg -TCL_MEM_DEBUG = 1 -!else -TCL_MEM_DEBUG = 0 -!endif -!if [nmakehlp -f $(STATS) "compdbg"] -!message *** Doing compdbg -TCL_COMPILE_DEBUG = 1 -!else -TCL_COMPILE_DEBUG = 0 -!endif -!endif - - -#---------------------------------------------------------- -# Decode the checks requested. -#---------------------------------------------------------- - -!if "$(CHECKS)" == "" || [nmakehlp -f "$(CHECKS)" "none"] -TCL_NO_DEPRECATED = 0 -WARNINGS = -W3 -!else -!if [nmakehlp -f $(CHECKS) "nodep"] -!message *** Doing nodep check -TCL_NO_DEPRECATED = 1 -!else -TCL_NO_DEPRECATED = 0 -!endif -!if [nmakehlp -f $(CHECKS) "fullwarn"] -!message *** Doing full warnings check -WARNINGS = -W4 -!if [nmakehlp -l -warn:3] -LINKERFLAGS = $(LINKERFLAGS) -warn:3 -!endif -!else -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) -DSTDC_HEADERS - -!if $(TCL_MEM_DEBUG) -OPTDEFINES = $(OPTDEFINES) -DTCL_MEM_DEBUG -!endif -!if $(TCL_COMPILE_DEBUG) -OPTDEFINES = $(OPTDEFINES) -DTCL_COMPILE_DEBUG -DTCL_COMPILE_STATS -!endif -!if $(TCL_THREADS) -OPTDEFINES = $(OPTDEFINES) -DTCL_THREADS=1 -!if $(USE_THREAD_ALLOC) -OPTDEFINES = $(OPTDEFINES) -DUSE_THREAD_ALLOC=1 -!endif -!endif -!if $(STATIC_BUILD) -OPTDEFINES = $(OPTDEFINES) -DSTATIC_BUILD -!endif -!if $(TCL_NO_DEPRECATED) -OPTDEFINES = $(OPTDEFINES) -DTCL_NO_DEPRECATED -!endif - -!if !$(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 - -#---------------------------------------------------------- -# Locate the Tcl headers to build against -#---------------------------------------------------------- - -!if "$(PROJECT)" == "tcl" - -_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") -_INSTALLDIR=$(_INSTALLDIR)\lib -!endif - -!if !defined(TCLDIR) -!if exist("$(_INSTALLDIR)\..\include\tcl.h") -TCLINSTALL = 1 -_TCLDIR = $(_INSTALLDIR)\.. -_TCL_H = $(_INSTALLDIR)\..\include\tcl.h -TCLDIR = $(_INSTALLDIR)\.. -!else -MSG=^ -Failed to find tcl.h. Set the TCLDIR macro. -!error $(MSG) -!endif -!else -_TCLDIR = $(TCLDIR:/=\) -!if exist("$(_TCLDIR)\include\tcl.h") -TCLINSTALL = 1 -_TCL_H = $(_TCLDIR)\include\tcl.h -!elseif exist("$(_TCLDIR)\generic\tcl.h") -TCLINSTALL = 0 -_TCL_H = $(_TCLDIR)\generic\tcl.h -!else -MSG =^ -Failed to find tcl.h. The TCLDIR macro does not appear correct. -!error $(MSG) -!endif -!endif -!endif - -#-------------------------------------------------------------- -# Extract various version numbers from tcl headers -# The generated file is then included in the makefile. -#-------------------------------------------------------------- - -!if [echo REM = This file is generated from rules.vc > versions.vc] -!endif -!if [echo TCL_MAJOR_VERSION = \>> versions.vc] \ - && [nmakehlp -V "$(_TCL_H)" TCL_MAJOR_VERSION >> versions.vc] -!endif -!if [echo TCL_MINOR_VERSION = \>> versions.vc] \ - && [nmakehlp -V "$(_TCL_H)" TCL_MINOR_VERSION >> versions.vc] -!endif -!if [echo TCL_PATCH_LEVEL = \>> versions.vc] \ - && [nmakehlp -V "$(_TCL_H)" TCL_PATCH_LEVEL >> versions.vc] -!endif - -# If building the tcl core then we need additional package versions -!if "$(PROJECT)" == "tcl" -!if [echo PKG_HTTP_VER = \>> versions.vc] \ - && [nmakehlp -V ..\library\http\pkgIndex.tcl http >> versions.vc] -!endif -!if [echo PKG_TCLTEST_VER = \>> versions.vc] \ - && [nmakehlp -V ..\library\tcltest\pkgIndex.tcl tcltest >> versions.vc] -!endif -!if [echo PKG_MSGCAT_VER = \>> versions.vc] \ - && [nmakehlp -V ..\library\msgcat\pkgIndex.tcl msgcat >> versions.vc] -!endif -!if [echo PKG_PLATFORM_VER = \>> versions.vc] \ - && [nmakehlp -V ..\library\platform\pkgIndex.tcl "platform " >> versions.vc] -!endif -!if [echo PKG_SHELL_VER = \>> versions.vc] \ - && [nmakehlp -V ..\library\platform\pkgIndex.tcl "platform::shell" >> versions.vc] -!endif -!if [echo PKG_DDE_VER = \>> versions.vc] \ - && [nmakehlp -V ..\library\dde\pkgIndex.tcl "dde " >> versions.vc] -!endif -!if [echo PKG_REG_VER =\>> versions.vc] \ - && [nmakehlp -V ..\library\reg\pkgIndex.tcl registry >> versions.vc] -!endif -!endif - -!include versions.vc - -#-------------------------------------------------------------- -# Setup tcl version dependent stuff headers -#-------------------------------------------------------------- - -!if "$(PROJECT)" != "tcl" - -TCL_VERSION = $(TCL_MAJOR_VERSION)$(TCL_MINOR_VERSION) - -!if $(TCLINSTALL) -TCLSH = "$(_TCLDIR)\bin\tclsh$(TCL_VERSION)$(SUFX).exe" -!if !exist($(TCLSH)) && $(TCL_THREADS) -TCLSH = "$(_TCLDIR)\bin\tclsh$(TCL_VERSION)t$(SUFX).exe" -!endif -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)\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 -#------------------------------------------------------------------------- - -!if "$(PROJECT)" == "tk" -_TK_H = ..\generic\tk.h -_INSTALLDIR = $(_INSTALLDIR)\.. -!endif - -!ifdef PROJECT_REQUIRES_TK -!if !defined(TKDIR) -!if exist("$(_INSTALLDIR)\..\include\tk.h") -TKINSTALL = 1 -_TKDIR = $(_INSTALLDIR)\.. -_TK_H = $(_TKDIR)\include\tk.h -TKDIR = $(_TKDIR) -!elseif exist("$(_TCLDIR)\include\tk.h") -TKINSTALL = 1 -_TKDIR = $(_TCLDIR) -_TK_H = $(_TKDIR)\include\tk.h -TKDIR = $(_TKDIR) -!endif -!else -_TKDIR = $(TKDIR:/=\) -!if exist("$(_TKDIR)\include\tk.h") -TKINSTALL = 1 -_TK_H = $(_TKDIR)\include\tk.h -!elseif exist("$(_TKDIR)\generic\tk.h") -TKINSTALL = 0 -_TK_H = $(_TKDIR)\generic\tk.h -!else -MSG =^ -Failed to find tk.h. The TKDIR macro does not appear correct. -!error $(MSG) -!endif -!endif -!endif - -#------------------------------------------------------------------------- -# Extract Tk version numbers -#------------------------------------------------------------------------- - -!if defined(PROJECT_REQUIRES_TK) || "$(PROJECT)" == "tk" - -!if [echo TK_MAJOR_VERSION = \>> versions.vc] \ - && [nmakehlp -V $(_TK_H) TK_MAJOR_VERSION >> versions.vc] -!endif -!if [echo TK_MINOR_VERSION = \>> versions.vc] \ - && [nmakehlp -V $(_TK_H) TK_MINOR_VERSION >> versions.vc] -!endif -!if [echo TK_PATCH_LEVEL = \>> versions.vc] \ - && [nmakehlp -V $(_TK_H) TK_PATCH_LEVEL >> versions.vc] -!endif - -!include versions.vc - -TK_DOTVERSION = $(TK_MAJOR_VERSION).$(TK_MINOR_VERSION) -TK_VERSION = $(TK_MAJOR_VERSION)$(TK_MINOR_VERSION) - -!if "$(PROJECT)" != "tk" -!if $(TKINSTALL) -WISH = "$(_TKDIR)\bin\wish$(TK_VERSION)$(SUFX).exe" -TKSTUBLIB = "$(_TKDIR)\lib\tkstub$(TK_VERSION).lib" -TKIMPLIB = "$(_TKDIR)\lib\tk$(TK_VERSION)$(SUFX).lib" -TK_INCLUDES = -I"$(_TKDIR)\include" -!else -WISH = "$(_TKDIR)\win\$(BUILDDIRTOP)\wish$(TCL_VERSION)$(SUFX).exe" -TKSTUBLIB = "$(_TKDIR)\win\$(BUILDDIRTOP)\tkstub$(TCL_VERSION).lib" -TKIMPLIB = "$(_TKDIR)\win\$(BUILDDIRTOP)\tk$(TCL_VERSION)$(SUFX).lib" -TK_INCLUDES = -I"$(_TKDIR)\generic" -I"$(_TKDIR)\win" -I"$(_TKDIR)\xlib" -!endif -!endif - -!endif - -#---------------------------------------------------------- -# Display stats being used. -#---------------------------------------------------------- - -!message *** Intermediate directory will be '$(TMP_DIR)' -!message *** Output directory will be '$(OUT_DIR)' -!message *** Suffix for binaries will be '$(SUFX)' -!message *** Optional defines are '$(OPTDEFINES)' -!message *** Compiler version $(VCVER). Target machine is $(MACHINE) -!message *** Host architecture is $(NATIVE_ARCH) -!message *** Compiler options '$(COMPILERFLAGS) $(OPTIMIZATIONS) $(DEBUGFLAGS) $(WARNINGS)' -!message *** Link options '$(LINKERFLAGS)' - -!endif +#------------------------------------------------------------------------------
+# rules.vc --
+#
+# Microsoft Visual C++ makefile include for decoding the commandline
+# macros. This file does not need editing to build Tcl.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# Copyright (c) 2001-2003 David Gravereaux.
+# Copyright (c) 2003-2008 Patrick Thoyts
+#------------------------------------------------------------------------------
+
+!ifndef _RULES_VC
+_RULES_VC = 1
+
+cc32 = $(CC) # built-in default.
+link32 = link
+lib32 = lib
+rc32 = $(RC) # built-in default.
+
+!ifndef INSTALLDIR
+### Assume the normal default.
+_INSTALLDIR = C:\Program Files\Tcl
+!else
+### Fix the path separators.
+_INSTALLDIR = $(INSTALLDIR:/=\)
+!endif
+
+#----------------------------------------------------------
+# Set the proper copy method to avoid overwrite questions
+# to the user when copying files and selecting the right
+# "delete all" method.
+#----------------------------------------------------------
+
+!if "$(OS)" == "Windows_NT"
+RMDIR = rmdir /S /Q
+ERRNULL = 2>NUL
+!if ![ver | find "4.0" > nul]
+CPY = echo y | xcopy /i >NUL
+COPY = copy >NUL
+!else
+CPY = xcopy /i /y >NUL
+COPY = copy /y >NUL
+!endif
+!else # "$(OS)" != "Windows_NT"
+CPY = xcopy /i >_JUNK.OUT # On Win98 NUL does not work here.
+COPY = copy >_JUNK.OUT # On Win98 NUL does not work here.
+RMDIR = deltree /Y
+NULL = \NUL # Used in testing directory existence
+ERRNULL = >NUL # Win9x shell cannot redirect stderr
+!endif
+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 ===============================================================================
+
+#----------------------------------------------------------
+# build the helper app we need to overcome nmake's limiting
+# environment.
+#----------------------------------------------------------
+
+!if !exist(nmakehlp.exe)
+!if [$(cc32) -nologo nmakehlp.c -link -subsystem:console > nul]
+!endif
+!endif
+
+#----------------------------------------------------------
+# Test for compiler features
+#----------------------------------------------------------
+
+### test for optimizations
+!if [nmakehlp -c -Ot]
+!message *** Compiler has 'Optimizations'
+OPTIMIZING = 1
+!else
+!message *** Compiler does not have 'Optimizations'
+OPTIMIZING = 0
+!endif
+
+OPTIMIZATIONS =
+
+!if [nmakehlp -c -Ot]
+OPTIMIZATIONS = $(OPTIMIZATIONS) -Ot
+!endif
+
+!if [nmakehlp -c -Oi]
+OPTIMIZATIONS = $(OPTIMIZATIONS) -Oi
+!endif
+
+!if [nmakehlp -c -Op]
+OPTIMIZATIONS = $(OPTIMIZATIONS) -Op
+!endif
+
+!if [nmakehlp -c -fp:strict]
+OPTIMIZATIONS = $(OPTIMIZATIONS) -fp:strict
+!endif
+
+!if [nmakehlp -c -Gs]
+OPTIMIZATIONS = $(OPTIMIZATIONS) -Gs
+!endif
+
+!if [nmakehlp -c -GS]
+OPTIMIZATIONS = $(OPTIMIZATIONS) -GS
+!endif
+
+!if [nmakehlp -c -GL]
+OPTIMIZATIONS = $(OPTIMIZATIONS) -GL
+!endif
+
+DEBUGFLAGS =
+
+!if [nmakehlp -c -RTC1]
+DEBUGFLAGS = $(DEBUGFLAGS) -RTC1
+!elseif [nmakehlp -c -GZ]
+DEBUGFLAGS = $(DEBUGFLAGS) -GZ
+!endif
+
+COMPILERFLAGS =-W3
+
+# In v13 -GL and -YX are incompatible.
+!if [nmakehlp -c -YX]
+!if ![nmakehlp -c -GL]
+OPTIMIZATIONS = $(OPTIMIZATIONS) -YX
+!endif
+!endif
+
+!if "$(MACHINE)" == "IX86"
+### test for pentium errata
+!if [nmakehlp -c -QI0f]
+!message *** Compiler has 'Pentium 0x0f fix'
+COMPILERFLAGS = $(COMPILERFLAGS) -QI0f
+!else
+!message *** Compiler does not have 'Pentium 0x0f fix'
+!endif
+!endif
+
+!if "$(MACHINE)" == "IA64"
+### test for Itanium errata
+!if [nmakehlp -c -QIA64_Bx]
+!message *** Compiler has 'B-stepping errata workarounds'
+COMPILERFLAGS = $(COMPILERFLAGS) -QIA64_Bx
+!else
+!message *** Compiler does not have 'B-stepping errata workarounds'
+!endif
+!endif
+
+!if "$(MACHINE)" == "IX86"
+### test for -align:4096, when align:512 will do.
+!if [nmakehlp -l -opt:nowin98]
+!message *** Linker has 'Win98 alignment problem'
+ALIGN98_HACK = 1
+!else
+!message *** Linker does not have 'Win98 alignment problem'
+ALIGN98_HACK = 0
+!endif
+!else
+ALIGN98_HACK = 0
+!endif
+
+LINKERFLAGS =
+
+!if [nmakehlp -l -ltcg]
+LINKERFLAGS =-ltcg
+!endif
+
+#----------------------------------------------------------
+# Decode the options requested.
+#----------------------------------------------------------
+
+!if "$(OPTS)" == "" || [nmakehlp -f "$(OPTS)" "none"]
+STATIC_BUILD = 0
+TCL_THREADS = 0
+DEBUG = 0
+SYMBOLS = 0
+PROFILE = 0
+PGO = 0
+MSVCRT = 1
+LOIMPACT = 0
+TCL_USE_STATIC_PACKAGES = 0
+USE_THREAD_ALLOC = 0
+UNCHECKED = 0
+!else
+!if [nmakehlp -f $(OPTS) "static"]
+!message *** Doing static
+STATIC_BUILD = 1
+!else
+STATIC_BUILD = 0
+!endif
+!if [nmakehlp -f $(OPTS) "msvcrt"]
+!message *** Doing msvcrt
+MSVCRT = 1
+!else
+!if !$(STATIC_BUILD)
+MSVCRT = 1
+!else
+MSVCRT = 0
+!endif
+!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
+USE_THREAD_ALLOC = 1
+!else
+TCL_THREADS = 0
+USE_THREAD_ALLOC = 0
+!endif
+!if [nmakehlp -f $(OPTS) "symbols"]
+!message *** Doing symbols
+DEBUG = 1
+!else
+DEBUG = 0
+!endif
+!if [nmakehlp -f $(OPTS) "pdbs"]
+!message *** Doing pdbs
+SYMBOLS = 1
+!else
+SYMBOLS = 0
+!endif
+!if [nmakehlp -f $(OPTS) "profile"]
+!message *** Doing profile
+PROFILE = 1
+!else
+PROFILE = 0
+!endif
+!if [nmakehlp -f $(OPTS) "pgi"]
+!message *** Doing profile guided optimization instrumentation
+PGO = 1
+!elseif [nmakehlp -f $(OPTS) "pgo"]
+!message *** Doing profile guided optimization
+PGO = 2
+!else
+PGO = 0
+!endif
+!if [nmakehlp -f $(OPTS) "loimpact"]
+!message *** Doing loimpact
+LOIMPACT = 1
+!else
+LOIMPACT = 0
+!endif
+!if [nmakehlp -f $(OPTS) "thrdalloc"]
+!message *** Doing thrdalloc
+USE_THREAD_ALLOC = 1
+!endif
+!if [nmakehlp -f $(OPTS) "tclalloc"]
+!message *** Doing tclalloc
+USE_THREAD_ALLOC = 0
+!endif
+!if [nmakehlp -f $(OPTS) "unchecked"]
+!message *** Doing unchecked
+UNCHECKED = 1
+!else
+UNCHECKED = 0
+!endif
+!endif
+
+#----------------------------------------------------------
+# Figure-out how to name our intermediate and output directories.
+# We wouldn't want different builds to use the same .obj files
+# by accident.
+#----------------------------------------------------------
+
+#----------------------------------------
+# Naming convention:
+# t = full thread support.
+# s = static library (as opposed to an
+# import library)
+# g = linked to the debug enabled C
+# run-time.
+# x = special static build when it
+# links to the dynamic C run-time.
+#----------------------------------------
+SUFX = tsgx
+
+!if $(DEBUG)
+BUILDDIRTOP = Debug
+!else
+BUILDDIRTOP = Release
+!endif
+
+!if "$(MACHINE)" != "IX86"
+BUILDDIRTOP =$(BUILDDIRTOP)_$(MACHINE)
+!endif
+!if $(VCVER) > 6
+BUILDDIRTOP =$(BUILDDIRTOP)_VC$(VCVER)
+!endif
+
+!if !$(DEBUG) || $(DEBUG) && $(UNCHECKED)
+SUFX = $(SUFX:g=)
+!endif
+
+TMP_DIRFULL = .\$(BUILDDIRTOP)\$(PROJECT)_ThreadedDynamicStaticX
+
+!if !$(STATIC_BUILD)
+TMP_DIRFULL = $(TMP_DIRFULL:Static=)
+SUFX = $(SUFX:s=)
+EXT = dll
+TMP_DIRFULL = $(TMP_DIRFULL:X=)
+SUFX = $(SUFX:x=)
+!else
+TMP_DIRFULL = $(TMP_DIRFULL:Dynamic=)
+EXT = lib
+!if !$(MSVCRT)
+TMP_DIRFULL = $(TMP_DIRFULL:X=)
+SUFX = $(SUFX:x=)
+!endif
+!endif
+
+!if !$(TCL_THREADS)
+TMP_DIRFULL = $(TMP_DIRFULL:Threaded=)
+SUFX = $(SUFX:t=)
+!endif
+
+!ifndef TMP_DIR
+TMP_DIR = $(TMP_DIRFULL)
+!ifndef OUT_DIR
+OUT_DIR = .\$(BUILDDIRTOP)
+!endif
+!else
+!ifndef OUT_DIR
+OUT_DIR = $(TMP_DIR)
+!endif
+!endif
+
+
+#----------------------------------------------------------
+# Decode the statistics requested.
+#----------------------------------------------------------
+
+!if "$(STATS)" == "" || [nmakehlp -f "$(STATS)" "none"]
+TCL_MEM_DEBUG = 0
+TCL_COMPILE_DEBUG = 0
+!else
+!if [nmakehlp -f $(STATS) "memdbg"]
+!message *** Doing memdbg
+TCL_MEM_DEBUG = 1
+!else
+TCL_MEM_DEBUG = 0
+!endif
+!if [nmakehlp -f $(STATS) "compdbg"]
+!message *** Doing compdbg
+TCL_COMPILE_DEBUG = 1
+!else
+TCL_COMPILE_DEBUG = 0
+!endif
+!endif
+
+
+#----------------------------------------------------------
+# Decode the checks requested.
+#----------------------------------------------------------
+
+!if "$(CHECKS)" == "" || [nmakehlp -f "$(CHECKS)" "none"]
+TCL_NO_DEPRECATED = 0
+WARNINGS = -W3
+!else
+!if [nmakehlp -f $(CHECKS) "nodep"]
+!message *** Doing nodep check
+TCL_NO_DEPRECATED = 1
+!else
+TCL_NO_DEPRECATED = 0
+!endif
+!if [nmakehlp -f $(CHECKS) "fullwarn"]
+!message *** Doing full warnings check
+WARNINGS = -W4
+!if [nmakehlp -l -warn:3]
+LINKERFLAGS = $(LINKERFLAGS) -warn:3
+!endif
+!else
+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) -DSTDC_HEADERS
+
+!if $(TCL_MEM_DEBUG)
+OPTDEFINES = $(OPTDEFINES) -DTCL_MEM_DEBUG
+!endif
+!if $(TCL_COMPILE_DEBUG)
+OPTDEFINES = $(OPTDEFINES) -DTCL_COMPILE_DEBUG -DTCL_COMPILE_STATS
+!endif
+!if $(TCL_THREADS)
+OPTDEFINES = $(OPTDEFINES) -DTCL_THREADS=1
+!if $(USE_THREAD_ALLOC)
+OPTDEFINES = $(OPTDEFINES) -DUSE_THREAD_ALLOC=1
+!endif
+!endif
+!if $(STATIC_BUILD)
+OPTDEFINES = $(OPTDEFINES) -DSTATIC_BUILD
+!endif
+!if $(TCL_NO_DEPRECATED)
+OPTDEFINES = $(OPTDEFINES) -DTCL_NO_DEPRECATED
+!endif
+
+!if !$(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
+
+#----------------------------------------------------------
+# Locate the Tcl headers to build against
+#----------------------------------------------------------
+
+!if "$(PROJECT)" == "tcl"
+
+_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")
+_INSTALLDIR=$(_INSTALLDIR)\lib
+!endif
+
+!if !defined(TCLDIR)
+!if exist("$(_INSTALLDIR)\..\include\tcl.h")
+TCLINSTALL = 1
+_TCLDIR = $(_INSTALLDIR)\..
+_TCL_H = $(_INSTALLDIR)\..\include\tcl.h
+TCLDIR = $(_INSTALLDIR)\..
+!else
+MSG=^
+Failed to find tcl.h. Set the TCLDIR macro.
+!error $(MSG)
+!endif
+!else
+_TCLDIR = $(TCLDIR:/=\)
+!if exist("$(_TCLDIR)\include\tcl.h")
+TCLINSTALL = 1
+_TCL_H = $(_TCLDIR)\include\tcl.h
+!elseif exist("$(_TCLDIR)\generic\tcl.h")
+TCLINSTALL = 0
+_TCL_H = $(_TCLDIR)\generic\tcl.h
+!else
+MSG =^
+Failed to find tcl.h. The TCLDIR macro does not appear correct.
+!error $(MSG)
+!endif
+!endif
+!endif
+
+#--------------------------------------------------------------
+# Extract various version numbers from tcl headers
+# The generated file is then included in the makefile.
+#--------------------------------------------------------------
+
+!if [echo REM = This file is generated from rules.vc > versions.vc]
+!endif
+!if [echo TCL_MAJOR_VERSION = \>> versions.vc] \
+ && [nmakehlp -V "$(_TCL_H)" TCL_MAJOR_VERSION >> versions.vc]
+!endif
+!if [echo TCL_MINOR_VERSION = \>> versions.vc] \
+ && [nmakehlp -V "$(_TCL_H)" TCL_MINOR_VERSION >> versions.vc]
+!endif
+!if [echo TCL_PATCH_LEVEL = \>> versions.vc] \
+ && [nmakehlp -V "$(_TCL_H)" TCL_PATCH_LEVEL >> versions.vc]
+!endif
+
+# If building the tcl core then we need additional package versions
+!if "$(PROJECT)" == "tcl"
+!if [echo PKG_HTTP_VER = \>> versions.vc] \
+ && [nmakehlp -V ..\library\http\pkgIndex.tcl http >> versions.vc]
+!endif
+!if [echo PKG_TCLTEST_VER = \>> versions.vc] \
+ && [nmakehlp -V ..\library\tcltest\pkgIndex.tcl tcltest >> versions.vc]
+!endif
+!if [echo PKG_MSGCAT_VER = \>> versions.vc] \
+ && [nmakehlp -V ..\library\msgcat\pkgIndex.tcl msgcat >> versions.vc]
+!endif
+!if [echo PKG_PLATFORM_VER = \>> versions.vc] \
+ && [nmakehlp -V ..\library\platform\pkgIndex.tcl "platform " >> versions.vc]
+!endif
+!if [echo PKG_SHELL_VER = \>> versions.vc] \
+ && [nmakehlp -V ..\library\platform\pkgIndex.tcl "platform::shell" >> versions.vc]
+!endif
+!if [echo PKG_DDE_VER = \>> versions.vc] \
+ && [nmakehlp -V ..\library\dde\pkgIndex.tcl "dde " >> versions.vc]
+!endif
+!if [echo PKG_REG_VER =\>> versions.vc] \
+ && [nmakehlp -V ..\library\reg\pkgIndex.tcl registry >> versions.vc]
+!endif
+!endif
+
+!include versions.vc
+
+#--------------------------------------------------------------
+# Setup tcl version dependent stuff headers
+#--------------------------------------------------------------
+
+!if "$(PROJECT)" != "tcl"
+
+TCL_VERSION = $(TCL_MAJOR_VERSION)$(TCL_MINOR_VERSION)
+
+!if $(TCLINSTALL)
+TCLSH = "$(_TCLDIR)\bin\tclsh$(TCL_VERSION)$(SUFX).exe"
+!if !exist($(TCLSH)) && $(TCL_THREADS)
+TCLSH = "$(_TCLDIR)\bin\tclsh$(TCL_VERSION)t$(SUFX).exe"
+!endif
+TCLSTUBLIB = "$(_TCLDIR)\lib\tclstub$(TCL_VERSION).lib"
+TCLIMPLIB = "$(_TCLDIR)\lib\tcl$(TCL_VERSION)$(SUFX).lib"
+TCL_LIBRARY = $(_TCLDIR)\lib
+TCLREGLIB = "$(_TCLDIR)\lib\tclreg12$(SUFX:t=).lib"
+TCLDDELIB = "$(_TCLDIR)\lib\tcldde13$(SUFX:t=).lib"
+COFFBASE = \must\have\tcl\sources\to\build\this\target
+TCLTOOLSDIR = \must\have\tcl\sources\to\build\this\target
+TCL_INCLUDES = -I"$(_TCLDIR)\include"
+!else
+TCLSH = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclsh$(TCL_VERSION)$(SUFX).exe"
+!if !exist($(TCLSH)) && $(TCL_THREADS)
+TCLSH = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclsh$(TCL_VERSION)t$(SUFX).exe"
+!endif
+TCLSTUBLIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclstub$(TCL_VERSION).lib"
+TCLIMPLIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tcl$(TCL_VERSION)$(SUFX).lib"
+TCL_LIBRARY = $(_TCLDIR)\library
+TCLREGLIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclreg12$(SUFX:t=).lib"
+TCLDDELIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tcldde13$(SUFX:t=).lib"
+COFFBASE = "$(_TCLDIR)\win\coffbase.txt"
+TCLTOOLSDIR = $(_TCLDIR)\tools
+TCL_INCLUDES = -I"$(_TCLDIR)\generic" -I"$(_TCLDIR)\win"
+!endif
+
+!endif
+
+#-------------------------------------------------------------------------
+# Locate the Tk headers to build against
+#-------------------------------------------------------------------------
+
+!if "$(PROJECT)" == "tk"
+_TK_H = ..\generic\tk.h
+_INSTALLDIR = $(_INSTALLDIR)\..
+!endif
+
+!ifdef PROJECT_REQUIRES_TK
+!if !defined(TKDIR)
+!if exist("$(_INSTALLDIR)\..\include\tk.h")
+TKINSTALL = 1
+_TKDIR = $(_INSTALLDIR)\..
+_TK_H = $(_TKDIR)\include\tk.h
+TKDIR = $(_TKDIR)
+!elseif exist("$(_TCLDIR)\include\tk.h")
+TKINSTALL = 1
+_TKDIR = $(_TCLDIR)
+_TK_H = $(_TKDIR)\include\tk.h
+TKDIR = $(_TKDIR)
+!endif
+!else
+_TKDIR = $(TKDIR:/=\)
+!if exist("$(_TKDIR)\include\tk.h")
+TKINSTALL = 1
+_TK_H = $(_TKDIR)\include\tk.h
+!elseif exist("$(_TKDIR)\generic\tk.h")
+TKINSTALL = 0
+_TK_H = $(_TKDIR)\generic\tk.h
+!else
+MSG =^
+Failed to find tk.h. The TKDIR macro does not appear correct.
+!error $(MSG)
+!endif
+!endif
+!endif
+
+#-------------------------------------------------------------------------
+# Extract Tk version numbers
+#-------------------------------------------------------------------------
+
+!if defined(PROJECT_REQUIRES_TK) || "$(PROJECT)" == "tk"
+
+!if [echo TK_MAJOR_VERSION = \>> versions.vc] \
+ && [nmakehlp -V $(_TK_H) TK_MAJOR_VERSION >> versions.vc]
+!endif
+!if [echo TK_MINOR_VERSION = \>> versions.vc] \
+ && [nmakehlp -V $(_TK_H) TK_MINOR_VERSION >> versions.vc]
+!endif
+!if [echo TK_PATCH_LEVEL = \>> versions.vc] \
+ && [nmakehlp -V $(_TK_H) TK_PATCH_LEVEL >> versions.vc]
+!endif
+
+!include versions.vc
+
+TK_DOTVERSION = $(TK_MAJOR_VERSION).$(TK_MINOR_VERSION)
+TK_VERSION = $(TK_MAJOR_VERSION)$(TK_MINOR_VERSION)
+
+!if "$(PROJECT)" != "tk"
+!if $(TKINSTALL)
+WISH = "$(_TKDIR)\bin\wish$(TK_VERSION)$(SUFX).exe"
+TKSTUBLIB = "$(_TKDIR)\lib\tkstub$(TK_VERSION).lib"
+TKIMPLIB = "$(_TKDIR)\lib\tk$(TK_VERSION)$(SUFX).lib"
+TK_INCLUDES = -I"$(_TKDIR)\include"
+!else
+WISH = "$(_TKDIR)\win\$(BUILDDIRTOP)\wish$(TCL_VERSION)$(SUFX).exe"
+TKSTUBLIB = "$(_TKDIR)\win\$(BUILDDIRTOP)\tkstub$(TCL_VERSION).lib"
+TKIMPLIB = "$(_TKDIR)\win\$(BUILDDIRTOP)\tk$(TCL_VERSION)$(SUFX).lib"
+TK_INCLUDES = -I"$(_TKDIR)\generic" -I"$(_TKDIR)\win" -I"$(_TKDIR)\xlib"
+!endif
+!endif
+
+!endif
+
+#----------------------------------------------------------
+# Display stats being used.
+#----------------------------------------------------------
+
+!message *** Intermediate directory will be '$(TMP_DIR)'
+!message *** Output directory will be '$(OUT_DIR)'
+!message *** Suffix for binaries will be '$(SUFX)'
+!message *** Optional defines are '$(OPTDEFINES)'
+!message *** Compiler version $(VCVER). Target machine is $(MACHINE)
+!message *** Host architecture is $(NATIVE_ARCH)
+!message *** Compiler options '$(COMPILERFLAGS) $(OPTIMIZATIONS) $(DEBUGFLAGS) $(WARNINGS)'
+!message *** Link options '$(LINKERFLAGS)'
+
+!endif
diff --git a/win/stub16.c b/win/stub16.c new file mode 100644 index 0000000..70fc051 --- /dev/null +++ b/win/stub16.c @@ -0,0 +1,195 @@ +/* + * stub16.c + * + * A helper program used for running 16-bit DOS applications under + * Windows 95. + * + * Copyright (c) 1996 by Sun Microsystems, Inc. + * + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + +#define STRICT + +#include <windows.h> +#include <stdio.h> + +static HANDLE CreateTempFile(void); + +/* + *--------------------------------------------------------------------------- + * + * main + * + * Entry point for the 32-bit console mode app used by Windows 95 to help + * run the 16-bit program specified on the command line. + * + * 1. EOF on a pipe that connects a detached 16-bit process and a 32-bit + * process is never seen. So, this process runs the 16-bit process + * _attached_, and then it is run detached from the calling 32-bit + * process. + * + * 2. If a 16-bit process blocks reading from or writing to a pipe, it + * never wakes up, and eventually brings the whole system down with it if + * you try to kill the process. This app simulates pipes. If any of the + * stdio handles is a pipe, this program accumulates information into + * temp files and forwards it to or from the DOS application as + * appropriate. This means that this program must receive EOF from a + * stdin pipe before it will actually start the DOS app, and the DOS app + * must finish generating stdout or stderr before the data will be sent + * to the next stage of the pipe. If the stdio handles are not pipes, no + * accumulation occurs and the data is passed straight through to and + * from the DOS application. + * + * Results: + * None. + * + * Side effects: + * The child process is created and this process waits for it to + * complete. + * + *--------------------------------------------------------------------------- + */ + +int +main(void) +{ + DWORD dwRead, dwWrite; + char *cmdLine; + HANDLE hStdInput, hStdOutput, hStdError; + HANDLE hFileInput, hFileOutput, hFileError; + STARTUPINFO si; + PROCESS_INFORMATION pi; + char buf[8192]; + DWORD result; + + hFileInput = INVALID_HANDLE_VALUE; + hFileOutput = INVALID_HANDLE_VALUE; + hFileError = INVALID_HANDLE_VALUE; + result = 1; + + /* + * Don't get command line from argc, argv, because the command line + * tokenizer will have stripped off all the escape sequences needed for + * quotes and backslashes, and then we'd have to put them all back in + * again. Get the raw command line and parse off what we want ourselves. + * The command line should be of the form: + * + * stub16.exe program arg1 arg2 ... + */ + + cmdLine = strchr(GetCommandLine(), ' '); + if (cmdLine == NULL) { + return 1; + } + cmdLine++; + + hStdInput = GetStdHandle(STD_INPUT_HANDLE); + hStdOutput = GetStdHandle(STD_OUTPUT_HANDLE); + hStdError = GetStdHandle(STD_ERROR_HANDLE); + + if (GetFileType(hStdInput) == FILE_TYPE_PIPE) { + hFileInput = CreateTempFile(); + if (hFileInput == INVALID_HANDLE_VALUE) { + goto cleanup; + } + while (ReadFile(hStdInput, buf, sizeof(buf), &dwRead, NULL) != FALSE) { + if (dwRead == 0) { + break; + } + if (WriteFile(hFileInput, buf, dwRead, &dwWrite, NULL) == FALSE) { + goto cleanup; + } + } + SetFilePointer(hFileInput, 0, 0, FILE_BEGIN); + SetStdHandle(STD_INPUT_HANDLE, hFileInput); + } + if (GetFileType(hStdOutput) == FILE_TYPE_PIPE) { + hFileOutput = CreateTempFile(); + if (hFileOutput == INVALID_HANDLE_VALUE) { + goto cleanup; + } + SetStdHandle(STD_OUTPUT_HANDLE, hFileOutput); + } + if (GetFileType(hStdError) == FILE_TYPE_PIPE) { + hFileError = CreateTempFile(); + if (hFileError == INVALID_HANDLE_VALUE) { + goto cleanup; + } + SetStdHandle(STD_ERROR_HANDLE, hFileError); + } + + ZeroMemory(&si, sizeof(si)); + si.cb = sizeof(si); + if (CreateProcess(NULL, cmdLine, NULL, NULL, TRUE, 0, NULL, NULL, &si, + &pi) == FALSE) { + goto cleanup; + } + + WaitForInputIdle(pi.hProcess, 5000); + WaitForSingleObject(pi.hProcess, INFINITE); + GetExitCodeProcess(pi.hProcess, &result); + CloseHandle(pi.hProcess); + CloseHandle(pi.hThread); + + if (hFileOutput != INVALID_HANDLE_VALUE) { + SetFilePointer(hFileOutput, 0, 0, FILE_BEGIN); + while (ReadFile(hFileOutput, buf, sizeof(buf), &dwRead, NULL) != FALSE) { + if (dwRead == 0) { + break; + } + if (WriteFile(hStdOutput, buf, dwRead, &dwWrite, NULL) == FALSE) { + break; + } + } + } + if (hFileError != INVALID_HANDLE_VALUE) { + SetFilePointer(hFileError, 0, 0, FILE_BEGIN); + while (ReadFile(hFileError, buf, sizeof(buf), &dwRead, NULL) != FALSE) { + if (dwRead == 0) { + break; + } + if (WriteFile(hStdError, buf, dwRead, &dwWrite, NULL) == FALSE) { + break; + } + } + } + + cleanup: + if (hFileInput != INVALID_HANDLE_VALUE) { + CloseHandle(hFileInput); + } + if (hFileOutput != INVALID_HANDLE_VALUE) { + CloseHandle(hFileOutput); + } + if (hFileError != INVALID_HANDLE_VALUE) { + CloseHandle(hFileError); + } + CloseHandle(hStdInput); + CloseHandle(hStdOutput); + CloseHandle(hStdError); + ExitProcess(result); + return 1; +} + +static HANDLE +CreateTempFile(void) +{ + char name[MAX_PATH]; + SECURITY_ATTRIBUTES sa; + + if (GetTempPath(sizeof(name), name) == 0) { + return INVALID_HANDLE_VALUE; + } + if (GetTempFileName(name, "tcl", 0, name) == 0) { + return INVALID_HANDLE_VALUE; + } + + sa.nLength = sizeof(sa); + sa.lpSecurityDescriptor = NULL; + sa.bInheritHandle = TRUE; + return CreateFile(name, GENERIC_READ | GENERIC_WRITE, 0, &sa, + CREATE_ALWAYS, FILE_ATTRIBUTE_TEMPORARY | FILE_FLAG_DELETE_ON_CLOSE, + NULL); +} diff --git a/win/tcl.dsp b/win/tcl.dsp index 57ec6bf..68920ad 100644 --- a/win/tcl.dsp +++ b/win/tcl.dsp @@ -1,1567 +1,1567 @@ -# Microsoft Developer Studio Project File - Name="tcl" - Package Owner=<4> -# Microsoft Developer Studio Generated Build File, Format Version 6.00 -# ** DO NOT EDIT ** - -# TARGTYPE "Win32 (x86) External Target" 0x0106 - -CFG=tcl - Win32 Debug Static -!MESSAGE This is not a valid makefile. To build this project using NMAKE, -!MESSAGE use the Export Makefile command and run -!MESSAGE -!MESSAGE NMAKE /f "tcl.mak". -!MESSAGE -!MESSAGE You can specify a configuration when running NMAKE -!MESSAGE by defining the macro CFG on the command line. For example: -!MESSAGE -!MESSAGE NMAKE /f "tcl.mak" CFG="tcl - Win32 Debug Static" -!MESSAGE -!MESSAGE Possible choices for configuration are: -!MESSAGE -!MESSAGE "tcl - Win32 Release" (based on "Win32 (x86) External Target") -!MESSAGE "tcl - Win32 Debug" (based on "Win32 (x86) External Target") -!MESSAGE "tcl - Win32 Debug Static" (based on "Win32 (x86) External Target") -!MESSAGE "tcl - Win32 Release Static" (based on "Win32 (x86) External Target") -!MESSAGE - -# Begin Project -# PROP AllowPerConfigDependencies 0 -# PROP Scc_ProjName "" -# PROP Scc_LocalPath "" - -!IF "$(CFG)" == "tcl - Win32 Release" - -# PROP BASE Use_MFC 0 -# PROP BASE Use_Debug_Libraries 0 -# PROP BASE Output_Dir "Release" -# PROP BASE Intermediate_Dir "Release\tcl_Dynamic" -# PROP BASE Cmd_Line "nmake -nologo -f makefile.vc OPTS=none MSVCDIR=IDE" -# PROP BASE Rebuild_Opt "-a" -# PROP BASE Target_File "Release\tclsh85.exe" -# PROP BASE Bsc_Name "" -# PROP BASE Target_Dir "" -# PROP Use_MFC 0 -# PROP Use_Debug_Libraries 0 -# PROP Output_Dir "Release" -# PROP Intermediate_Dir "Release\tcl_Dynamic" -# PROP Cmd_Line "nmake -nologo -f makefile.vc OPTS=threads MSVCDIR=IDE" -# PROP Rebuild_Opt "clean release" -# PROP Target_File "Release\tclsh85t.exe" -# PROP Bsc_Name "" -# PROP Target_Dir "" - -!ELSEIF "$(CFG)" == "tcl - Win32 Debug" - -# PROP BASE Use_MFC 0 -# PROP BASE Use_Debug_Libraries 1 -# PROP BASE Output_Dir "Debug" -# PROP BASE Intermediate_Dir "Debug\tcl_Dynamic" -# PROP BASE Cmd_Line "nmake -nologo -f makefile.vc OPTS=symbols MSVCDIR=IDE" -# PROP BASE Rebuild_Opt "-a" -# PROP BASE Target_File "Debug\tclsh85g.exe" -# PROP BASE Bsc_Name "" -# PROP BASE Target_Dir "" -# PROP Use_MFC 0 -# PROP Use_Debug_Libraries 1 -# PROP Output_Dir "Debug" -# PROP Intermediate_Dir "Debug\tcl_Dynamic" -# PROP Cmd_Line "nmake -nologo -f makefile.vc OPTS=threads,symbols MSVCDIR=IDE" -# PROP Rebuild_Opt "clean release" -# PROP Target_File "Debug\tclsh85tg.exe" -# PROP Bsc_Name "" -# PROP Target_Dir "" - -!ELSEIF "$(CFG)" == "tcl - Win32 Debug Static" - -# PROP BASE Use_MFC 0 -# PROP BASE Use_Debug_Libraries 1 -# PROP BASE Output_Dir "Debug" -# PROP BASE Intermediate_Dir "Debug\tcl_Static" -# PROP BASE Cmd_Line "nmake -nologo -f makefile.vc OPTS=symbols,static MSVCDIR=IDE" -# PROP BASE Rebuild_Opt "-a" -# PROP BASE Target_File "Debug\tclsh85sg.exe" -# PROP BASE Bsc_Name "" -# PROP BASE Target_Dir "" -# PROP Use_MFC 0 -# PROP Use_Debug_Libraries 1 -# PROP Output_Dir "Debug" -# PROP Intermediate_Dir "Debug\tcl_Static" -# PROP Cmd_Line "nmake -nologo -f makefile.vc OPTS=symbols,static MSVCDIR=IDE" -# PROP Rebuild_Opt "-a" -# PROP Target_File "Debug\tclsh85sg.exe" -# PROP Bsc_Name "" -# PROP Target_Dir "" - -!ELSEIF "$(CFG)" == "tcl - Win32 Release Static" - -# PROP BASE Use_MFC 0 -# PROP BASE Use_Debug_Libraries 0 -# PROP BASE Output_Dir "Release" -# PROP BASE Intermediate_Dir "Release\tcl_Static" -# PROP BASE Cmd_Line "nmake -nologo -f makefile.vc OPTS=static MSVCDIR=IDE" -# PROP BASE Rebuild_Opt "-a" -# PROP BASE Target_File "Release\tclsh85s.exe" -# PROP BASE Bsc_Name "" -# PROP BASE Target_Dir "" -# PROP Use_MFC 0 -# PROP Use_Debug_Libraries 0 -# PROP Output_Dir "Release" -# PROP Intermediate_Dir "Release\tcl_Static" -# PROP Cmd_Line "nmake -nologo -f makefile.vc OPTS=static MSVCDIR=IDE" -# PROP Rebuild_Opt "-a" -# PROP Target_File "Release\tclsh85s.exe" -# PROP Bsc_Name "" -# PROP Target_Dir "" - -!ENDIF - -# Begin Target - -# Name "tcl - Win32 Release" -# Name "tcl - Win32 Debug" -# Name "tcl - Win32 Debug Static" -# Name "tcl - Win32 Release Static" - -!IF "$(CFG)" == "tcl - Win32 Release" - -!ELSEIF "$(CFG)" == "tcl - Win32 Debug" - -!ELSEIF "$(CFG)" == "tcl - Win32 Debug Static" - -!ELSEIF "$(CFG)" == "tcl - Win32 Release Static" - -!ENDIF - -# Begin Group "compat" - -# PROP Default_Filter "" -# Begin Source File - -SOURCE=..\compat\dirent.h -# End Source File -# Begin Source File - -SOURCE=..\compat\dirent2.h -# End Source File -# Begin Source File - -SOURCE=..\compat\dlfcn.h -# End Source File -# Begin Source File - -SOURCE=..\compat\fixstrtod.c -# End Source File -# Begin Source File - -SOURCE=..\compat\float.h -# End Source File -# Begin Source File - -SOURCE=..\compat\gettod.c -# End Source File -# Begin Source File - -SOURCE=..\compat\limits.h -# End Source File -# Begin Source File - -SOURCE=..\compat\memcmp.c -# End Source File -# Begin Source File - -SOURCE=..\compat\opendir.c -# End Source File -# Begin Source File - -SOURCE=..\compat\README -# End Source File -# Begin Source File - -SOURCE=..\compat\stdlib.h -# End Source File -# Begin Source File - -SOURCE=..\compat\string.h -# End Source File -# Begin Source File - -SOURCE=..\compat\strncasecmp.c -# End Source File -# Begin Source File - -SOURCE=..\compat\strstr.c -# End Source File -# Begin Source File - -SOURCE=..\compat\strtod.c -# End Source File -# Begin Source File - -SOURCE=..\compat\strtol.c -# End Source File -# Begin Source File - -SOURCE=..\compat\strtoul.c -# End Source File -# Begin Source File - -SOURCE=..\compat\tclErrno.h -# End Source File -# Begin Source File - -SOURCE=..\compat\unistd.h -# End Source File -# Begin Source File - -SOURCE=..\compat\waitpid.c -# End Source File -# End Group -# Begin Group "doc" - -# PROP Default_Filter "" -# Begin Source File - -SOURCE=..\doc\Access.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\AddErrInfo.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\after.n -# End Source File -# Begin Source File - -SOURCE=..\doc\Alloc.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\AllowExc.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\append.n -# End Source File -# Begin Source File - -SOURCE=..\doc\AppInit.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\array.n -# End Source File -# Begin Source File - -SOURCE=..\doc\AssocData.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\Async.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\BackgdErr.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\Backslash.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\bgerror.n -# End Source File -# Begin Source File - -SOURCE=..\doc\binary.n -# End Source File -# Begin Source File - -SOURCE=..\doc\BoolObj.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\break.n -# End Source File -# Begin Source File - -SOURCE=..\doc\ByteArrObj.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\CallDel.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\case.n -# End Source File -# Begin Source File - -SOURCE=..\doc\catch.n -# End Source File -# Begin Source File - -SOURCE=..\doc\cd.n -# End Source File -# Begin Source File - -SOURCE=..\doc\ChnlStack.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\clock.n -# End Source File -# Begin Source File - -SOURCE=..\doc\close.n -# End Source File -# Begin Source File - -SOURCE=..\doc\CmdCmplt.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\Concat.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\concat.n -# End Source File -# Begin Source File - -SOURCE=..\doc\continue.n -# End Source File -# Begin Source File - -SOURCE=..\doc\CrtChannel.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\CrtChnlHdlr.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\CrtCloseHdlr.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\CrtCommand.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\CrtFileHdlr.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\CrtInterp.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\CrtMathFnc.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\CrtObjCmd.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\CrtSlave.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\CrtTimerHdlr.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\CrtTrace.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\dde.n -# End Source File -# Begin Source File - -SOURCE=..\doc\DetachPids.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\DoOneEvent.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\DoubleObj.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\DoWhenIdle.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\DString.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\DumpActiveMemory.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\Encoding.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\encoding.n -# End Source File -# Begin Source File - -SOURCE=..\doc\Environment.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\eof.n -# End Source File -# Begin Source File - -SOURCE=..\doc\error.n -# End Source File -# Begin Source File - -SOURCE=..\doc\Eval.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\eval.n -# End Source File -# Begin Source File - -SOURCE=..\doc\exec.n -# End Source File -# Begin Source File - -SOURCE=..\doc\Exit.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\exit.n -# End Source File -# Begin Source File - -SOURCE=..\doc\expr.n -# End Source File -# Begin Source File - -SOURCE=..\doc\ExprLong.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\ExprLongObj.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\fblocked.n -# End Source File -# Begin Source File - -SOURCE=..\doc\fconfigure.n -# End Source File -# Begin Source File - -SOURCE=..\doc\fcopy.n -# End Source File -# Begin Source File - -SOURCE=..\doc\file.n -# End Source File -# Begin Source File - -SOURCE=..\doc\fileevent.n -# End Source File -# Begin Source File - -SOURCE=..\doc\filename.n -# End Source File -# Begin Source File - -SOURCE=..\doc\FileSystem.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\FindExec.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\flush.n -# End Source File -# Begin Source File - -SOURCE=..\doc\for.n -# End Source File -# Begin Source File - -SOURCE=..\doc\foreach.n -# End Source File -# Begin Source File - -SOURCE=..\doc\format.n -# End Source File -# Begin Source File - -SOURCE=..\doc\GetCwd.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\GetHostName.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\GetIndex.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\GetInt.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\GetOpnFl.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\gets.n -# End Source File -# Begin Source File - -SOURCE=..\doc\GetStdChan.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\GetVersion.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\glob.n -# End Source File -# Begin Source File - -SOURCE=..\doc\global.n -# End Source File -# Begin Source File - -SOURCE=..\doc\Hash.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\history.n -# End Source File -# Begin Source File - -SOURCE=..\doc\http.n -# End Source File -# Begin Source File - -SOURCE=..\doc\if.n -# End Source File -# Begin Source File - -SOURCE=..\doc\incr.n -# End Source File -# Begin Source File - -SOURCE=..\doc\info.n -# End Source File -# Begin Source File - -SOURCE=..\doc\Init.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\InitStubs.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\Interp.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\interp.n -# End Source File -# Begin Source File - -SOURCE=..\doc\IntObj.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\join.n -# End Source File -# Begin Source File - -SOURCE=..\doc\lappend.n -# End Source File -# Begin Source File - -SOURCE=..\doc\library.n -# End Source File -# Begin Source File - -SOURCE=..\doc\lindex.n -# End Source File -# Begin Source File - -SOURCE=..\doc\LinkVar.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\linsert.n -# End Source File -# Begin Source File - -SOURCE=..\doc\list.n -# End Source File -# Begin Source File - -SOURCE=..\doc\ListObj.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\llength.n -# End Source File -# Begin Source File - -SOURCE=..\doc\load.n -# End Source File -# Begin Source File - -SOURCE=..\doc\lrange.n -# End Source File -# Begin Source File - -SOURCE=..\doc\lreplace.n -# End Source File -# Begin Source File - -SOURCE=..\doc\lsearch.n -# End Source File -# Begin Source File - -SOURCE=..\doc\lsort.n -# End Source File -# Begin Source File - -SOURCE=..\doc\man.macros -# End Source File -# Begin Source File - -SOURCE=..\doc\memory.n -# End Source File -# Begin Source File - -SOURCE=..\doc\msgcat.n -# End Source File -# Begin Source File - -SOURCE=..\doc\namespace.n -# End Source File -# Begin Source File - -SOURCE=..\doc\Notifier.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\Object.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\ObjectType.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\open.n -# End Source File -# Begin Source File - -SOURCE=..\doc\OpenFileChnl.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\OpenTcp.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\package.n -# End Source File -# Begin Source File - -SOURCE=..\doc\packagens.n -# End Source File -# Begin Source File - -SOURCE=..\doc\Panic.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\ParseCmd.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\pid.n -# End Source File -# Begin Source File - -SOURCE=..\doc\pkgMkIndex.n -# End Source File -# Begin Source File - -SOURCE=..\doc\PkgRequire.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\Preserve.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\PrintDbl.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\proc.n -# End Source File -# Begin Source File - -SOURCE=..\doc\puts.n -# End Source File -# Begin Source File - -SOURCE=..\doc\pwd.n -# End Source File -# Begin Source File - -SOURCE=..\doc\re_syntax.n -# End Source File -# Begin Source File - -SOURCE=..\doc\read.n -# End Source File -# Begin Source File - -SOURCE=..\doc\RecEvalObj.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\RecordEval.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\RegExp.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\regexp.n -# End Source File -# Begin Source File - -SOURCE=..\doc\registry.n -# End Source File -# Begin Source File - -SOURCE=..\doc\regsub.n -# End Source File -# Begin Source File - -SOURCE=..\doc\rename.n -# End Source File -# Begin Source File - -SOURCE=..\doc\return.n -# End Source File -# Begin Source File - -SOURCE=..\doc\safe.n -# End Source File -# Begin Source File - -SOURCE=..\doc\SaveResult.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\scan.n -# End Source File -# Begin Source File - -SOURCE=..\doc\seek.n -# End Source File -# Begin Source File - -SOURCE=..\doc\set.n -# End Source File -# Begin Source File - -SOURCE=..\doc\SetErrno.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\SetRecLmt.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\SetResult.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\SetVar.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\Signal.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\Sleep.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\socket.n -# End Source File -# Begin Source File - -SOURCE=..\doc\source.n -# End Source File -# Begin Source File - -SOURCE=..\doc\SourceRCFile.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\split.n -# End Source File -# Begin Source File - -SOURCE=..\doc\SplitList.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\SplitPath.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\StaticPkg.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\StdChannels.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\string.n -# End Source File -# Begin Source File - -SOURCE=..\doc\StringObj.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\StrMatch.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\subst.n -# End Source File -# Begin Source File - -SOURCE=..\doc\SubstObj.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\switch.n -# End Source File -# Begin Source File - -SOURCE=..\doc\Tcl.n -# End Source File -# Begin Source File - -SOURCE=..\doc\Tcl_Main.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\TCL_MEM_DEBUG.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\tclsh.1 -# End Source File -# Begin Source File - -SOURCE=..\doc\tcltest.n -# End Source File -# Begin Source File - -SOURCE=..\doc\tclvars.n -# End Source File -# Begin Source File - -SOURCE=..\doc\tell.n -# End Source File -# Begin Source File - -SOURCE=..\doc\Thread.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\time.n -# End Source File -# Begin Source File - -SOURCE=..\doc\ToUpper.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\trace.n -# End Source File -# Begin Source File - -SOURCE=..\doc\TraceVar.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\Translate.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\UniCharIsAlpha.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\unknown.n -# End Source File -# Begin Source File - -SOURCE=..\doc\unset.n -# End Source File -# Begin Source File - -SOURCE=..\doc\update.n -# End Source File -# Begin Source File - -SOURCE=..\doc\uplevel.n -# End Source File -# Begin Source File - -SOURCE=..\doc\UpVar.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\upvar.n -# End Source File -# Begin Source File - -SOURCE=..\doc\Utf.3 -# End Source File -# Begin Source File - -SOURCE=..\doc\variable.n -# End Source File -# Begin Source File - -SOURCE=..\doc\vwait.n -# End Source File -# Begin Source File - -SOURCE=..\doc\while.n -# End Source File -# Begin Source File - -SOURCE=..\doc\WrongNumArgs.3 -# End Source File -# End Group -# Begin Group "generic" - -# PROP Default_Filter "" -# Begin Source File - -SOURCE=..\generic\README -# End Source File -# Begin Source File - -SOURCE=..\generic\regc_color.c -# End Source File -# Begin Source File - -SOURCE=..\generic\regc_cvec.c -# End Source File -# Begin Source File - -SOURCE=..\generic\regc_lex.c -# End Source File -# Begin Source File - -SOURCE=..\generic\regc_locale.c -# End Source File -# Begin Source File - -SOURCE=..\generic\regc_nfa.c -# End Source File -# Begin Source File - -SOURCE=..\generic\regcomp.c -# End Source File -# Begin Source File - -SOURCE=..\generic\regcustom.h -# End Source File -# Begin Source File - -SOURCE=..\generic\rege_dfa.c -# End Source File -# Begin Source File - -SOURCE=..\generic\regerror.c -# End Source File -# Begin Source File - -SOURCE=..\generic\regerrs.h -# End Source File -# Begin Source File - -SOURCE=..\generic\regex.h -# End Source File -# Begin Source File - -SOURCE=..\generic\regexec.c -# End Source File -# Begin Source File - -SOURCE=..\generic\regfree.c -# End Source File -# Begin Source File - -SOURCE=..\generic\regfronts.c -# End Source File -# Begin Source File - -SOURCE=..\generic\regguts.h -# End Source File -# Begin Source File - -SOURCE=..\generic\tcl.decls -# End Source File -# Begin Source File - -SOURCE=..\generic\tcl.h -# End Source File -# Begin Source File - -SOURCE=..\generic\tclAlloc.c -# End Source File -# Begin Source File - -SOURCE=..\generic\tclAsync.c -# End Source File -# Begin Source File - -SOURCE=..\generic\tclBasic.c -# End Source File -# Begin Source File - -SOURCE=..\generic\tclBinary.c -# End Source File -# Begin Source File - -SOURCE=..\generic\tclCkalloc.c -# End Source File -# Begin Source File - -SOURCE=..\generic\tclClock.c -# End Source File -# Begin Source File - -SOURCE=..\generic\tclCmdAH.c -# End Source File -# Begin Source File - -SOURCE=..\generic\tclCmdIL.c -# End Source File -# Begin Source File - -SOURCE=..\generic\tclCmdMZ.c -# End Source File -# Begin Source File - -SOURCE=..\generic\tclCompCmds.c -# End Source File -# Begin Source File - -SOURCE=..\generic\tclCompExpr.c -# End Source File -# Begin Source File - -SOURCE=..\generic\tclCompile.c -# End Source File -# Begin Source File - -SOURCE=..\generic\tclCompile.h -# End Source File -# Begin Source File - -SOURCE=..\generic\tclDate.c -# End Source File -# Begin Source File - -SOURCE=..\generic\tclDecls.h -# End Source File -# Begin Source File - -SOURCE=..\generic\tclEncoding.c -# End Source File -# Begin Source File - -SOURCE=..\generic\tclEnv.c -# End Source File -# Begin Source File - -SOURCE=..\generic\tclEvent.c -# End Source File -# Begin Source File - -SOURCE=..\generic\tclExecute.c -# End Source File -# Begin Source File - -SOURCE=..\generic\tclFCmd.c -# End Source File -# Begin Source File - -SOURCE=..\generic\tclFileName.c -# End Source File -# Begin Source File - -SOURCE=..\generic\tclGet.c -# End Source File -# Begin Source File - -SOURCE=..\generic\tclGetDate.y -# End Source File -# Begin Source File - -SOURCE=..\generic\tclHash.c -# End Source File -# Begin Source File - -SOURCE=..\generic\tclHistory.c -# End Source File -# Begin Source File - -SOURCE=..\generic\tclIndexObj.c -# End Source File -# Begin Source File - -SOURCE=..\generic\tclInt.decls -# End Source File -# Begin Source File - -SOURCE=..\generic\tclInt.h -# End Source File -# Begin Source File - -SOURCE=..\generic\tclIntDecls.h -# End Source File -# Begin Source File - -SOURCE=..\generic\tclInterp.c -# End Source File -# Begin Source File - -SOURCE=..\generic\tclIntPlatDecls.h -# End Source File -# Begin Source File - -SOURCE=..\generic\tclIO.c -# End Source File -# Begin Source File - -SOURCE=..\generic\tclIO.h -# End Source File -# Begin Source File - -SOURCE=..\generic\tclIOCmd.c -# End Source File -# Begin Source File - -SOURCE=..\generic\tclIOGT.c -# End Source File -# Begin Source File - -SOURCE=..\generic\tclIOSock.c -# End Source File -# Begin Source File - -SOURCE=..\generic\tclIOUtil.c -# End Source File -# Begin Source File - -SOURCE=..\generic\tclLink.c -# End Source File -# Begin Source File - -SOURCE=..\generic\tclListObj.c -# End Source File -# Begin Source File - -SOURCE=..\generic\tclLiteral.c -# End Source File -# Begin Source File - -SOURCE=..\generic\tclLoad.c -# End Source File -# Begin Source File - -SOURCE=..\generic\tclLoadNone.c -# End Source File -# Begin Source File - -SOURCE=..\generic\tclMain.c -# End Source File -# Begin Source File - -SOURCE=..\generic\tclNamesp.c -# End Source File -# Begin Source File - -SOURCE=..\generic\tclNotify.c -# End Source File -# Begin Source File - -SOURCE=..\generic\tclObj.c -# End Source File -# Begin Source File - -SOURCE=..\generic\tclPanic.c -# End Source File -# Begin Source File - -SOURCE=..\generic\tclParse.c -# End Source File -# Begin Source File - -SOURCE=..\generic\tclPipe.c -# End Source File -# Begin Source File - -SOURCE=..\generic\tclPkg.c -# End Source File -# Begin Source File - -SOURCE=..\generic\tclPlatDecls.h -# End Source File -# Begin Source File - -SOURCE=..\generic\tclPort.h -# End Source File -# Begin Source File - -SOURCE=..\generic\tclPosixStr.c -# End Source File -# Begin Source File - -SOURCE=..\generic\tclPreserve.c -# End Source File -# Begin Source File - -SOURCE=..\generic\tclProc.c -# End Source File -# Begin Source File - -SOURCE=..\generic\tclRegexp.c -# End Source File -# Begin Source File - -SOURCE=..\generic\tclRegexp.h -# End Source File -# Begin Source File - -SOURCE=..\generic\tclResolve.c -# End Source File -# Begin Source File - -SOURCE=..\generic\tclResult.c -# End Source File -# Begin Source File - -SOURCE=..\generic\tclScan.c -# End Source File -# Begin Source File - -SOURCE=..\generic\tclStringObj.c -# End Source File -# Begin Source File - -SOURCE=..\generic\tclStubInit.c -# End Source File -# Begin Source File - -SOURCE=..\generic\tclStubLib.c -# End Source File -# Begin Source File - -SOURCE=..\generic\tclOOStubLib.c -# End Source File -# Begin Source File - -SOURCE=..\generic\tclTomMathStubLib.c -# End Source File -# Begin Source File - -SOURCE=..\generic\tclTest.c -# End Source File -# Begin Source File - -SOURCE=..\generic\tclTestObj.c -# End Source File -# Begin Source File - -SOURCE=..\generic\tclTestProcBodyObj.c -# End Source File -# Begin Source File - -SOURCE=..\generic\tclThread.c -# End Source File -# Begin Source File - -SOURCE=..\generic\tclThreadJoin.c -# End Source File -# Begin Source File - -SOURCE=..\generic\tclThreadTest.c -# End Source File -# Begin Source File - -SOURCE=..\generic\tclTimer.c -# End Source File -# Begin Source File - -SOURCE=..\generic\tclUniData.c -# End Source File -# Begin Source File - -SOURCE=..\generic\tclUtf.c -# End Source File -# Begin Source File - -SOURCE=..\generic\tclUtil.c -# End Source File -# Begin Source File - -SOURCE=..\generic\tclVar.c -# End Source File -# End Group -# Begin Group "library" - -# PROP Default_Filter "" -# Begin Source File - -SOURCE=..\library\auto.tcl -# End Source File -# Begin Source File - -SOURCE=..\library\history.tcl -# End Source File -# Begin Source File - -SOURCE=..\library\init.tcl -# End Source File -# Begin Source File - -SOURCE=..\library\ldAout.tcl -# End Source File -# Begin Source File - -SOURCE=..\library\package.tcl -# End Source File -# Begin Source File - -SOURCE=..\library\parray.tcl -# End Source File -# Begin Source File - -SOURCE=..\library\safe.tcl -# End Source File -# Begin Source File - -SOURCE=..\library\tclIndex -# End Source File -# Begin Source File - -SOURCE=..\library\word.tcl -# End Source File -# End Group -# Begin Group "mac" - -# PROP Default_Filter "" -# End Group -# Begin Group "tests" - -# PROP Default_Filter "" -# End Group -# Begin Group "tools" - -# PROP Default_Filter "" -# End Group -# Begin Group "unix" - -# PROP Default_Filter "" -# End Group -# Begin Group "win" - -# PROP Default_Filter "" -# Begin Source File - -SOURCE=.\aclocal.m4 -# End Source File -# Begin Source File - -SOURCE=.\cat.c -# End Source File -# Begin Source File - -SOURCE=.\configure -# End Source File -# Begin Source File - -SOURCE=.\configure.in -# End Source File -# Begin Source File - -SOURCE=.\makefile.bc -# End Source File -# Begin Source File - -SOURCE=.\Makefile.in -# End Source File -# Begin Source File - -SOURCE=.\makefile.vc -# End Source File -# Begin Source File - -SOURCE=.\mkd.bat -# End Source File -# Begin Source File - -SOURCE=.\README -# End Source File -# Begin Source File - -SOURCE=.\README.binary -# End Source File -# Begin Source File - -SOURCE=.\rmd.bat -# End Source File -# Begin Source File - -SOURCE=.\rules.vc -# End Source File -# Begin Source File - -SOURCE=.\tcl.hpj.in -# End Source File -# Begin Source File - -SOURCE=.\tcl.m4 -# End Source File -# Begin Source File - -SOURCE=.\tcl.rc -# End Source File -# Begin Source File - -SOURCE=.\tclAppInit.c -# End Source File -# Begin Source File - -SOURCE=.\tclConfig.sh.in -# End Source File -# Begin Source File - -SOURCE=.\tclsh.ico -# End Source File -# Begin Source File - -SOURCE=.\tclsh.rc -# End Source File -# Begin Source File - -SOURCE=.\tclWin32Dll.c -# End Source File -# Begin Source File - -SOURCE=.\tclWinChan.c -# End Source File -# Begin Source File - -SOURCE=.\tclWinConsole.c -# End Source File -# Begin Source File - -SOURCE=.\tclWinDde.c -# End Source File -# Begin Source File - -SOURCE=.\tclWinError.c -# End Source File -# Begin Source File - -SOURCE=.\tclWinFCmd.c -# End Source File -# Begin Source File - -SOURCE=.\tclWinFile.c -# End Source File -# Begin Source File - -SOURCE=.\tclWinInit.c -# End Source File -# Begin Source File - -SOURCE=.\tclWinInt.h -# End Source File -# Begin Source File - -SOURCE=.\tclWinLoad.c -# End Source File -# Begin Source File - -SOURCE=.\tclWinNotify.c -# End Source File -# Begin Source File - -SOURCE=.\tclWinPipe.c -# End Source File -# Begin Source File - -SOURCE=.\tclWinPort.h -# End Source File -# Begin Source File - -SOURCE=.\tclWinReg.c -# End Source File -# Begin Source File - -SOURCE=.\tclWinSerial.c -# End Source File -# Begin Source File - -SOURCE=.\tclWinSock.c -# End Source File -# Begin Source File - -SOURCE=.\tclWinTest.c -# End Source File -# Begin Source File - -SOURCE=.\tclWinThrd.c -# End Source File -# Begin Source File - -SOURCE=.\tclWinTime.c -# End Source File -# End Group -# End Target -# End Project +# Microsoft Developer Studio Project File - Name="tcl" - Package Owner=<4>
+# Microsoft Developer Studio Generated Build File, Format Version 6.00
+# ** DO NOT EDIT **
+
+# TARGTYPE "Win32 (x86) External Target" 0x0106
+
+CFG=tcl - Win32 Debug Static
+!MESSAGE This is not a valid makefile. To build this project using NMAKE,
+!MESSAGE use the Export Makefile command and run
+!MESSAGE
+!MESSAGE NMAKE /f "tcl.mak".
+!MESSAGE
+!MESSAGE You can specify a configuration when running NMAKE
+!MESSAGE by defining the macro CFG on the command line. For example:
+!MESSAGE
+!MESSAGE NMAKE /f "tcl.mak" CFG="tcl - Win32 Debug Static"
+!MESSAGE
+!MESSAGE Possible choices for configuration are:
+!MESSAGE
+!MESSAGE "tcl - Win32 Release" (based on "Win32 (x86) External Target")
+!MESSAGE "tcl - Win32 Debug" (based on "Win32 (x86) External Target")
+!MESSAGE "tcl - Win32 Debug Static" (based on "Win32 (x86) External Target")
+!MESSAGE "tcl - Win32 Release Static" (based on "Win32 (x86) External Target")
+!MESSAGE
+
+# Begin Project
+# PROP AllowPerConfigDependencies 0
+# PROP Scc_ProjName ""
+# PROP Scc_LocalPath ""
+
+!IF "$(CFG)" == "tcl - Win32 Release"
+
+# PROP BASE Use_MFC 0
+# PROP BASE Use_Debug_Libraries 0
+# PROP BASE Output_Dir "Release"
+# PROP BASE Intermediate_Dir "Release\tcl_Dynamic"
+# PROP BASE Cmd_Line "nmake -nologo -f makefile.vc OPTS=none MSVCDIR=IDE"
+# PROP BASE Rebuild_Opt "-a"
+# PROP BASE Target_File "Release\tclsh85.exe"
+# PROP BASE Bsc_Name ""
+# PROP BASE Target_Dir ""
+# PROP Use_MFC 0
+# PROP Use_Debug_Libraries 0
+# PROP Output_Dir "Release"
+# PROP Intermediate_Dir "Release\tcl_Dynamic"
+# PROP Cmd_Line "nmake -nologo -f makefile.vc OPTS=threads MSVCDIR=IDE"
+# PROP Rebuild_Opt "clean release"
+# PROP Target_File "Release\tclsh85t.exe"
+# PROP Bsc_Name ""
+# PROP Target_Dir ""
+
+!ELSEIF "$(CFG)" == "tcl - Win32 Debug"
+
+# PROP BASE Use_MFC 0
+# PROP BASE Use_Debug_Libraries 1
+# PROP BASE Output_Dir "Debug"
+# PROP BASE Intermediate_Dir "Debug\tcl_Dynamic"
+# PROP BASE Cmd_Line "nmake -nologo -f makefile.vc OPTS=symbols MSVCDIR=IDE"
+# PROP BASE Rebuild_Opt "-a"
+# PROP BASE Target_File "Debug\tclsh85g.exe"
+# PROP BASE Bsc_Name ""
+# PROP BASE Target_Dir ""
+# PROP Use_MFC 0
+# PROP Use_Debug_Libraries 1
+# PROP Output_Dir "Debug"
+# PROP Intermediate_Dir "Debug\tcl_Dynamic"
+# PROP Cmd_Line "nmake -nologo -f makefile.vc OPTS=threads,symbols MSVCDIR=IDE"
+# PROP Rebuild_Opt "clean release"
+# PROP Target_File "Debug\tclsh85tg.exe"
+# PROP Bsc_Name ""
+# PROP Target_Dir ""
+
+!ELSEIF "$(CFG)" == "tcl - Win32 Debug Static"
+
+# PROP BASE Use_MFC 0
+# PROP BASE Use_Debug_Libraries 1
+# PROP BASE Output_Dir "Debug"
+# PROP BASE Intermediate_Dir "Debug\tcl_Static"
+# PROP BASE Cmd_Line "nmake -nologo -f makefile.vc OPTS=symbols,static MSVCDIR=IDE"
+# PROP BASE Rebuild_Opt "-a"
+# PROP BASE Target_File "Debug\tclsh85sg.exe"
+# PROP BASE Bsc_Name ""
+# PROP BASE Target_Dir ""
+# PROP Use_MFC 0
+# PROP Use_Debug_Libraries 1
+# PROP Output_Dir "Debug"
+# PROP Intermediate_Dir "Debug\tcl_Static"
+# PROP Cmd_Line "nmake -nologo -f makefile.vc OPTS=symbols,static MSVCDIR=IDE"
+# PROP Rebuild_Opt "-a"
+# PROP Target_File "Debug\tclsh85sg.exe"
+# PROP Bsc_Name ""
+# PROP Target_Dir ""
+
+!ELSEIF "$(CFG)" == "tcl - Win32 Release Static"
+
+# PROP BASE Use_MFC 0
+# PROP BASE Use_Debug_Libraries 0
+# PROP BASE Output_Dir "Release"
+# PROP BASE Intermediate_Dir "Release\tcl_Static"
+# PROP BASE Cmd_Line "nmake -nologo -f makefile.vc OPTS=static MSVCDIR=IDE"
+# PROP BASE Rebuild_Opt "-a"
+# PROP BASE Target_File "Release\tclsh85s.exe"
+# PROP BASE Bsc_Name ""
+# PROP BASE Target_Dir ""
+# PROP Use_MFC 0
+# PROP Use_Debug_Libraries 0
+# PROP Output_Dir "Release"
+# PROP Intermediate_Dir "Release\tcl_Static"
+# PROP Cmd_Line "nmake -nologo -f makefile.vc OPTS=static MSVCDIR=IDE"
+# PROP Rebuild_Opt "-a"
+# PROP Target_File "Release\tclsh85s.exe"
+# PROP Bsc_Name ""
+# PROP Target_Dir ""
+
+!ENDIF
+
+# Begin Target
+
+# Name "tcl - Win32 Release"
+# Name "tcl - Win32 Debug"
+# Name "tcl - Win32 Debug Static"
+# Name "tcl - Win32 Release Static"
+
+!IF "$(CFG)" == "tcl - Win32 Release"
+
+!ELSEIF "$(CFG)" == "tcl - Win32 Debug"
+
+!ELSEIF "$(CFG)" == "tcl - Win32 Debug Static"
+
+!ELSEIF "$(CFG)" == "tcl - Win32 Release Static"
+
+!ENDIF
+
+# Begin Group "compat"
+
+# PROP Default_Filter ""
+# Begin Source File
+
+SOURCE=..\compat\dirent.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\compat\dirent2.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\compat\dlfcn.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\compat\fixstrtod.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\compat\float.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\compat\gettod.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\compat\limits.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\compat\memcmp.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\compat\opendir.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\compat\README
+# End Source File
+# Begin Source File
+
+SOURCE=..\compat\stdlib.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\compat\string.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\compat\strncasecmp.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\compat\strstr.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\compat\strtod.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\compat\strtol.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\compat\strtoul.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\compat\tclErrno.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\compat\unistd.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\compat\waitpid.c
+# End Source File
+# End Group
+# Begin Group "doc"
+
+# PROP Default_Filter ""
+# Begin Source File
+
+SOURCE=..\doc\Access.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\AddErrInfo.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\after.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\Alloc.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\AllowExc.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\append.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\AppInit.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\array.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\AssocData.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\Async.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\BackgdErr.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\Backslash.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\bgerror.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\binary.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\BoolObj.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\break.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\ByteArrObj.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\CallDel.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\case.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\catch.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\cd.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\ChnlStack.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\clock.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\close.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\CmdCmplt.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\Concat.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\concat.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\continue.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\CrtChannel.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\CrtChnlHdlr.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\CrtCloseHdlr.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\CrtCommand.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\CrtFileHdlr.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\CrtInterp.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\CrtMathFnc.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\CrtObjCmd.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\CrtSlave.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\CrtTimerHdlr.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\CrtTrace.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\dde.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\DetachPids.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\DoOneEvent.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\DoubleObj.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\DoWhenIdle.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\DString.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\DumpActiveMemory.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\Encoding.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\encoding.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\Environment.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\eof.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\error.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\Eval.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\eval.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\exec.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\Exit.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\exit.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\expr.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\ExprLong.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\ExprLongObj.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\fblocked.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\fconfigure.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\fcopy.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\file.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\fileevent.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\filename.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\FileSystem.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\FindExec.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\flush.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\for.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\foreach.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\format.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\GetCwd.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\GetHostName.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\GetIndex.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\GetInt.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\GetOpnFl.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\gets.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\GetStdChan.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\GetVersion.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\glob.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\global.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\Hash.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\history.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\http.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\if.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\incr.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\info.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\Init.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\InitStubs.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\Interp.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\interp.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\IntObj.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\join.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\lappend.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\library.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\lindex.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\LinkVar.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\linsert.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\list.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\ListObj.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\llength.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\load.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\lrange.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\lreplace.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\lsearch.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\lsort.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\man.macros
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\memory.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\msgcat.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\namespace.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\Notifier.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\Object.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\ObjectType.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\open.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\OpenFileChnl.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\OpenTcp.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\package.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\packagens.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\Panic.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\ParseCmd.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\pid.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\pkgMkIndex.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\PkgRequire.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\Preserve.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\PrintDbl.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\proc.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\puts.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\pwd.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\re_syntax.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\read.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\RecEvalObj.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\RecordEval.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\RegExp.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\regexp.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\registry.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\regsub.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\rename.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\return.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\safe.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\SaveResult.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\scan.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\seek.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\set.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\SetErrno.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\SetRecLmt.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\SetResult.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\SetVar.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\Signal.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\Sleep.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\socket.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\source.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\SourceRCFile.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\split.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\SplitList.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\SplitPath.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\StaticPkg.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\StdChannels.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\string.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\StringObj.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\StrMatch.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\subst.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\SubstObj.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\switch.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\Tcl.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\Tcl_Main.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\TCL_MEM_DEBUG.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\tclsh.1
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\tcltest.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\tclvars.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\tell.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\Thread.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\time.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\ToUpper.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\trace.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\TraceVar.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\Translate.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\UniCharIsAlpha.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\unknown.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\unset.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\update.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\uplevel.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\UpVar.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\upvar.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\Utf.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\variable.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\vwait.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\while.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\WrongNumArgs.3
+# End Source File
+# End Group
+# Begin Group "generic"
+
+# PROP Default_Filter ""
+# Begin Source File
+
+SOURCE=..\generic\README
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\regc_color.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\regc_cvec.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\regc_lex.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\regc_locale.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\regc_nfa.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\regcomp.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\regcustom.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\rege_dfa.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\regerror.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\regerrs.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\regex.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\regexec.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\regfree.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\regfronts.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\regguts.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tcl.decls
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tcl.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclAlloc.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclAsync.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclBasic.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclBinary.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclCkalloc.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclClock.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclCmdAH.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclCmdIL.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclCmdMZ.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclCompCmds.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclCompExpr.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclCompile.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclCompile.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclDate.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclDecls.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclEncoding.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclEnv.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclEvent.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclExecute.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclFCmd.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclFileName.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclGet.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclGetDate.y
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclHash.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclHistory.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclIndexObj.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclInt.decls
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclInt.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclIntDecls.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclInterp.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclIntPlatDecls.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclIO.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclIO.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclIOCmd.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclIOGT.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclIOSock.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclIOUtil.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclLink.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclListObj.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclLiteral.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclLoad.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclLoadNone.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclMain.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclNamesp.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclNotify.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclObj.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclPanic.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclParse.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclPipe.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclPkg.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclPlatDecls.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclPort.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclPosixStr.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclPreserve.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclProc.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclRegexp.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclRegexp.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclResolve.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclResult.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclScan.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclStringObj.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclStubInit.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclStubLib.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclTest.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclTestObj.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclTestProcBodyObj.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclThread.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclThreadJoin.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclThreadTest.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclTimer.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclUniData.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclUtf.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclUtil.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclVar.c
+# End Source File
+# End Group
+# Begin Group "library"
+
+# PROP Default_Filter ""
+# Begin Source File
+
+SOURCE=..\library\auto.tcl
+# End Source File
+# Begin Source File
+
+SOURCE=..\library\history.tcl
+# End Source File
+# Begin Source File
+
+SOURCE=..\library\init.tcl
+# End Source File
+# Begin Source File
+
+SOURCE=..\library\ldAout.tcl
+# End Source File
+# Begin Source File
+
+SOURCE=..\library\package.tcl
+# End Source File
+# Begin Source File
+
+SOURCE=..\library\parray.tcl
+# End Source File
+# Begin Source File
+
+SOURCE=..\library\safe.tcl
+# End Source File
+# Begin Source File
+
+SOURCE=..\library\tclIndex
+# End Source File
+# Begin Source File
+
+SOURCE=..\library\word.tcl
+# End Source File
+# End Group
+# Begin Group "mac"
+
+# PROP Default_Filter ""
+# End Group
+# Begin Group "tests"
+
+# PROP Default_Filter ""
+# End Group
+# Begin Group "tools"
+
+# PROP Default_Filter ""
+# End Group
+# Begin Group "unix"
+
+# PROP Default_Filter ""
+# End Group
+# Begin Group "win"
+
+# PROP Default_Filter ""
+# Begin Source File
+
+SOURCE=.\aclocal.m4
+# End Source File
+# Begin Source File
+
+SOURCE=.\cat.c
+# End Source File
+# Begin Source File
+
+SOURCE=.\configure
+# End Source File
+# Begin Source File
+
+SOURCE=.\configure.in
+# End Source File
+# Begin Source File
+
+SOURCE=.\makefile.bc
+# End Source File
+# Begin Source File
+
+SOURCE=.\Makefile.in
+# End Source File
+# Begin Source File
+
+SOURCE=.\makefile.vc
+# End Source File
+# Begin Source File
+
+SOURCE=.\mkd.bat
+# End Source File
+# Begin Source File
+
+SOURCE=.\README
+# End Source File
+# Begin Source File
+
+SOURCE=.\README.binary
+# End Source File
+# Begin Source File
+
+SOURCE=.\rmd.bat
+# End Source File
+# Begin Source File
+
+SOURCE=.\rules.vc
+# End Source File
+# Begin Source File
+
+SOURCE=.\stub16.c
+# End Source File
+# Begin Source File
+
+SOURCE=.\tcl.hpj.in
+# End Source File
+# Begin Source File
+
+SOURCE=.\tcl.m4
+# End Source File
+# Begin Source File
+
+SOURCE=.\tcl.rc
+# End Source File
+# Begin Source File
+
+SOURCE=.\tclAppInit.c
+# End Source File
+# Begin Source File
+
+SOURCE=.\tclConfig.sh.in
+# End Source File
+# Begin Source File
+
+SOURCE=.\tclsh.ico
+# End Source File
+# Begin Source File
+
+SOURCE=.\tclsh.rc
+# End Source File
+# Begin Source File
+
+SOURCE=.\tclWin32Dll.c
+# End Source File
+# Begin Source File
+
+SOURCE=.\tclWinChan.c
+# End Source File
+# Begin Source File
+
+SOURCE=.\tclWinConsole.c
+# End Source File
+# Begin Source File
+
+SOURCE=.\tclWinDde.c
+# End Source File
+# Begin Source File
+
+SOURCE=.\tclWinError.c
+# End Source File
+# Begin Source File
+
+SOURCE=.\tclWinFCmd.c
+# End Source File
+# Begin Source File
+
+SOURCE=.\tclWinFile.c
+# End Source File
+# Begin Source File
+
+SOURCE=.\tclWinInit.c
+# End Source File
+# Begin Source File
+
+SOURCE=.\tclWinInt.h
+# End Source File
+# Begin Source File
+
+SOURCE=.\tclWinLoad.c
+# End Source File
+# Begin Source File
+
+SOURCE=.\tclWinNotify.c
+# End Source File
+# Begin Source File
+
+SOURCE=.\tclWinPipe.c
+# End Source File
+# Begin Source File
+
+SOURCE=.\tclWinPort.h
+# End Source File
+# Begin Source File
+
+SOURCE=.\tclWinReg.c
+# End Source File
+# Begin Source File
+
+SOURCE=.\tclWinSerial.c
+# End Source File
+# Begin Source File
+
+SOURCE=.\tclWinSock.c
+# End Source File
+# Begin Source File
+
+SOURCE=.\tclWinTest.c
+# End Source File
+# Begin Source File
+
+SOURCE=.\tclWinThrd.c
+# End Source File
+# Begin Source File
+
+SOURCE=.\tclWinThrd.h
+# End Source File
+# Begin Source File
+
+SOURCE=.\tclWinTime.c
+# End Source File
+# End Group
+# End Target
+# End Project
diff --git a/win/tcl.dsw b/win/tcl.dsw index fa93b00..1c16fad 100644 --- a/win/tcl.dsw +++ b/win/tcl.dsw @@ -1,29 +1,29 @@ -Microsoft Developer Studio Workspace File, Format Version 6.00 -# WARNING: DO NOT EDIT OR DELETE THIS WORKSPACE FILE! - -############################################################################### - -Project: "tcl"=.\tcl.dsp - Package Owner=<4> - -Package=<5> -{{{ -}}} - -Package=<4> -{{{ -}}} - -############################################################################### - -Global: - -Package=<5> -{{{ -}}} - -Package=<3> -{{{ -}}} - -############################################################################### - +Microsoft Developer Studio Workspace File, Format Version 6.00
+# WARNING: DO NOT EDIT OR DELETE THIS WORKSPACE FILE!
+
+###############################################################################
+
+Project: "tcl"=.\tcl.dsp - Package Owner=<4>
+
+Package=<5>
+{{{
+}}}
+
+Package=<4>
+{{{
+}}}
+
+###############################################################################
+
+Global:
+
+Package=<5>
+{{{
+}}}
+
+Package=<3>
+{{{
+}}}
+
+###############################################################################
+
diff --git a/win/tcl.hpj.in b/win/tcl.hpj.in index 3bdccbe..8efff0b 100644 --- a/win/tcl.hpj.in +++ b/win/tcl.hpj.in @@ -1,19 +1,19 @@ -; This file is maintained by HCW. Do not modify this file directly. - -[OPTIONS] -HCW=0 -LCID=0x409 0x0 0x0 ;English (United States) -REPORT=Yes -TITLE=Tcl/Tk Reference Manual -CNT=tcl86.cnt -COPYRIGHT=Copyright © 2000 Ajuba Solutions -HLP=tcl86.hlp - -[FILES] -tcl.rtf - -[WINDOWS] -main="Tcl/Tk Reference Manual",,0 - -[CONFIG] -BrowseButtons() +; This file is maintained by HCW. Do not modify this file directly.
+
+[OPTIONS]
+HCW=0
+LCID=0x409 0x0 0x0 ;English (United States)
+REPORT=Yes
+TITLE=Tcl/Tk Reference Manual
+CNT=tcl85.cnt
+COPYRIGHT=Copyright © 2000 Ajuba Solutions
+HLP=tcl85.hlp
+
+[FILES]
+tcl.rtf
+
+[WINDOWS]
+main="Tcl/Tk Reference Manual",,0
+
+[CONFIG]
+BrowseButtons()
@@ -3,50 +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.6$1/win; then - TCL_BIN_DIR_DEFAULT=../../tcl8.6$1/win - elif test -d ../../tcl8.6/win; then - TCL_BIN_DIR_DEFAULT=../../tcl8.6/win - else - TCL_BIN_DIR_DEFAULT=../../tcl/win - fi + 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 - AC_ARG_WITH(tcl, [ --with-tcl=DIR use Tcl 8.6 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 - if test ! -f $TCL_BIN_DIR/../unix/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?) + # 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 - TCL_BIN_DIR=`cd ${TCL_BIN_DIR}/../unix; pwd` 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 @@ -56,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.6$1/win; then - TK_BIN_DIR_DEFAULT=../../tk8.6$1/win - elif test -d ../../tk8.6/win; then - TK_BIN_DIR_DEFAULT=../../tk8.6/win - else - TK_BIN_DIR_DEFAULT=../../tk/win - 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 - AC_ARG_WITH(tk, [ --with-tk=DIR use Tk 8.6 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 + # then check for a private Tk library + if test x"${ac_cv_c_tkconfig}" = x ; then + for i in \ + ../tk \ + `ls -dr ../tk[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \ + `ls -dr ../tk[[8-9]].[[0-9]] 2>/dev/null` \ + `ls -dr ../tk[[8-9]].[[0-9]]* 2>/dev/null` \ + ../../tk \ + `ls -dr ../../tk[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \ + `ls -dr ../../tk[[8-9]].[[0-9]] 2>/dev/null` \ + `ls -dr ../../tk[[8-9]].[[0-9]]* 2>/dev/null` \ + ../../../tk \ + `ls -dr ../../../tk[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \ + `ls -dr ../../../tk[[8-9]].[[0-9]] 2>/dev/null` \ + `ls -dr ../../../tk[[8-9]].[[0-9]]* 2>/dev/null` ; do + if test -f "$i/win/tkConfig.sh" ; then + ac_cv_c_tkconfig="`(cd $i/win; pwd)`" + break + fi + done + fi + + # check in a few common install locations + if test x"${ac_cv_c_tkconfig}" = x ; then + for i in `ls -d ${libdir} 2>/dev/null` \ + `ls -d ${exec_prefix}/lib 2>/dev/null` \ + `ls -d ${prefix}/lib 2>/dev/null` \ + `ls -d /cygdrive/c/Tcl/lib 2>/dev/null` \ + `ls -d /cygdrive/c/Progra~1/Tcl/lib 2>/dev/null` \ + `ls -d /c/Tcl/lib 2>/dev/null` \ + `ls -d /c/Progra~1/Tcl/lib 2>/dev/null` \ + `ls -d C:/Tcl/lib 2>/dev/null` \ + `ls -d C:/Progra~1/Tcl/lib 2>/dev/null` \ + ; do + if test -f "$i/tkConfig.sh" ; then + ac_cv_c_tkconfig="`(cd $i; pwd)`" + break + fi + done + fi + + # check in a few other private locations + if test x"${ac_cv_c_tkconfig}" = x ; then + for i in \ + ${srcdir}/../tk \ + `ls -dr ${srcdir}/../tk[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \ + `ls -dr ${srcdir}/../tk[[8-9]].[[0-9]] 2>/dev/null` \ + `ls -dr ${srcdir}/../tk[[8-9]].[[0-9]]* 2>/dev/null` ; do + if test -f "$i/win/tkConfig.sh" ; then + ac_cv_c_tkconfig="`(cd $i/win; pwd)`" + break + fi + done + fi + ]) - AC_MSG_RESULT([$TK_BIN_DIR/tkConfig.sh]) + 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 ]) #------------------------------------------------------------------------ @@ -103,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 # @@ -158,7 +310,6 @@ AC_DEFUN([SC_LOAD_TCLCONFIG], [ # SC_LOAD_TKCONFIG -- # # Load the tkConfig.sh file -# Currently a no-op for Windows # # Arguments: # @@ -172,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 @@ -212,7 +363,7 @@ AC_DEFUN([SC_ENABLE_SHARED], [ AC_MSG_CHECKING([how to build libraries]) AC_ARG_ENABLE(shared, [ --enable-shared build and link with shared libraries (default: on)], - [tcl_ok=$enableval], [tcl_ok=yes]) + [tcl_ok=$enableval], [tcl_ok=yes]) if test "${enable_shared+set}" = set; then enableval="$enable_shared" @@ -227,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 ]) @@ -250,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 (default: on)], - [tcl_ok=$enableval], [tcl_ok=yes]) + AC_ARG_ENABLE(threads, [ --enable-threads build with threads (default: off)], + [tcl_ok=$enableval], [tcl_ok=no]) if test "$tcl_ok" = "yes"; then - AC_MSG_RESULT([yes (default)]) + AC_MSG_RESULT(yes) TCL_THREADS=1 AC_DEFINE(TCL_THREADS) # USE_THREAD_ALLOC tells us to try the special thread-based @@ -262,7 +413,7 @@ AC_DEFUN([SC_ENABLE_THREADS], [ AC_DEFINE(USE_THREAD_ALLOC) else TCL_THREADS=0 - AC_MSG_RESULT(no) + AC_MSG_RESULT([no (default)]) fi AC_SUBST(TCL_THREADS) ]) @@ -270,7 +421,7 @@ 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. # @@ -372,6 +523,7 @@ AC_DEFUN([SC_ENABLE_SYMBOLS], [ # RES # # MAKE_LIB +# MAKE_STUB_LIB # MAKE_EXE # MAKE_DLL # @@ -405,9 +557,8 @@ 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) + AC_CHECK_PROG(CYGPATH, cygpath, cygpath -m, echo) SHLIB_SUFFIX=".dll" @@ -482,6 +633,8 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ # set various compiler flags depending on whether we are using gcc or cl if test "${GCC}" = "yes" ; then + extra_cflags="-pipe" + extra_ldflags="-pipe -static-libgcc" AC_CACHE_CHECK(for mingw32 version of gcc, ac_cv_win32, AC_TRY_COMPILE([ @@ -495,31 +648,13 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ if test "$ac_cv_win32" != "yes"; then AC_MSG_ERROR([${CC} cannot produce win32 executables.]) fi - - hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -mwindows -municode -Dmain=xxmain" - AC_CACHE_CHECK(for working -municode linker flag, - ac_cv_municode, - AC_TRY_LINK([ - #include <windows.h> - int APIENTRY wWinMain(HINSTANCE a, HINSTANCE b, LPWSTR c, int d) {return 0;} - ], - [], - ac_cv_municode=yes, - ac_cv_municode=no) - ) - CFLAGS=$hold_cflags - if test "$ac_cv_municode" = "yes" ; then - extra_ldflags="$extra_ldflags -municode" - else - extra_cflags="$extra_cflags -DTCL_BROKEN_MAINARGS" - fi fi AC_MSG_CHECKING([compiler flags]) if test "${GCC}" = "yes" ; then SHLIB_LD="" - SHLIB_LD_LIBS='${LIBS}' - LIBS="-lnetapi32 -lkernel32 -luser32 -ladvapi32 -lws2_32" + SHLIB_LD_LIBS="" + LIBS="-lws2_32" # mingw needs to link ole32 and oleaut32 for [send], but MSVC doesn't LIBS_GUI="-lgdi32 -lcomdlg32 -limm32 -lcomctl32 -lshell32 -luuid -lole32 -loleaut32" STLIB_LD='${AR} cr' @@ -529,17 +664,18 @@ 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" - extra_cflags="$extra_cflags -pipe" - extra_ldflags="$extra_ldflags -pipe" - 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 @@ -553,30 +689,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. + SHLIB_LD='${CC} -shared' + SHLIB_LD_LIBS='${LIBS}' # Add SHLIB_LD_LIBS to the Make rule, not here. + MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -o \[$]@ ${extra_ldflags} \ + -Wl,--out-implib,\$(patsubst %.dll,lib%.a,\[$]@)" + 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. Make sure CFLAGS is - # included so -mno-cygwin passed the correct libs to the linker. - SHLIB_LD='${CC} -shared ${CFLAGS}' - SHLIB_LD_LIBS='${LIBS}' - MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -o \[$]@ ${extra_ldflags} \ - -Wl,--out-implib,\$(patsubst %.dll,lib%.a,\[$]@)" # DLLSUFFIX is separate because it is the building block for # users of tclConfig.sh that may build shared or static. DLLSUFFIX="\${DBGX}.dll" - LIBSUFFIX="\${DBGX}.a" - LIBFLAGSUFFIX="\${DBGX}" SHLIB_SUFFIX=.dll EXTRA_CFLAGS="${extra_cflags}" CFLAGS_DEBUG=-g CFLAGS_OPTIMIZE="-O2 -fomit-frame-pointer" - CFLAGS_WARNING="-Wall -Wdeclaration-after-statement" + CFLAGS_WARNING="-Wall" LDFLAGS_DEBUG= LDFLAGS_OPTIMIZE= @@ -631,22 +766,34 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ # static AC_MSG_RESULT([using static flags]) runtime=-MT + MAKE_DLL="echo " + LIBSUFFIX="s\${DBGX}.lib" + LIBFLAGSUFFIX="s\${DBGX}" LIBRARIES="\${STATIC_LIBRARIES}" EXESUFFIX="s\${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. - LIBRARIES="\${SHARED_LIBRARIES}" + MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -out:\[$]@" + LIBSUFFIX="\${DBGX}.lib" + LIBFLAGSUFFIX="\${DBGX}" EXESUFFIX="\${DBGX}.exe" + LIBRARIES="\${SHARED_LIBRARIES}" + SHLIB_LD_LIBS='${LIBS}' + case "x`echo \${VisualStudioVersion}`" in + x1[[4-9]]*) + lflags="${lflags} -nodefaultlib:libucrt.lib" + ;; + *) + ;; + esac fi - MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -out:\[$]@" # DLLSUFFIX is separate because it is the building block for # users of tclConfig.sh that may build shared or static. DLLSUFFIX="\${DBGX}.dll" - LIBSUFFIX="\${DBGX}.lib" - LIBFLAGSUFFIX="\${DBGX}" # This is a 2-stage check to make sure we have the 64-bit SDK # We have to know where the SDK is installed. @@ -668,15 +815,21 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ ;; esac if test ! -d "${PATH64}" ; then - AC_MSG_WARN([Could not find 64-bit $MACHINE SDK to enable 64bit mode]) - AC_MSG_WARN([Ensure latest Platform SDK is installed]) - do64bit="no" - else - AC_MSG_RESULT([ Using 64-bit $MACHINE mode]) + AC_MSG_WARN([Could not find 64-bit $MACHINE SDK]) fi + AC_MSG_RESULT([ Using 64-bit $MACHINE mode]) fi - LIBS="netapi32.lib kernel32.lib user32.lib advapi32.lib ws2_32.lib" + LIBS="user32.lib advapi32.lib ws2_32.lib" + + case "x`echo \${VisualStudioVersion}`" in + x1[[4-9]]*) + LIBS="$LIBS ucrt.lib" + ;; + *) + ;; + esac + if test "$do64bit" != "no" ; then # The space-based-path will work for the Makefile, but will # not work if AC_TRY_COMPILE is called. TEA has the @@ -691,7 +844,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ CFLAGS_DEBUG="-nologo -Zi -Od ${runtime}d" # Do not use -O2 for Win64 - this has proved buggy in code gen. CFLAGS_OPTIMIZE="-nologo -O1 ${runtime}" - lflags="-nologo -MACHINE:${MACHINE} -LIBPATH:\"${MSSDK}/Lib/${MACHINE}\"" + lflags="${lflags} -nologo -MACHINE:${MACHINE} -LIBPATH:\"${MSSDK}/Lib/${MACHINE}\"" LINKBIN="\"${PATH64}/link.exe\"" # Avoid 'unresolved external symbol __security_cookie' errors. # c.f. http://support.microsoft.com/?id=894573 @@ -703,7 +856,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ CFLAGS_DEBUG="-nologo -Z7 -Od -WX ${runtime}d" # -O2 - create fast code (/Og /Oi /Ot /Oy /Ob2 /Gs /GF /Gy) CFLAGS_OPTIMIZE="-nologo -O2 ${runtime}" - lflags="-nologo" + lflags="${lflags} -nologo" LINKBIN="link" fi @@ -801,7 +954,6 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ 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 @@ -810,6 +962,7 @@ 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="" @@ -961,13 +1114,13 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ #------------------------------------------------------------------------ AC_DEFUN([SC_WITH_TCL], [ - if test -d ../../tcl8.6$1/win; then - TCL_BIN_DEFAULT=../../tcl8.6$1/win + if test -d ../../tcl8.5$1/win; then + TCL_BIN_DEFAULT=../../tcl8.5$1/win else - TCL_BIN_DEFAULT=../../tcl8.6/win + TCL_BIN_DEFAULT=../../tcl8.5/win fi - AC_ARG_WITH(tcl, [ --with-tcl=DIR use Tcl 8.6 binaries from DIR], + AC_ARG_WITH(tcl, [ --with-tcl=DIR use Tcl 8.5 binaries from DIR], TCL_BIN_DIR=$withval, TCL_BIN_DIR=`cd $TCL_BIN_DEFAULT; pwd`) if test ! -d $TCL_BIN_DIR; then AC_MSG_ERROR(Tcl directory $TCL_BIN_DIR does not exist) @@ -48,7 +48,7 @@ BEGIN VALUE "LegalCopyright", "Copyright \251 2001 by ActiveState Corporation, et al\0" VALUE "ProductName", "Tcl " TCL_VERSION " for Windows\0" VALUE "ProductVersion", TCL_PATCH_LEVEL - END + END END BLOCK "VarFileInfo" BEGIN diff --git a/win/tclAppInit.c b/win/tclAppInit.c index 3f26172..251a610 100644 --- a/win/tclAppInit.c +++ b/win/tclAppInit.c @@ -2,61 +2,31 @@ * tclAppInit.c -- * * Provides a default version of the main program and Tcl_AppInit - * procedure for tclsh and other Tcl-based applications (without Tk). - * Note that this program must be built in Win32 console mode to work - * properly. + * function for Tcl applications (without Tk). Note that this program + * must be built in Win32 console mode to work properly. * - * Copyright (c) 1993 The Regents of the University of California. - * Copyright (c) 1994-1997 Sun Microsystems, Inc. - * Copyright (c) 1998-1999 Scriptics Corporation. + * Copyright (c) 1996-1997 by Sun Microsystems, Inc. + * Copyright (c) 1998-1999 by Scriptics Corporation. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tcl.h" -#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 Tcltest_Init; -extern Tcl_PackageInitProc Tcltest_SafeInit; +extern Tcl_PackageInitProc Procbodytest_Init; +extern Tcl_PackageInitProc Procbodytest_SafeInit; +extern Tcl_PackageInitProc Tcltest_Init; +extern Tcl_PackageInitProc TclObjTest_Init; #endif /* TCL_TEST */ -#if defined(STATIC_BUILD) && TCL_USE_STATIC_PACKAGES -extern Tcl_PackageInitProc Registry_Init; -extern Tcl_PackageInitProc Dde_Init; -extern Tcl_PackageInitProc Dde_SafeInit; -#endif - -#ifdef TCL_BROKEN_MAINARGS -static void setargv(int *argcPtr, TCHAR ***argvPtr); -#endif /* TCL_BROKEN_MAINARGS */ - -/* - * The following #if block allows you to change the AppInit function by using - * a #define of TCL_LOCAL_APPINIT instead of rewriting this entire file. The - * #if checks for that #define and uses Tcl_AppInit if it doesn't exist. - */ - -#ifndef TCL_LOCAL_APPINIT -#define TCL_LOCAL_APPINIT Tcl_AppInit -#endif -extern int TCL_LOCAL_APPINIT(Tcl_Interp *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 -extern int TCL_LOCAL_MAIN_HOOK(int *argc, TCHAR ***argv); -#endif +#if defined(__GNUC__) +int _CRT_glob = 0; +static void setargv(int *argcPtr, char ***argvPtr); +#endif /* __GNUC__ */ /* *---------------------------------------------------------------------- @@ -66,46 +36,53 @@ extern int TCL_LOCAL_MAIN_HOOK(int *argc, TCHAR ***argv); * This is the main program for the application. * * Results: - * None: Tcl_Main never returns here, so this procedure never returns + * None: Tcl_Main never returns here, so this function never returns * either. * * Side effects: - * Just about anything, since from here we call arbitrary Tcl code. + * Whatever the application does. * *---------------------------------------------------------------------- */ int -#ifdef TCL_BROKEN_MAINARGS main( int argc, - char *dummy[]) -#else -_tmain( - int argc, - TCHAR *argv[]) -#endif /* TCL_BROKEN_MAINARGS */ + char *argv[]) { -#ifdef TCL_BROKEN_MAINARGS - TCHAR **argv; -#else - TCHAR *p; -#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 + * doesn't exist. + */ + +#ifndef TCL_LOCAL_APPINIT +#define TCL_LOCAL_APPINIT Tcl_AppInit +#endif + extern int TCL_LOCAL_APPINIT (Tcl_Interp *interp); /* - * Set up the default locale to be standard "C" locale so parsing is - * performed correctly. + * The following #if block allows you to change how Tcl finds the startup + * script, prime the library or encoding paths, fiddle with the argv, + * etc., without needing to rewrite Tcl_Main() */ - setlocale(LC_ALL, "C"); +#ifdef TCL_LOCAL_MAIN_HOOK + extern int TCL_LOCAL_MAIN_HOOK (int *argc, char ***argv); +#endif + + char *p; /* - * Get our args from the c-runtime. Ignore lpszCmdLine. + * Set up the default locale to be standard "C" locale so parsing is + * performed correctly. */ -#ifdef TCL_BROKEN_MAINARGS - setargv(&argc, &argv); -#endif /* TCL_BROKEN_MAINARGS */ +#if defined(__GNUC__) + setargv( &argc, &argv ); +#endif + setlocale(LC_ALL, "C"); /* * Forward slashes substituted for backslashes. @@ -122,6 +99,7 @@ _tmain( #endif Tcl_Main(argc, argv, TCL_LOCAL_APPINIT); + return 0; /* Needed only to prevent compiler warning. */ } @@ -130,9 +108,9 @@ _tmain( * * Tcl_AppInit -- * - * This procedure performs application-specific initialization. Most + * This function performs application-specific initialization. Most * applications, especially those that incorporate additional packages, - * will have their own version of this procedure. + * will have their own version of this function. * * Results: * Returns a standard Tcl completion code, and leaves an error message in @@ -148,55 +126,67 @@ int Tcl_AppInit( Tcl_Interp *interp) /* Interpreter for application. */ { - if ((Tcl_Init)(interp) == TCL_ERROR) { + if (Tcl_Init(interp) == TCL_ERROR) { return TCL_ERROR; } -#if defined(STATIC_BUILD) && TCL_USE_STATIC_PACKAGES - if (Registry_Init(interp) == TCL_ERROR) { +#ifdef TCL_TEST + if (Tcltest_Init(interp) == TCL_ERROR) { return TCL_ERROR; } - Tcl_StaticPackage(interp, "registry", Registry_Init, NULL); - - if (Dde_Init(interp) == TCL_ERROR) { + Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init, NULL); + if (TclObjTest_Init(interp) == TCL_ERROR) { return TCL_ERROR; } - Tcl_StaticPackage(interp, "dde", Dde_Init, Dde_SafeInit); -#endif - -#ifdef TCL_TEST - if (Tcltest_Init(interp) == TCL_ERROR) { + if (Procbodytest_Init(interp) == TCL_ERROR) { return TCL_ERROR; } - Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init, Tcltest_SafeInit); + Tcl_StaticPackage(interp, "procbodytest", Procbodytest_Init, + Procbodytest_SafeInit); #endif /* TCL_TEST */ +#if defined(STATIC_BUILD) && TCL_USE_STATIC_PACKAGES + { + extern Tcl_PackageInitProc Registry_Init; + extern Tcl_PackageInitProc Dde_Init; + extern Tcl_PackageInitProc Dde_SafeInit; + + if (Registry_Init(interp) == TCL_ERROR) { + return TCL_ERROR; + } + Tcl_StaticPackage(interp, "registry", Registry_Init, NULL); + + if (Dde_Init(interp) == TCL_ERROR) { + return TCL_ERROR; + } + Tcl_StaticPackage(interp, "dde", Dde_Init, Dde_SafeInit); + } +#endif + /* - * Call the init procedures for included packages. Each call should look + * Call the init functions for included packages. Each call should look * like this: * * if (Mod_Init(interp) == TCL_ERROR) { * return TCL_ERROR; * } * - * where "Mod" is the name of the module. (Dynamically-loadable packages - * should have the same entry-point name.) + * where "Mod" is the name of the module. */ /* * Call Tcl_CreateCommand for application-specific commands, if they - * weren't already created by the init procedures called above. + * weren't already created by the init functions called above. */ /* * Specify a user-specific startup file to invoke if the application is * run interactively. Typically the startup file is "~/.apprc" where "app" - * is the name of the application. If this line is deleted then no user- - * specific startup file will be run under any conditions. + * is the name of the application. If this line is deleted then no + * user-specific startup file will be run under any conditions. */ - (Tcl_SetVar2)(interp, "tcl_rcFileName", NULL, "~/tclshrc.tcl", - TCL_GLOBAL_ONLY); + Tcl_SetVar(interp, "tcl_rcFileName", "~/tclshrc.tcl", TCL_GLOBAL_ONLY); return TCL_OK; } @@ -227,17 +217,17 @@ Tcl_AppInit( *-------------------------------------------------------------------------- */ -#ifdef TCL_BROKEN_MAINARGS +#if defined(__GNUC__) static void setargv( int *argcPtr, /* Filled with number of argument strings. */ - TCHAR ***argvPtr) /* Filled with argument strings (malloc'd). */ + char ***argvPtr) /* Filled with argument strings (malloc'd). */ { - TCHAR *cmdLine, *p, *arg, *argSpace; - TCHAR **argv; + char *cmdLine, *p, *arg, *argSpace; + char **argv; int argc, size, inquote, copy, slashes; - cmdLine = GetCommandLine(); + cmdLine = GetCommandLine(); /* INTL: BUG */ /* * Precompute an overly pessimistic guess at the number of arguments in @@ -256,19 +246,10 @@ setargv( } } } - - /* - * 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)); + argSpace = (char *) ckalloc( + (unsigned) (size * sizeof(char *) + strlen(cmdLine) + 1)); + argv = (char **) argSpace; + argSpace += size * sizeof(char *); size--; p = cmdLine; @@ -326,7 +307,7 @@ setargv( *argcPtr = argc; *argvPtr = argv; } -#endif /* TCL_BROKEN_MAINARGS */ +#endif /* __GNUC__ */ /* * Local Variables: diff --git a/win/tclConfig.sh.in b/win/tclConfig.sh.in index 65bc5c5..75324b2 100644 --- a/win/tclConfig.sh.in +++ b/win/tclConfig.sh.in @@ -1,5 +1,5 @@ # tclConfig.sh -- -# +# # This shell script (for sh) is generated automatically by Tcl's # configure script. It will create shell variables for most of # the configuration options discovered by the configure script. @@ -175,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 c5e5f39..e5e5202 100644 --- a/win/tclWin32Dll.c +++ b/win/tclWin32Dll.c @@ -12,9 +12,30 @@ */ #include "tclWinInt.h" -#if defined(HAVE_INTRIN_H) -# include <intrin.h> -#endif + +#ifndef TCL_NO_STACK_CHECK +/* + * The following functions implement stack depth checking + */ +typedef struct ThreadSpecificData { + int *stackBound; /* The current stack boundary */ +} ThreadSpecificData; +static Tcl_ThreadDataKey dataKey; +#endif /* TCL_NO_STACK_CHECK */ + +/* + * The following data structures are used when loading the thunking library + * for execing child processes under Win32s. + */ + +typedef DWORD (WINAPI UT32PROC)(LPVOID lpBuff, DWORD dwUserDefined, + LPVOID *lpTranslationList); + +typedef BOOL (WINAPI UTREGISTER)(HANDLE hModule, LPCSTR SixteenBitDLL, + LPCSTR InitName, LPCSTR ProcName, UT32PROC **ThirtyTwoBitThunk, + FARPROC UT32Callback, LPVOID Buff); + +typedef VOID (WINAPI UTUNREGISTER)(HANDLE hModule); /* * The following variables keep track of information about this DLL on a @@ -25,39 +46,158 @@ 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. + * VC++ 5.x has no 'cpuid' assembler instruction, so we must emulate it */ -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; +#if defined(_MSC_VER) && (_MSC_VER <= 1100) +#define cpuid __asm __emit 0fh __asm __emit 0a2h #endif /* - * VC++ 5.x has no 'cpuid' assembler instruction, so we must emulate it + * 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. */ -#if defined(_MSC_VER) && (_MSC_VER <= 1100) -#define cpuid __asm __emit 0fh __asm __emit 0a2h -#endif +static TclWinProcs asciiProcs = { + 0, + + (BOOL (WINAPI *)(CONST TCHAR *, LPDCB)) BuildCommDCBA, + (TCHAR *(WINAPI *)(TCHAR *)) CharLowerA, + (BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR *, BOOL)) CopyFileA, + (BOOL (WINAPI *)(CONST TCHAR *, LPSECURITY_ATTRIBUTES)) CreateDirectoryA, + (HANDLE (WINAPI *)(CONST TCHAR *, DWORD, DWORD, SECURITY_ATTRIBUTES *, + DWORD, DWORD, HANDLE)) CreateFileA, + (BOOL (WINAPI *)(CONST TCHAR *, TCHAR *, LPSECURITY_ATTRIBUTES, + LPSECURITY_ATTRIBUTES, BOOL, DWORD, LPVOID, CONST TCHAR *, + LPSTARTUPINFOA, LPPROCESS_INFORMATION)) CreateProcessA, + (BOOL (WINAPI *)(CONST TCHAR *)) DeleteFileA, + (HANDLE (WINAPI *)(CONST TCHAR *, WIN32_FIND_DATAT *)) FindFirstFileA, + (BOOL (WINAPI *)(HANDLE, WIN32_FIND_DATAT *)) FindNextFileA, + (BOOL (WINAPI *)(WCHAR *, LPDWORD)) GetComputerNameA, + (DWORD (WINAPI *)(DWORD, WCHAR *)) GetCurrentDirectoryA, + (DWORD (WINAPI *)(CONST TCHAR *)) GetFileAttributesA, + (DWORD (WINAPI *)(CONST TCHAR *, DWORD nBufferLength, WCHAR *, + TCHAR **)) GetFullPathNameA, + (DWORD (WINAPI *)(HMODULE, WCHAR *, int)) GetModuleFileNameA, + (DWORD (WINAPI *)(CONST TCHAR *, WCHAR *, DWORD)) GetShortPathNameA, + (UINT (WINAPI *)(CONST TCHAR *, CONST TCHAR *, UINT uUnique, + WCHAR *)) GetTempFileNameA, + (DWORD (WINAPI *)(DWORD, WCHAR *)) GetTempPathA, + (BOOL (WINAPI *)(CONST TCHAR *, WCHAR *, DWORD, LPDWORD, LPDWORD, LPDWORD, + WCHAR *, DWORD)) GetVolumeInformationA, + (HINSTANCE (WINAPI *)(CONST TCHAR *, HANDLE, DWORD)) LoadLibraryExA, + (TCHAR (WINAPI *)(WCHAR *, CONST TCHAR *)) lstrcpyA, + (BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR *)) MoveFileA, + (BOOL (WINAPI *)(CONST TCHAR *)) RemoveDirectoryA, + (DWORD (WINAPI *)(CONST TCHAR *, CONST TCHAR *, CONST TCHAR *, DWORD, + WCHAR *, TCHAR **)) SearchPathA, + (BOOL (WINAPI *)(CONST TCHAR *)) SetCurrentDirectoryA, + (BOOL (WINAPI *)(CONST TCHAR *, DWORD)) SetFileAttributesA, + + /* + * The three NULL function pointers will only be set when + * Tcl_FindExecutable is called. If you don't ever call that function, the + * application will crash whenever WinTcl tries to call functions through + * these null pointers. That is not a bug in Tcl - Tcl_FindExecutable is + * mandatory in recent Tcl releases. + */ -static Tcl_Encoding winTCharEncoding = NULL; + NULL, + NULL, + /* deleted (int (__cdecl*)(CONST TCHAR *, struct _utimbuf *)) _utime, */ + NULL, + NULL, + /* getLongPathNameProc */ + NULL, + /* Security SDK - not available on 95,98,ME */ + NULL, NULL, NULL, NULL, NULL, NULL, + /* ReadConsole and WriteConsole */ + (BOOL (WINAPI *)(HANDLE, LPVOID, DWORD, LPDWORD, LPVOID)) ReadConsoleA, + (BOOL (WINAPI *)(HANDLE, const VOID*, DWORD, LPDWORD, LPVOID)) WriteConsoleA, + (BOOL (WINAPI *)(LPTSTR, LPDWORD)) GetUserNameA +}; + +static TclWinProcs unicodeProcs = { + 1, + + (BOOL (WINAPI *)(CONST TCHAR *, LPDCB)) BuildCommDCBW, + (TCHAR *(WINAPI *)(TCHAR *)) CharLowerW, + (BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR *, BOOL)) CopyFileW, + (BOOL (WINAPI *)(CONST TCHAR *, LPSECURITY_ATTRIBUTES)) CreateDirectoryW, + (HANDLE (WINAPI *)(CONST TCHAR *, DWORD, DWORD, SECURITY_ATTRIBUTES *, + DWORD, DWORD, HANDLE)) CreateFileW, + (BOOL (WINAPI *)(CONST TCHAR *, TCHAR *, LPSECURITY_ATTRIBUTES, + LPSECURITY_ATTRIBUTES, BOOL, DWORD, LPVOID, CONST TCHAR *, + LPSTARTUPINFOA, LPPROCESS_INFORMATION)) CreateProcessW, + (BOOL (WINAPI *)(CONST TCHAR *)) DeleteFileW, + (HANDLE (WINAPI *)(CONST TCHAR *, WIN32_FIND_DATAT *)) FindFirstFileW, + (BOOL (WINAPI *)(HANDLE, WIN32_FIND_DATAT *)) FindNextFileW, + (BOOL (WINAPI *)(WCHAR *, LPDWORD)) GetComputerNameW, + (DWORD (WINAPI *)(DWORD, WCHAR *)) GetCurrentDirectoryW, + (DWORD (WINAPI *)(CONST TCHAR *)) GetFileAttributesW, + (DWORD (WINAPI *)(CONST TCHAR *, DWORD nBufferLength, WCHAR *, + TCHAR **)) GetFullPathNameW, + (DWORD (WINAPI *)(HMODULE, WCHAR *, int)) GetModuleFileNameW, + (DWORD (WINAPI *)(CONST TCHAR *, WCHAR *, DWORD)) GetShortPathNameW, + (UINT (WINAPI *)(CONST TCHAR *, CONST TCHAR *, UINT uUnique, + WCHAR *)) GetTempFileNameW, + (DWORD (WINAPI *)(DWORD, WCHAR *)) GetTempPathW, + (BOOL (WINAPI *)(CONST TCHAR *, WCHAR *, DWORD, LPDWORD, LPDWORD, LPDWORD, + WCHAR *, DWORD)) GetVolumeInformationW, + (HINSTANCE (WINAPI *)(CONST TCHAR *, HANDLE, DWORD)) LoadLibraryExW, + (TCHAR (WINAPI *)(WCHAR *, CONST TCHAR *)) lstrcpyW, + (BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR *)) MoveFileW, + (BOOL (WINAPI *)(CONST TCHAR *)) RemoveDirectoryW, + (DWORD (WINAPI *)(CONST TCHAR *, CONST TCHAR *, CONST TCHAR *, DWORD, + WCHAR *, TCHAR **)) SearchPathW, + (BOOL (WINAPI *)(CONST TCHAR *)) SetCurrentDirectoryW, + (BOOL (WINAPI *)(CONST TCHAR *, DWORD)) SetFileAttributesW, + /* + * The three NULL function pointers will only be set when + * Tcl_FindExecutable is called. If you don't ever call that function, the + * application will crash whenever WinTcl tries to call functions through + * these null pointers. That is not a bug in Tcl - Tcl_FindExecutable is + * mandatory in recent Tcl releases. + */ + + NULL, + NULL, + /* deleted (int (__cdecl*)(CONST TCHAR *, struct _utimbuf *)) _wutime, */ + NULL, + NULL, + /* getLongPathNameProc */ + NULL, + /* Security SDK - will be filled in on NT,XP,2000,2003 */ + NULL, NULL, NULL, NULL, NULL, NULL, + /* ReadConsole and WriteConsole */ + (BOOL (WINAPI *)(HANDLE, LPVOID, DWORD, LPDWORD, LPVOID)) ReadConsoleW, + (BOOL (WINAPI *)(HANDLE, const VOID*, DWORD, LPDWORD, LPVOID)) WriteConsoleW, + (BOOL (WINAPI *)(LPTSTR, LPDWORD)) GetUserNameW +}; + +TclWinProcs *tclWinProcs; +static Tcl_Encoding tclWinTCharEncoding; + +#ifdef HAVE_NO_SEH +/* + * Need to add noinline flag to DllMain declaration so that gcc -O3 does not + * inline asm code into DllEntryPoint and cause a compile time error because + * of redefined local labels. + */ + +BOOL APIENTRY DllMain(HINSTANCE hInst, DWORD reason, + LPVOID reserved) __attribute__ ((noinline)); +#else /* * The following declaration is for the VC++ DLL entry point. */ BOOL APIENTRY DllMain(HINSTANCE hInst, DWORD reason, LPVOID reserved); +#endif /* HAVE_NO_SEH */ /* * The following structure and linked list is to allow us to map between @@ -66,8 +206,8 @@ BOOL APIENTRY DllMain(HINSTANCE hInst, DWORD reason, */ typedef struct MountPointMap { - const TCHAR *volumeName; /* Native wide string volume name. */ - TCHAR driveLetter; /* Drive letter corresponding to the volume + CONST WCHAR *volumeName; /* Native wide string volume name. */ + char driveLetter; /* Drive letter corresponding to the volume * name. */ struct MountPointMap *nextPtr; /* Pointer to next structure in list, or @@ -86,7 +226,10 @@ TCL_DECLARE_MUTEX(mountPointMap) * We will need this below. */ -#if defined(__WIN32__) && !defined(STATIC_BUILD) +extern Tcl_FSDupInternalRepProc TclNativeDupInternalRep; + +#ifdef __WIN32__ +#ifndef STATIC_BUILD /* *---------------------------------------------------------------------- @@ -127,7 +270,10 @@ DllEntryPoint( * TRUE on sucess, FALSE on failure. * * Side effects: - * Initializes most rudimentary Windows bits. + * Establishes 32-to-16 bit thunk and initializes sockets library. This + * might call some sycronization functions, but MSDN documentation + * states: "Waiting on synchronization objects in DllMain can cause a + * deadlock." * *---------------------------------------------------------------------- */ @@ -138,21 +284,111 @@ DllMain( DWORD reason, /* Reason this function is being called. */ LPVOID reserved) /* Not used. */ { +#if defined(HAVE_NO_SEH) && !defined(_WIN64) + TCLEXCEPTION_REGISTRATION registration; +#endif + switch (reason) { case DLL_PROCESS_ATTACH: DisableThreadLibraryCalls(hInst); TclWinInit(hInst); return TRUE; + case DLL_PROCESS_DETACH: /* - * DLL_PROCESS_DETACH is unnecessary as the user should call - * Tcl_Finalize explicitly before unloading Tcl. + * Protect the call to Tcl_Finalize. The OS could be unloading us from + * an exception handler and the state of the stack might be unstable. */ + +#if defined(HAVE_NO_SEH) && !defined(_WIN64) + __asm__ __volatile__ ( + + /* + * Construct an TCLEXCEPTION_REGISTRATION to protect the call to + * Tcl_Finalize + */ + + "leal %[registration], %%edx" "\n\t" + "movl %%fs:0, %%eax" "\n\t" + "movl %%eax, 0x0(%%edx)" "\n\t" /* link */ + "leal 1f, %%eax" "\n\t" + "movl %%eax, 0x4(%%edx)" "\n\t" /* handler */ + "movl %%ebp, 0x8(%%edx)" "\n\t" /* ebp */ + "movl %%esp, 0xc(%%edx)" "\n\t" /* esp */ + "movl %[error], 0x10(%%edx)" "\n\t" /* status */ + + /* + * Link the TCLEXCEPTION_REGISTRATION on the chain + */ + + "movl %%edx, %%fs:0" "\n\t" + + /* + * Call Tcl_Finalize + */ + + "call _Tcl_Finalize" "\n\t" + + /* + * Come here on a normal exit. Recover the TCLEXCEPTION_REGISTRATION + * and store a TCL_OK status + */ + + "movl %%fs:0, %%edx" "\n\t" + "movl %[ok], %%eax" "\n\t" + "movl %%eax, 0x10(%%edx)" "\n\t" + "jmp 2f" "\n" + + /* + * Come here on an exception. Get the TCLEXCEPTION_REGISTRATION that + * we previously put on the chain. + */ + + "1:" "\t" + "movl %%fs:0, %%edx" "\n\t" + "movl 0x8(%%edx), %%edx" "\n" + + + /* + * Come here however we exited. Restore context from the + * TCLEXCEPTION_REGISTRATION in case the stack is unbalanced. + */ + + "2:" "\t" + "movl 0xc(%%edx), %%esp" "\n\t" + "movl 0x8(%%edx), %%ebp" "\n\t" + "movl 0x0(%%edx), %%eax" "\n\t" + "movl %%eax, %%fs:0" "\n\t" + + : + /* No outputs */ + : + [registration] "m" (registration), + [ok] "i" (TCL_OK), + [error] "i" (TCL_ERROR) + : + "%eax", "%ebx", "%ecx", "%edx", "%esi", "%edi", "memory" + ); + +#else +#ifndef HAVE_NO_SEH + __try { +#endif + Tcl_Finalize(); +#ifndef HAVE_NO_SEH + } __except (EXCEPTION_EXECUTE_HANDLER) { + /* empty handler body. */ + } +#endif +#endif + + break; } return TRUE; } -#endif /* __WIN32__ && !STATIC_BUILD */ +#endif /* !STATIC_BUILD */ +#endif /* __WIN32__ */ /* *---------------------------------------------------------------------- @@ -196,26 +432,23 @@ 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 or Win9x, so just in case someone manages - * to get a runtime there, make sure they know that. + * We no longer support Win32s, so just in case someone manages to get a + * runtime there, make sure they know that. */ if (platformId == VER_PLATFORM_WIN32s) { Tcl_Panic("Win32s is not a supported platform"); } - if (platformId == VER_PLATFORM_WIN32_WINDOWS) { - Tcl_Panic("Windows 9x is not a supported platform"); - } - TclWinResetInterfaces(); + tclWinProcs = &asciiProcs; } /* @@ -228,10 +461,9 @@ 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 (not supported) - * VER_PLATFORM_WIN32_NT Win32 on Windows NT, 2000, XP - * VER_PLATFORM_WIN32_CE Win32 on Windows CE + * VER_PLATFORM_WIN32s Win32s on Windows 3.1. (not supported) + * VER_PLATFORM_WIN32_WINDOWS Win32 on Windows 95, 98, ME. + * VER_PLATFORM_WIN32_NT Win32 on Windows NT, 2000, XP * * Side effects: * None. @@ -277,6 +509,83 @@ TclWinNoBackslash( } /* + *---------------------------------------------------------------------- + * + * TclpGetStackParams -- + * + * Determine the stack params for the current thread: in which + * direction does the stack grow, and what is the stack lower (resp. + * upper) bound for safe invocation of a new command? This is used to + * cache the values needed for an efficient computation of + * TclpCheckStackSpace() when the interp is known. + * + * Results: + * Returns 1 if the stack grows down, in which case a stack lower bound + * is stored at stackBoundPtr. If the stack grows up, 0 is returned and + * an upper bound is stored at stackBoundPtr. If a bound cannot be + * determined NULL is stored at stackBoundPtr. + * + *---------------------------------------------------------------------- + */ + +#ifndef TCL_NO_STACK_CHECK +int +TclpGetCStackParams( + int **stackBoundPtr) +{ + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + SYSTEM_INFO si; /* The system information, used to + * determine the page size */ + MEMORY_BASIC_INFORMATION mbi; + /* The information about the memory + * area in which the stack resides */ + + if (!tsdPtr->stackBound + || ((UINT_PTR)&tsdPtr < (UINT_PTR)tsdPtr->stackBound)) { + + /* + * Either we haven't determined the stack bound in this thread, + * or else we've overflowed the bound that we previously + * determined. We need to find a new stack bound from + * Windows. + */ + + GetSystemInfo(&si); + if (VirtualQuery((LPCVOID) &tsdPtr, &mbi, sizeof(mbi)) == 0) { + + /* For some reason, the system didn't let us query the + * stack size. Nevertheless, we got here and haven't + * blown up yet. Don't update the calculated stack bound. + * If there is no calculated stack bound yet, set it to + * the base of the current page of stack. */ + + if (!tsdPtr->stackBound) { + tsdPtr->stackBound = + (int*) ((UINT_PTR)(&tsdPtr) + & ~ (UINT_PTR)(si.dwPageSize - 1)); + } + + } else { + + /* The allocation base of the stack segment has to be advanced + * by one page (to allow for the guard page maintained in the + * C runtime) and then by TCL_WIN_STACK_THRESHOLD (to allow + * for the amount of stack that Tcl needs). + */ + + tsdPtr->stackBound = + (int*) ((UINT_PTR)(mbi.AllocationBase) + + (UINT_PTR)(si.dwPageSize) + + TCL_WIN_STACK_THRESHOLD); + } + } + *stackBoundPtr = tsdPtr->stackBound; + return 1; +} +#endif + + +/* *--------------------------------------------------------------------------- * * TclWinSetInterfaces -- @@ -304,17 +613,107 @@ TclWinSetInterfaces( int wide) /* Non-zero to use wide interfaces, 0 * otherwise. */ { - TclWinResetInterfaces(); + Tcl_FreeEncoding(tclWinTCharEncoding); if (wide) { - winTCharEncoding = Tcl_GetEncoding(NULL, "unicode"); + 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); + } + } } } /* *--------------------------------------------------------------------------- * - * TclWinEncodingsCleanup -- + * TclWinResetInterfaceEncodings -- * * Called during finalization to free up any encodings we use. The * tclWinProcs-> look up table is still ok to use after this call, @@ -334,11 +733,13 @@ TclWinSetInterfaces( */ void -TclWinEncodingsCleanup(void) +TclWinResetInterfaceEncodings(void) { MountPointMap *dlIter, *dlIter2; - - TclWinResetInterfaces(); + if (tclWinTCharEncoding != NULL) { + Tcl_FreeEncoding(tclWinTCharEncoding); + tclWinTCharEncoding = NULL; + } /* * Clean up the mount point map. @@ -348,8 +749,8 @@ TclWinEncodingsCleanup(void) dlIter = driveLetterLookup; while (dlIter != NULL) { dlIter2 = dlIter->nextPtr; - ckfree(dlIter->volumeName); - ckfree(dlIter); + ckfree((char*)dlIter->volumeName); + ckfree((char*)dlIter); dlIter = dlIter2; } Tcl_MutexUnlock(&mountPointMap); @@ -372,14 +773,10 @@ TclWinEncodingsCleanup(void) * *--------------------------------------------------------------------------- */ - void TclWinResetInterfaces(void) { - if (winTCharEncoding != NULL) { - Tcl_FreeEncoding(winTCharEncoding); - winTCharEncoding = NULL; - } + tclWinProcs = &asciiProcs; } /* @@ -406,11 +803,11 @@ TclWinResetInterfaces(void) char TclWinDriveLetterForVolMountPoint( - const TCHAR *mountPoint) + CONST WCHAR *mountPoint) { MountPointMap *dlIter, *dlPtr2; - TCHAR Target[55]; /* Target of mount at mount point */ - TCHAR drive[4] = TEXT("A:\\"); + WCHAR Target[55]; /* Target of mount at mount point */ + WCHAR drive[4] = { L'A', L':', L'\\', L'\0' }; /* * Detect the volume mounted there. Unfortunately, there is no simple way @@ -421,28 +818,28 @@ TclWinDriveLetterForVolMountPoint( Tcl_MutexLock(&mountPointMap); dlIter = driveLetterLookup; while (dlIter != NULL) { - if (_tcscmp(dlIter->volumeName, mountPoint) == 0) { + if (wcscmp(dlIter->volumeName, mountPoint) == 0) { /* * We need to check whether this information is still valid, since * either the user or various programs could have adjusted the * mount points on the fly. */ - drive[0] = (TCHAR) dlIter->driveLetter; + drive[0] = L'A' + (dlIter->driveLetter - 'A'); /* * Try to read the volume mount point and see where it points. */ - if (GetVolumeNameForVolumeMountPoint(drive, - Target, 55) != 0) { - if (_tcscmp(dlIter->volumeName, Target) == 0) { + if ((*tclWinProcs->getVolumeNameForVMPProc)((TCHAR*)drive, + (TCHAR*)Target, 55) != 0) { + if (wcscmp((WCHAR*)dlIter->volumeName, Target) == 0) { /* * Nothing has changed. */ Tcl_MutexUnlock(&mountPointMap); - return (char) dlIter->driveLetter; + return dlIter->driveLetter; } } @@ -469,8 +866,8 @@ TclWinDriveLetterForVolMountPoint( * Now dlPtr2 points to the structure to free. */ - ckfree(dlPtr2->volumeName); - ckfree(dlPtr2); + ckfree((char*)dlPtr2->volumeName); + ckfree((char*)dlPtr2); /* * Restart the loop - we could try to be clever and continue half @@ -493,23 +890,23 @@ TclWinDriveLetterForVolMountPoint( * Try to read the volume mount point and see where it points. */ - if (GetVolumeNameForVolumeMountPoint(drive, - Target, 55) != 0) { + if ((*tclWinProcs->getVolumeNameForVMPProc)((TCHAR*)drive, + (TCHAR*)Target, 55) != 0) { int alreadyStored = 0; for (dlIter = driveLetterLookup; dlIter != NULL; dlIter = dlIter->nextPtr) { - if (_tcscmp(dlIter->volumeName, Target) == 0) { + if (wcscmp((WCHAR*)dlIter->volumeName, Target) == 0) { alreadyStored = 1; break; } } if (!alreadyStored) { - dlPtr2 = ckalloc(sizeof(MountPointMap)); + dlPtr2 = (MountPointMap *) ckalloc(sizeof(MountPointMap)); dlPtr2->volumeName = TclNativeDupInternalRep(Target); - dlPtr2->driveLetter = (char) drive[0]; + dlPtr2->driveLetter = 'A' + (drive[0] - L'A'); dlPtr2->nextPtr = driveLetterLookup; - driveLetterLookup = dlPtr2; + driveLetterLookup = dlPtr2; } } } @@ -520,9 +917,9 @@ TclWinDriveLetterForVolMountPoint( for (dlIter = driveLetterLookup; dlIter != NULL; dlIter = dlIter->nextPtr) { - if (_tcscmp(dlIter->volumeName, mountPoint) == 0) { + if (wcscmp(dlIter->volumeName, mountPoint) == 0) { Tcl_MutexUnlock(&mountPointMap); - return (char) dlIter->driveLetter; + return dlIter->driveLetter; } } @@ -531,11 +928,11 @@ TclWinDriveLetterForVolMountPoint( * that fact and store '-1' so we don't have to look it up each time. */ - dlPtr2 = ckalloc(sizeof(MountPointMap)); - dlPtr2->volumeName = TclNativeDupInternalRep((ClientData) mountPoint); + dlPtr2 = (MountPointMap*) ckalloc(sizeof(MountPointMap)); + dlPtr2->volumeName = TclNativeDupInternalRep((ClientData)mountPoint); dlPtr2->driveLetter = -1; dlPtr2->nextPtr = driveLetterLookup; - driveLetterLookup = dlPtr2; + driveLetterLookup = dlPtr2; Tcl_MutexUnlock(&mountPointMap); return -1; } @@ -592,28 +989,27 @@ TclWinDriveLetterForVolMountPoint( TCHAR * Tcl_WinUtfToTChar( - const char *string, /* Source string in UTF-8. */ - size_t len, /* Source string length in bytes, or - * TCL_STRLEN for strlen(). */ + 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(winTCharEncoding, + return (TCHAR *) Tcl_UtfToExternalDString(tclWinTCharEncoding, 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. */ - size_t len, /* Source string length in bytes, or - * TCL_STRLEN for platform-specific string - * length. */ + 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(winTCharEncoding, - (const char *) string, len, dsPtr); + return Tcl_ExternalToUtfDString(tclWinTCharEncoding, + (CONST char *) string, len, dsPtr); } /* @@ -641,16 +1037,11 @@ TclWinCPUID( { int status = TCL_ERROR; -#if defined(HAVE_INTRIN_H) && defined(_WIN64) - - __cpuid(regsPtr, index); - status = TCL_OK; - -#elif defined(__GNUC__) +#if defined(__GNUC__) # if defined(_WIN64) /* * Execute the CPUID instruction with the given index, and store results - * off 'regPtr'. + * off 'regsPtr'. */ __asm__ __volatile__( @@ -678,7 +1069,7 @@ TclWinCPUID( # else - EXCEPTION_REGISTRATION registration; + TCLEXCEPTION_REGISTRATION registration; /* * Execute the CPUID instruction with the given index, and store results @@ -687,7 +1078,7 @@ TclWinCPUID( __asm__ __volatile__( /* - * Construct an EXCEPTION_REGISTRATION to protect the CPUID + * Construct an TCLEXCEPTION_REGISTRATION to protect the CPUID * instruction (early 486's don't have CPUID) */ @@ -701,7 +1092,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" @@ -720,7 +1111,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. */ @@ -730,7 +1121,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. */ @@ -740,7 +1131,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" diff --git a/win/tclWinChan.c b/win/tclWinChan.c index 464a908..a271919 100644 --- a/win/tclWinChan.c +++ b/win/tclWinChan.c @@ -71,31 +71,36 @@ typedef struct FileEvent { * Static routines for this file: */ -static Tcl_DriverBlockModeProc FileBlockProc; -static Tcl_DriverCloseProc FileCloseProc; -static Tcl_DriverGetHandleProc FileGetHandleProc; -static Tcl_DriverInputProc FileInputProc; -static Tcl_DriverOutputProc FileOutputProc; -static Tcl_DriverSeekProc FileSeekProc; -static Tcl_DriverThreadActionProc FileThreadActionProc; -static Tcl_DriverTruncateProc FileTruncateProc; -static Tcl_DriverWideSeekProc FileWideSeekProc; -static Tcl_DriverWatchProc FileWatchProc; - -static Tcl_EventCheckProc FileCheckProc; -static Tcl_EventProc FileEventProc; -static Tcl_EventSetupProc FileSetupProc; - -static Tcl_ExitProc FileChannelExitHandler; - -static ThreadSpecificData * FileInit(void); -static DWORD FileGetType(HANDLE handle); - +static int FileBlockProc(ClientData instanceData, int mode); +static void FileChannelExitHandler(ClientData clientData); +static void FileCheckProc(ClientData clientData, int flags); +static int FileCloseProc(ClientData instanceData, + Tcl_Interp *interp); +static int FileEventProc(Tcl_Event *evPtr, int flags); +static int FileGetHandleProc(ClientData instanceData, + int direction, ClientData *handlePtr); +static ThreadSpecificData *FileInit(void); +static int FileInputProc(ClientData instanceData, char *buf, + int toRead, int *errorCode); +static int FileOutputProc(ClientData instanceData, + CONST char *buf, int toWrite, int *errorCode); +static int FileSeekProc(ClientData instanceData, long offset, + int mode, int *errorCode); +static Tcl_WideInt FileWideSeekProc(ClientData instanceData, + Tcl_WideInt offset, int mode, int *errorCode); +static void FileSetupProc(ClientData clientData, int flags); +static void FileWatchProc(ClientData instanceData, int mask); +static void FileThreadActionProc(ClientData instanceData, + int action); +static int FileTruncateProc(ClientData instanceData, + Tcl_WideInt length); +static DWORD FileGetType(HANDLE handle); +static int NativeIsComPort(CONST TCHAR *nativeName); /* * This structure describes the channel type structure for file based IO. */ -static const Tcl_ChannelType fileChannelType = { +static Tcl_ChannelType fileChannelType = { "file", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ FileCloseProc, /* Close proc. */ @@ -112,25 +117,8 @@ static const 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 /* *---------------------------------------------------------------------- @@ -269,7 +257,7 @@ FileCheckProc( infoPtr = infoPtr->nextPtr) { if (infoPtr->watchMask && !(infoPtr->flags & FILE_PENDING)) { infoPtr->flags |= FILE_PENDING; - evPtr = ckalloc(sizeof(FileEvent)); + evPtr = (FileEvent *) ckalloc(sizeof(FileEvent)); evPtr->header.proc = FileEventProc; evPtr->infoPtr = infoPtr; Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL); @@ -352,7 +340,7 @@ FileBlockProc( int mode) /* TCL_MODE_BLOCKING or * TCL_MODE_NONBLOCKING. */ { - FileInfo *infoPtr = instanceData; + FileInfo *infoPtr = (FileInfo *) instanceData; /* * Files on Windows can not be switched between blocking and nonblocking, @@ -390,7 +378,7 @@ FileCloseProc( ClientData instanceData, /* Pointer to FileInfo structure. */ Tcl_Interp *interp) /* Not used. */ { - FileInfo *fileInfoPtr = instanceData; + FileInfo *fileInfoPtr = (FileInfo *) instanceData; FileInfo *infoPtr; ThreadSpecificData *tsdPtr; int errorCode = 0; @@ -436,7 +424,7 @@ FileCloseProc( break; } } - ckfree(fileInfoPtr); + ckfree((char *)fileInfoPtr); return errorCode; } @@ -465,7 +453,7 @@ FileSeekProc( int mode, /* Relative to where should we seek? */ int *errorCodePtr) /* To store error code. */ { - FileInfo *infoPtr = instanceData; + FileInfo *infoPtr = (FileInfo *) instanceData; LONG newPos, newPosHigh, oldPos, oldPosHigh; DWORD moveMethod; @@ -543,7 +531,7 @@ FileWideSeekProc( int mode, /* Relative to where should we seek? */ int *errorCodePtr) /* To store error code. */ { - FileInfo *infoPtr = instanceData; + FileInfo *infoPtr = (FileInfo *) instanceData; DWORD moveMethod; LONG newPos, newPosHigh; @@ -592,7 +580,7 @@ FileTruncateProc( ClientData instanceData, /* File state. */ Tcl_WideInt length) /* Length to truncate at. */ { - FileInfo *infoPtr = instanceData; + FileInfo *infoPtr = (FileInfo *) instanceData; LONG newPos, newPosHigh, oldPos, oldPosHigh; /* @@ -661,17 +649,18 @@ FileTruncateProc( *---------------------------------------------------------------------- */ -static ssize_t +static int FileInputProc( ClientData instanceData, /* File state. */ char *buf, /* Where to store data read. */ - size_t bufSize, /* Num bytes available in buffer. */ + int bufSize, /* Num bytes available in buffer. */ int *errorCode) /* Where to store error code. */ { - FileInfo *infoPtr = instanceData; + FileInfo *infoPtr; DWORD bytesRead; *errorCode = 0; + infoPtr = (FileInfo *) instanceData; /* * Note that we will block on reads from a console buffer until a full @@ -683,7 +672,7 @@ FileInputProc( if (ReadFile(infoPtr->handle, (LPVOID) buf, (DWORD) bufSize, &bytesRead, (LPOVERLAPPED) NULL) != FALSE) { - return (ssize_t) bytesRead; + return bytesRead; } TclWinConvertError(GetLastError()); @@ -712,14 +701,14 @@ FileInputProc( *---------------------------------------------------------------------- */ -static ssize_t +static int FileOutputProc( ClientData instanceData, /* File state. */ - const char *buf, /* The data buffer. */ - size_t toWrite, /* How many bytes to write? */ + CONST char *buf, /* The data buffer. */ + int toWrite, /* How many bytes to write? */ int *errorCode) /* Where to store error code. */ { - FileInfo *infoPtr = instanceData; + FileInfo *infoPtr = (FileInfo *) instanceData; DWORD bytesWritten; *errorCode = 0; @@ -740,7 +729,7 @@ FileOutputProc( return -1; } infoPtr->dirty = 1; - return (ssize_t) bytesWritten; + return bytesWritten; } /* @@ -766,7 +755,7 @@ FileWatchProc( * of TCL_READABLE, TCL_WRITABLE and * TCL_EXCEPTION. */ { - FileInfo *infoPtr = instanceData; + FileInfo *infoPtr = (FileInfo *) instanceData; Tcl_Time blockTime = { 0, 0 }; /* @@ -804,7 +793,7 @@ FileGetHandleProc( int direction, /* TCL_READABLE or TCL_WRITABLE */ ClientData *handlePtr) /* Where to store the handle. */ { - FileInfo *infoPtr = instanceData; + FileInfo *infoPtr = (FileInfo *) instanceData; if (direction & infoPtr->validMask) { *handlePtr = (ClientData) infoPtr->handle; @@ -844,13 +833,18 @@ 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 = Tcl_FSGetNativePath(pathPtr); + nativeName = (TCHAR*) Tcl_FSGetNativePath(pathPtr); if (nativeName == NULL) { + if (interp != (Tcl_Interp *) NULL) { + Tcl_AppendResult(interp, "couldn't open \"", + TclGetString(pathPtr), "\": filename is invalid on this platform", + NULL); + } return NULL; } @@ -897,6 +891,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. */ @@ -908,7 +929,7 @@ TclpOpenFileChannel( flags = FILE_ATTRIBUTE_READONLY; } } else { - flags = GetFileAttributes(nativeName); + flags = (*tclWinProcs->getFileAttributesProc)(nativeName); if (flags == 0xFFFFFFFF) { flags = 0; } @@ -924,8 +945,8 @@ TclpOpenFileChannel( * Now we get to create the file. */ - handle = CreateFile(nativeName, accessMode, shareMode, - NULL, createMode, flags, (HANDLE) NULL); + handle = (*tclWinProcs->createFileProc)(nativeName, accessMode, + shareMode, NULL, createMode, flags, (HANDLE) NULL); if (handle == INVALID_HANDLE_VALUE) { DWORD err = GetLastError(); @@ -935,9 +956,8 @@ TclpOpenFileChannel( } TclWinConvertError(err); if (interp != (Tcl_Interp *) NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "couldn't open \"%s\": %s", - TclGetString(pathPtr), Tcl_PosixError(interp))); + Tcl_AppendResult(interp, "couldn't open \"", TclGetString(pathPtr), + "\": ", Tcl_PosixError(interp), NULL); } return NULL; } @@ -947,17 +967,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_SetObjResult(interp, Tcl_ObjPrintf( - "couldn't reopen serial \"%s\": %s", - TclGetString(pathPtr), Tcl_PosixError(interp))); + Tcl_AppendResult(interp, "couldn't reopen serial \"", + TclGetString(pathPtr), "\": ", + Tcl_PosixError(interp), NULL); } return NULL; } @@ -991,11 +1015,8 @@ TclpOpenFileChannel( */ channel = NULL; - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "couldn't open \"%s\": bad file type", - TclGetString(pathPtr))); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "CHANNEL", "BAD_TYPE", - NULL); + Tcl_AppendResult(interp, "couldn't open \"", TclGetString(pathPtr), + "\": bad file type", NULL); break; } @@ -1025,7 +1046,7 @@ Tcl_MakeFileChannel( * TCL_WRITABLE to indicate file mode. */ { #if defined(HAVE_NO_SEH) && !defined(_WIN64) - EXCEPTION_REGISTRATION registration; + TCLEXCEPTION_REGISTRATION registration; #endif char channelName[16 + TCL_INTEGER_SPACE]; Tcl_Channel channel = NULL; @@ -1106,7 +1127,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. */ @@ -1120,7 +1141,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" @@ -1133,7 +1154,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. */ @@ -1143,7 +1164,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" @@ -1152,7 +1173,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" @@ -1221,8 +1242,8 @@ TclpGetDefaultStdChannel( Tcl_Channel channel; HANDLE handle; int mode = -1; - const char *bufMode = NULL; - DWORD handleId = (DWORD) -1; + char *bufMode = NULL; + DWORD handleId = (DWORD)-1; /* Standard handle to retrieve. */ switch (type) { @@ -1321,7 +1342,7 @@ TclWinOpenFileChannel( } } - infoPtr = ckalloc(sizeof(FileInfo)); + infoPtr = (FileInfo *) ckalloc((unsigned) sizeof(FileInfo)); /* * TIP #218. Removed the code inserting the new structure into the global @@ -1335,10 +1356,10 @@ TclWinOpenFileChannel( infoPtr->flags = appendMode; infoPtr->handle = handle; infoPtr->dirty = 0; - sprintf(channelName, "file%" TCL_I_MODIFIER "x", (size_t) infoPtr); + sprintf(channelName, "file%" TCL_I_MODIFIER "x", (size_t)infoPtr); infoPtr->channel = Tcl_CreateChannel(&fileChannelType, channelName, - infoPtr, permissions); + (ClientData) infoPtr, permissions); /* * Files have default translation of AUTO and ^Z eof char, which means @@ -1412,7 +1433,7 @@ FileThreadActionProc( int action) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - FileInfo *infoPtr = instanceData; + FileInfo *infoPtr = (FileInfo *) instanceData; if (action == TCL_CHANNEL_THREAD_INSERT) { infoPtr->nextPtr = tsdPtr->firstFilePtr; @@ -1491,6 +1512,122 @@ FileGetType( 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. */ +{ + /* + * Use wide-char or plain character case-insensitive comparison + */ + if (tclWinProcs->useWide) { + 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; + } + + } else { + const char *p = (const char *) nativePath; + int i, len = strlen(p); + + /* + * 1. Look for com[1-9]:? + */ + + if ( (len >= 4) && (len <= 5) + && (strnicmp(p, "com", 3) == 0) ) { + /* + * The 4th character must be a digit 1..9 optionally followed by a ":" + */ + + if ( (p[3] < '1') || (p[3] > '9') ) { + return 0; + } + if ( (len == 5) && (p[4] != ':') ) { + return 0; + } + return 1; + } + + /* + * 2. Look for //./com[0-9]+ or \\.\com[0-9]+ + */ + + if ( (len >= 8) && ( + (strnicmp(p, "//./com", 7) == 0) + || (strnicmp(p, "\\\\.\\com", 7) == 0) ) ) + { + /* + * Charaters 8..end must be a digits 0..9 + */ + + for ( i=7; i<len; i++ ) { + if ( (p[i] < '0') || (p[i] > '9') ) { + return 0; + } + } + return 1; + } + } + return 0; +} + /* * Local Variables: * mode: c diff --git a/win/tclWinConsole.c b/win/tclWinConsole.c index 1cf921e..361fb3d 100644 --- a/win/tclWinConsole.c +++ b/win/tclWinConsole.c @@ -11,7 +11,9 @@ */ #include "tclWinInt.h" -#include <sys/stat.h> + +#include <fcntl.h> +#include <io.h> /* * The following variable is used to tell whether this module has been @@ -46,23 +48,6 @@ 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. */ @@ -81,18 +66,24 @@ typedef struct ConsoleInfo { Tcl_ThreadId threadId; /* Thread to which events should be reported. * This value is used by the reader/writer * threads. */ - ConsoleThreadInfo writer; /* A specialized thread for handling - * asynchronous writes to the console; the - * waiting starts when a 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. */ + HANDLE writeThread; /* Handle to writer thread. */ + HANDLE readThread; /* Handle to reader thread. */ + HANDLE writable; /* Manual-reset event to signal when the + * writer thread has finished waiting for the + * current buffer to be written. */ + HANDLE readable; /* Manual-reset event to signal when the + * reader thread has finished waiting for + * input. */ + HANDLE startWriter; /* Auto-reset event used by the main thread to + * signal when the writer thread should + * attempt to write to the console. */ + HANDLE stopWriter; /* Auto-reset event used by the main thread to + * signal when the writer thread should exit */ + HANDLE startReader; /* Auto-reset event used by the main thread to + * signal when the reader thread should + * attempt to read from the console. */ + HANDLE stopReader; /* Auto-reset event used by the main thread to + * signal when the reader thread should exit */ DWORD writeError; /* An error caused by the last background * write. Set to 0 if no error has been * detected. This word is shared with the @@ -100,15 +91,15 @@ typedef struct ConsoleInfo { * synchronized with the writable object. */ char *writeBuf; /* Current background output buffer. Access is * synchronized with the writable object. */ - size_t writeBufLen; /* Size of write buffer. Access is + int writeBufLen; /* Size of write buffer. Access is * synchronized with the writable object. */ - size_t toWrite; /* Current amount to be written. Access is + int toWrite; /* Current amount to be written. Access is * synchronized with the writable object. */ int readFlags; /* Flags that are shared with the reader * thread. Access is synchronized with the * readable object. */ - size_t bytesRead; /* Number of bytes in the buffer. */ - size_t 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; @@ -142,41 +133,34 @@ typedef struct ConsoleEvent { * Declarations for functions used only in this file. */ -static Tcl_DriverBlockModeProc ConsoleBlockModeProc; -static Tcl_DriverCloseProc ConsoleCloseProc; -static Tcl_DriverGetHandleProc ConsoleGetHandleProc; -static Tcl_DriverInputProc ConsoleInputProc; -static Tcl_DriverOutputProc ConsoleOutputProc; -static Tcl_DriverThreadActionProc ConsoleThreadActionProc; -static Tcl_DriverWatchProc ConsoleWatchProc; - -static Tcl_EventCheckProc ConsoleCheckProc; -static Tcl_EventProc ConsoleEventProc; -static Tcl_EventSetupProc ConsoleSetupProc; - -static Tcl_ExitProc ConsoleExitHandler; -static Tcl_ExitProc ProcExitHandler; - +static int ConsoleBlockModeProc(ClientData instanceData,int mode); +static void ConsoleCheckProc(ClientData clientData, int flags); +static int ConsoleCloseProc(ClientData instanceData, + Tcl_Interp *interp); +static int ConsoleEventProc(Tcl_Event *evPtr, int flags); +static void ConsoleExitHandler(ClientData clientData); +static int ConsoleGetHandleProc(ClientData instanceData, + int direction, ClientData *handlePtr); static void ConsoleInit(void); +static int ConsoleInputProc(ClientData instanceData, char *buf, + int toRead, int *errorCode); +static int ConsoleOutputProc(ClientData instanceData, + CONST char *buf, int toWrite, int *errorCode); static DWORD WINAPI ConsoleReaderThread(LPVOID arg); +static void ConsoleSetupProc(ClientData clientData, int flags); +static void ConsoleWatchProc(ClientData instanceData, int mask); static DWORD WINAPI ConsoleWriterThread(LPVOID arg); +static void ProcExitHandler(ClientData clientData); static int WaitForRead(ConsoleInfo *infoPtr, int blocking); -static 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); +static void ConsoleThreadActionProc(ClientData instanceData, + int action); /* * This structure describes the channel type structure for command console * based IO. */ -static const Tcl_ChannelType consoleChannelType = { +static Tcl_ChannelType consoleChannelType = { "console", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ ConsoleCloseProc, /* Close proc. */ @@ -188,27 +172,23 @@ static const 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 proc. */ + ConsoleBlockModeProc, /* Set blocking or non-blocking mode.*/ + NULL, /* flush proc. */ + NULL, /* handler proc. */ + NULL, /* wide seek proc */ + ConsoleThreadActionProc, /* thread action proc */ + NULL, /* truncation */ }; /* *---------------------------------------------------------------------- * - * ReadConsoleBytes, WriteConsoleBytes -- - * - * Wrapper for ReadConsole{A,W}, that takes and returns number of bytes - * instead of number of TCHARS. - * - *---------------------------------------------------------------------- + * 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, @@ -216,32 +196,30 @@ ReadConsoleBytes( { DWORD ntchars; BOOL result; - int tcharsize = sizeof(TCHAR); - - result = ReadConsole(hConsole, lpBuffer, nbytes / tcharsize, &ntchars, - NULL); - if (nbytesread != NULL) { - *nbytesread = ntchars * tcharsize; - } + int tcharsize; + tcharsize = tclWinProcs->useWide? 2 : 1; + result = tclWinProcs->readConsoleProc( + hConsole, lpBuffer, nbytes / tcharsize, &ntchars, NULL); + if (nbytesread) + *nbytesread = (ntchars*tcharsize); return result; } static BOOL -WriteConsoleBytes( +writeConsoleBytes( HANDLE hConsole, - const void *lpBuffer, + const VOID *lpBuffer, DWORD nbytes, LPDWORD nbyteswritten) { DWORD ntchars; BOOL result; - int tcharsize = sizeof(TCHAR); - - result = WriteConsole(hConsole, lpBuffer, nbytes / tcharsize, &ntchars, - NULL); - if (nbyteswritten != NULL) { - *nbyteswritten = ntchars * tcharsize; - } + int tcharsize; + tcharsize = tclWinProcs->useWide? 2 : 1; + result = tclWinProcs->writeConsoleProc( + hConsole, lpBuffer, nbytes / tcharsize, &ntchars, NULL); + if (nbyteswritten) + *nbyteswritten = (ntchars*tcharsize); return result; } @@ -264,6 +242,8 @@ WriteConsoleBytes( static void ConsoleInit(void) { + ThreadSpecificData *tsdPtr; + /* * Check the initialized flag first, then check again in the mutex. This * is a speed enhancement. @@ -278,9 +258,9 @@ ConsoleInit(void) Tcl_MutexUnlock(&consoleMutex); } - if (TclThreadDataKeyGet(&dataKey) == NULL) { - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - + tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); + if (tsdPtr == NULL) { + tsdPtr = TCL_TSD_INIT(&dataKey); tsdPtr->firstConsolePtr = NULL; Tcl_CreateEventSource(ConsoleSetupProc, ConsoleCheckProc, NULL); Tcl_CreateThreadExitHandler(ConsoleExitHandler, NULL); @@ -306,7 +286,7 @@ ConsoleInit(void) static void ConsoleExitHandler( - ClientData clientData) /* Old window proc. */ + ClientData clientData) /* Old window proc */ { Tcl_DeleteEventSource(ConsoleSetupProc, ConsoleCheckProc, NULL); } @@ -330,7 +310,7 @@ ConsoleExitHandler( static void ProcExitHandler( - ClientData clientData) /* Old window proc. */ + ClientData clientData) /* Old window proc */ { Tcl_MutexLock(&consoleMutex); initialized = 0; @@ -375,8 +355,7 @@ ConsoleSetupProc( for (infoPtr = tsdPtr->firstConsolePtr; infoPtr != NULL; infoPtr = infoPtr->nextPtr) { if (infoPtr->watchMask & TCL_WRITABLE) { - if (WaitForSingleObject(infoPtr->writer.readyEvent, - 0) != WAIT_TIMEOUT) { + if (WaitForSingleObject(infoPtr->writable, 0) != WAIT_TIMEOUT) { block = 0; } } @@ -414,6 +393,7 @@ ConsoleCheckProc( int flags) /* Event flags as passed to Tcl_DoOneEvent. */ { ConsoleInfo *infoPtr; + ConsoleEvent *evPtr; int needEvent; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -438,8 +418,7 @@ ConsoleCheckProc( needEvent = 0; if (infoPtr->watchMask & TCL_WRITABLE) { - if (WaitForSingleObject(infoPtr->writer.readyEvent, - 0) != WAIT_TIMEOUT) { + if (WaitForSingleObject(infoPtr->writable, 0) != WAIT_TIMEOUT) { needEvent = 1; } } @@ -451,9 +430,8 @@ 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); @@ -461,6 +439,7 @@ ConsoleCheckProc( } } + /* *---------------------------------------------------------------------- * @@ -483,7 +462,7 @@ ConsoleBlockModeProc( int mode) /* TCL_MODE_BLOCKING or * TCL_MODE_NONBLOCKING. */ { - ConsoleInfo *infoPtr = instanceData; + ConsoleInfo *infoPtr = (ConsoleInfo *) instanceData; /* * Consoles on Windows can not be switched between blocking and @@ -496,7 +475,7 @@ ConsoleBlockModeProc( if (mode == TCL_MODE_NONBLOCKING) { infoPtr->flags |= CONSOLE_ASYNC; } else { - infoPtr->flags &= ~CONSOLE_ASYNC; + infoPtr->flags &= ~(CONSOLE_ASYNC); } return 0; } @@ -504,84 +483,6 @@ 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. @@ -600,10 +501,13 @@ ConsoleCloseProc( ClientData instanceData, /* Pointer to ConsoleInfo structure. */ Tcl_Interp *interp) /* For error reporting. */ { - ConsoleInfo *consolePtr = instanceData; - int errorCode = 0; + ConsoleInfo *consolePtr = (ConsoleInfo *) instanceData; + int errorCode; 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 @@ -611,8 +515,49 @@ ConsoleCloseProc( * trying to read from the console. */ - if (consolePtr->reader.thread) { - StopChannelThread(&consolePtr->reader); + 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; } consolePtr->validMask &= ~TCL_READABLE; @@ -622,20 +567,62 @@ ConsoleCloseProc( * should be no pending write operations. */ - if (consolePtr->writer.thread) { + if (consolePtr->writeThread) { if (consolePtr->toWrite) { /* * We only need to wait if there is something to write. This may - * prevent infinite wait on exit. [Python Bug 216289] + * 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. + */ + + SetEvent(consolePtr->stopWriter); + + /* + * Wait at most 20 milliseconds for the writer thread to close. */ - WaitForSingleObject(consolePtr->writer.readyEvent, INFINITE); + 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); + } } - StopChannelThread(&consolePtr->writer); + CloseHandle(consolePtr->writeThread); + CloseHandle(consolePtr->writable); + CloseHandle(consolePtr->startWriter); + CloseHandle(consolePtr->stopWriter); + consolePtr->writeThread = NULL; } consolePtr->validMask &= ~TCL_WRITABLE; + /* * Don't close the Win32 handle if the handle is a standard channel during * the thread exit process. Otherwise, one thread may kill the stdio of @@ -661,7 +648,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; } @@ -670,7 +657,7 @@ ConsoleCloseProc( ckfree(consolePtr->writeBuf); consolePtr->writeBuf = 0; } - ckfree(consolePtr); + ckfree((char*) consolePtr); return errorCode; } @@ -693,15 +680,15 @@ ConsoleCloseProc( *---------------------------------------------------------------------- */ -static ssize_t +static int ConsoleInputProc( ClientData instanceData, /* Console state. */ char *buf, /* Where to store data read. */ - size_t bufSize, /* How much space is available in the + int bufSize, /* How much space is available in the * buffer? */ int *errorCode) /* Where to store error code. */ { - ConsoleInfo *infoPtr = instanceData; + ConsoleInfo *infoPtr = (ConsoleInfo *) instanceData; DWORD count, bytesRead = 0; int result; @@ -736,7 +723,7 @@ ConsoleInputProc( bytesRead = infoPtr->bytesRead - infoPtr->offset; /* - * Reset the buffer. + * Reset the buffer */ infoPtr->readFlags &= ~CONSOLE_BUFFERED; @@ -752,8 +739,8 @@ 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) { buf[count] = '\0'; return count; } @@ -779,20 +766,19 @@ ConsoleInputProc( *---------------------------------------------------------------------- */ -static ssize_t +static int ConsoleOutputProc( ClientData instanceData, /* Console state. */ - const char *buf, /* The data buffer. */ - size_t toWrite, /* How many bytes to write? */ + CONST char *buf, /* The data buffer. */ + int toWrite, /* How many bytes to write? */ int *errorCode) /* Where to store error code. */ { - ConsoleInfo *infoPtr = instanceData; - ConsoleThreadInfo *threadInfo = &infoPtr->reader; + ConsoleInfo *infoPtr = (ConsoleInfo *) instanceData; DWORD bytesWritten, timeout; *errorCode = 0; timeout = (infoPtr->flags & CONSOLE_ASYNC) ? 0 : INFINITE; - if (WaitForSingleObject(threadInfo->readyEvent,timeout) == WAIT_TIMEOUT) { + if (WaitForSingleObject(infoPtr->writable, timeout) == WAIT_TIMEOUT) { /* * The writer thread is blocked waiting for a write to complete and * the channel is in non-blocking mode. @@ -827,12 +813,12 @@ ConsoleOutputProc( ckfree(infoPtr->writeBuf); } infoPtr->writeBufLen = toWrite; - infoPtr->writeBuf = ckalloc(toWrite); + infoPtr->writeBuf = ckalloc((size_t)toWrite); } - memcpy(infoPtr->writeBuf, buf, (size_t) toWrite); + memcpy(infoPtr->writeBuf, buf, (size_t)toWrite); infoPtr->toWrite = toWrite; - ResetEvent(threadInfo->readyEvent); - SetEvent(threadInfo->startEvent); + ResetEvent(infoPtr->writable); + SetEvent(infoPtr->startWriter); bytesWritten = toWrite; } else { /* @@ -840,8 +826,9 @@ 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; } @@ -880,7 +867,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); @@ -899,7 +886,7 @@ ConsoleEventProc( for (infoPtr = tsdPtr->firstConsolePtr; infoPtr != NULL; infoPtr = infoPtr->nextPtr) { if (consoleEvPtr->infoPtr == infoPtr) { - infoPtr->flags &= ~CONSOLE_PENDING; + infoPtr->flags &= ~(CONSOLE_PENDING); break; } } @@ -920,8 +907,7 @@ ConsoleEventProc( mask = 0; if (infoPtr->watchMask & TCL_WRITABLE) { - if (WaitForSingleObject(infoPtr->writer.readyEvent, - 0) != WAIT_TIMEOUT) { + if (WaitForSingleObject(infoPtr->writable, 0) != WAIT_TIMEOUT) { mask = TCL_WRITABLE; } } @@ -968,7 +954,7 @@ ConsoleWatchProc( * TCL_EXCEPTION. */ { ConsoleInfo **nextPtrPtr, *ptr; - ConsoleInfo *infoPtr = instanceData; + ConsoleInfo *infoPtr = (ConsoleInfo *) instanceData; int oldMask = infoPtr->watchMask; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -980,7 +966,6 @@ ConsoleWatchProc( infoPtr->watchMask = mask & infoPtr->validMask; if (infoPtr->watchMask) { Tcl_Time blockTime = { 0, 0 }; - if (!oldMask) { infoPtr->nextPtr = tsdPtr->firstConsolePtr; tsdPtr->firstConsolePtr = infoPtr; @@ -1023,12 +1008,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 = instanceData; + ConsoleInfo *infoPtr = (ConsoleInfo *) instanceData; - *handlePtr = infoPtr->handle; + *handlePtr = (ClientData) infoPtr->handle; return TCL_OK; } @@ -1061,7 +1046,6 @@ WaitForRead( { DWORD timeout, count; HANDLE *handle = infoPtr->handle; - ConsoleThreadInfo *threadInfo = &infoPtr->reader; INPUT_RECORD input; while (1) { @@ -1070,8 +1054,7 @@ WaitForRead( */ timeout = blocking ? INFINITE : 0; - if (WaitForSingleObject(threadInfo->readyEvent, - timeout) == WAIT_TIMEOUT) { + if (WaitForSingleObject(infoPtr->readable, timeout) == WAIT_TIMEOUT) { /* * The reader thread is blocked waiting for data and the channel * is in non-blocking mode. @@ -1130,8 +1113,8 @@ WaitForRead( * There wasn't any data available, so reset the thread and try again. */ - ResetEvent(threadInfo->readyEvent); - SetEvent(threadInfo->startEvent); + ResetEvent(infoPtr->readable); + SetEvent(infoPtr->startReader); } } @@ -1158,18 +1141,14 @@ static DWORD WINAPI ConsoleReaderThread( LPVOID arg) { - ConsoleInfo *infoPtr = arg; + ConsoleInfo *infoPtr = (ConsoleInfo *)arg; HANDLE *handle = infoPtr->handle; - ConsoleThreadInfo *threadInfo = &infoPtr->reader; DWORD waitResult; HANDLE wEvents[2]; - /* - * The first event takes precedence. - */ - - wEvents[0] = threadInfo->stopEvent; - wEvents[1] = threadInfo->startEvent; + /* The first event takes precedence. */ + wEvents[0] = infoPtr->stopReader; + wEvents[1] = infoPtr->startReader; for (;;) { /* @@ -1192,7 +1171,7 @@ ConsoleReaderThread( * 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. @@ -1200,9 +1179,10 @@ ConsoleReaderThread( infoPtr->readFlags |= CONSOLE_BUFFERED; } else { - DWORD err = GetLastError(); + DWORD err; + err = GetLastError(); - if (err == (DWORD) EOF) { + if (err == (DWORD)EOF) { infoPtr->readFlags = CONSOLE_EOF; } } @@ -1212,7 +1192,7 @@ ConsoleReaderThread( * waking up the notifier thread. */ - SetEvent(threadInfo->readyEvent); + SetEvent(infoPtr->readable); /* * Alert the foreground thread. Note that we need to treat this like a @@ -1226,7 +1206,6 @@ ConsoleReaderThread( * TIP #218. When in flight ignore the event, no one will receive * it anyway. */ - Tcl_ThreadAlert(infoPtr->threadId); } Tcl_MutexUnlock(&consoleMutex); @@ -1258,19 +1237,16 @@ static DWORD WINAPI ConsoleWriterThread( LPVOID arg) { - ConsoleInfo *infoPtr = arg; + + ConsoleInfo *infoPtr = (ConsoleInfo *)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] = threadInfo->stopEvent; - wEvents[1] = threadInfo->startEvent; + /* The first event takes precedence. */ + wEvents[0] = infoPtr->stopWriter; + wEvents[1] = infoPtr->startWriter; for (;;) { /* @@ -1296,13 +1272,14 @@ 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; } /* @@ -1310,7 +1287,7 @@ ConsoleWriterThread( * waking up the notifier thread. */ - SetEvent(threadInfo->readyEvent); + SetEvent(infoPtr->writable); /* * Alert the foreground thread. Note that we need to treat this like a @@ -1346,7 +1323,7 @@ ConsoleWriterThread( * Returns the new channel, or NULL. * * Side effects: - * May open the channel. + * May open the channel * *---------------------------------------------------------------------- */ @@ -1359,7 +1336,7 @@ TclWinOpenConsoleChannel( { char encoding[4 + TCL_INTEGER_SPACE]; ConsoleInfo *infoPtr; - DWORD modes; + DWORD id, modes; ConsoleInit(); @@ -1367,7 +1344,7 @@ TclWinOpenConsoleChannel( * See if a channel with this handle already exists. */ - infoPtr = ckalloc(sizeof(ConsoleInfo)); + infoPtr = (ConsoleInfo *) ckalloc((unsigned) sizeof(ConsoleInfo)); memset(infoPtr, 0, sizeof(ConsoleInfo)); infoPtr->validMask = permissions; @@ -1384,10 +1361,10 @@ TclWinOpenConsoleChannel( * for instance). */ - sprintf(channelName, "file%" TCL_I_MODIFIER "x", (size_t) infoPtr); + sprintf(channelName, "file%" TCL_I_MODIFIER "x", (size_t)infoPtr); infoPtr->channel = Tcl_CreateChannel(&consoleChannelType, channelName, - infoPtr, permissions); + (ClientData) infoPtr, permissions); if (permissions & TCL_READABLE) { /* @@ -1400,11 +1377,22 @@ TclWinOpenConsoleChannel( modes &= ~(ENABLE_WINDOW_INPUT | ENABLE_MOUSE_INPUT); modes |= ENABLE_LINE_INPUT; SetConsoleMode(infoPtr->handle, modes); - StartChannelThread(infoPtr, &infoPtr->reader, ConsoleReaderThread); + + 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); } if (permissions & TCL_WRITABLE) { - StartChannelThread(infoPtr, &infoPtr->writer, ConsoleWriterThread); + 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); } /* @@ -1414,11 +1402,11 @@ TclWinOpenConsoleChannel( Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto"); Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "\032 {}"); -#ifdef UNICODE - Tcl_SetChannelOption(NULL, infoPtr->channel, "-encoding", "unicode"); -#else - Tcl_SetChannelOption(NULL, infoPtr->channel, "-encoding", encoding); -#endif + if (tclWinProcs->useWide) + Tcl_SetChannelOption(NULL, infoPtr->channel, "-encoding", "unicode"); + else + Tcl_SetChannelOption(NULL, infoPtr->channel, "-encoding", encoding); + return infoPtr->channel; } @@ -1443,10 +1431,9 @@ ConsoleThreadActionProc( ClientData instanceData, int action) { - ConsoleInfo *infoPtr = instanceData; + ConsoleInfo *infoPtr = (ConsoleInfo *) 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 9d05a4e..eef5caa 100644 --- a/win/tclWinDde.c +++ b/win/tclWinDde.c @@ -10,28 +10,11 @@ * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ -#undef STATIC_BUILD -#undef USE_TCL_STUBS -#define USE_TCL_STUBS #include "tclInt.h" +#include "tclPort.h" #include <dde.h> #include <ddeml.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 * declaration is in the source file itself, which is only accessed when we @@ -51,7 +34,7 @@ typedef struct RegisteredInterp { struct RegisteredInterp *nextPtr; /* The next interp this application knows * about. */ - TCHAR *name; /* Interpreter's name (malloc-ed). */ + char *name; /* Interpreter's name (malloc-ed). */ Tcl_Obj *handlerPtr; /* The server handler command */ Tcl_Interp *interp; /* The interpreter attached to this name. */ } RegisteredInterp; @@ -96,14 +79,13 @@ static DWORD ddeInstance; /* The application instance handle given to us * by DdeInitialize. */ static int ddeIsServer = 0; -#define TCL_DDE_VERSION "1.4.0" #define TCL_DDE_PACKAGE_NAME "dde" -#define TCL_DDE_SERVICE_NAME TEXT("TclEval") -#define TCL_DDE_EXECUTE_RESULT TEXT("$TCLEVAL$EXECUTE$RESULT") +#define TCL_DDE_SERVICE_NAME "TclEval" +#define TCL_DDE_EXECUTE_RESULT "$TCLEVAL$EXECUTE$RESULT" -#define DDE_FLAG_ASYNC 1 -#define DDE_FLAG_BINARY 2 -#define DDE_FLAG_FORCE 4 +#define DDE_FLAG_ASYNC 1 +#define DDE_FLAG_BINARY 2 +#define DDE_FLAG_FORCE 4 TCL_DECLARE_MUTEX(ddeMutex) @@ -118,7 +100,7 @@ static BOOL CALLBACK DdeEnumWindowsCallback(HWND hwndTarget, LPARAM lParam); static void DdeExitProc(ClientData clientData); static int DdeGetServicesList(Tcl_Interp *interp, - const TCHAR *serviceName, const TCHAR *topicName); + const char *serviceName, const char *topicName); static HDDEDATA CALLBACK DdeServerProc(UINT uType, UINT uFmt, HCONV hConv, HSZ ddeTopic, HSZ ddeItem, HDDEDATA hData, DWORD dwData1, DWORD dwData2); @@ -128,9 +110,11 @@ static void DeleteProc(ClientData clientData); static Tcl_Obj * ExecuteRemoteObject(RegisteredInterp *riPtr, Tcl_Obj *ddeObjectPtr); static int MakeDdeConnection(Tcl_Interp *interp, - const TCHAR *name, HCONV *ddeConvPtr); + const char *name, HCONV *ddeConvPtr); static void SetDdeError(Tcl_Interp *interp); -static Tcl_ObjCmdProc DdeObjCmd; +static int DdeObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); EXTERN int Dde_Init(Tcl_Interp *interp); EXTERN int Dde_SafeInit(Tcl_Interp *interp); @@ -155,21 +139,13 @@ int Dde_Init( Tcl_Interp *interp) { - if (!Tcl_InitStubs(interp, TCL_VERSION, 0)) { + if (!Tcl_InitStubs(interp, "8.1", 0)) { return TCL_ERROR; } -#ifdef UNICODE - if (TclWinGetPlatformId() < VER_PLATFORM_WIN32_NT) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "Win32s and Windows 9x are not supported platforms", - TCL_STRLEN)); - 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); + return Tcl_PkgProvide(interp, TCL_DDE_PACKAGE_NAME, "1.3.3"); } /* @@ -253,7 +229,7 @@ Initialize(void) ddeIsServer = 1; Tcl_CreateExitHandler(DdeExitProc, NULL); ddeServiceGlobal = DdeCreateStringHandle(ddeInstance, - TCL_DDE_SERVICE_NAME, CP_WINUNICODE); + TCL_DDE_SERVICE_NAME, 0); DdeNameService(ddeInstance, ddeServiceGlobal, 0L, DNS_REGISTER); } else { ddeIsServer = 0; @@ -287,21 +263,20 @@ Initialize(void) *---------------------------------------------------------------------- */ -static const TCHAR * +static const char * DdeSetServerName( Tcl_Interp *interp, - const TCHAR *name, /* The name that will be used to refer to the + const char *name, /* The name that will be used to refer to the * interpreter in later "send" commands. Must * be globally unique. */ - int flags, /* DDE_FLAG_FORCE or 0 */ + int flags, /* DDE_FLAG_FORCE or 0 */ Tcl_Obj *handlerPtr) /* Name of the optional proc/command to handle * incoming Dde eval's */ { - int suffix; - size_t offset; + int suffix, offset; RegisteredInterp *riPtr, *prevPtr; Tcl_DString dString; - const TCHAR *actualName; + const char *actualName; Tcl_Obj *srvListPtr = NULL, **srvPtrPtr = NULL; int n, srvCount = 0, lastSuffix, r = TCL_OK; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -339,7 +314,7 @@ DdeSetServerName( * current interp, but it doesn't have a name. */ - return TEXT(""); + return ""; } /* @@ -360,10 +335,7 @@ DdeSetServerName( &srvPtrPtr); } if (r != TCL_OK) { - Tcl_WinUtfToTChar(Tcl_GetStringResult(interp), TCL_STRLEN, - &dString); - OutputDebugString((TCHAR *) Tcl_DStringValue(&dString)); - Tcl_DStringFree(&dString); + OutputDebugString(Tcl_GetStringResult(interp)); return NULL; } @@ -380,17 +352,13 @@ DdeSetServerName( lastSuffix = suffix; if (suffix > 1) { if (suffix == 2) { - Tcl_DStringAppend(&dString, (char *) name, - _tcslen(name) * sizeof(TCHAR)); - Tcl_DStringAppend(&dString, (char *) TEXT(" #"), - 2 * sizeof(TCHAR)); + Tcl_DStringAppend(&dString, name, -1); + Tcl_DStringAppend(&dString, " #", 2); offset = Tcl_DStringLength(&dString); - Tcl_DStringSetLength(&dString, - offset + sizeof(TCHAR) * TCL_INTEGER_SPACE); - actualName = (TCHAR *) Tcl_DStringValue(&dString); + Tcl_DStringSetLength(&dString, offset + TCL_INTEGER_SPACE); + actualName = Tcl_DStringValue(&dString); } - _stprintf((TCHAR *) (Tcl_DStringValue(&dString) + offset), - TEXT("%d"), suffix); + sprintf(Tcl_DStringValue(&dString) + offset, "%d", suffix); } /* @@ -399,41 +367,39 @@ DdeSetServerName( for (n = 0; n < srvCount; ++n) { Tcl_Obj* namePtr; - Tcl_DString ds; Tcl_ListObjIndex(interp, srvPtrPtr[n], 1, &namePtr); - Tcl_WinUtfToTChar(Tcl_GetString(namePtr), TCL_STRLEN, &ds); - if (_tcscmp(actualName, (TCHAR *)Tcl_DStringValue(&ds)) == 0) { + if (strcmp(actualName, Tcl_GetString(namePtr)) == 0) { suffix++; - Tcl_DStringFree(&ds); break; } - Tcl_DStringFree(&ds); } } + Tcl_DStringSetLength(&dString, + offset + (int)strlen(Tcl_DStringValue(&dString)+offset)); } /* * We have found a unique name. Now add it to the registry. */ - riPtr = ckalloc(sizeof(RegisteredInterp)); + riPtr = (RegisteredInterp *) ckalloc(sizeof(RegisteredInterp)); riPtr->interp = interp; - riPtr->name = ckalloc((_tcslen(actualName) + 1) * sizeof(TCHAR)); + riPtr->name = ckalloc((unsigned int) strlen(actualName) + 1); riPtr->nextPtr = tsdPtr->interpListPtr; riPtr->handlerPtr = handlerPtr; if (riPtr->handlerPtr != NULL) { Tcl_IncrRefCount(riPtr->handlerPtr); } tsdPtr->interpListPtr = riPtr; - _tcscpy(riPtr->name, actualName); + strcpy(riPtr->name, actualName); if (Tcl_IsSafe(interp)) { Tcl_ExposeCommand(interp, "dde", "dde"); } Tcl_CreateObjCommand(interp, "dde", DdeObjCmd, - riPtr, DeleteProc); + (ClientData) riPtr, DeleteProc); if (Tcl_IsSafe(interp)) { Tcl_HideCommand(interp, "dde", "dde"); } @@ -561,8 +527,7 @@ ExecuteRemoteObject( if (riPtr->handlerPtr == NULL && Tcl_IsSafe(riPtr->interp)) { Tcl_SetObjResult(riPtr->interp, Tcl_NewStringObj("permission denied: " "a handler procedure must be defined for use in a safe " - "interp", TCL_STRLEN)); - Tcl_SetErrorCode(riPtr->interp, "TCL", "DDE", "SECURITY_CHECK", NULL); + "interp", -1)); result = TCL_ERROR; } @@ -642,7 +607,7 @@ DdeServerProc( Tcl_DString dString; int len; DWORD dlen; - TCHAR *utilString; + char *utilString; Tcl_Obj *ddeObjectPtr; HDDEDATA ddeReturn = NULL; RegisteredInterp *riPtr; @@ -656,16 +621,16 @@ DdeServerProc( * sure we have a valid topic. */ - len = DdeQueryString(ddeInstance, ddeTopic, NULL, 0, CP_WINUNICODE); + len = DdeQueryString(ddeInstance, ddeTopic, NULL, 0, 0); Tcl_DStringInit(&dString); - Tcl_DStringSetLength(&dString, (len + 1) * sizeof(TCHAR) - 1); - utilString = (TCHAR *) Tcl_DStringValue(&dString); + Tcl_DStringSetLength(&dString, len); + utilString = Tcl_DStringValue(&dString); DdeQueryString(ddeInstance, ddeTopic, utilString, (DWORD) len + 1, - CP_WINUNICODE); + CP_WINANSI); for (riPtr = tsdPtr->interpListPtr; riPtr != NULL; riPtr = riPtr->nextPtr) { - if (_tcsicmp(utilString, riPtr->name) == 0) { + if (stricmp(utilString, riPtr->name) == 0) { Tcl_DStringFree(&dString); return (HDDEDATA) TRUE; } @@ -681,16 +646,16 @@ DdeServerProc( * result to return in an XTYP_REQUEST. */ - len = DdeQueryString(ddeInstance, ddeTopic, NULL, 0, CP_WINUNICODE); + len = DdeQueryString(ddeInstance, ddeTopic, NULL, 0, 0); Tcl_DStringInit(&dString); - Tcl_DStringSetLength(&dString, (len + 1) * sizeof(TCHAR) - 1); - utilString = (TCHAR *) Tcl_DStringValue(&dString); + Tcl_DStringSetLength(&dString, len); + utilString = Tcl_DStringValue(&dString); DdeQueryString(ddeInstance, ddeTopic, utilString, (DWORD) len + 1, - CP_WINUNICODE); + CP_WINANSI); for (riPtr = tsdPtr->interpListPtr; riPtr != NULL; riPtr = riPtr->nextPtr) { - if (_tcsicmp(riPtr->name, utilString) == 0) { - convPtr = ckalloc(sizeof(Conversation)); + if (stricmp(riPtr->name, utilString) == 0) { + convPtr = (Conversation *) ckalloc(sizeof(Conversation)); convPtr->nextPtr = tsdPtr->currentConversations; convPtr->returnPackagePtr = NULL; convPtr->hConv = hConv; @@ -720,7 +685,7 @@ DdeServerProc( if (convPtr->returnPackagePtr != NULL) { Tcl_DecrRefCount(convPtr->returnPackagePtr); } - ckfree(convPtr); + ckfree((char *) convPtr); break; } } @@ -748,33 +713,30 @@ DdeServerProc( if (convPtr != NULL) { char *returnString; - len = DdeQueryString(ddeInstance, ddeItem, NULL,0, CP_WINUNICODE); + len = DdeQueryString(ddeInstance, ddeItem, NULL, 0, CP_WINANSI); Tcl_DStringInit(&dString); - Tcl_DStringSetLength(&dString, (len + 1) * sizeof(TCHAR) - 1); - utilString = (TCHAR *) Tcl_DStringValue(&dString); + Tcl_DStringSetLength(&dString, len); + utilString = Tcl_DStringValue(&dString); DdeQueryString(ddeInstance, ddeItem, utilString, (DWORD) len + 1, - CP_WINUNICODE); - if (_tcsicmp(utilString, TCL_DDE_EXECUTE_RESULT) == 0) { + CP_WINANSI); + if (stricmp(utilString, TCL_DDE_EXECUTE_RESULT) == 0) { if (uFmt == CF_TEXT) { - returnString = Tcl_GetStringFromObj( - convPtr->returnPackagePtr, &len); + returnString = + Tcl_GetStringFromObj(convPtr->returnPackagePtr, &len); } else { - returnString = (char *) Tcl_GetUnicodeFromObj( - convPtr->returnPackagePtr, &len); - len = sizeof(TCHAR) * len + 1; + returnString = (char *) + Tcl_GetUnicodeFromObj(convPtr->returnPackagePtr, &len); + len = 2 * len + 1; } - ddeReturn = DdeCreateDataHandle(ddeInstance, (BYTE *) - returnString, (DWORD) len+1, 0, ddeItem, uFmt, 0); + ddeReturn = DdeCreateDataHandle(ddeInstance, (BYTE *)returnString, + (DWORD) len+1, 0, ddeItem, uFmt, 0); } else { if (Tcl_IsSafe(convPtr->riPtr->interp)) { ddeReturn = NULL; } else { - Tcl_DString ds; - Tcl_Obj *variableObjPtr; - - Tcl_WinTCharToUtf(utilString, TCL_STRLEN, &ds); - variableObjPtr = Tcl_GetVar2Ex(convPtr->riPtr->interp, - Tcl_DStringValue(&ds), NULL, TCL_GLOBAL_ONLY); + Tcl_Obj *variableObjPtr = Tcl_GetVar2Ex( + convPtr->riPtr->interp, utilString, NULL, + TCL_GLOBAL_ONLY); if (variableObjPtr != NULL) { if (uFmt == CF_TEXT) { returnString = Tcl_GetStringFromObj( @@ -782,69 +744,20 @@ DdeServerProc( } else { returnString = (char *) Tcl_GetUnicodeFromObj( variableObjPtr, &len); - len = sizeof(TCHAR) * len + 1; + len = 2 * len + 1; } - ddeReturn = DdeCreateDataHandle(ddeInstance, (BYTE *) - returnString, (DWORD) len+1, 0, ddeItem, uFmt, - 0); + ddeReturn = DdeCreateDataHandle(ddeInstance, + (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, TCL_STRLEN, &ds); - utilString = (TCHAR *) DdeAccessData(hData, &dlen); - if (uFmt == CF_TEXT) { - variableObjPtr = Tcl_NewStringObj((char *) - utilString, TCL_STRLEN); - } else { - variableObjPtr = Tcl_NewUnicodeObj(utilString, TCL_STRLEN); - } - - 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 @@ -852,7 +765,7 @@ DdeServerProc( */ Tcl_Obj *returnPackagePtr; - char *string; + Tcl_UniChar *uniStr; for (convPtr = tsdPtr->currentConversations; (convPtr != NULL) && (convPtr->hConv != hConv); convPtr = convPtr->nextPtr) { @@ -865,22 +778,21 @@ DdeServerProc( return (HDDEDATA) DDE_FNOTPROCESSED; } - utilString = (TCHAR *) DdeAccessData(hData, &dlen); - string = (char *) utilString; + utilString = (char *) DdeAccessData(hData, &dlen); + uniStr = (Tcl_UniChar *) utilString; if (!dlen) { /* Empty binary array. */ ddeObjectPtr = Tcl_NewObj(); - } else if ((dlen & 1) || utilString[(dlen>>1)-1]) { + } else if ((dlen & 1) || uniStr[(dlen>>1)-1]) { /* Cannot be unicode, so assume utf-8 */ - if (!string[dlen-1]) { + if (!utilString[dlen-1]) { dlen--; } - ddeObjectPtr = Tcl_NewStringObj(string, dlen); + ddeObjectPtr = Tcl_NewStringObj(utilString, dlen); } else { /* unicode */ dlen >>= 1; - ddeObjectPtr = Tcl_NewUnicodeObj((Tcl_UniChar *) - utilString, dlen - 1); + ddeObjectPtr = Tcl_NewUnicodeObj(uniStr, dlen - 1); } Tcl_IncrRefCount(ddeObjectPtr); DdeUnaccessData(hData); @@ -933,9 +845,9 @@ DdeServerProc( for (i = 0, riPtr = tsdPtr->interpListPtr; i < numItems; i++, riPtr = riPtr->nextPtr) { returnPtr[i].hszSvc = DdeCreateStringHandle(ddeInstance, - TCL_DDE_SERVICE_NAME, CP_WINUNICODE); + TCL_DDE_SERVICE_NAME, CP_WINANSI); returnPtr[i].hszTopic = DdeCreateStringHandle(ddeInstance, - riPtr->name, CP_WINUNICODE); + riPtr->name, CP_WINANSI); } returnPtr[i].hszSvc = NULL; returnPtr[i].hszTopic = NULL; @@ -993,15 +905,14 @@ DdeExitProc( static int MakeDdeConnection( Tcl_Interp *interp, /* Used to report errors. */ - const TCHAR *name, /* The connection to use. */ + const char *name, /* The connection to use. */ HCONV *ddeConvPtr) { HSZ ddeTopic, ddeService; HCONV ddeConv; - ddeService = DdeCreateStringHandle(ddeInstance, TCL_DDE_SERVICE_NAME, - CP_WINUNICODE); - ddeTopic = DdeCreateStringHandle(ddeInstance, name, CP_WINUNICODE); + ddeService = DdeCreateStringHandle(ddeInstance, TCL_DDE_SERVICE_NAME, 0); + ddeTopic = DdeCreateStringHandle(ddeInstance, name, 0); ddeConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL); DdeFreeStringHandle(ddeInstance, ddeService); @@ -1009,14 +920,8 @@ MakeDdeConnection( if (ddeConv == (HCONV) NULL) { if (interp != NULL) { - Tcl_DString dString; - - Tcl_WinTCharToUtf(name, TCL_STRLEN, &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); + Tcl_AppendResult(interp, "no registered server named \"", + name, "\"", NULL); } return TCL_ERROR; } @@ -1050,8 +955,8 @@ DdeCreateClient( struct DdeEnumServices *es) { WNDCLASSEX wc; - static const TCHAR *szDdeClientClassName = TEXT("TclEval client class"); - static const TCHAR *szDdeClientWindowName = TEXT("TclEval client window"); + static const char *szDdeClientClassName = "TclEval client class"; + static const char *szDdeClientWindowName = "TclEval client window"; memset(&wc, 0, sizeof(wc)); wc.cbSize = sizeof(wc); @@ -1106,8 +1011,7 @@ DdeServicesOnAck( ATOM service = (ATOM)LOWORD(lParam); ATOM topic = (ATOM)HIWORD(lParam); struct DdeEnumServices *es; - TCHAR sz[255]; - Tcl_DString dString; + char sz[255]; #ifdef _WIN64 es = (struct DdeEnumServices *) GetWindowLongPtr(hwnd, GWLP_USERDATA); @@ -1121,15 +1025,9 @@ DdeServicesOnAck( Tcl_Obj *resultPtr = Tcl_GetObjResult(es->interp); GlobalGetAtomName(service, sz, 255); - Tcl_WinTCharToUtf(sz, TCL_STRLEN, &dString); - Tcl_ListObjAppendElement(NULL, matchPtr, Tcl_NewStringObj( - Tcl_DStringValue(&dString), TCL_STRLEN)); - Tcl_DStringFree(&dString); + Tcl_ListObjAppendElement(NULL, matchPtr, Tcl_NewStringObj(sz, -1)); GlobalGetAtomName(topic, sz, 255); - Tcl_WinTCharToUtf(sz, TCL_STRLEN, &dString); - Tcl_ListObjAppendElement(NULL, matchPtr, Tcl_NewStringObj( - Tcl_DStringValue(&dString), TCL_STRLEN)); - Tcl_DStringFree(&dString); + Tcl_ListObjAppendElement(NULL, matchPtr, Tcl_NewStringObj(sz, -1)); /* * Adding the hwnd as a third list element provides a unique @@ -1176,8 +1074,8 @@ DdeEnumWindowsCallback( static int DdeGetServicesList( Tcl_Interp *interp, - const TCHAR *serviceName, - const TCHAR *topicName) + const char *serviceName, + const char *topicName) { struct DdeEnumServices es; @@ -1224,30 +1122,25 @@ static void SetDdeError( Tcl_Interp *interp) /* The interp to put the message in. */ { - const char *errorMessage, *errorCode; + const char *errorMessage; switch (DdeGetLastError(ddeInstance)) { case DMLERR_DATAACKTIMEOUT: case DMLERR_EXECACKTIMEOUT: case DMLERR_POKEACKTIMEOUT: errorMessage = "remote interpreter did not respond"; - errorCode = "TIMEOUT"; break; case DMLERR_BUSY: errorMessage = "remote server is busy"; - errorCode = "BUSY"; break; case DMLERR_NOTPROCESSED: errorMessage = "remote server cannot handle this command"; - errorCode = "NOCANDO"; break; default: errorMessage = "dde command failed"; - errorCode = "FAILED"; } - Tcl_SetObjResult(interp, Tcl_NewStringObj(errorMessage, TCL_STRLEN)); - Tcl_SetErrorCode(interp, "TCL", "DDE", errorCode, NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj(errorMessage, -1)); } /* @@ -1271,43 +1164,35 @@ static int DdeObjCmd( ClientData clientData, /* Used only for deletion */ Tcl_Interp *interp, /* The interp we are sending from */ - size_t objc, /* Number of arguments */ + int objc, /* Number of arguments */ Tcl_Obj *const *objv) /* The arguments */ { - static const char *const ddeCommands[] = { + static const char *ddeCommands[] = { "servername", "execute", "poke", "request", "services", "eval", (char *) NULL}; enum DdeSubcommands { DDE_SERVERNAME, DDE_EXECUTE, DDE_POKE, DDE_REQUEST, DDE_SERVICES, DDE_EVAL }; - static const char *const ddeSrvOptions[] = { + static const char *ddeSrvOptions[] = { "-force", "-handler", "--", NULL }; enum DdeSrvOptions { DDE_SERVERNAME_EXACT, DDE_SERVERNAME_HANDLER, DDE_SERVERNAME_LAST, }; - static const char *const ddeExecOptions[] = { - "-async", "-binary", NULL - }; - enum DdeExecOptions { - DDE_EXEC_ASYNC, DDE_EXEC_BINARY - }; - static const char *const ddeEvalOptions[] = { + static const char *ddeExecOptions[] = { "-async", NULL }; - static const char *const ddeReqOptions[] = { + static const char *ddeReqOptions[] = { "-binary", NULL }; - size_t i, length; - int index, argIndex; + int index, i, length, argIndex; int flags = 0, result = TCL_OK, firstArg = 0; HSZ ddeService = NULL, ddeTopic = NULL, ddeItem = NULL, ddeCookie = NULL; HDDEDATA ddeData = NULL, ddeItemData = NULL, ddeReturn; HCONV hConv = NULL; - const TCHAR *serviceName = NULL, *topicName = NULL; - const char *string; + const char *serviceName = NULL, *topicName = NULL, *string; DWORD ddeResult; Tcl_Obj *objPtr, *handlerPtr = NULL; @@ -1374,53 +1259,38 @@ DdeObjCmd( if (objc == 5) { firstArg = 2; break; - } else if (objc >= 6 && objc <= 7) { - firstArg = objc - 3; - for (i = 2; i < firstArg; i++) { - if (Tcl_GetIndexFromObj(interp, objv[i], ddeExecOptions, - "option", 0, &argIndex) != TCL_OK) { - goto wrongDdeExecuteArgs; - } - if (argIndex == DDE_EXEC_ASYNC) { - flags |= DDE_FLAG_ASYNC; - } else { - flags |= DDE_FLAG_BINARY; - } + } else if (objc == 6) { + if (Tcl_GetIndexFromObj(NULL, objv[2], ddeExecOptions, "option", 0, + &argIndex) == TCL_OK) { + flags |= DDE_FLAG_ASYNC; + firstArg = 3; + break; } - break; } /* otherwise... */ - wrongDdeExecuteArgs: Tcl_WrongNumArgs(interp, 2, objv, - "?-async? ?-binary? serviceName topicName value"); + "?-async? serviceName topicName value"); return TCL_ERROR; case DDE_POKE: - if (objc == 6) { - firstArg = 2; - break; - } else if ((objc == 7) && (Tcl_GetIndexFromObj(NULL, objv[2], - ddeReqOptions, "option", 0, &argIndex) == TCL_OK)) { - flags |= DDE_FLAG_BINARY; - firstArg = 3; - break; + if (objc != 6) { + Tcl_WrongNumArgs(interp, 2, objv, + "serviceName topicName item value"); + return TCL_ERROR; } - - /* - * Otherwise... - */ - - Tcl_WrongNumArgs(interp, 2, objv, - "?-binary? serviceName topicName item value"); - return TCL_ERROR; + firstArg = 2; + break; case DDE_REQUEST: if (objc == 5) { firstArg = 2; break; - } else if ((objc == 6) && (Tcl_GetIndexFromObj(NULL, objv[2], - ddeReqOptions, "option", 0, &argIndex) == TCL_OK)) { - flags |= DDE_FLAG_BINARY; - firstArg = 3; - break; + } else if (objc == 6) { + int dummy; + if (Tcl_GetIndexFromObj(NULL, objv[2], ddeReqOptions, "option", 0, + &dummy) == TCL_OK) { + flags |= DDE_FLAG_BINARY; + firstArg = 3; + break; + } } /* @@ -1444,7 +1314,7 @@ DdeObjCmd( return TCL_ERROR; } else { firstArg = 2; - if (Tcl_GetIndexFromObj(NULL, objv[2], ddeEvalOptions, "option", + if (Tcl_GetIndexFromObj(NULL, objv[2], ddeExecOptions, "option", 0, &argIndex) == TCL_OK) { if (objc < 5) { goto wrongDdeEvalArgs; @@ -1459,11 +1329,7 @@ DdeObjCmd( Initialize(); if (firstArg != 1) { -#ifdef UNICODE - serviceName = Tcl_GetUnicodeFromObj(objv[firstArg], &length); -#else serviceName = Tcl_GetStringFromObj(objv[firstArg], &length); -#endif } else { length = 0; } @@ -1472,21 +1338,16 @@ DdeObjCmd( serviceName = NULL; } else if ((index != DDE_SERVERNAME) && (index != DDE_EVAL)) { ddeService = DdeCreateStringHandle(ddeInstance, (void *) serviceName, - CP_WINUNICODE); + CP_WINANSI); } 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, (void *) topicName, - CP_WINUNICODE); + CP_WINANSI); } } @@ -1495,13 +1356,7 @@ DdeObjCmd( serviceName = DdeSetServerName(interp, serviceName, flags, handlerPtr); if (serviceName != NULL) { -#ifdef UNICODE - Tcl_SetObjResult(interp, Tcl_NewUnicodeObj((Tcl_UniChar *) - serviceName, TCL_STRLEN)); -#else - Tcl_SetObjResult(interp, Tcl_NewStringObj( - serviceName, TCL_STRLEN)); -#endif + Tcl_SetObjResult(interp, Tcl_NewStringObj(serviceName, -1)); } else { Tcl_ResetResult(interp); } @@ -1509,21 +1364,12 @@ DdeObjCmd( case DDE_EXECUTE: { int dataLength; - const Tcl_UniChar *dataString; + BYTE *dataString = (BYTE *) Tcl_GetStringFromObj( + objv[firstArg + 2], &dataLength); - 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) { + if (dataLength == 0) { Tcl_SetObjResult(interp, - Tcl_NewStringObj("cannot execute null data", TCL_STRLEN)); - Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", NULL); + Tcl_NewStringObj("cannot execute null data", -1)); result = TCL_ERROR; break; } @@ -1537,20 +1383,16 @@ DdeObjCmd( break; } - ddeData = DdeCreateDataHandle(ddeInstance, (BYTE *) dataString, - (DWORD) dataLength, 0, 0, - (flags & DDE_FLAG_BINARY) ? CF_TEXT : CF_UNICODETEXT, 0); + ddeData = DdeCreateDataHandle(ddeInstance, dataString, + (DWORD) dataLength+1, 0, 0, CF_TEXT, 0); if (ddeData != NULL) { if (flags & DDE_FLAG_ASYNC) { DdeClientTransaction((LPBYTE) ddeData, 0xFFFFFFFF, hConv, 0, - (flags & DDE_FLAG_BINARY) ? CF_TEXT : CF_UNICODETEXT, - XTYP_EXECUTE, TIMEOUT_ASYNC, &ddeResult); + CF_TEXT, XTYP_EXECUTE, TIMEOUT_ASYNC, &ddeResult); DdeAbandonTransaction(ddeInstance, hConv, ddeResult); } else { - ddeReturn = DdeClientTransaction((LPBYTE) ddeData, - 0xFFFFFFFF, hConv, 0, - (flags & DDE_FLAG_BINARY) ? CF_TEXT : CF_UNICODETEXT, - XTYP_EXECUTE, 30000, NULL); + ddeReturn = DdeClientTransaction((LPBYTE) ddeData, 0xFFFFFFFF, + hConv, 0, CF_TEXT, XTYP_EXECUTE, 30000, NULL); if (ddeReturn == 0) { SetDdeError(interp); result = TCL_ERROR; @@ -1564,18 +1406,12 @@ DdeObjCmd( break; } case DDE_REQUEST: { -#ifdef UNICODE - const TCHAR *itemString = (TCHAR *) - Tcl_GetUnicodeFromObj(objv[firstArg + 2], &length); -#else - const TCHAR *itemString = Tcl_GetStringFromObj(objv[firstArg + 2], + const char *itemString = Tcl_GetStringFromObj(objv[firstArg + 2], &length); -#endif if (length == 0) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "cannot request value of null data", TCL_STRLEN)); - Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", NULL); + Tcl_SetObjResult(interp, + Tcl_NewStringObj("cannot request value of null data", -1)); result = TCL_ERROR; goto cleanup; } @@ -1588,30 +1424,27 @@ DdeObjCmd( result = TCL_ERROR; } else { Tcl_Obj *returnObjPtr; - ddeItem = DdeCreateStringHandle(ddeInstance, (void *) itemString, - CP_WINUNICODE); + ddeItem = DdeCreateStringHandle(ddeInstance, (void *)itemString, + CP_WINANSI); if (ddeItem != NULL) { ddeData = DdeClientTransaction(NULL, 0, hConv, ddeItem, - (flags & DDE_FLAG_BINARY) ? CF_TEXT : CF_UNICODETEXT, - XTYP_REQUEST, 5000, NULL); + CF_TEXT, XTYP_REQUEST, 5000, NULL); if (ddeData == NULL) { SetDdeError(interp); result = TCL_ERROR; } else { DWORD tmp; - const Tcl_UniChar *dataString = (const Tcl_UniChar *) - DdeAccessData(ddeData, &tmp); + const char *dataString = (const char *) DdeAccessData(ddeData, &tmp); if (flags & DDE_FLAG_BINARY) { - returnObjPtr = Tcl_NewByteArrayObj((BYTE *) - dataString, (int) tmp); + returnObjPtr = + Tcl_NewByteArrayObj((BYTE *) dataString, (int) tmp); } else { - tmp >>= 1; if (tmp && !dataString[tmp-1]) { --tmp; } - returnObjPtr = Tcl_NewUnicodeObj(dataString, - (size_t) tmp); + returnObjPtr = Tcl_NewStringObj(dataString, + (int) tmp); } DdeUnaccessData(ddeData); DdeFreeDataHandle(ddeData); @@ -1626,30 +1459,18 @@ DdeObjCmd( break; } case DDE_POKE: { -#ifdef UNICODE - const TCHAR *itemString = (TCHAR *) - Tcl_GetUnicodeFromObj(objv[firstArg + 2], &length); -#else - const TCHAR *itemString = Tcl_GetStringFromObj(objv[firstArg + 2], + const char *itemString = Tcl_GetStringFromObj(objv[firstArg + 2], &length); -#endif BYTE *dataString; if (length == 0) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "cannot have a null item", TCL_STRLEN)); - Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", NULL); + Tcl_SetObjResult(interp, + Tcl_NewStringObj("cannot have a null item", -1)); result = TCL_ERROR; goto cleanup; } - 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; - } + dataString = (BYTE *) Tcl_GetStringFromObj(objv[firstArg + 3], + &length); hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL); DdeFreeStringHandle(ddeInstance, ddeService); @@ -1660,12 +1481,10 @@ DdeObjCmd( result = TCL_ERROR; } else { ddeItem = DdeCreateStringHandle(ddeInstance, (void *) itemString, - CP_WINUNICODE); + CP_WINANSI); if (ddeItem != NULL) { - ddeData = DdeClientTransaction(dataString, - (DWORD) length, hConv, ddeItem, - (flags & DDE_FLAG_BINARY) ? CF_TEXT : CF_UNICODETEXT, - XTYP_POKE, 5000, NULL); + ddeData = DdeClientTransaction(dataString, (DWORD) length+1, + hConv, ddeItem, CF_TEXT, XTYP_POKE, 5000, NULL); if (ddeData == NULL) { SetDdeError(interp); result = TCL_ERROR; @@ -1687,9 +1506,8 @@ DdeObjCmd( ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); if (serviceName == NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "invalid service name \"\"", TCL_STRLEN)); - Tcl_SetErrorCode(interp, "TCL", "DDE", "NO_SERVER", NULL); + Tcl_SetObjResult(interp, + Tcl_NewStringObj("invalid service name \"\"", -1)); result = TCL_ERROR; goto cleanup; } @@ -1708,7 +1526,7 @@ DdeObjCmd( for (riPtr = tsdPtr->interpListPtr; riPtr != NULL; riPtr = riPtr->nextPtr) { - if (_tcsicmp(serviceName, riPtr->name) == 0) { + if (stricmp(serviceName, riPtr->name) == 0) { break; } } @@ -1721,9 +1539,9 @@ DdeObjCmd( * server. */ - Tcl_Preserve(riPtr); + Tcl_Preserve((ClientData) riPtr); sendInterp = riPtr->interp; - Tcl_Preserve(sendInterp); + Tcl_Preserve((ClientData) sendInterp); /* * Don't exchange objects between interps. The target interp would @@ -1734,11 +1552,9 @@ DdeObjCmd( */ if (Tcl_IsSafe(riPtr->interp) && riPtr->handlerPtr == NULL) { - Tcl_SetObjResult(riPtr->interp, Tcl_NewStringObj( - "permission denied: a handler procedure must be" - " defined for use in a safe interp", TCL_STRLEN)); - Tcl_SetErrorCode(interp, "TCL", "DDE", "SECURITY_CHECK", - NULL); + Tcl_SetResult(riPtr->interp, "permission denied: " + "a handler procedure must be defined for use in " + "a safe interp", TCL_STATIC); result = TCL_ERROR; } @@ -1755,7 +1571,6 @@ DdeObjCmd( * &(riPtr->handlerPtr)); */ Tcl_Obj *cmdPtr = Tcl_DuplicateObj(riPtr->handlerPtr); - result = Tcl_ListObjAppendElement(sendInterp, cmdPtr, objPtr); if (result == TCL_OK) { @@ -1791,8 +1606,8 @@ DdeObjCmd( } Tcl_SetObjResult(interp, Tcl_GetObjResult(sendInterp)); } - Tcl_Release(riPtr); - Tcl_Release(sendInterp); + Tcl_Release((ClientData) riPtr); + Tcl_Release((ClientData) sendInterp); } else { /* * This is a non-local request. Send the script to the server and @@ -1801,32 +1616,32 @@ DdeObjCmd( if (MakeDdeConnection(interp, serviceName, &hConv) != TCL_OK) { invalidServerResponse: - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "invalid data returned from server", TCL_STRLEN)); - Tcl_SetErrorCode(interp, "TCL", "DDE", "BAD_RESPONSE", NULL); + Tcl_SetObjResult(interp, + Tcl_NewStringObj("invalid data returned from server", + -1)); result = TCL_ERROR; goto cleanup; } objPtr = Tcl_ConcatObj(objc, objv); - string = (const char *) Tcl_GetUnicodeFromObj(objPtr, &length); - ddeItemData = DdeCreateDataHandle(ddeInstance, (BYTE *) string, - (DWORD) 2*length+2, 0, 0, CF_UNICODETEXT, 0); + string = Tcl_GetStringFromObj(objPtr, &length); + ddeItemData = DdeCreateDataHandle(ddeInstance, + (BYTE *) string, (DWORD) length+1, 0, 0, CF_TEXT, 0); if (flags & DDE_FLAG_ASYNC) { ddeData = DdeClientTransaction((LPBYTE) ddeItemData, - 0xFFFFFFFF, hConv, 0, CF_UNICODETEXT, XTYP_EXECUTE, - TIMEOUT_ASYNC, &ddeResult); + 0xFFFFFFFF, hConv, 0, + CF_TEXT, XTYP_EXECUTE, TIMEOUT_ASYNC, &ddeResult); DdeAbandonTransaction(ddeInstance, hConv, ddeResult); } else { ddeData = DdeClientTransaction((LPBYTE) ddeItemData, 0xFFFFFFFF, hConv, 0, - CF_UNICODETEXT, XTYP_EXECUTE, 30000, NULL); + CF_TEXT, XTYP_EXECUTE, 30000, NULL); if (ddeData != 0) { ddeCookie = DdeCreateStringHandle(ddeInstance, - TCL_DDE_EXECUTE_RESULT, CP_WINUNICODE); + TCL_DDE_EXECUTE_RESULT, CP_WINANSI); ddeData = DdeClientTransaction(NULL, 0, hConv, ddeCookie, - CF_UNICODETEXT, XTYP_REQUEST, 30000, NULL); + CF_TEXT, XTYP_REQUEST, 30000, NULL); } } @@ -1835,12 +1650,10 @@ DdeObjCmd( if (ddeData == 0) { SetDdeError(interp); result = TCL_ERROR; - goto cleanup; } if (!(flags & DDE_FLAG_ASYNC)) { Tcl_Obj *resultPtr; - Tcl_UniChar *ddeDataString; /* * The return handle has a two or four element list in it. The @@ -1853,11 +1666,10 @@ DdeObjCmd( resultPtr = Tcl_NewObj(); length = DdeGetData(ddeData, NULL, 0, 0); - ddeDataString = ckalloc(length); - DdeGetData(ddeData, (BYTE *) ddeDataString, (DWORD) length, 0); - length = (length >> 1) - 1; - resultPtr = Tcl_NewUnicodeObj(ddeDataString, length); - ckfree(ddeDataString); + Tcl_SetObjLength(resultPtr, length); + string = Tcl_GetString(resultPtr); + DdeGetData(ddeData, (BYTE *) string, (DWORD) length, 0); + Tcl_SetObjLength(resultPtr, (int) strlen(string)); if (Tcl_ListObjIndex(NULL, resultPtr, 0, &objPtr) != TCL_OK) { Tcl_DecrRefCount(resultPtr); @@ -1875,7 +1687,7 @@ DdeObjCmd( Tcl_DecrRefCount(resultPtr); goto invalidServerResponse; } - length = 0; /* Stop warning message */ + length = -1; string = Tcl_GetStringFromObj(objPtr, &length); Tcl_AddObjErrorInfo(interp, string, length); diff --git a/win/tclWinError.c b/win/tclWinError.c index 49eeed3..a74d2e2 100644 --- a/win/tclWinError.c +++ b/win/tclWinError.c @@ -11,11 +11,13 @@ */ #include "tclInt.h" +#include "tclPort.h" + /* * The following table contains the mapping from Win32 errors to errno errors. */ -static const unsigned char errorTable[] = { +static CONST unsigned char errorTable[] = { 0, EINVAL, /* ERROR_INVALID_FUNCTION 1 */ ENOENT, /* ERROR_FILE_NOT_FOUND 2 */ @@ -291,8 +293,8 @@ static const unsigned char errorTable[] = { * errno errors. */ -static const unsigned char wsaErrorTable[] = { - EAGAIN, /* WSAEWOULDBLOCK */ +static CONST int wsaErrorTable[] = { + EWOULDBLOCK, /* WSAEWOULDBLOCK */ EINPROGRESS, /* WSAEINPROGRESS */ EALREADY, /* WSAEALREADY */ ENOTSOCK, /* WSAENOTSOCK */ @@ -362,62 +364,39 @@ TclWinConvertError( Tcl_SetErrno(errorTable[errCode]); } } - -#ifdef __CYGWIN__ + /* *---------------------------------------------------------------------- * - * tclWinDebugPanic -- + * TclWinConvertWSAError -- * - * Display a message. If a debugger is present, present it directly to - * the debugger, otherwise send it to stderr. + * This routine converts a WinSock error into an errno value. * * Results: * None. * * Side effects: - * None. + * Sets the errno global variable. * *---------------------------------------------------------------------- */ void -tclWinDebugPanic( - const char *format, ...) +TclWinConvertWSAError( + DWORD errCode) /* Win32 error code. */ { -#define TCL_MAX_WARN_LEN 1024 - va_list argList; - va_start(argList, format); - - if (IsDebuggerPresent()) { - WCHAR msgString[TCL_MAX_WARN_LEN]; - char buf[TCL_MAX_WARN_LEN * 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)); + if (errCode >= sizeof(errorTable)/sizeof(errorTable[0])) { + errCode -= WSAEWOULDBLOCK; + if (errCode >= sizeof(wsaErrorTable)/sizeof(wsaErrorTable[0])) { + Tcl_SetErrno(errorTable[1]); + } else { + Tcl_SetErrno(wsaErrorTable[errCode]); } - OutputDebugStringW(msgString); } else { - vfprintf(stderr, format, argList); - fprintf(stderr, "\n"); - fflush(stderr); + Tcl_SetErrno(errorTable[errCode]); } -# if defined(__GNUC__) - __builtin_trap(); -# else - DebugBreak(); -# endif - abort(); } -#endif + /* * Local Variables: * mode: c diff --git a/win/tclWinFCmd.c b/win/tclWinFCmd.c index aa169ed..441337e 100644 --- a/win/tclWinFCmd.c +++ b/win/tclWinFCmd.c @@ -54,12 +54,12 @@ static const int attributeArray[] = {FILE_ATTRIBUTE_ARCHIVE, FILE_ATTRIBUTE_HIDD 0, FILE_ATTRIBUTE_READONLY, 0, FILE_ATTRIBUTE_SYSTEM}; -const char *const tclpFileAttrStrings[] = { +CONST char *tclpFileAttrStrings[] = { "-archive", "-hidden", "-longname", "-readonly", "-shortname", "-system", (char *) NULL }; -const TclFileAttrProcs tclpFileAttrProcs[] = { +CONST TclFileAttrProcs tclpFileAttrProcs[] = { {GetWinFileAttributes, SetWinFileAttributes}, {GetWinFileAttributes, SetWinFileAttributes}, {GetWinFileLongName, CannotSetAttribute}, @@ -67,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); /* @@ -101,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, @@ -170,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). */ { #if defined(HAVE_NO_SEH) && !defined(_WIN64) - EXCEPTION_REGISTRATION registration; + TCLEXCEPTION_REGISTRATION registration; #endif DWORD srcAttr, dstAttr; int retval = -1; @@ -213,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. */ @@ -227,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" @@ -242,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. */ @@ -251,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" @@ -260,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" @@ -275,7 +256,7 @@ DoRenameFile( [registration] "m" (registration), [nativeDst] "m" (nativeDst), [nativeSrc] "m" (nativeSrc), - [moveFile] "r" (MoveFile) + [moveFile] "r" (tclWinProcs->moveFileProc) : "%eax", "%ebx", "%ecx", "%edx", "memory" ); @@ -286,7 +267,7 @@ DoRenameFile( #ifndef HAVE_NO_SEH __try { #endif - if ((*MoveFile)(nativeSrc, nativeDst) != FALSE) { + if ((*tclWinProcs->moveFileProc)(nativeSrc, nativeDst) != FALSE) { retval = TCL_OK; } #ifndef HAVE_NO_SEH @@ -300,10 +281,10 @@ DoRenameFile( TclWinConvertError(GetLastError()); - srcAttr = GetFileAttributes(nativeSrc); - dstAttr = GetFileAttributes(nativeDst); + srcAttr = (*tclWinProcs->getFileAttributesProc)(nativeSrc); + dstAttr = (*tclWinProcs->getFileAttributesProc)(nativeDst); if (srcAttr == 0xffffffff) { - if (GetFullPathName(nativeSrc, 0, NULL, + if ((*tclWinProcs->getFullPathNameProc)(nativeSrc, 0, NULL, NULL) >= MAX_PATH) { errno = ENAMETOOLONG; return TCL_ERROR; @@ -311,7 +292,7 @@ DoRenameFile( srcAttr = 0; } if (dstAttr == 0xffffffff) { - if (GetFullPathName(nativeDst, 0, NULL, + if ((*tclWinProcs->getFullPathNameProc)(nativeDst, 0, NULL, NULL) >= MAX_PATH) { errno = ENAMETOOLONG; return TCL_ERROR; @@ -327,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; - TCHAR nativeSrcPath[MAX_PATH]; - TCHAR nativeDstPath[MAX_PATH]; + WCHAR nativeSrcPath[MAX_PATH]; + WCHAR nativeDstPath[MAX_PATH]; Tcl_DString srcString, dstString; - const char *src, *dst; + CONST char *src, *dst; - size = GetFullPathName(nativeSrc, MAX_PATH, + size = (*tclWinProcs->getFullPathNameProc)(nativeSrc, MAX_PATH, nativeSrcPath, &nativeSrcRest); if ((size == 0) || (size > MAX_PATH)) { return TCL_ERROR; } - size = GetFullPathName(nativeDst, MAX_PATH, + size = (*tclWinProcs->getFullPathNameProc)(nativeDst, MAX_PATH, nativeDstPath, &nativeDstRest); if ((size == 0) || (size > MAX_PATH)) { return TCL_ERROR; } - CharLower(nativeSrcPath); - CharLower(nativeDstPath); + (*tclWinProcs->charLowerProc)((TCHAR *) nativeSrcPath); + (*tclWinProcs->charLowerProc)((TCHAR *) nativeDstPath); - src = Tcl_WinTCharToUtf(nativeSrcPath, TCL_STRLEN, &srcString); - dst = Tcl_WinTCharToUtf(nativeDstPath, TCL_STRLEN, &dstString); + src = Tcl_WinTCharToUtf((TCHAR *) nativeSrcPath, -1, &srcString); + dst = Tcl_WinTCharToUtf((TCHAR *) nativeDstPath, -1, &dstString); /* * Check whether the destination path is actually inside the @@ -395,8 +376,8 @@ DoRenameFile( Tcl_SetErrno(EXDEV); } - ckfree(srcArgv); - ckfree(dstArgv); + ckfree((char *) srcArgv); + ckfree((char *) dstArgv); } /* @@ -427,7 +408,7 @@ DoRenameFile( * directory back, for completeness. */ - if (MoveFile(nativeSrc, + if ((*tclWinProcs->moveFileProc)(nativeSrc, nativeDst) != FALSE) { return TCL_OK; } @@ -438,8 +419,8 @@ DoRenameFile( */ TclWinConvertError(GetLastError()); - CreateDirectory(nativeDst, NULL); - SetFileAttributes(nativeDst, dstAttr); + (*tclWinProcs->createDirectoryProc)(nativeDst, NULL); + (*tclWinProcs->setFileAttributesProc)(nativeDst, dstAttr); if (Tcl_GetErrno() == EACCES) { /* * Decode the EACCES to a more meaningful error. @@ -466,20 +447,22 @@ DoRenameFile( TCHAR *nativeRest, *nativeTmp, *nativePrefix; int result, size; - TCHAR tempBuf[MAX_PATH]; + WCHAR tempBuf[MAX_PATH]; - size = GetFullPathName(nativeDst, MAX_PATH, + size = (*tclWinProcs->getFullPathNameProc)(nativeDst, MAX_PATH, tempBuf, &nativeRest); if ((size == 0) || (size > MAX_PATH) || (nativeRest == NULL)) { return TCL_ERROR; } nativeTmp = (TCHAR *) tempBuf; - nativeRest[0] = L'\0'; + ((char *) nativeRest)[0] = '\0'; + ((char *) nativeRest)[1] = '\0'; /* In case it's Unicode. */ result = TCL_ERROR; - nativePrefix = (TCHAR *) L"tclr"; - if (GetTempFileName(nativeTmp, nativePrefix, - 0, tempBuf) != 0) { + nativePrefix = (tclWinProcs->useWide) + ? (TCHAR *) L"tclr" : (TCHAR *) "tclr"; + if ((*tclWinProcs->getTempFileNameProc)(nativeTmp, + nativePrefix, 0, tempBuf) != 0) { /* * Strictly speaking, need the following DeleteFile and * MoveFile to be joined as an atomic operation so no @@ -487,16 +470,19 @@ DoRenameFile( * same temp file. */ - nativeTmp = tempBuf; - DeleteFile(nativeTmp); - if (MoveFile(nativeDst, nativeTmp) != FALSE) { - if (MoveFile(nativeSrc, nativeDst) != FALSE) { - SetFileAttributes(nativeTmp, FILE_ATTRIBUTE_NORMAL); - DeleteFile(nativeTmp); + nativeTmp = (TCHAR *) tempBuf; + (*tclWinProcs->deleteFileProc)(nativeTmp); + if ((*tclWinProcs->moveFileProc)(nativeDst, + nativeTmp) != FALSE) { + if ((*tclWinProcs->moveFileProc)(nativeSrc, + nativeDst) != FALSE) { + (*tclWinProcs->setFileAttributesProc)(nativeTmp, + FILE_ATTRIBUTE_NORMAL); + (*tclWinProcs->deleteFileProc)(nativeTmp); return TCL_OK; } else { - DeleteFile(nativeDst); - MoveFile(nativeTmp, nativeDst); + (*tclWinProcs->deleteFileProc)(nativeDst); + (*tclWinProcs->moveFileProc)(nativeTmp, nativeDst); } } @@ -559,11 +545,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). */ { #if defined(HAVE_NO_SEH) && !defined(_WIN64) - EXCEPTION_REGISTRATION registration; + TCLEXCEPTION_REGISTRATION registration; #endif int retval = -1; @@ -600,7 +586,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. */ @@ -614,7 +600,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" @@ -630,7 +616,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. */ @@ -639,7 +625,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" @@ -648,7 +634,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" @@ -663,7 +649,7 @@ DoCopyFile( [registration] "m" (registration), [nativeDst] "m" (nativeDst), [nativeSrc] "m" (nativeSrc), - [copyFile] "r" (CopyFile) + [copyFile] "r" (tclWinProcs->copyFileProc) : "%eax", "%ebx", "%ecx", "%edx", "memory" ); @@ -674,7 +660,7 @@ DoCopyFile( #ifndef HAVE_NO_SEH __try { #endif - if (CopyFile(nativeSrc, nativeDst, 0) != FALSE) { + if ((*tclWinProcs->copyFileProc)(nativeSrc, nativeDst, 0) != FALSE) { retval = TCL_OK; } #ifndef HAVE_NO_SEH @@ -694,8 +680,8 @@ DoCopyFile( if (Tcl_GetErrno() == EACCES) { DWORD srcAttr, dstAttr; - srcAttr = GetFileAttributes(nativeSrc); - dstAttr = GetFileAttributes(nativeDst); + srcAttr = (*tclWinProcs->getFileAttributesProc)(nativeSrc); + dstAttr = (*tclWinProcs->getFileAttributesProc)(nativeDst); if (srcAttr != 0xffffffff) { if (dstAttr == 0xffffffff) { dstAttr = 0; @@ -711,9 +697,9 @@ DoCopyFile( Tcl_SetErrno(EISDIR); } if (dstAttr & FILE_ATTRIBUTE_READONLY) { - SetFileAttributes(nativeDst, + (*tclWinProcs->setFileAttributesProc)(nativeDst, dstAttr & ~((DWORD)FILE_ATTRIBUTE_READONLY)); - if (CopyFile(nativeSrc, nativeDst, + if ((*tclWinProcs->copyFileProc)(nativeSrc, nativeDst, 0) != FALSE) { return TCL_OK; } @@ -724,7 +710,7 @@ DoCopyFile( */ TclWinConvertError(GetLastError()); - SetFileAttributes(nativeDst, dstAttr); + (*tclWinProcs->setFileAttributesProc)(nativeDst, dstAttr); } } } @@ -765,35 +751,34 @@ TclpObjDeleteFile( int TclpDeleteFile( - const void *nativePath) /* Pathname of file to be removed (native). */ + CONST TCHAR *nativePath) /* Pathname of file to be removed (native). */ { DWORD attr; - const TCHAR *path = nativePath; /* * The DeleteFile API acts differently under Win95/98 and NT WRT NULL and * "". Avoid passing these values. */ - if (path == NULL || path[0] == '\0') { + if (nativePath == NULL || nativePath[0] == '\0') { Tcl_SetErrno(ENOENT); return TCL_ERROR; } - if (DeleteFile(path) != FALSE) { + if ((*tclWinProcs->deleteFileProc)(nativePath) != FALSE) { return TCL_OK; } TclWinConvertError(GetLastError()); if (Tcl_GetErrno() == EACCES) { - attr = GetFileAttributes(path); + attr = (*tclWinProcs->getFileAttributesProc)(nativePath); if (attr != 0xffffffff) { if (attr & FILE_ATTRIBUTE_DIRECTORY) { if (attr & FILE_ATTRIBUTE_REPARSE_POINT) { /* * It is a symbolic link - remove it. */ - if (TclWinSymLinkDelete(path, 0) == 0) { + if (TclWinSymLinkDelete(nativePath, 0) == 0) { return TCL_OK; } } @@ -807,21 +792,21 @@ TclpDeleteFile( Tcl_SetErrno(EISDIR); } else if (attr & FILE_ATTRIBUTE_READONLY) { - int res = SetFileAttributes(path, - attr & ~((DWORD) FILE_ATTRIBUTE_READONLY)); + int res = (*tclWinProcs->setFileAttributesProc)(nativePath, + attr & ~((DWORD)FILE_ATTRIBUTE_READONLY)); - if ((res != 0) && - (DeleteFile(path) != FALSE)) { + if ((res != 0) && ((*tclWinProcs->deleteFileProc)(nativePath) + != FALSE)) { return TCL_OK; } TclWinConvertError(GetLastError()); if (res != 0) { - SetFileAttributes(path, attr); + (*tclWinProcs->setFileAttributesProc)(nativePath, attr); } } } } else if (Tcl_GetErrno() == ENOENT) { - attr = GetFileAttributes(path); + attr = (*tclWinProcs->getFileAttributesProc)(nativePath); if (attr != 0xffffffff) { if (attr & FILE_ATTRIBUTE_DIRECTORY) { /* @@ -878,11 +863,11 @@ TclpObjCreateDirectory( static int DoCreateDirectory( - const TCHAR *nativePath) /* Pathname of directory to create (native). */ + CONST TCHAR *nativePath) /* Pathname of directory to create (native). */ { - if (CreateDirectory(nativePath, NULL) == 0) { - DWORD error = GetLastError(); - + DWORD error; + if ((*tclWinProcs->createDirectoryProc)(nativePath, NULL) == 0) { + error = GetLastError(); TclWinConvertError(error); return TCL_ERROR; } @@ -930,8 +915,8 @@ TclpObjCopyDirectory( return TCL_ERROR; } - Tcl_WinUtfToTChar(Tcl_GetString(normSrcPtr), TCL_STRLEN, &srcString); - Tcl_WinUtfToTChar(Tcl_GetString(normDestPtr), TCL_STRLEN, &dstString); + Tcl_WinUtfToTChar(Tcl_GetString(normSrcPtr), -1, &srcString); + Tcl_WinUtfToTChar(Tcl_GetString(normDestPtr), -1, &dstString); ret = TraverseWinTree(TraversalCopy, &srcString, &dstString, &ds); @@ -944,7 +929,7 @@ TclpObjCopyDirectory( } else if (!strcmp(Tcl_DStringValue(&ds), TclGetString(normDestPtr))) { *errorPtr = destPathPtr; } else { - *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), TCL_STRLEN); + *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1); } Tcl_DStringFree(&ds); Tcl_IncrRefCount(*errorPtr); @@ -1003,7 +988,7 @@ TclpObjRemoveDirectory( if (normPtr == NULL) { return TCL_ERROR; } - Tcl_WinUtfToTChar(Tcl_GetString(normPtr), TCL_STRLEN, &native); + Tcl_WinUtfToTChar(Tcl_GetString(normPtr), -1, &native); ret = DoRemoveDirectory(&native, recursive, &ds); Tcl_DStringFree(&native); } else { @@ -1011,12 +996,13 @@ TclpObjRemoveDirectory( } if (ret != TCL_OK) { - if (Tcl_DStringLength(&ds) > 0) { + int len = Tcl_DStringLength(&ds); + if (len > 0) { if (normPtr != NULL && !strcmp(Tcl_DStringValue(&ds), TclGetString(normPtr))) { *errorPtr = pathPtr; } else { - *errorPtr = TclDStringToObj(&ds); + *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1); } Tcl_IncrRefCount(*errorPtr); } @@ -1028,7 +1014,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. */ @@ -1048,7 +1034,7 @@ DoRemoveJustDirectory( goto end; } - attr = GetFileAttributes(nativePath); + attr = (*tclWinProcs->getFileAttributesProc)(nativePath); if (attr & FILE_ATTRIBUTE_REPARSE_POINT) { /* @@ -1062,7 +1048,7 @@ DoRemoveJustDirectory( * Ordinary directory. */ - if (RemoveDirectory(nativePath) != FALSE) { + if ((*tclWinProcs->removeDirectoryProc)(nativePath) != FALSE) { return TCL_OK; } } @@ -1070,7 +1056,7 @@ DoRemoveJustDirectory( TclWinConvertError(GetLastError()); if (Tcl_GetErrno() == EACCES) { - attr = GetFileAttributes(nativePath); + attr = (*tclWinProcs->getFileAttributesProc)(nativePath); if (attr != 0xffffffff) { if ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0) { /* @@ -1094,40 +1080,40 @@ DoRemoveJustDirectory( if (attr & FILE_ATTRIBUTE_READONLY) { attr &= ~FILE_ATTRIBUTE_READONLY; - if (SetFileAttributes(nativePath, + if ((*tclWinProcs->setFileAttributesProc)(nativePath, attr) == FALSE) { goto end; } - if (RemoveDirectory(nativePath) != FALSE) { + if ((*tclWinProcs->removeDirectoryProc)(nativePath) != FALSE) { return TCL_OK; } TclWinConvertError(GetLastError()); - SetFileAttributes(nativePath, + (*tclWinProcs->setFileAttributesProc)(nativePath, attr | FILE_ATTRIBUTE_READONLY); } /* - * Windows 95 reports removing a non-empty directory as + * 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_WINDOWS) { - const char *path, *find; + 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; + path = (CONST char *) nativePath; Tcl_DStringInit(&buffer); len = strlen(path); find = Tcl_DStringAppend(&buffer, path, len); if ((len > 0) && (find[len - 1] != '\\')) { - TclDStringAppendLiteral(&buffer, "\\"); + Tcl_DStringAppend(&buffer, "\\", 1); } - find = TclDStringAppendLiteral(&buffer, "*.*"); + find = Tcl_DStringAppend(&buffer, "*.*", 3); handle = FindFirstFileA(find, &data); if (handle != INVALID_HANDLE_VALUE) { while (1) { @@ -1170,7 +1156,12 @@ DoRemoveJustDirectory( end: if (errorPtr != NULL) { - Tcl_WinTCharToUtf(nativePath, TCL_STRLEN, errorPtr); + char *p; + Tcl_WinTCharToUtf(nativePath, -1, errorPtr); + p = Tcl_DStringValue(errorPtr); + for (; *p; ++p) { + if (*p == '\\') *p = '/'; + } } return TCL_ERROR; @@ -1187,10 +1178,10 @@ DoRemoveDirectory( * filled with UTF-8 name of file causing * error. */ { - int res = DoRemoveJustDirectory((const TCHAR *)Tcl_DStringValue(pathPtr), - recursive, errorPtr); + int res = DoRemoveJustDirectory(Tcl_DStringValue(pathPtr), recursive, + errorPtr); - if ((res == TCL_ERROR) && recursive && (Tcl_GetErrno() == EEXIST)) { + if ((res == TCL_ERROR) && (recursive != 0) && (Tcl_GetErrno() == EEXIST)) { /* * The directory is nonempty, but the recursive flag has been * specified, so we recursively remove all the files in the directory. @@ -1241,7 +1232,7 @@ TraverseWinTree( TCHAR *nativeSource, *nativeTarget, *nativeErrfile; int result, found, sourceLen, targetLen = 0, oldSourceLen, oldTargetLen; HANDLE handle; - WIN32_FIND_DATA data; + WIN32_FIND_DATAT data; nativeErrfile = NULL; result = TCL_OK; @@ -1252,7 +1243,7 @@ TraverseWinTree( (targetPtr == NULL ? NULL : Tcl_DStringValue(targetPtr)); oldSourceLen = Tcl_DStringLength(sourcePtr); - sourceAttr = GetFileAttributes(nativeSource); + sourceAttr = (*tclWinProcs->getFileAttributesProc)(nativeSource); if (sourceAttr == 0xffffffff) { nativeErrfile = nativeSource; goto end; @@ -1263,7 +1254,7 @@ TraverseWinTree( * Process the symbolic link */ - return traverseProc(nativeSource, nativeTarget, DOTREE_LINK, + return (*traverseProc)(nativeSource, nativeTarget, DOTREE_LINK, errorPtr); } @@ -1272,14 +1263,18 @@ TraverseWinTree( * Process the regular file */ - return traverseProc(nativeSource, nativeTarget, DOTREE_F, errorPtr); + return (*traverseProc)(nativeSource, nativeTarget, DOTREE_F, errorPtr); } - Tcl_DStringAppend(sourcePtr, (char *) TEXT("\\*.*"), 4 * sizeof(TCHAR) + 1); - Tcl_DStringSetLength(sourcePtr, Tcl_DStringLength(sourcePtr) - 1); + if (tclWinProcs->useWide) { + Tcl_DStringAppend(sourcePtr, (char *) L"\\*.*", 4 * sizeof(WCHAR) + 1); + Tcl_DStringSetLength(sourcePtr, Tcl_DStringLength(sourcePtr) - 1); + } else { + Tcl_DStringAppend(sourcePtr, "\\*.*", 4); + } nativeSource = (TCHAR *) Tcl_DStringValue(sourcePtr); - handle = FindFirstFile(nativeSource, &data); + handle = (*tclWinProcs->findFirstFileProc)(nativeSource, &data); if (handle == INVALID_HANDLE_VALUE) { /* * Can't read directory. @@ -1290,44 +1285,67 @@ TraverseWinTree( goto end; } - Tcl_DStringSetLength(sourcePtr, oldSourceLen + 1); + nativeSource[oldSourceLen + 1] = '\0'; Tcl_DStringSetLength(sourcePtr, oldSourceLen); - result = traverseProc(nativeSource, nativeTarget, DOTREE_PRED, + result = (*traverseProc)(nativeSource, nativeTarget, DOTREE_PRED, errorPtr); if (result != TCL_OK) { FindClose(handle); return result; } - sourceLen = oldSourceLen + sizeof(TCHAR); - Tcl_DStringAppend(sourcePtr, (char *) TEXT("\\"), sizeof(TCHAR) + 1); - Tcl_DStringSetLength(sourcePtr, sourceLen); + sourceLen = oldSourceLen; + + if (tclWinProcs->useWide) { + sourceLen += sizeof(WCHAR); + Tcl_DStringAppend(sourcePtr, (char *) L"\\", sizeof(WCHAR) + 1); + Tcl_DStringSetLength(sourcePtr, sourceLen); + } else { + sourceLen += 1; + Tcl_DStringAppend(sourcePtr, "\\", 1); + } if (targetPtr != NULL) { oldTargetLen = Tcl_DStringLength(targetPtr); targetLen = oldTargetLen; - targetLen += sizeof(TCHAR); - Tcl_DStringAppend(targetPtr, (char *) TEXT("\\"), sizeof(TCHAR) + 1); - Tcl_DStringSetLength(targetPtr, targetLen); + if (tclWinProcs->useWide) { + targetLen += sizeof(WCHAR); + Tcl_DStringAppend(targetPtr, (char *) L"\\", sizeof(WCHAR) + 1); + Tcl_DStringSetLength(targetPtr, targetLen); + } else { + targetLen += 1; + Tcl_DStringAppend(targetPtr, "\\", 1); + } } found = 1; - for (; found; found = FindNextFile(handle, &data)) { + for (; found; found = (*tclWinProcs->findNextFileProc)(handle, &data)) { TCHAR *nativeName; int len; - TCHAR *wp = data.cFileName; - if (*wp == '.') { - wp++; + if (tclWinProcs->useWide) { + WCHAR *wp; + + wp = data.w.cFileName; if (*wp == '.') { wp++; + if (*wp == '.') { + wp++; + } + if (*wp == '\0') { + continue; + } } - if (*wp == '\0') { + nativeName = (TCHAR *) data.w.cFileName; + len = wcslen(data.w.cFileName) * sizeof(WCHAR); + } else { + if ((strcmp(data.a.cFileName, ".") == 0) + || (strcmp(data.a.cFileName, "..") == 0)) { continue; } + nativeName = (TCHAR *) data.a.cFileName; + len = strlen(data.a.cFileName); } - nativeName = (TCHAR *) data.cFileName; - len = _tcslen(data.cFileName) * sizeof(TCHAR); /* * Append name after slash, and recurse on the file. @@ -1372,8 +1390,8 @@ TraverseWinTree( * files in that directory. */ - result = traverseProc((const TCHAR *)Tcl_DStringValue(sourcePtr), - (const TCHAR *)(targetPtr == NULL ? NULL : Tcl_DStringValue(targetPtr)), + result = (*traverseProc)(Tcl_DStringValue(sourcePtr), + (targetPtr == NULL ? NULL : Tcl_DStringValue(targetPtr)), DOTREE_POSTD, errorPtr); } @@ -1381,7 +1399,7 @@ TraverseWinTree( if (nativeErrfile != NULL) { TclWinConvertError(GetLastError()); if (errorPtr != NULL) { - Tcl_WinTCharToUtf(nativeErrfile, TCL_STRLEN, errorPtr); + Tcl_WinTCharToUtf(nativeErrfile, -1, errorPtr); } result = TCL_ERROR; } @@ -1408,8 +1426,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. */ @@ -1427,9 +1445,9 @@ TraversalCopy( break; case DOTREE_PRED: if (DoCreateDirectory(nativeDst) == TCL_OK) { - DWORD attr = GetFileAttributes(nativeSrc); + DWORD attr = (tclWinProcs->getFileAttributesProc)(nativeSrc); - if (SetFileAttributes(nativeDst, + if ((tclWinProcs->setFileAttributesProc)(nativeDst, attr) != FALSE) { return TCL_OK; } @@ -1446,7 +1464,7 @@ TraversalCopy( */ if (errorPtr != NULL) { - Tcl_WinTCharToUtf(nativeDst, TCL_STRLEN, errorPtr); + Tcl_WinTCharToUtf(nativeDst, -1, errorPtr); } return TCL_ERROR; } @@ -1474,8 +1492,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. */ @@ -1501,7 +1519,7 @@ TraversalDelete( } if (errorPtr != NULL) { - Tcl_WinTCharToUtf(nativeSrc, TCL_STRLEN, errorPtr); + Tcl_WinTCharToUtf(nativeSrc, -1, errorPtr); } return TCL_ERROR; } @@ -1530,8 +1548,8 @@ StatError( * error. */ { TclWinConvertError(GetLastError()); - Tcl_SetObjResult(interp, Tcl_ObjPrintf("could not read \"%s\": %s", - TclGetString(fileName), Tcl_PosixError(interp))); + Tcl_AppendResult(interp, "could not read \"", TclGetString(fileName), + "\": ", Tcl_PosixError(interp), (char *) NULL); } /* @@ -1561,11 +1579,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 = GetFileAttributes(nativeName); + result = (*tclWinProcs->getFileAttributesProc)(nativeName); if (result == 0xffffffff) { StatError(interp, fileName); @@ -1583,7 +1601,7 @@ GetWinFileAttributes( */ int len; - const char *str = Tcl_GetStringFromObj(fileName,&len); + char *str = Tcl_GetStringFromObj(fileName,&len); if (len < 4) { if (len == 0) { @@ -1649,11 +1667,9 @@ ConvertFileNameFormat( if (splitPath == NULL || pathc == 0) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "could not read \"%s\": no such file or directory", - Tcl_GetString(fileName))); - errno = ENOENT; - Tcl_PosixError(interp); + Tcl_AppendResult(interp, "could not read \"", + Tcl_GetString(fileName), "\": no such file or directory", + (char *) NULL); } goto cleanup; } @@ -1694,10 +1710,10 @@ ConvertFileNameFormat( Tcl_Obj *tempPath; Tcl_DString ds; Tcl_DString dsTemp; - const TCHAR *nativeName; - const char *tempString; + TCHAR *nativeName; + char *tempString; int tempLen; - WIN32_FIND_DATA data; + WIN32_FIND_DATAT data; HANDLE handle; DWORD attr; @@ -1713,7 +1729,7 @@ ConvertFileNameFormat( tempString = Tcl_GetStringFromObj(tempPath,&tempLen); nativeName = Tcl_WinUtfToTChar(tempString, tempLen, &ds); Tcl_DecrRefCount(tempPath); - handle = FindFirstFile(nativeName, &data); + handle = (*tclWinProcs->findFirstFileProc)(nativeName, &data); if (handle == INVALID_HANDLE_VALUE) { /* * FindFirstFile() doesn't like root directories. We would @@ -1722,7 +1738,7 @@ ConvertFileNameFormat( * root directory */ - attr = GetFileAttributes(nativeName); + attr = (*tclWinProcs->getFileAttributesProc)(nativeName); if ((attr!=0xFFFFFFFF) && (attr & FILE_ATTRIBUTE_DIRECTORY)) { Tcl_DStringFree(&ds); goto simple; @@ -1736,14 +1752,27 @@ ConvertFileNameFormat( } goto cleanup; } - nativeName = data.cAlternateFileName; - if (longShort) { - if (data.cFileName[0] != '\0') { - nativeName = data.cFileName; + if (tclWinProcs->useWide) { + nativeName = (TCHAR *) data.w.cAlternateFileName; + if (longShort) { + if (data.w.cFileName[0] != '\0') { + nativeName = (TCHAR *) data.w.cFileName; + } + } else { + if (data.w.cAlternateFileName[0] == '\0') { + nativeName = (TCHAR *) data.w.cFileName; + } } } else { - if (data.cAlternateFileName[0] == '\0') { - nativeName = (TCHAR *) data.cFileName; + nativeName = (TCHAR *) data.a.cAlternateFileName; + if (longShort) { + if (data.a.cFileName[0] != '\0') { + nativeName = (TCHAR *) data.a.cFileName; + } + } else { + if (data.a.cAlternateFileName[0] == '\0') { + nativeName = (TCHAR *) data.a.cFileName; + } } } @@ -1760,27 +1789,28 @@ ConvertFileNameFormat( */ Tcl_DStringInit(&dsTemp); - Tcl_WinTCharToUtf(nativeName, TCL_STRLEN, &dsTemp); - Tcl_DStringFree(&ds); + Tcl_WinTCharToUtf(nativeName, -1, &dsTemp); /* * Deal with issues of tildes being absolute. */ if (Tcl_DStringValue(&dsTemp)[0] == '~') { - TclNewLiteralStringObj(tempPath, "./"); + tempPath = Tcl_NewStringObj("./",2); Tcl_AppendToObj(tempPath, Tcl_DStringValue(&dsTemp), Tcl_DStringLength(&dsTemp)); - Tcl_DStringFree(&dsTemp); } else { - tempPath = TclDStringToObj(&dsTemp); + tempPath = Tcl_NewStringObj(Tcl_DStringValue(&dsTemp), + Tcl_DStringLength(&dsTemp)); } Tcl_ListObjReplace(NULL, splitPath, i, 1, 1, &tempPath); + Tcl_DStringFree(&ds); + Tcl_DStringFree(&dsTemp); FindClose(handle); } } - *attributePtrPtr = Tcl_FSJoinPath(splitPath, TCL_STRLEN); + *attributePtrPtr = Tcl_FSJoinPath(splitPath, -1); if (splitPath != NULL) { /* @@ -1888,11 +1918,12 @@ SetWinFileAttributes( Tcl_Obj *attributePtr) /* The new value of the attribute. */ { DWORD fileAttributes; - int yesNo, result; - const TCHAR *nativeName; + int yesNo; + int result; + CONST TCHAR *nativeName; nativeName = Tcl_FSGetNativePath(fileName); - fileAttributes = GetFileAttributes(nativeName); + fileAttributes = (*tclWinProcs->getFileAttributesProc)(nativeName); if (fileAttributes == 0xffffffff) { StatError(interp, fileName); @@ -1910,7 +1941,7 @@ SetWinFileAttributes( fileAttributes &= ~(attributeArray[objIndex]); } - if (!SetFileAttributes(nativeName, fileAttributes)) { + if (!(*tclWinProcs->setFileAttributesProc)(nativeName, fileAttributes)) { StatError(interp, fileName); return TCL_ERROR; } @@ -1941,13 +1972,13 @@ CannotSetAttribute( Tcl_Obj *fileName, /* The name of the file. */ Tcl_Obj *attributePtr) /* The new value of the attribute. */ { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "cannot set attribute \"%s\" for file \"%s\": attribute is readonly", - tclpFileAttrStrings[objIndex], Tcl_GetString(fileName))); - errno = EINVAL; - Tcl_PosixError(interp); + Tcl_AppendResult(interp, "cannot set attribute \"", + tclpFileAttrStrings[objIndex], "\" for file \"", + Tcl_GetString(fileName), "\": attribute is readonly", + (char *) NULL); return TCL_ERROR; } + /* *--------------------------------------------------------------------------- @@ -1965,7 +1996,7 @@ CannotSetAttribute( *--------------------------------------------------------------------------- */ -Tcl_Obj * +Tcl_Obj* TclpObjListVolumes(void) { Tcl_Obj *resultPtr, *elemPtr; @@ -1999,14 +2030,14 @@ TclpObjListVolumes(void) buf[0] = (char) ('a' + i); if (GetVolumeInformationA(buf, NULL, 0, NULL, NULL, NULL, NULL, 0) || (GetLastError() == ERROR_NOT_READY)) { - elemPtr = Tcl_NewStringObj(buf, TCL_STRLEN); + elemPtr = Tcl_NewStringObj(buf, -1); Tcl_ListObjAppendElement(NULL, resultPtr, elemPtr); } } } else { for (p = buf; *p != '\0'; p += 4) { p[2] = '/'; - elemPtr = Tcl_NewStringObj(p, TCL_STRLEN); + elemPtr = Tcl_NewStringObj(p, -1); Tcl_ListObjAppendElement(NULL, resultPtr, elemPtr); } } diff --git a/win/tclWinFile.c b/win/tclWinFile.c index 1fc3549..41de4a8 100644..100755 --- a/win/tclWinFile.c +++ b/win/tclWinFile.c @@ -15,9 +15,9 @@ #include "tclWinInt.h" #include "tclFileSystem.h" #include <winioctl.h> -#include <sys/stat.h> #include <shlobj.h> -#include <lm.h> /* For TclpGetUserHome(). */ +#include <lmaccess.h> /* For TclpGetUserHome(). */ +#include <userenv.h> /* For TclpGetUserHome(). */ /* * The number of 100-ns intervals between the Windows system epoch (1601-01-01 @@ -141,6 +141,28 @@ typedef struct { WCHAR dummyBuf[MAX_PATH * 3]; } DUMMY_REPARSE_BUFFER; +#if defined(_MSC_VER) && (_MSC_VER <= 1100) +#undef HAVE_NO_FINDEX_ENUMS +#define HAVE_NO_FINDEX_ENUMS +#elif !defined(_WIN32_WINNT) || (_WIN32_WINNT < 0x0400) +#undef HAVE_NO_FINDEX_ENUMS +#define HAVE_NO_FINDEX_ENUMS +#endif + +#ifdef HAVE_NO_FINDEX_ENUMS +/* These two aren't in VC++ 5.2 headers */ +typedef enum _FINDEX_INFO_LEVELS { + FindExInfoStandard, + FindExInfoMaxInfoLevel +} FINDEX_INFO_LEVELS; +typedef enum _FINDEX_SEARCH_OPS { + FindExSearchNameMatch, + FindExSearchLimitToDirectories, + FindExSearchLimitToDevices, + FindExSearchMaxSearchOp +} FINDEX_SEARCH_OPS; +#endif /* HAVE_NO_FINDEX_ENUMS */ + /* * Other typedefs required by this code. */ @@ -148,6 +170,18 @@ typedef struct { static time_t ToCTime(FILETIME fileTime); static void FromCTime(time_t posixTime, FILETIME *fileTime); +typedef NET_API_STATUS NET_API_FUNCTION NETUSERGETINFOPROC( + LPWSTR servername, LPWSTR username, DWORD level, LPBYTE *bufptr); + +typedef NET_API_STATUS NET_API_FUNCTION NETAPIBUFFERFREEPROC(LPVOID Buffer); + +typedef NET_API_STATUS NET_API_FUNCTION NETGETDCNAMEPROC( + LPWSTR servername, LPWSTR domainname, LPBYTE *bufptr); + +typedef BOOL WINAPI GETPROFILESDIRECTORYPROC( + LPWSTR lpProfilesDir, LPDWORD lpcchSize +); + /* * Declarations for local functions defined in this file: */ @@ -160,12 +194,12 @@ 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); + 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, size_t nameLen); +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); @@ -173,7 +207,6 @@ 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, ...); /* *-------------------------------------------------------------------- @@ -191,7 +224,7 @@ WinLink( const TCHAR *linkTargetPath, int linkAction) { - TCHAR tempFileName[MAX_PATH]; + WCHAR tempFileName[MAX_PATH]; TCHAR *tempFilePart; DWORD attr; @@ -199,8 +232,8 @@ WinLink( * Get the full path referenced by the target. */ - if (!GetFullPathName(linkTargetPath, MAX_PATH, tempFileName, - &tempFilePart)) { + if (!(*tclWinProcs->getFullPathNameProc)(linkTargetPath, MAX_PATH, + tempFileName, &tempFilePart)) { /* * Invalid file. */ @@ -213,7 +246,7 @@ WinLink( * Make sure source file doesn't exist. */ - attr = GetFileAttributes(linkSourcePath); + attr = (*tclWinProcs->getFileAttributesProc)(linkSourcePath); if (attr != INVALID_FILE_ATTRIBUTES) { Tcl_SetErrno(EEXIST); return -1; @@ -223,8 +256,8 @@ WinLink( * Get the full path referenced by the source file/directory. */ - if (!GetFullPathName(linkSourcePath, MAX_PATH, tempFileName, - &tempFilePart)) { + if (!(*tclWinProcs->getFullPathNameProc)(linkSourcePath, MAX_PATH, + tempFileName, &tempFilePart)) { /* * Invalid file. */ @@ -237,36 +270,43 @@ WinLink( * Check the target. */ - attr = GetFileAttributes(linkTargetPath); + attr = (*tclWinProcs->getFileAttributesProc)(linkTargetPath); if (attr == INVALID_FILE_ATTRIBUTES) { /* * The target doesn't exist. */ TclWinConvertError(GetLastError()); + return -1; + } else if ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0) { /* * It is a file. */ - if (linkAction & TCL_CREATE_HARD_LINK) { - if (CreateHardLink(linkSourcePath, linkTargetPath, NULL)) { - /* - * Success! - */ + if (tclWinProcs->createHardLinkProc == NULL) { + Tcl_SetErrno(ENOTDIR); + return -1; + } - return 0; + if (linkAction & TCL_CREATE_HARD_LINK) { + if (!(*tclWinProcs->createHardLinkProc)(linkSourcePath, + linkTargetPath, NULL)) { + TclWinConvertError(GetLastError()); + return -1; } + return 0; - 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 { /* @@ -283,11 +323,12 @@ WinLink( */ Tcl_SetErrno(EISDIR); + return -1; } else { Tcl_SetErrno(ENODEV); + return -1; } } - return -1; } /* @@ -304,7 +345,7 @@ static Tcl_Obj * WinReadLink( const TCHAR *linkSourcePath) { - TCHAR tempFileName[MAX_PATH]; + WCHAR tempFileName[MAX_PATH]; TCHAR *tempFilePart; DWORD attr; @@ -312,8 +353,8 @@ WinReadLink( * Get the full path referenced by the target. */ - if (!GetFullPathName(linkSourcePath, MAX_PATH, tempFileName, - &tempFilePart)) { + if (!(*tclWinProcs->getFullPathNameProc)(linkSourcePath, MAX_PATH, + tempFileName, &tempFilePart)) { /* * Invalid file. */ @@ -326,7 +367,7 @@ WinReadLink( * Make sure source file does exist. */ - attr = GetFileAttributes(linkSourcePath); + attr = (*tclWinProcs->getFileAttributesProc)(linkSourcePath); if (attr == INVALID_FILE_ATTRIBUTES) { /* * The source doesn't exist. @@ -342,9 +383,9 @@ WinReadLink( Tcl_SetErrno(ENOTDIR); return NULL; + } else { + return WinReadLinkDirectory(linkSourcePath); } - - return WinReadLinkDirectory(linkSourcePath); } /* @@ -444,7 +485,7 @@ TclWinSymLinkCopyDirectory( 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); @@ -483,8 +524,9 @@ TclWinSymLinkDelete( memset(reparseBuffer, 0, sizeof(DUMMY_REPARSE_BUFFER)); reparseBuffer->ReparseTag = IO_REPARSE_TAG_MOUNT_POINT; - hFile = CreateFile(linkOrigPath, GENERIC_WRITE, 0, NULL, OPEN_EXISTING, - FILE_FLAG_OPEN_REPARSE_POINT | FILE_FLAG_BACKUP_SEMANTICS, NULL); + hFile = (*tclWinProcs->createFileProc)(linkOrigPath, GENERIC_WRITE, 0, + NULL, OPEN_EXISTING, + FILE_FLAG_OPEN_REPARSE_POINT|FILE_FLAG_BACKUP_SEMANTICS, NULL); if (hFile != INVALID_HANDLE_VALUE) { if (!DeviceIoControl(hFile, FSCTL_DELETE_REPARSE_POINT, reparseBuffer, @@ -498,7 +540,7 @@ TclWinSymLinkDelete( } else { CloseHandle(hFile); if (!linkOnly) { - RemoveDirectory(linkOrigPath); + (*tclWinProcs->removeDirectoryProc)(linkOrigPath); } return 0; } @@ -538,11 +580,11 @@ WinReadLinkDirectory( Tcl_DString ds; const char *copy; - attr = GetFileAttributes(linkDirPath); + attr = (*tclWinProcs->getFileAttributesProc)(linkDirPath); if (!(attr & FILE_ATTRIBUTE_REPARSE_POINT)) { goto invalidError; } - if (NativeReadReparse(linkDirPath, reparseBuffer)) { + if (NativeReadReparse(linkDirPath, reparseBuffer, 0)) { return NULL; } @@ -563,7 +605,6 @@ WinReadLinkDirectory( */ offset = 0; -#ifdef UNICODE if (reparseBuffer->MountPointReparseBuffer.PathBuffer[0] == L'\\') { /* * Check whether this is a mounted volume. @@ -625,9 +666,8 @@ WinReadLinkDirectory( offset = 4; } } -#endif /* UNICODE */ - Tcl_WinTCharToUtf((const TCHAR *) + Tcl_WinTCharToUtf((const char *) reparseBuffer->MountPointReparseBuffer.PathBuffer, (int) reparseBuffer->MountPointReparseBuffer .SubstituteNameLength, &ds); @@ -663,13 +703,15 @@ WinReadLinkDirectory( static int NativeReadReparse( const TCHAR *linkDirPath, /* The junction to read */ - REPARSE_DATA_BUFFER *buffer)/* Pointer to buffer. Cannot be NULL */ + REPARSE_DATA_BUFFER *buffer,/* Pointer to buffer. Cannot be NULL */ + DWORD desiredAccess) { HANDLE hFile; DWORD returnedLength; - hFile = CreateFile(linkDirPath, GENERIC_READ, 0, NULL, OPEN_EXISTING, - FILE_FLAG_OPEN_REPARSE_POINT | FILE_FLAG_BACKUP_SEMANTICS, NULL); + hFile = (*tclWinProcs->createFileProc)(linkDirPath, desiredAccess, FILE_SHARE_READ, + NULL, OPEN_EXISTING, + FILE_FLAG_OPEN_REPARSE_POINT|FILE_FLAG_BACKUP_SEMANTICS, NULL); if (hFile == INVALID_HANDLE_VALUE) { /* @@ -727,7 +769,7 @@ NativeWriteReparse( * Create the directory - it must not already exist. */ - if (CreateDirectory(linkDirPath, NULL) == 0) { + if ((*tclWinProcs->createDirectoryProc)(linkDirPath, NULL) == 0) { /* * Error creating directory. */ @@ -735,9 +777,9 @@ NativeWriteReparse( TclWinConvertError(GetLastError()); return -1; } - hFile = CreateFile(linkDirPath, GENERIC_WRITE, 0, NULL, - OPEN_EXISTING, FILE_FLAG_OPEN_REPARSE_POINT - | FILE_FLAG_BACKUP_SEMANTICS, NULL); + hFile = (*tclWinProcs->createFileProc)(linkDirPath, GENERIC_WRITE, 0, + NULL, OPEN_EXISTING, + FILE_FLAG_OPEN_REPARSE_POINT|FILE_FLAG_BACKUP_SEMANTICS, NULL); if (hFile == INVALID_HANDLE_VALUE) { /* * Error creating directory. @@ -760,7 +802,7 @@ NativeWriteReparse( TclWinConvertError(GetLastError()); CloseHandle(hFile); - RemoveDirectory(linkDirPath); + (*tclWinProcs->removeDirectoryProc)(linkDirPath); return -1; } CloseHandle(hFile); @@ -773,65 +815,6 @@ NativeWriteReparse( } /* - *---------------------------------------------------------------------- - * - * tclWinDebugPanic -- - * - * Display a message. If a debugger is present, present it directly to - * the debugger, otherwise use a MessageBox. - * - * Results: - * None. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -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 -- @@ -850,35 +833,30 @@ tclWinDebugPanic( void TclpFindExecutable( - const char *argv0) /* If NULL, install PanicMessageBox, otherwise - * ignore. */ + const char *argv0) /* The value of the application's argv[0] + * (native). */ { WCHAR wName[MAX_PATH]; char name[MAX_PATH * TCL_UTF_MAX]; /* * Under Windows we ignore argv0, and return the path for the file used to - * create this process. Only if it is NULL, install a new panic handler. + * create this process. */ - if (argv0 == NULL) { - Tcl_SetPanicProc(tclWinDebugPanic); - } + if (GetModuleFileNameW(NULL, wName, MAX_PATH) == 0) { + GetModuleFileNameA(NULL, name, sizeof(name)); -#ifdef UNICODE - GetModuleFileNameW(NULL, wName, MAX_PATH); -#else - GetModuleFileNameA(NULL, name, sizeof(name)); + /* + * Convert to WCHAR to get out of ANSI codepage + */ - /* - * Convert to WCHAR to get out of ANSI codepage - */ + MultiByteToWideChar(CP_ACP, 0, name, -1, wName, MAX_PATH); + } - MultiByteToWideChar(CP_ACP, 0, name, -1, wName, MAX_PATH); -#endif - WideCharToMultiByte(CP_UTF8, 0, wName, -1, name, sizeof(name), NULL, NULL); + WideCharToMultiByte(CP_UTF8, 0, wName, -1, name, sizeof(name), NULL,NULL); TclWinNoBackslash(name); - TclSetObjNameOfExecutable(Tcl_NewStringObj(name, TCL_STRLEN), NULL); + TclSetObjNameOfExecutable(Tcl_NewStringObj(name, -1), NULL); } /* @@ -922,24 +900,30 @@ TclpMatchInDirectory( if (pattern == NULL || (*pattern == '\0')) { Tcl_Obj *norm = Tcl_FSGetNormalizedPath(NULL, pathPtr); - if (norm != NULL) { /* * Match a single file directly. */ - size_t len; + int len; DWORD attr; - WIN32_FILE_ATTRIBUTE_DATA data; - const char *str = Tcl_GetStringFromObj(norm, &len); + const char *str = Tcl_GetStringFromObj(norm,&len); - native = Tcl_FSGetNativePath(pathPtr); + native = (const TCHAR *) Tcl_FSGetNativePath(pathPtr); - if (GetFileAttributesEx(native, - GetFileExInfoStandard, &data) != TRUE) { - return TCL_OK; + if (tclWinProcs->getFileAttributesExProc == NULL) { + attr = (*tclWinProcs->getFileAttributesProc)(native); + if (attr == 0xffffffff) { + return TCL_OK; + } + } else { + WIN32_FILE_ATTRIBUTE_DATA data; + if ((*tclWinProcs->getFileAttributesExProc)(native, + GetFileExInfoStandard, &data) != TRUE) { + return TCL_OK; + } + attr = data.dwFileAttributes; } - attr = data.dwFileAttributes; if (NativeMatchType(WinIsDrive(str,len), attr, native, types)) { Tcl_ListObjAppendElement(interp, resultPtr, pathPtr); @@ -949,7 +933,7 @@ TclpMatchInDirectory( } else { DWORD attr; HANDLE handle; - WIN32_FIND_DATA data; + WIN32_FIND_DATAT data; const char *dirName; /* UTF-8 dir name, later with pattern * appended. */ int dirLength; @@ -978,10 +962,9 @@ TclpMatchInDirectory( if (native == NULL) { return TCL_OK; } - attr = GetFileAttributes(native); + attr = (*tclWinProcs->getFileAttributesProc)(native); - if ((attr == INVALID_FILE_ATTRIBUTES) - || ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0)) { + if ((attr == 0xffffffff) || ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0)) { return TCL_OK; } @@ -996,7 +979,7 @@ TclpMatchInDirectory( lastChar = dirName[dirLength -1]; if ((lastChar != '\\') && (lastChar != '/') && (lastChar != ':')) { - TclDStringAppendLiteral(&dsOrig, "/"); + Tcl_DStringAppend(&dsOrig, "/", 1); dirLength++; } dirName = Tcl_DStringValue(&dsOrig); @@ -1014,27 +997,27 @@ TclpMatchInDirectory( * pattern. */ - dirName = Tcl_DStringAppend(&dsOrig, pattern, TCL_STRLEN); + dirName = Tcl_DStringAppend(&dsOrig, pattern, -1); } else { - dirName = TclDStringAppendLiteral(&dsOrig, "*.*"); + dirName = Tcl_DStringAppend(&dsOrig, "*.*", 3); } - native = Tcl_WinUtfToTChar(dirName, TCL_STRLEN, &ds); - if ((types == NULL) || (types->type != TCL_GLOB_TYPE_DIR)) { - handle = FindFirstFile(native, &data); + native = Tcl_WinUtfToTChar(dirName, -1, &ds); + if (tclWinProcs->findFirstFileExProc == NULL || (types == NULL) + || (types->type != TCL_GLOB_TYPE_DIR)) { + handle = (*tclWinProcs->findFirstFileProc)(native, &data); } else { /* * We can be more efficient, for pure directory requests. */ - handle = FindFirstFileEx(native, + handle = (*tclWinProcs->findFirstFileExProc)(native, FindExInfoStandard, &data, FindExSearchLimitToDirectories, NULL, 0); } if (handle == INVALID_HANDLE_VALUE) { DWORD err = GetLastError(); - Tcl_DStringFree(&ds); if (err == ERROR_FILE_NOT_FOUND) { /* @@ -1048,9 +1031,10 @@ TclpMatchInDirectory( TclWinConvertError(err); if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "couldn't read directory \"%s\": %s", - Tcl_DStringValue(&dsOrig), Tcl_PosixError(interp))); + Tcl_ResetResult(interp); + Tcl_AppendResult(interp, "couldn't read directory \"", + Tcl_DStringValue(&dsOrig), "\": ", + Tcl_PosixError(interp), NULL); } Tcl_DStringFree(&dsOrig); return TCL_ERROR; @@ -1090,9 +1074,15 @@ TclpMatchInDirectory( int checkDrive = 0, isDrive; DWORD attr; - native = data.cFileName; - attr = data.dwFileAttributes; - utfname = Tcl_WinTCharToUtf(native, TCL_STRLEN, &ds); + if (tclWinProcs->useWide) { + native = (const TCHAR *) data.w.cFileName; + attr = data.w.dwFileAttributes; + } else { + native = (const TCHAR *) data.a.cFileName; + attr = data.a.dwFileAttributes; + } + + utfname = Tcl_WinTCharToUtf(native, -1, &ds); if (!matchSpecialDots) { /* @@ -1134,7 +1124,6 @@ TclpMatchInDirectory( if (checkDrive) { const char *fullname = Tcl_DStringAppend(&dsOrig, utfname, Tcl_DStringLength(&ds)); - isDrive = WinIsDrive(fullname, Tcl_DStringLength(&dsOrig)); Tcl_DStringSetLength(&dsOrig, dirLength); } else { @@ -1152,7 +1141,7 @@ TclpMatchInDirectory( */ Tcl_DStringFree(&ds); - } while (FindNextFile(handle, &data) == TRUE); + } while ((*tclWinProcs->findNextFileProc)(handle, &data) == TRUE); FindClose(handle); Tcl_DStringFree(&dsOrig); @@ -1169,7 +1158,7 @@ TclpMatchInDirectory( static int WinIsDrive( const char *name, /* Name (UTF-8) */ - size_t len) /* Length of name */ + int len) /* Length of name */ { int remove = 0; @@ -1241,9 +1230,9 @@ WinIsReserved( if ((path[0] == 'c' || path[0] == 'C') && (path[1] == 'o' || path[1] == 'O')) { if ((path[2] == 'm' || path[2] == 'M') - && path[3] >= '1' && path[3] <= '4') { + && path[3] >= '1' && path[3] <= '9') { /* - * May have match for 'com[1-4]:?', which is a serial port. + * May have match for 'com[1-9]:?', which is a serial port. */ if (path[4] == '\0') { @@ -1262,9 +1251,9 @@ WinIsReserved( } else if ((path[0] == 'l' || path[0] == 'L') && (path[1] == 'p' || path[1] == 'P') && (path[2] == 't' || path[2] == 'T')) { - if (path[3] >= '1' && path[3] <= '3') { + if (path[3] >= '1' && path[3] <= '9') { /* - * May have match for 'lpt[1-3]:?' + * May have match for 'lpt[1-9]:?' */ if (path[4] == '\0') { @@ -1325,80 +1314,81 @@ NativeMatchType( * If invisible, don't return the file. */ - return !(attr & FILE_ATTRIBUTE_HIDDEN && !isDrive); - } - - if (attr & FILE_ATTRIBUTE_HIDDEN && !isDrive) { - /* - * If invisible. - */ - - if ((types->perm == 0) || !(types->perm & TCL_GLOB_PERM_HIDDEN)) { + if (attr & FILE_ATTRIBUTE_HIDDEN && !isDrive) { return 0; } } else { - /* - * Visible. - */ + if (attr & FILE_ATTRIBUTE_HIDDEN && !isDrive) { + /* + * If invisible. + */ - if (types->perm & TCL_GLOB_PERM_HIDDEN) { - return 0; - } - } + if ((types->perm == 0) || !(types->perm & TCL_GLOB_PERM_HIDDEN)) { + return 0; + } + } else { + /* + * Visible. + */ - if (types->perm != 0) { - if (((types->perm & TCL_GLOB_PERM_RONLY) && - !(attr & FILE_ATTRIBUTE_READONLY)) || - ((types->perm & TCL_GLOB_PERM_R) && - (0 /* File exists => R_OK on Windows */)) || - ((types->perm & TCL_GLOB_PERM_W) && - (attr & FILE_ATTRIBUTE_READONLY)) || - ((types->perm & TCL_GLOB_PERM_X) && - (!(attr & FILE_ATTRIBUTE_DIRECTORY) - && !NativeIsExec(nativeName)))) { - return 0; + if (types->perm & TCL_GLOB_PERM_HIDDEN) { + return 0; + } } - } - if ((types->type & TCL_GLOB_TYPE_DIR) - && (attr & FILE_ATTRIBUTE_DIRECTORY)) { - /* - * Quicker test for directory, which is a common case. - */ + if (types->perm != 0) { + if (((types->perm & TCL_GLOB_PERM_RONLY) && + !(attr & FILE_ATTRIBUTE_READONLY)) || + ((types->perm & TCL_GLOB_PERM_R) && + (0 /* File exists => R_OK on Windows */)) || + ((types->perm & TCL_GLOB_PERM_W) && + (attr & FILE_ATTRIBUTE_READONLY)) || + ((types->perm & TCL_GLOB_PERM_X) && + (!(attr & FILE_ATTRIBUTE_DIRECTORY) + && !NativeIsExec(nativeName)))) { + return 0; + } + } + if ((types->type & TCL_GLOB_TYPE_DIR) + && (attr & FILE_ATTRIBUTE_DIRECTORY)) { + /* + * Quicker test for directory, which is a common case. + */ - return 1; + return 1; - } else if (types->type != 0) { - unsigned short st_mode; - int isExec = NativeIsExec(nativeName); + } else if (types->type != 0) { + unsigned short st_mode; + int isExec = NativeIsExec(nativeName); - st_mode = NativeStatMode(attr, 0, isExec); + st_mode = NativeStatMode(attr, 0, isExec); - /* - * In order bcdpfls as in 'find -t' - */ + /* + * In order bcdpfls as in 'find -t' + */ - if (((types->type&TCL_GLOB_TYPE_BLOCK) && S_ISBLK(st_mode)) || - ((types->type&TCL_GLOB_TYPE_CHAR) && S_ISCHR(st_mode)) || - ((types->type&TCL_GLOB_TYPE_DIR) && S_ISDIR(st_mode)) || - ((types->type&TCL_GLOB_TYPE_PIPE) && S_ISFIFO(st_mode)) || + if (((types->type&TCL_GLOB_TYPE_BLOCK) && S_ISBLK(st_mode)) || + ((types->type&TCL_GLOB_TYPE_CHAR) && S_ISCHR(st_mode)) || + ((types->type&TCL_GLOB_TYPE_DIR) && S_ISDIR(st_mode)) || + ((types->type&TCL_GLOB_TYPE_PIPE) && S_ISFIFO(st_mode)) || #ifdef S_ISSOCK - ((types->type&TCL_GLOB_TYPE_SOCK) && S_ISSOCK(st_mode)) || + ((types->type&TCL_GLOB_TYPE_SOCK) && S_ISSOCK(st_mode)) || #endif - ((types->type&TCL_GLOB_TYPE_FILE) && S_ISREG(st_mode))) { - /* - * Do nothing - this file is ok. - */ - } else { + ((types->type&TCL_GLOB_TYPE_FILE) && S_ISREG(st_mode))) { + /* + * Do nothing - this file is ok. + */ + } else { #ifdef S_ISLNK - if (types->type & TCL_GLOB_TYPE_LINK) { - st_mode = NativeStatMode(attr, 1, isExec); - if (S_ISLNK(st_mode)) { - return 1; + if (types->type & TCL_GLOB_TYPE_LINK) { + st_mode = NativeStatMode(attr, 1, isExec); + if (S_ISLNK(st_mode)) { + return 1; + } } +#endif + return 0; } -#endif /* S_ISLNK */ - return 0; } } return 1; @@ -1425,56 +1415,90 @@ NativeMatchType( *---------------------------------------------------------------------- */ -const char * +char * TclpGetUserHome( const char *name, /* User name for desired home directory. */ Tcl_DString *bufferPtr) /* Uninitialized or free DString filled with * name of user's home directory. */ { - 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]; + char *result; + HINSTANCE netapiInst; + HINSTANCE userenvInst; + result = NULL; Tcl_DStringInit(bufferPtr); - wDomain = NULL; - domain = strchr(name, '@'); - if (domain != NULL) { - Tcl_DStringInit(&ds); - wName = Tcl_UtfToUniCharDString(domain + 1, TCL_STRLEN, &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". - */ - GetWindowsDirectoryW(buf, MAX_PATH); - Tcl_UniCharToUtfDString(buf, 2, bufferPtr); - TclDStringAppendLiteral(bufferPtr, "/users/default"); + netapiInst = LoadLibraryA("netapi32.dll"); + userenvInst = LoadLibraryA("userenv.dll"); + if (netapiInst != NULL && userenvInst != NULL) { + NETAPIBUFFERFREEPROC *netApiBufferFreeProc; + NETGETDCNAMEPROC *netGetDCNameProc; + NETUSERGETINFOPROC *netUserGetInfoProc; + GETPROFILESDIRECTORYPROC *getProfilesDirectoryProc; + + netApiBufferFreeProc = (NETAPIBUFFERFREEPROC *) + GetProcAddress(netapiInst, "NetApiBufferFree"); + netGetDCNameProc = (NETGETDCNAMEPROC *) + GetProcAddress(netapiInst, "NetGetDCName"); + netUserGetInfoProc = (NETUSERGETINFOPROC *) + GetProcAddress(netapiInst, "NetUserGetInfo"); + getProfilesDirectoryProc = (GETPROFILESDIRECTORYPROC *) + GetProcAddress(userenvInst, "GetProfilesDirectoryW"); + if ((netUserGetInfoProc != NULL) && (netGetDCNameProc != NULL) + && (netApiBufferFreeProc != NULL) && (getProfilesDirectoryProc != NULL)) { + USER_INFO_1 *uiPtr, **uiPtrPtr = &uiPtr; + Tcl_DString ds; + int nameLen, badDomain; + char *domain; + WCHAR *wName, *wHomeDir, *wDomain, **wDomainPtr = &wDomain; + WCHAR buf[MAX_PATH]; + + badDomain = 0; + nameLen = -1; + wDomain = NULL; + domain = strchr(name, '@'); + if (domain != NULL) { + Tcl_DStringInit(&ds); + wName = Tcl_UtfToUniCharDString(domain + 1, -1, &ds); + badDomain = (netGetDCNameProc)(NULL, wName, + (LPBYTE *) wDomainPtr); + Tcl_DStringFree(&ds); + nameLen = domain - name; + } + if (badDomain == 0) { + Tcl_DStringInit(&ds); + wName = Tcl_UtfToUniCharDString(name, nameLen, &ds); + if ((netUserGetInfoProc)(wDomain, wName, 1, + (LPBYTE *) uiPtrPtr) == 0) { + wHomeDir = uiPtr->usri1_home_dir; + if ((wHomeDir != NULL) && (wHomeDir[0] != L'\0')) { + Tcl_UniCharToUtfDString(wHomeDir, lstrlenW(wHomeDir), + bufferPtr); + } else { + /* + * User exists but has no home dir. Return + * "{GetProfilesDirectory}/<user>". + */ + DWORD i, size = MAX_PATH; + getProfilesDirectoryProc(buf, &size); + for (i = 0; i < size; ++i){ + if (buf[i] == '\\') buf[i] = '/'; + } + Tcl_UniCharToUtfDString(buf, size-1, bufferPtr); + Tcl_DStringAppend(bufferPtr, "/", -1); + Tcl_DStringAppend(bufferPtr, name, -1); + } + result = Tcl_DStringValue(bufferPtr); + (*netApiBufferFreeProc)((void *) uiPtr); + } + Tcl_DStringFree(&ds); + } + if (wDomain != NULL) { + (*netApiBufferFreeProc)((void *) wDomain); } - result = Tcl_DStringValue(bufferPtr); - NetApiBufferFree((void *) uiPtr); } - Tcl_DStringFree(&ds); - } - if (wDomain != NULL) { - NetApiBufferFree((void *) wDomain); + FreeLibrary(userenvInst); + FreeLibrary(netapiInst); } if (result == NULL) { /* @@ -1528,22 +1552,20 @@ NativeAccess( const TCHAR *nativePath, /* Path of file to access, native encoding. */ int mode) /* Permission setting. */ { - DWORD attr = GetFileAttributes(nativePath); + DWORD attr; - if (attr == INVALID_FILE_ATTRIBUTES) { + attr = (*tclWinProcs->getFileAttributesProc)(nativePath); + + if (attr == 0xffffffff) { /* * File might not exist. */ - WIN32_FIND_DATA ffd; - HANDLE hFind = FindFirstFile(nativePath, &ffd); - - if (hFind == INVALID_HANDLE_VALUE) { - TclWinConvertError(GetLastError()); + DWORD lasterror = GetLastError(); + if (lasterror != ERROR_SHARING_VIOLATION) { + TclWinConvertError(lasterror); return -1; } - attr = ffd.dwFileAttributes; - FindClose(hFind); } if (mode == F_OK) { @@ -1554,8 +1576,9 @@ NativeAccess( return 0; } - if ((mode & W_OK) && (attr & FILE_ATTRIBUTE_READONLY) - && !(attr & FILE_ATTRIBUTE_DIRECTORY)) { + 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 @@ -1589,8 +1612,7 @@ NativeAccess( * what permissions the OS has set for a file. */ -#ifdef UNICODE - { + if (tclWinProcs->getFileSecurityProc != NULL) { SECURITY_DESCRIPTOR *sdPtr = NULL; unsigned long size; PSID pSid = 0; @@ -1605,11 +1627,11 @@ NativeAccess( int error; /* - * First find out how big the buffer needs to be. + * First find out how big the buffer needs to be */ size = 0; - GetFileSecurity(nativePath, + (*tclWinProcs->getFileSecurityProc)(nativePath, OWNER_SECURITY_INFORMATION | GROUP_SECURITY_INFORMATION | DACL_SECURITY_INFORMATION | LABEL_SECURITY_INFORMATION, 0, 0, &size); @@ -1643,7 +1665,7 @@ NativeAccess( * Call GetFileSecurity() for real. */ - if (!GetFileSecurity(nativePath, + if (!(*tclWinProcs->getFileSecurityProc)(nativePath, OWNER_SECURITY_INFORMATION | GROUP_SECURITY_INFORMATION | DACL_SECURITY_INFORMATION | LABEL_SECURITY_INFORMATION, sdPtr, size, &size)) { @@ -1679,14 +1701,14 @@ NativeAccess( * thread token. */ - if (!ImpersonateSelf(SecurityImpersonation)) { + if (!(*tclWinProcs->impersonateSelfProc)(SecurityImpersonation)) { /* * Unable to perform security impersonation. */ goto accessError; } - if (!OpenThreadToken(GetCurrentThread(), + if (!(*tclWinProcs->openThreadTokenProc)(GetCurrentThread(), TOKEN_DUPLICATE | TOKEN_QUERY, FALSE, &hToken)) { /* * Unable to get current thread's token. @@ -1695,7 +1717,7 @@ NativeAccess( goto accessError; } - RevertToSelf(); + (*tclWinProcs->revertToSelfProc)(); /* * Setup desiredAccess according to the access priveleges we are @@ -1722,7 +1744,7 @@ NativeAccess( * Perform access check using the token. */ - if (!AccessCheck(sdPtr, hToken, desiredAccess, + if (!(*tclWinProcs->accessCheckProc)(sdPtr, hToken, desiredAccess, &genMap, &privSet, &privSetSize, &grantedAccess, &accessYesNo)) { /* @@ -1752,7 +1774,6 @@ NativeAccess( } } -#endif /* !UNICODE */ return 0; } @@ -1772,22 +1793,55 @@ NativeAccess( static int NativeIsExec( - const TCHAR *path) + const TCHAR *nativePath) { - int len = _tcslen(path); + if (tclWinProcs->useWide) { + const WCHAR *path = (const WCHAR *) nativePath; + int len = wcslen(path); - if (len < 5) { - return 0; - } + if (len < 5) { + return 0; + } - if (path[len-4] != '.') { - return 0; - } + if (path[len-4] != L'.') { + return 0; + } + + /* + * Use wide-char case-insensitive comparison + */ + + if ((_wcsicmp(path+len-3, L"exe") == 0) + || (_wcsicmp(path+len-3, L"com") == 0) + || (_wcsicmp(path+len-3, L"bat") == 0)) { + return 1; + } + } else { + const char *p; + + /* + * We are only looking for pure ascii. + */ - if ((_tcsicmp(path+len-3, TEXT("exe")) == 0) - || (_tcsicmp(path+len-3, TEXT("com")) == 0) - || (_tcsicmp(path+len-3, TEXT("bat")) == 0)) { - return 1; + 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 ((strcasecmp(p, "exe") == 0) + || (strcasecmp(p, "com") == 0) + || (strcasecmp(p, "bat") == 0)) { + /* + * File that ends with .exe, .com, or .bat is executable. + */ + + return 1; + } + } } return 0; } @@ -1815,9 +1869,12 @@ TclpObjChdir( int result; const TCHAR *nativePath; - nativePath = Tcl_FSGetNativePath(pathPtr); + nativePath = (const TCHAR *) Tcl_FSGetNativePath(pathPtr); - result = SetCurrentDirectory(nativePath); + if (!nativePath) { + return -1; + } + result = (*tclWinProcs->setCurrentDirectoryProc)(nativePath); if (result == 0) { TclWinConvertError(GetLastError()); @@ -1854,16 +1911,14 @@ TclpGetCwd( Tcl_DString *bufferPtr) /* Uninitialized or free DString filled with * name of current directory. */ { - TCHAR buffer[MAX_PATH]; + WCHAR buffer[MAX_PATH]; char *p; - WCHAR *native; - if (GetCurrentDirectory(MAX_PATH, buffer) == 0) { + if ((*tclWinProcs->getCurrentDirectoryProc)(MAX_PATH, buffer) == 0) { TclWinConvertError(GetLastError()); if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "error getting working directory name: %s", - Tcl_PosixError(interp))); + Tcl_AppendResult(interp, "error getting working directory name: ", + Tcl_PosixError(interp), NULL); } return NULL; } @@ -1872,12 +1927,25 @@ TclpGetCwd( * Watch for the weird Windows c:\\UNC syntax. */ - native = (WCHAR *) buffer; - if ((native[0] != '\0') && (native[1] == ':') - && (native[2] == '\\') && (native[3] == '\\')) { - native += 2; + if (tclWinProcs->useWide) { + WCHAR *native; + + native = (WCHAR *) buffer; + if ((native[0] != '\0') && (native[1] == ':') + && (native[2] == '\\') && (native[3] == '\\')) { + native += 2; + } + Tcl_WinTCharToUtf((TCHAR *) native, -1, bufferPtr); + } else { + char *native; + + native = (char *) buffer; + if ((native[0] != '\0') && (native[1] == ':') + && (native[2] == '\\') && (native[3] == '\\')) { + native += 2; + } + Tcl_WinTCharToUtf((TCHAR *) native, -1, bufferPtr); } - Tcl_WinTCharToUtf((TCHAR *) native, TCL_STRLEN, bufferPtr); /* * Convert to forward slashes for easier use in scripts. @@ -1904,7 +1972,8 @@ TclpObjStat( TclWinFlushDirtyChannels(); - return NativeStat(Tcl_FSGetNativePath(pathPtr), statPtr, 0); + return NativeStat((const TCHAR *) Tcl_FSGetNativePath(pathPtr), + statPtr, 0); } /* @@ -1950,7 +2019,7 @@ NativeStat( * simpler routines. */ - fileHandle = CreateFile(nativePath, GENERIC_READ, + 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); @@ -1989,24 +2058,26 @@ NativeStat( */ inode = data.nFileIndexHigh | data.nFileIndexLow; - } else { + } else if (tclWinProcs->getFileAttributesExProc != NULL) { /* * Fall back on the less capable routines. This means no nlink or ino. */ WIN32_FILE_ATTRIBUTE_DATA data; - if (GetFileAttributesEx(nativePath, + if ((*tclWinProcs->getFileAttributesExProc)(nativePath, GetFileExInfoStandard, &data) != TRUE) { - /* - * We might have just been denied access - */ - - WIN32_FIND_DATA ffd; - HANDLE hFind = FindFirstFile(nativePath, &ffd); + HANDLE hFind; + WIN32_FIND_DATAT ffd; + DWORD lasterror = GetLastError(); + if (lasterror != ERROR_SHARING_VIOLATION) { + TclWinConvertError(lasterror); + return -1; + } + hFind = (*tclWinProcs->findFirstFileProc)(nativePath, &ffd); if (hFind == INVALID_HANDLE_VALUE) { - Tcl_SetErrno(ENOENT); + TclWinConvertError(GetLastError()); return -1; } memcpy(&data, &ffd, sizeof(data)); @@ -2020,6 +2091,46 @@ NativeStat( 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); @@ -2051,12 +2162,14 @@ NativeDev( { int dev; Tcl_DString ds; - TCHAR nativeFullPath[MAX_PATH]; + WCHAR nativeFullPath[MAX_PATH]; TCHAR *nativePart; const char *fullPath; - GetFullPathName(nativePath, MAX_PATH, nativeFullPath, &nativePart); - fullPath = Tcl_WinTCharToUtf(nativeFullPath, TCL_STRLEN, &ds); + (*tclWinProcs->getFullPathNameProc)(nativePath, MAX_PATH, + nativeFullPath, &nativePart); + + fullPath = Tcl_WinTCharToUtf((TCHAR *) nativeFullPath, -1, &ds); if ((fullPath[0] == '\\') && (fullPath[1] == '\\')) { const char *p; @@ -2072,14 +2185,15 @@ NativeDev( * won't work. */ - fullPath = TclDStringAppendLiteral(&ds, "\\"); + fullPath = Tcl_DStringAppend(&ds, "\\", 1); p = fullPath + Tcl_DStringLength(&ds); } else { p++; } nativeVol = Tcl_WinUtfToTChar(fullPath, p - fullPath, &volString); dw = (DWORD) -1; - GetVolumeInformation(nativeVol, NULL, 0, &dw, NULL, NULL, NULL, 0); + (*tclWinProcs->getVolumeInformationProc)(nativeVol, NULL, 0, &dw, + NULL, NULL, NULL, 0); /* * GetFullPathName() turns special devices like "NUL" into "\\.\NUL", @@ -2191,9 +2305,8 @@ FromCTime( 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; } @@ -2223,20 +2336,34 @@ ClientData TclpGetNativeCwd( ClientData clientData) { - TCHAR buffer[MAX_PATH]; + WCHAR buffer[MAX_PATH]; - if (GetCurrentDirectory(MAX_PATH, buffer) == 0) { + if ((*tclWinProcs->getCurrentDirectoryProc)(MAX_PATH, buffer) == 0) { TclWinConvertError(GetLastError()); return NULL; } if (clientData != NULL) { - if (_tcscmp((const TCHAR*)clientData, buffer) == 0) { - return clientData; + if (tclWinProcs->useWide) { + /* + * Unicode representation when running on NT/2K/XP. + */ + + if (wcscmp((const WCHAR*)clientData, (const WCHAR*)buffer) == 0) { + return clientData; + } + } else { + /* + * ANSI representation when running on 95/98/ME. + */ + + if (strcmp((const char*) clientData, (const char*) buffer) == 0) { + return clientData; + } } } - return TclNativeDupInternalRep(buffer); + return TclNativeDupInternalRep((ClientData) buffer); } int @@ -2244,7 +2371,7 @@ TclpObjAccess( Tcl_Obj *pathPtr, int mode) { - return NativeAccess(Tcl_FSGetNativePath(pathPtr), mode); + return NativeAccess((const TCHAR *) Tcl_FSGetNativePath(pathPtr), mode); } int @@ -2260,7 +2387,8 @@ TclpObjLstat( TclWinFlushDirtyChannels(); - return NativeStat(Tcl_FSGetNativePath(pathPtr), statPtr, 1); + return NativeStat((const TCHAR *) Tcl_FSGetNativePath(pathPtr), + statPtr, 1); } #ifdef S_IFLNK @@ -2272,15 +2400,15 @@ TclpObjLink( { if (toPtr != NULL) { int res; - const TCHAR *LinkTarget; - const TCHAR *LinkSource = Tcl_FSGetNativePath(pathPtr); + TCHAR *LinkTarget; + TCHAR *LinkSource = (TCHAR *) Tcl_FSGetNativePath(pathPtr); Tcl_Obj *normalizedToPtr = Tcl_FSGetNormalizedPath(NULL, toPtr); if (normalizedToPtr == NULL) { return NULL; } - LinkTarget = Tcl_FSGetNativePath(normalizedToPtr); + LinkTarget = (TCHAR *) Tcl_FSGetNativePath(normalizedToPtr); if (LinkSource == NULL || LinkTarget == NULL) { return NULL; @@ -2292,7 +2420,7 @@ TclpObjLink( return NULL; } } else { - const TCHAR *LinkSource = Tcl_FSGetNativePath(pathPtr); + TCHAR *LinkSource = (TCHAR *) Tcl_FSGetNativePath(pathPtr); if (LinkSource == NULL) { return NULL; @@ -2300,7 +2428,7 @@ TclpObjLink( return WinReadLink(LinkSource); } } -#endif /* S_IFLNK */ +#endif /* *--------------------------------------------------------------------------- @@ -2326,7 +2454,7 @@ TclpFilesystemPathType( { #define VOL_BUF_SIZE 32 int found; - TCHAR volType[VOL_BUF_SIZE]; + WCHAR volType[VOL_BUF_SIZE]; char *firstSeparator; const char *path; Tcl_Obj *normPath = Tcl_FSGetNormalizedPath(NULL, pathPtr); @@ -2341,14 +2469,16 @@ TclpFilesystemPathType( firstSeparator = strchr(path, '/'); if (firstSeparator == NULL) { - found = GetVolumeInformation(Tcl_FSGetNativePath(pathPtr), - NULL, 0, NULL, NULL, NULL, volType, VOL_BUF_SIZE); + found = tclWinProcs->getVolumeInformationProc( + Tcl_FSGetNativePath(pathPtr), NULL, 0, NULL, NULL, NULL, + (WCHAR *) volType, VOL_BUF_SIZE); } else { Tcl_Obj *driveName = Tcl_NewStringObj(path, firstSeparator - path+1); Tcl_IncrRefCount(driveName); - found = GetVolumeInformation(Tcl_FSGetNativePath(driveName), - NULL, 0, NULL, NULL, NULL, volType, VOL_BUF_SIZE); + found = tclWinProcs->getVolumeInformationProc( + Tcl_FSGetNativePath(driveName), NULL, 0, NULL, NULL, NULL, + (WCHAR *) volType, VOL_BUF_SIZE); Tcl_DecrRefCount(driveName); } @@ -2356,9 +2486,13 @@ TclpFilesystemPathType( return NULL; } else { Tcl_DString ds; + Tcl_Obj *objPtr; - Tcl_WinTCharToUtf(volType, TCL_STRLEN, &ds); - return TclDStringToObj(&ds); + Tcl_WinTCharToUtf((const char *) volType, -1, &ds); + objPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), + Tcl_DStringLength(&ds)); + Tcl_DStringFree(&ds); + return objPtr; } #undef VOL_BUF_SIZE } @@ -2408,8 +2542,6 @@ TclpObjNormalizePath( Tcl_DString dsNorm; /* This will hold the normalized string. */ char *path, *currentPathEndPosition; Tcl_Obj *temp = NULL; - int isDrive = 1; - Tcl_DString ds; /* Some workspace. */ Tcl_DStringInit(&dsNorm); path = Tcl_GetString(pathPtr); @@ -2420,11 +2552,11 @@ TclpObjNormalizePath( * 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. - * - * FIXME: This code branch may be derelict as those are not supported - * platforms any more. */ + int isDrive = 1; + Tcl_DString ds; + currentPathEndPosition = path + nextCheckpoint; if (*currentPathEndPosition == '/') { currentPathEndPosition++; @@ -2471,6 +2603,12 @@ TclpObjNormalizePath( } Tcl_DStringAppend(&dsNorm, nativePath, len); lastValidPathEnd = currentPathEndPosition; + } else if (nextCheckpoint == 0) { + /* Path starts with a drive designation + * that's not actually on the system. + * We still must normalize up past the + * first separator. [Bug 3603434] */ + currentPathEndPosition++; } } Tcl_DStringFree(&ds); @@ -2504,7 +2642,7 @@ TclpObjNormalizePath( * path segment and continue */ - Tcl_DStringAppend(&dsNorm, (const char *) + Tcl_DStringAppend(&dsNorm, (TCHAR *) (nativePath + Tcl_DStringLength(&ds)-dotLen), dotLen); } else { @@ -2512,7 +2650,7 @@ TclpObjNormalizePath( * Normal path. */ - WIN32_FIND_DATAA fData; + WIN32_FIND_DATA fData; HANDLE handle; handle = FindFirstFileA(nativePath, &fData); @@ -2532,7 +2670,7 @@ TclpObjNormalizePath( * string. */ - TclDStringAppendLiteral(&dsNorm, "/"); + Tcl_DStringAppend(&dsNorm,"/", 1); } else { char *nativeName; @@ -2542,8 +2680,8 @@ TclpObjNormalizePath( nativeName = fData.cAlternateFileName; } FindClose(handle); - TclDStringAppendLiteral(&dsNorm, "/"); - Tcl_DStringAppend(&dsNorm, nativeName,TCL_STRLEN); + Tcl_DStringAppend(&dsNorm,"/", 1); + Tcl_DStringAppend(&dsNorm,nativeName,-1); } } } @@ -2567,6 +2705,9 @@ TclpObjNormalizePath( * We're on WinNT (or 2000 or XP; something with an NT core). */ + int isDrive = 1; + Tcl_DString ds; + currentPathEndPosition = path + nextCheckpoint; if (*currentPathEndPosition == '/') { currentPathEndPosition++; @@ -2580,10 +2721,10 @@ TclpObjNormalizePath( */ WIN32_FILE_ATTRIBUTE_DATA data; - const TCHAR *nativePath = Tcl_WinUtfToTChar(path, + const char *nativePath = Tcl_WinUtfToTChar(path, currentPathEndPosition - path, &ds); - if (GetFileAttributesEx(nativePath, + if ((*tclWinProcs->getFileAttributesExProc)(nativePath, GetFileExInfoStandard, &data) != TRUE) { /* * File doesn't exist. @@ -2607,10 +2748,15 @@ TclpObjNormalizePath( ((WCHAR *) nativePath)[i] = wc; } } - Tcl_DStringAppend(&dsNorm, - (const char *)nativePath, + Tcl_DStringAppend(&dsNorm, nativePath, (int)(sizeof(WCHAR) * len)); lastValidPathEnd = currentPathEndPosition; + } else if (nextCheckpoint == 0) { + /* Path starts with a drive designation + * that's not actually on the system. + * We still must normalize up past the + * first separator. [Bug 3603434] */ + currentPathEndPosition++; } } Tcl_DStringFree(&ds); @@ -2641,14 +2787,13 @@ TclpObjNormalizePath( * not be normalized, otherwise we could use: * * Tcl_GetStringFromObj(to, &pathLen); - * nextCheckpoint = pathLen; + * nextCheckpoint = pathLen * * So, instead we have to start from the beginning. */ nextCheckpoint = 0; - Tcl_AppendToObj(to, currentPathEndPosition, - TCL_STRLEN); + Tcl_AppendToObj(to, currentPathEndPosition, -1); /* * Convert link to forward slashes. @@ -2672,6 +2817,7 @@ TclpObjNormalizePath( isDrive = 1; Tcl_DStringFree(&dsNorm); + Tcl_DStringInit(&dsNorm); Tcl_DStringFree(&ds); continue; } @@ -2686,12 +2832,11 @@ TclpObjNormalizePath( if (isDrive) { WCHAR drive = ((WCHAR *) nativePath)[0]; - if (drive >= L'a') { drive -= (L'a' - L'A'); ((WCHAR *) nativePath)[0] = drive; } - Tcl_DStringAppend(&dsNorm, (const char *)nativePath, + Tcl_DStringAppend(&dsNorm, nativePath, Tcl_DStringLength(&ds)); } else { char *checkDots = NULL; @@ -2716,10 +2861,9 @@ TclpObjNormalizePath( * path segment and continue. */ - Tcl_DStringAppend(&dsNorm, ((const char *)nativePath) - + Tcl_DStringLength(&ds) - - (dotLen * sizeof(TCHAR)), - (int)(dotLen * sizeof(TCHAR))); + Tcl_DStringAppend(&dsNorm, (TCHAR *) + ((WCHAR*)(nativePath + Tcl_DStringLength(&ds)) + - dotLen), (int)(dotLen * sizeof(WCHAR))); } else { /* * Normal path. @@ -2748,13 +2892,12 @@ TclpObjNormalizePath( FindClose(handle); Tcl_DStringAppend(&dsNorm, (const char *) L"/", sizeof(WCHAR)); - Tcl_DStringAppend(&dsNorm, - (const char *) nativeName, + Tcl_DStringAppend(&dsNorm, (TCHAR *) nativeName, (int) (wcslen(nativeName)*sizeof(WCHAR))); } } } -#endif /* !TclNORM_LONG_PATH */ +#endif Tcl_DStringFree(&ds); lastValidPathEnd = currentPathEndPosition; if (cur == 0) { @@ -2778,10 +2921,10 @@ TclpObjNormalizePath( if (1) { WCHAR wpath[MAX_PATH]; - const TCHAR *nativePath = + const char *nativePath = Tcl_WinUtfToTChar(path, lastValidPathEnd - path, &ds); - DWORD wpathlen = GetLongPathNameProc(nativePath, - (TCHAR *) wpath, MAX_PATH); + DWORD wpathlen = (*tclWinProcs->getLongPathNameProc)( + nativePath, (TCHAR *) wpath, MAX_PATH); /* * We have to make the drive letter uppercase. @@ -2790,11 +2933,10 @@ TclpObjNormalizePath( if (wpath[0] >= L'a') { wpath[0] -= (L'a' - L'A'); } - Tcl_DStringAppend(&dsNorm, (const char *) wpath, - wpathlen * sizeof(WCHAR)); + Tcl_DStringAppend(&dsNorm, (TCHAR*)wpath, wpathlen*sizeof(WCHAR)); Tcl_DStringFree(&ds); } -#endif /* TclNORM_LONG_PATH */ +#endif } /* @@ -2809,9 +2951,11 @@ TclpObjNormalizePath( * native encoding, so we have to convert it to Utf. */ - Tcl_WinTCharToUtf((const TCHAR *) Tcl_DStringValue(&dsNorm), - Tcl_DStringLength(&dsNorm), &ds); - nextCheckpoint = Tcl_DStringLength(&ds); + Tcl_DString dsTemp; + + Tcl_WinTCharToUtf(Tcl_DStringValue(&dsNorm), + Tcl_DStringLength(&dsNorm), &dsTemp); + nextCheckpoint = Tcl_DStringLength(&dsTemp); if (*lastValidPathEnd != 0) { /* * Not the end of the string. @@ -2821,9 +2965,9 @@ TclpObjNormalizePath( char *path; Tcl_Obj *tmpPathPtr; - tmpPathPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), + tmpPathPtr = Tcl_NewStringObj(Tcl_DStringValue(&dsTemp), nextCheckpoint); - Tcl_AppendToObj(tmpPathPtr, lastValidPathEnd, TCL_STRLEN); + Tcl_AppendToObj(tmpPathPtr, lastValidPathEnd, -1); path = Tcl_GetStringFromObj(tmpPathPtr, &len); Tcl_SetStringObj(pathPtr, path, len); Tcl_DecrRefCount(tmpPathPtr); @@ -2832,9 +2976,10 @@ TclpObjNormalizePath( * End of string was reached above. */ - Tcl_SetStringObj(pathPtr, Tcl_DStringValue(&ds), nextCheckpoint); + Tcl_SetStringObj(pathPtr, Tcl_DStringValue(&dsTemp), + nextCheckpoint); } - Tcl_DStringFree(&ds); + Tcl_DStringFree(&dsTemp); } Tcl_DStringFree(&dsNorm); @@ -2846,7 +2991,6 @@ TclpObjNormalizePath( if (temp != NULL) { Tcl_DecrRefCount(temp); } - return nextCheckpoint; } @@ -2896,7 +3040,7 @@ TclWinVolumeRelativeNormalize( const char *drive = Tcl_GetString(useThisCwd); absolutePath = Tcl_NewStringObj(drive,2); - Tcl_AppendToObj(absolutePath, path, TCL_STRLEN); + Tcl_AppendToObj(absolutePath, path, -1); Tcl_IncrRefCount(absolutePath); /* @@ -2950,7 +3094,7 @@ TclWinVolumeRelativeNormalize( Tcl_AppendToObj(absolutePath, "/", 1); } Tcl_IncrRefCount(absolutePath); - Tcl_AppendToObj(absolutePath, path+2, TCL_STRLEN); + Tcl_AppendToObj(absolutePath, path+2, -1); } *useThisCwdPtr = useThisCwd; return absolutePath; @@ -2983,10 +3127,10 @@ TclpNativeToNormalized( { Tcl_DString ds; Tcl_Obj *objPtr; - size_t len; + int len; char *copy, *p; - Tcl_WinTCharToUtf((const TCHAR *) clientData, TCL_STRLEN, &ds); + Tcl_WinTCharToUtf((const char *) clientData, -1, &ds); copy = Tcl_DStringValue(&ds); len = Tcl_DStringLength(&ds); @@ -3016,7 +3160,7 @@ TclpNativeToNormalized( } } - objPtr = Tcl_NewStringObj(copy, len); + objPtr = Tcl_NewStringObj(copy,len); Tcl_DStringFree(&ds); return objPtr; @@ -3045,7 +3189,7 @@ TclNativeCreateNativeRep( char *nativePathPtr, *str; Tcl_DString ds; Tcl_Obj *validPathPtr; - size_t len; + int len; if (TclFSCwdIsNative()) { /* @@ -3071,23 +3215,83 @@ 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 == '/') { + Tcl_WinUtfToTChar(str, len, &ds); + if (tclWinProcs->useWide) { + WCHAR *wp = (WCHAR *) Tcl_DStringValue(&ds); + /* For a reserved device, strip a possible postfix ':' */ + len = WinIsReserved(str); + /* For normal devices */ + if (len == 0) len = Tcl_DStringLength(&ds)>>1; + /* + ** If path starts with "//?/" or "\\?\" (extended path), translate + ** any slashes to backslashes but accept the '?' as being valid. + */ + if ((str[0]=='\\' || str[0]=='/') && (str[1]=='\\' || str[1]=='/') + && str[2]=='?' && (str[3]=='\\' || str[3]=='/')) { + wp[0] = wp[1] = wp[3] = '\\'; + str += 4; + wp += 4; + len -= 4; + } + /* + ** If there is a drive prefix, the ':' must be considered valid. + **/ + if (((str[0]>='A'&&str[0]<='Z') || (str[0]>='a'&&str[0]<='z')) + && str[1]==':') { + wp += 2; + len -= 2; + } + while (len-->0) { + if ((*wp < ' ') || wcschr(L"\"*:<>?|", *wp)) { + Tcl_DecrRefCount(validPathPtr); + Tcl_DStringFree(&ds); + return NULL; + } else if (*wp=='/') { + *wp = '\\'; + } + ++wp; + } + len = Tcl_DStringLength(&ds) + sizeof(WCHAR); + } else { + char *p = Tcl_DStringValue(&ds); + len = Tcl_DStringLength(&ds); + /* + ** If path starts with "//?/" or "\\?\" (extended path), translate + ** any slashes to backslashes but accept the '?' as being valid. + */ + if ((str[0]=='\\' || str[0]=='/') && (str[1]=='\\' || str[1]=='/') + && str[2]=='?' && (str[3]=='\\' || str[3]=='/')) { + p[0] = p[1] = p[3] = '\\'; + str += 4; + p += 4; + len -= 4; + } + /* + ** If there is a drive prefix, the ':' must be considered valid. + **/ + if (((str[0]>='A'&&str[0]<='Z') || (str[0]>='a'&&str[0]<='z')) + && str[1]==':') { + p += 2; + len -= 2; + } + while (len-->0) { + if ((*p < ' ') || strchr("\"*:<>?|", *p)) { + Tcl_DecrRefCount(validPathPtr); + Tcl_DStringFree(&ds); + return NULL; + } else if (*p=='/') { *p = '\\'; } + ++p; } + len = Tcl_DStringLength(&ds) + sizeof(char); } - Tcl_WinUtfToTChar(str, len, &ds); - len = Tcl_DStringLength(&ds) + sizeof(WCHAR); Tcl_DecrRefCount(validPathPtr); - nativePathPtr = ckalloc(len); + nativePathPtr = ckalloc((unsigned) len); memcpy(nativePathPtr, Tcl_DStringValue(&ds), (size_t) len); Tcl_DStringFree(&ds); - return nativePathPtr; + return (ClientData) nativePathPtr; } /* @@ -3118,11 +3322,23 @@ TclNativeDupInternalRep( return NULL; } - len = sizeof(TCHAR) * (_tcslen((const TCHAR *) clientData) + 1); + if (tclWinProcs->useWide) { + /* + * Unicode representation when running on NT/2K/XP. + */ + + len = sizeof(WCHAR) * (wcslen((const WCHAR *) clientData) + 1); + } else { + /* + * ANSI representation when running on 95/98/ME. + */ + + len = sizeof(char) * (strlen((const char *) clientData) + 1); + } - copy = ckalloc(len); + copy = (char *) ckalloc(len); memcpy(copy, clientData, len); - return copy; + return (ClientData) copy; } /* @@ -3157,9 +3373,9 @@ TclpUtime( FromCTime(tval->actime, &lastAccessTime); FromCTime(tval->modtime, &lastModTime); - native = Tcl_FSGetNativePath(pathPtr); + native = (const TCHAR *) Tcl_FSGetNativePath(pathPtr); - attr = GetFileAttributes(native); + attr = (*tclWinProcs->getFileAttributesProc)(native); if (attr != INVALID_FILE_ATTRIBUTES && attr & FILE_ATTRIBUTE_DIRECTORY) { flags = FILE_FLAG_BACKUP_SEMANTICS; @@ -3170,8 +3386,8 @@ TclpUtime( * savings complications that utime gets wrong. */ - fileHandle = CreateFile(native, FILE_WRITE_ATTRIBUTES, 0, NULL, - OPEN_EXISTING, flags, NULL); + fileHandle = (tclWinProcs->createFileProc)(native, FILE_WRITE_ATTRIBUTES, + 0, NULL, OPEN_EXISTING, flags, NULL); if (fileHandle == INVALID_HANDLE_VALUE || !SetFileTime(fileHandle, NULL, &lastAccessTime, &lastModTime)) { diff --git a/win/tclWinInit.c b/win/tclWinInit.c index 2e7b2dd..4e860b2 100644 --- a/win/tclWinInit.c +++ b/win/tclWinInit.c @@ -83,12 +83,12 @@ typedef struct { #define NUMPLATFORMS 4 -static const char *const platforms[NUMPLATFORMS] = { +static char* platforms[NUMPLATFORMS] = { "Win32s", "Windows 95", "Windows NT", "Windows CE" }; #define NUMPROCESSORS 11 -static const char *const processors[NUMPROCESSORS] = { +static char* processors[NUMPROCESSORS] = { "intel", "mips", "alpha", "ppc", "shx", "arm", "ia64", "alpha64", "msil", "amd64", "ia32_on_win64" }; @@ -105,16 +105,16 @@ 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); +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. * @@ -130,20 +130,16 @@ static int ToUtf(const WCHAR *wSrc, char *dst); void TclpInitPlatform(void) { - tclPlatform = TCL_PLATFORM_WINDOWS; + WSADATA wsaData; + WORD wVersionRequested = MAKEWORD(2, 2); - /* - * 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. - */ + tclPlatform = TCL_PLATFORM_WINDOWS; - SetErrorMode(SetErrorMode(0) | SEM_FAILCRITICALERRORS); + /* + * Initialize the winsock library. On Windows XP and higher this + * can never fail. + */ + WSAStartup(wVersionRequested, &wsaData); #ifdef STATIC_BUILD /* @@ -176,13 +172,13 @@ TclpInitPlatform(void) void TclpInitLibraryPath( char **valuePtr, - size_t *lengthPtr, + int *lengthPtr, Tcl_Encoding *encodingPtr) { #define LIBRARY_SIZE 64 Tcl_Obj *pathPtr; char installLib[LIBRARY_SIZE]; - const char *bytes; + char *bytes; pathPtr = Tcl_NewObj(); @@ -219,8 +215,8 @@ TclpInitLibraryPath( *encodingPtr = NULL; bytes = Tcl_GetStringFromObj(pathPtr, lengthPtr); - *valuePtr = ckalloc((*lengthPtr) + 1); - memcpy(*valuePtr, bytes, (*lengthPtr)+1); + *valuePtr = ckalloc((unsigned int)(*lengthPtr)+1); + memcpy(*valuePtr, bytes, (size_t)(*lengthPtr)+1); Tcl_DecrRefCount(pathPtr); } @@ -246,14 +242,14 @@ TclpInitLibraryPath( static void AppendEnvironment( Tcl_Obj *pathPtr, - const char *lib) + CONST char *lib) { - size_t pathc; + 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; /* @@ -287,7 +283,7 @@ AppendEnvironment( } if (buf[0] != '\0') { - objPtr = Tcl_NewStringObj(buf, TCL_STRLEN); + objPtr = Tcl_NewStringObj(buf, -1); Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); TclWinNoBackslash(buf); @@ -299,6 +295,8 @@ 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 @@ -308,13 +306,14 @@ AppendEnvironment( pathv[pathc - 1] = shortlib; Tcl_DStringInit(&ds); - (void) Tcl_JoinPath(pathc, pathv, &ds); - objPtr = TclDStringToObj(&ds); + str = Tcl_JoinPath(pathc, pathv, &ds); + objPtr = Tcl_NewStringObj(str, Tcl_DStringLength(&ds)); + Tcl_DStringFree(&ds); } else { - objPtr = Tcl_NewStringObj(buf, TCL_STRLEN); + objPtr = Tcl_NewStringObj(buf, -1); } Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); - ckfree(pathv); + ckfree((char *) pathv); } } @@ -414,7 +413,7 @@ InitializeSourceLibraryDir( TclWinNoBackslash(name); sprintf(end + 1, "../library"); *lengthPtr = strlen(name); - *valuePtr = ckalloc(*lengthPtr + 1); + *valuePtr = ckalloc((unsigned int) *lengthPtr + 1); *encodingPtr = NULL; memcpy(*valuePtr, name, (size_t) *lengthPtr + 1); } @@ -437,7 +436,7 @@ InitializeSourceLibraryDir( static int ToUtf( - const WCHAR *wSrc, + CONST WCHAR *wSrc, char *dst) { char *start; @@ -454,6 +453,31 @@ ToUtf( /* *--------------------------------------------------------------------------- * + * TclWinEncodingsCleanup -- + * + * Reset information to its original state in finalization to allow for + * reinitialization to be possible. This must not be called until after + * the filesystem has been finalised, or exit crashes may occur when + * using virtual filesystems. + * + * Results: + * None. + * + * Side effects: + * Static information reset to startup state. + * + *--------------------------------------------------------------------------- + */ + +void +TclWinEncodingsCleanup(void) +{ + TclWinResetInterfaceEncodings(); +} + +/* + *--------------------------------------------------------------------------- + * * TclpSetInitialEncodings -- * * Based on the locale, determine the encoding of the operating system @@ -489,13 +513,15 @@ TclpSetInitialEncodings(void) void TclpSetInterfaces(void) { - int useWide; + int platformId, useWide; - useWide = (TclWinGetPlatformId() != VER_PLATFORM_WIN32_WINDOWS); + platformId = TclWinGetPlatformId(); + useWide = ((platformId == VER_PLATFORM_WIN32_NT) + || (platformId == VER_PLATFORM_WIN32_CE)); TclWinSetInterfaces(useWide); } -const char * +CONST char * Tcl_GetEncodingNameFromEnvironment( Tcl_DString *bufPtr) { @@ -527,23 +553,34 @@ void TclpSetVariables( Tcl_Interp *interp) /* Interp to initialize. */ { - const char *ptr; + CONST char *ptr; char buffer[TCL_INTEGER_SPACE * 2]; union { SYSTEM_INFO info; OemId oemId; } sys; - OSVERSIONINFOA osInfo; + static OSVERSIONINFOW osInfo; + static int osInfoInitialized = 0; Tcl_DString ds; - TCHAR szUserName[UNLEN+1]; + WCHAR szUserName[UNLEN+1]; DWORD cchUserNameLen = UNLEN; Tcl_SetVar2Ex(interp, "tclDefaultLibrary", NULL, TclGetProcessGlobalValue(&defaultLibraryDir), TCL_GLOBAL_ONLY); - osInfo.dwOSVersionInfoSize = sizeof(OSVERSIONINFOA); - GetVersionExA(&osInfo); - + 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); /* @@ -564,7 +601,7 @@ TclpSetVariables( TCL_GLOBAL_ONLY); } -#ifdef _DEBUG +#ifndef NDEBUG /* * The existence of the "debug" element of the tcl_platform array * indicates that this particular Tcl shell has been compiled with debug @@ -587,11 +624,11 @@ TclpSetVariables( if (ptr == NULL) { ptr = Tcl_GetVar2(interp, "env", "HOMEDRIVE", TCL_GLOBAL_ONLY); if (ptr != NULL) { - Tcl_DStringAppend(&ds, ptr, TCL_STRLEN); + Tcl_DStringAppend(&ds, ptr, -1); } ptr = Tcl_GetVar2(interp, "env", "HOMEPATH", TCL_GLOBAL_ONLY); if (ptr != NULL) { - Tcl_DStringAppend(&ds, ptr, TCL_STRLEN); + Tcl_DStringAppend(&ds, ptr, -1); } if (Tcl_DStringLength(&ds) > 0) { Tcl_SetVar2(interp, "env", "HOME", Tcl_DStringValue(&ds), @@ -609,22 +646,15 @@ TclpSetVariables( Tcl_DStringInit(&ds); if (TclGetEnv("USERNAME", &ds) == NULL) { - if (GetUserName(szUserName, &cchUserNameLen) != 0) { + if (tclWinProcs->getUserName((LPTSTR)szUserName, &cchUserNameLen) != 0) { int cbUserNameLen = cchUserNameLen - 1; - - cbUserNameLen *= sizeof(TCHAR); - Tcl_WinTCharToUtf(szUserName, cbUserNameLen, &ds); + if (tclWinProcs->useWide) cbUserNameLen *= sizeof(WCHAR); + Tcl_WinTCharToUtf((LPTSTR)szUserName, cbUserNameLen, &ds); } } Tcl_SetVar2(interp, "tcl_platform", "user", Tcl_DStringValue(&ds), TCL_GLOBAL_ONLY); Tcl_DStringFree(&ds); - - /* - * Define what the platform PATH separator is. [TIP #315] - */ - - Tcl_SetVar2(interp, "tcl_platform","pathSeparator", ";", TCL_GLOBAL_ONLY); } /* @@ -649,16 +679,15 @@ TclpSetVariables( int TclpFindVariable( - const char *name, /* Name of desired environment variable + CONST char *name, /* Name of desired environment variable * (UTF-8). */ - size_t *lengthPtr) /* Used to return length of name (for + int *lengthPtr) /* Used to return length of name (for * successful searches) or number of non-NULL * entries in environ (for unsuccessful * searches). */ { - int i, result = -1; - size_t length; - register const char *env, *p1, *p2; + int i, length, result = -1; + register CONST char *env, *p1, *p2; char *envUpper, *nameUpper; Tcl_DString envString; @@ -667,8 +696,8 @@ TclpFindVariable( */ length = strlen(name); - nameUpper = ckalloc(length + 1); - memcpy(nameUpper, name, length+1); + nameUpper = (char *) ckalloc((unsigned) length+1); + memcpy(nameUpper, name, (size_t) length+1); Tcl_UtfToUpper(nameUpper); Tcl_DStringInit(&envString); @@ -679,7 +708,7 @@ TclpFindVariable( * after the equal sign. */ - envUpper = Tcl_ExternalToUtfDString(NULL,env,TCL_STRLEN, &envString); + envUpper = Tcl_ExternalToUtfDString(NULL, env, -1, &envString); p1 = strchr(envUpper, '='); if (p1 == NULL) { continue; diff --git a/win/tclWinInt.h b/win/tclWinInt.h index 22ad8e9..ccf48bb 100644 --- a/win/tclWinInt.h +++ b/win/tclWinInt.h @@ -14,6 +14,31 @@ #include "tclInt.h" +#ifdef HAVE_NO_SEH +/* + * Unlike Borland and Microsoft, we don't register exception handlers by + * pushing registration records onto the runtime stack. Instead, we register + * them by creating an TCLEXCEPTION_REGISTRATION within the activation record. + */ + +typedef struct TCLEXCEPTION_REGISTRATION { + struct TCLEXCEPTION_REGISTRATION *link; + EXCEPTION_DISPOSITION (*handler)( + struct _EXCEPTION_RECORD*, void*, struct _CONTEXT*, void*); + void *ebp; + void *esp; + int status; +} TCLEXCEPTION_REGISTRATION; +#endif + +/* + * The following specifies how much stack space TclpCheckStackSpace() + * ensures is available. TclpCheckStackSpace() is called by Tcl_EvalObj() + * to help avoid overflowing the stack in the case of infinite recursion. + */ + +#define TCL_WIN_STACK_THRESHOLD 0x8000 + /* * Some versions of Borland C have a define for the OSVERSIONINFO for * Win32s and for NT, but not for Windows 95. @@ -33,11 +58,117 @@ # define TCL_I_MODIFIER "" #endif -#ifdef _WIN64 -# define TCL_I_MODIFIER "I" -#else -# define TCL_I_MODIFIER "" -#endif +/* + * The following structure keeps track of whether we are using the + * multi-byte or the wide-character interfaces to the operating system. + * System calls should be made through the following function table. + */ + +typedef union { + WIN32_FIND_DATAA a; + WIN32_FIND_DATAW w; +} WIN32_FIND_DATAT; + +typedef struct TclWinProcs { + int useWide; + + BOOL (WINAPI *buildCommDCBProc)(CONST TCHAR *, LPDCB); + TCHAR *(WINAPI *charLowerProc)(TCHAR *); + BOOL (WINAPI *copyFileProc)(CONST TCHAR *, CONST TCHAR *, BOOL); + BOOL (WINAPI *createDirectoryProc)(CONST TCHAR *, LPSECURITY_ATTRIBUTES); + HANDLE (WINAPI *createFileProc)(CONST TCHAR *, DWORD, DWORD, + LPSECURITY_ATTRIBUTES, DWORD, DWORD, HANDLE); + BOOL (WINAPI *createProcessProc)(CONST TCHAR *, TCHAR *, + LPSECURITY_ATTRIBUTES, LPSECURITY_ATTRIBUTES, BOOL, DWORD, + LPVOID, CONST TCHAR *, LPSTARTUPINFOA, LPPROCESS_INFORMATION); + BOOL (WINAPI *deleteFileProc)(CONST TCHAR *); + HANDLE (WINAPI *findFirstFileProc)(CONST TCHAR *, WIN32_FIND_DATAT *); + BOOL (WINAPI *findNextFileProc)(HANDLE, WIN32_FIND_DATAT *); + BOOL (WINAPI *getComputerNameProc)(WCHAR *, LPDWORD); + DWORD (WINAPI *getCurrentDirectoryProc)(DWORD, WCHAR *); + DWORD (WINAPI *getFileAttributesProc)(CONST TCHAR *); + DWORD (WINAPI *getFullPathNameProc)(CONST TCHAR *, DWORD nBufferLength, + WCHAR *, TCHAR **); + DWORD (WINAPI *getModuleFileNameProc)(HMODULE, WCHAR *, int); + DWORD (WINAPI *getShortPathNameProc)(CONST TCHAR *, WCHAR *, DWORD); + UINT (WINAPI *getTempFileNameProc)(CONST TCHAR *, CONST TCHAR *, UINT, + WCHAR *); + DWORD (WINAPI *getTempPathProc)(DWORD, WCHAR *); + BOOL (WINAPI *getVolumeInformationProc)(CONST TCHAR *, WCHAR *, DWORD, + LPDWORD, LPDWORD, LPDWORD, WCHAR *, DWORD); + HINSTANCE (WINAPI *loadLibraryExProc)(CONST TCHAR *, HANDLE, DWORD); + TCHAR (WINAPI *lstrcpyProc)(WCHAR *, CONST TCHAR *); + BOOL (WINAPI *moveFileProc)(CONST TCHAR *, CONST TCHAR *); + BOOL (WINAPI *removeDirectoryProc)(CONST TCHAR *); + DWORD (WINAPI *searchPathProc)(CONST TCHAR *, CONST TCHAR *, + CONST TCHAR *, DWORD, WCHAR *, TCHAR **); + BOOL (WINAPI *setCurrentDirectoryProc)(CONST TCHAR *); + BOOL (WINAPI *setFileAttributesProc)(CONST TCHAR *, DWORD); + /* + * These two function pointers will only be set when + * Tcl_FindExecutable is called. If you don't ever call that + * function, the application will crash whenever WinTcl tries to call + * functions through these null pointers. That is not a bug in Tcl + * -- Tcl_FindExecutable is obligatory in recent Tcl releases. + */ + BOOL (WINAPI *getFileAttributesExProc)(CONST TCHAR *, + GET_FILEEX_INFO_LEVELS, LPVOID); + BOOL (WINAPI *createHardLinkProc)(CONST TCHAR*, CONST TCHAR*, + LPSECURITY_ATTRIBUTES); + + /* deleted INT (__cdecl *utimeProc)(CONST TCHAR*, struct _utimbuf *); */ + /* These two are also NULL at start; see comment above */ + HANDLE (WINAPI *findFirstFileExProc)(CONST TCHAR*, UINT, + LPVOID, UINT, + LPVOID, DWORD); + BOOL (WINAPI *getVolumeNameForVMPProc)(CONST TCHAR*, TCHAR*, DWORD); + DWORD (WINAPI *getLongPathNameProc)(CONST TCHAR*, TCHAR*, DWORD); + /* + * These six are for the security sdk to get correct file + * permissions on NT, 2000, XP, etc. On 95,98,ME they are + * always null. + */ + BOOL (WINAPI *getFileSecurityProc)(LPCTSTR lpFileName, + SECURITY_INFORMATION RequestedInformation, + PSECURITY_DESCRIPTOR pSecurityDescriptor, + DWORD nLength, + LPDWORD lpnLengthNeeded); + BOOL (WINAPI *impersonateSelfProc) (SECURITY_IMPERSONATION_LEVEL + ImpersonationLevel); + BOOL (WINAPI *openThreadTokenProc) (HANDLE ThreadHandle, + DWORD DesiredAccess, BOOL OpenAsSelf, + PHANDLE TokenHandle); + BOOL (WINAPI *revertToSelfProc) (void); + VOID (WINAPI *mapGenericMaskProc) (PDWORD AccessMask, + PGENERIC_MAPPING GenericMapping); + BOOL (WINAPI *accessCheckProc)(PSECURITY_DESCRIPTOR pSecurityDescriptor, + HANDLE ClientToken, DWORD DesiredAccess, + PGENERIC_MAPPING GenericMapping, + PPRIVILEGE_SET PrivilegeSet, + LPDWORD PrivilegeSetLength, + LPDWORD GrantedAccess, + LPBOOL AccessStatus); + /* + * Unicode console support. WriteConsole and ReadConsole + */ + BOOL (WINAPI *readConsoleProc)( + HANDLE hConsoleInput, + LPVOID lpBuffer, + DWORD nNumberOfCharsToRead, + LPDWORD lpNumberOfCharsRead, + LPVOID lpReserved + ); + BOOL (WINAPI *writeConsoleProc)( + HANDLE hConsoleOutput, + const VOID* lpBuffer, + DWORD nNumberOfCharsToWrite, + LPDWORD lpNumberOfCharsWritten, + LPVOID lpReserved + ); + BOOL (WINAPI *getUserName)(LPTSTR lpBuffer, LPDWORD lpnSize); +} TclWinProcs; + +MODULE_SCOPE TclWinProcs *tclWinProcs; /* * Declarations of functions that are not accessible by way of the @@ -45,7 +176,7 @@ */ MODULE_SCOPE char TclWinDriveLetterForVolMountPoint( - const TCHAR *mountPoint); + CONST WCHAR *mountPoint); MODULE_SCOPE void TclWinEncodingsCleanup(); MODULE_SCOPE void TclWinInit(HINSTANCE hInst); MODULE_SCOPE TclFile TclWinMakeFile(HANDLE handle); @@ -55,11 +186,12 @@ MODULE_SCOPE Tcl_Channel TclWinOpenFileChannel(HANDLE handle, char *channelName, int permissions, int appendMode); MODULE_SCOPE Tcl_Channel TclWinOpenSerialChannel(HANDLE handle, char *channelName, int permissions); -MODULE_SCOPE HANDLE TclWinSerialReopen(HANDLE handle, const TCHAR *name, +MODULE_SCOPE void TclWinResetInterfaceEncodings(); +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 c7fc545..c4d08e8 100644 --- a/win/tclWinLoad.c +++ b/win/tclWinLoad.c @@ -13,23 +13,6 @@ #include "tclWinInt.h" -/* - * Native name of the directory in the native filesystem where DLLs used in - * this process are copied prior to loading, and mutex used to protect its - * allocation. - */ - -static WCHAR *dllDirectoryName = NULL; -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); /* *---------------------------------------------------------------------- @@ -57,15 +40,13 @@ TclpDlopen( Tcl_LoadHandle *loadHandle, /* Filled with token for dynamically loaded * file which will be passed back to * (*unloadProcPtr)() to unload the file. */ - Tcl_FSUnloadFileProc **unloadProcPtr, + Tcl_FSUnloadFileProc **unloadProcPtr) /* Filled with address of Tcl_FSUnloadFileProc * function which should be used for this * file. */ - int flags) { - HINSTANCE hInstance; - const TCHAR *nativeName; - Tcl_LoadHandle handlePtr; + HINSTANCE handle; + CONST TCHAR *nativeName; /* * First try the full path the user gave us. This is particularly @@ -74,8 +55,9 @@ TclpDlopen( */ nativeName = Tcl_FSGetNativePath(pathPtr); - hInstance = LoadLibraryEx(nativeName,NULL,LOAD_WITH_ALTERED_SEARCH_PATH); - if (hInstance == NULL) { + handle = (*tclWinProcs->loadLibraryExProc)(nativeName, NULL, + LOAD_WITH_ALTERED_SEARCH_PATH); + if (handle == NULL) { /* * Let the OS loader examine the binary search path for whatever * string the user gave us which hopefully refers to a file on the @@ -83,18 +65,38 @@ TclpDlopen( */ Tcl_DString ds; + char *fileName = Tcl_GetString(pathPtr); - nativeName = Tcl_WinUtfToTChar(Tcl_GetString(pathPtr), TCL_STRLEN, - &ds); - hInstance = LoadLibraryEx(nativeName, NULL, + nativeName = Tcl_WinUtfToTChar(fileName, -1, &ds); + handle = (*tclWinProcs->loadLibraryExProc)(nativeName, NULL, LOAD_WITH_ALTERED_SEARCH_PATH); Tcl_DStringFree(&ds); } - if (hInstance == NULL) { + *loadHandle = (Tcl_LoadHandle) handle; + + if (handle == NULL) { DWORD lastError = GetLastError(); - Tcl_Obj *errMsg = Tcl_ObjPrintf("couldn't load library \"%s\": ", - Tcl_GetString(pathPtr)); + +#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); /* * Check for possible DLL errors. This doesn't work quite right, @@ -105,55 +107,38 @@ 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_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", TCL_STRLEN); + Tcl_AppendResult(interp, "this library or a dependent library" + " could not be found in library path", NULL); break; case ERROR_PROC_NOT_FOUND: - Tcl_SetErrorCode(interp, "WIN_LOAD", "PROC_NOT_FOUND", NULL); - Tcl_AppendToObj(errMsg, "A function specified in the import" - " table could not be resolved by the system. Windows" - " is not telling which one, I'm sorry.", TCL_STRLEN); + Tcl_AppendResult(interp, "A function specified in the import" + " table could not be resolved by the system. Windows" + " is not telling which one, I'm sorry.", NULL); break; case ERROR_INVALID_DLL: - Tcl_SetErrorCode(interp, "WIN_LOAD", "INVALID_DLL", NULL); - Tcl_AppendToObj(errMsg, "this library or a dependent library" - " is damaged", TCL_STRLEN); + Tcl_AppendResult(interp, "this library or a dependent library" + " is damaged", NULL); break; case ERROR_DLL_INIT_FAILED: - Tcl_SetErrorCode(interp, "WIN_LOAD", "DLL_INIT_FAILED", NULL); - Tcl_AppendToObj(errMsg, "the library initialization" - " routine failed", TCL_STRLEN); + Tcl_AppendResult(interp, "the library initialization" + " routine failed", NULL); break; default: TclWinConvertError(lastError); - Tcl_AppendToObj(errMsg, Tcl_PosixError(interp), TCL_STRLEN); + Tcl_AppendResult(interp, Tcl_PosixError(interp), NULL); } - 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; } /* *---------------------------------------------------------------------- * - * FindSymbol -- + * TclpFindSymbol -- * * Looks up a symbol, by name, through a handle associated with a * previously loaded piece of code (shared library). @@ -166,43 +151,37 @@ TclpDlopen( *---------------------------------------------------------------------- */ -static void * -FindSymbol( +Tcl_PackageInitProc * +TclpFindSymbol( Tcl_Interp *interp, Tcl_LoadHandle loadHandle, - const char *symbol) + CONST char *symbol) { - HINSTANCE hInstance = (HINSTANCE) loadHandle->clientData; Tcl_PackageInitProc *proc = NULL; + HINSTANCE handle = (HINSTANCE)loadHandle; /* * For each symbol, check for both Symbol and _Symbol, since Borland * generates C symbols with a leading '_' by default. */ - proc = (void *) GetProcAddress(hInstance, symbol); + proc = (Tcl_PackageInitProc *) GetProcAddress(handle, symbol); if (proc == NULL) { Tcl_DString ds; - const char *sym2; Tcl_DStringInit(&ds); - TclDStringAppendLiteral(&ds, "_"); - sym2 = Tcl_DStringAppend(&ds, symbol, TCL_STRLEN); - proc = (Tcl_PackageInitProc *) GetProcAddress(hInstance, sym2); + Tcl_DStringAppend(&ds, "_", 1); + symbol = Tcl_DStringAppend(&ds, symbol, -1); + proc = (Tcl_PackageInitProc *) GetProcAddress(handle, symbol); Tcl_DStringFree(&ds); } - if (proc == NULL && interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "cannot find symbol \"%s\"", symbol)); - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LOAD_SYMBOL", symbol, NULL); - } return proc; } /* *---------------------------------------------------------------------- * - * UnloadFile -- + * TclpUnloadFile -- * * Unloads a dynamically loaded binary code file from memory. Code * pointers in the formerly loaded file are no longer valid after calling @@ -217,16 +196,16 @@ FindSymbol( *---------------------------------------------------------------------- */ -static void -UnloadFile( +void +TclpUnloadFile( Tcl_LoadHandle loadHandle) /* loadHandle returned by a previous call to * TclpDlopen(). The loadHandle is a token * that represents the loaded file. */ { - HINSTANCE hInstance = (HINSTANCE) loadHandle->clientData; + HINSTANCE handle; - FreeLibrary(hInstance); - ckfree(loadHandle); + handle = (HINSTANCE) loadHandle; + FreeLibrary(handle); } /* @@ -251,7 +230,7 @@ UnloadFile( 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. */ @@ -260,139 +239,6 @@ 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 4543b02..1cd5823 100644 --- a/win/tclWinNotify.c +++ b/win/tclWinNotify.c @@ -42,6 +42,9 @@ 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. @@ -50,7 +53,6 @@ static Tcl_ThreadDataKey dataKey; */ static int notifierCount = 0; -static const TCHAR classname[] = TEXT("TclNotifier"); TCL_DECLARE_MUTEX(notifierMutex) /* @@ -79,49 +81,45 @@ static LRESULT CALLBACK NotifierProc(HWND hwnd, UINT message, ClientData Tcl_InitNotifier(void) { - if (tclNotifierHooks.initNotifierProc) { - return tclNotifierHooks.initNotifierProc(); - } else { - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - WNDCLASS class; + 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 = classname; - class.lpfnWndProc = NotifierProc; - class.hIcon = NULL; - class.hCursor = NULL; - - if (!RegisterClass(&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 = "TclNotifier"; + class.lpfnWndProc = NotifierProc; + class.hIcon = NULL; + class.hCursor = NULL; + + if (!RegisterClassA(&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 tsdPtr; - } + return (ClientData) tsdPtr; } /* @@ -145,51 +143,46 @@ void Tcl_FinalizeNotifier( ClientData clientData) /* Pointer to notifier data. */ { - if (tclNotifierHooks.finalizeNotifierProc) { - tclNotifierHooks.finalizeNotifierProc(clientData); - return; - } else { - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData; + 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) { - UnregisterClass(classname, TclWinGetTclInstance()); - } - Tcl_MutexUnlock(¬ifierMutex); + Tcl_MutexLock(¬ifierMutex); + notifierCount--; + if (notifierCount == 0) { + UnregisterClassA("TclNotifier", TclWinGetTclInstance()); } + Tcl_MutexUnlock(¬ifierMutex); } /* @@ -218,32 +211,27 @@ void Tcl_AlertNotifier( ClientData clientData) /* Pointer to thread data. */ { - if (tclNotifierHooks.alertNotifierProc) { - tclNotifierHooks.alertNotifierProc(clientData); - return; - } else { - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData; + + /* + * Note that we do not need to lock around access to the hwnd because the + * race condition has no effect since any race condition implies that the + * notifier thread is already awake. + */ + if (tsdPtr->hwnd) { /* - * 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. + * We do need to lock around access to the pending flag. */ - 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); + EnterCriticalSection(&tsdPtr->crit); + if (!tsdPtr->pending) { + PostMessage(tsdPtr->hwnd, WM_WAKEUP, 0, 0); } + tsdPtr->pending = 1; + LeaveCriticalSection(&tsdPtr->crit); + } else { + SetEvent(tsdPtr->event); } } @@ -267,48 +255,53 @@ Tcl_AlertNotifier( void Tcl_SetTimer( - const Tcl_Time *timePtr) /* Maximum block time, or NULL. */ + Tcl_Time *timePtr) /* Maximum block time, or NULL. */ { - if (tclNotifierHooks.setTimerProc) { - tclNotifierHooks.setTimerProc(timePtr); + 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; - } else { - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - UINT timeout; + } - /* - * We only need to set up an interval timer if we're being called from - * an external event loop. If we don't have a window handle then we - * just return immediately and let Tcl_WaitForEvent handle timeouts. - */ + /* + * We only need to set up an interval timer if we're being called from an + * external event loop. If we don't have a window handle then we just + * return immediately and let Tcl_WaitForEvent handle timeouts. + */ - if (!tsdPtr->hwnd) { - return; - } + if (!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. - */ + 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); + 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); + } } /* @@ -333,36 +326,29 @@ Tcl_ServiceModeHook( int mode) /* Either TCL_SERVICE_ALL, or * TCL_SERVICE_NONE. */ { - if (tclNotifierHooks.serviceModeHookProc) { - tclNotifierHooks.serviceModeHookProc(mode); - return; - } else { - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - /* - * If this is the first time that the notifier has been used from a - * modal loop, then create a communication window. Note that after this - * point, the application needs to service events in a timely fashion - * or Windows will hang waiting for the window to respond to - * synchronous system messages. At some point, we may want to consider - * destroying the window if we leave the modal loop, but for now we'll - * leave it around. - */ + /* + * If this is the first time that the notifier has been used from a modal + * loop, then create a communication window. Note that after this point, + * the application needs to service events in a timely fashion or Windows + * will hang waiting for the window to respond to synchronous system + * messages. At some point, we may want to consider destroying the window + * if we leave the modal loop, but for now we'll leave it around. + */ - if (mode == TCL_SERVICE_ALL && !tsdPtr->hwnd) { - tsdPtr->hwnd = CreateWindow(classname, classname, - WS_TILED, 0, 0, 0, 0, NULL, NULL, TclWinGetTclInstance(), - NULL); + if (mode == TCL_SERVICE_ALL && !tsdPtr->hwnd) { + tsdPtr->hwnd = CreateWindowA("TclNotifier", "TclNotifier", WS_TILED, + 0, 0, 0, 0, NULL, NULL, TclWinGetTclInstance(), NULL); - /* - * Send an initial message to the window to ensure that we wake up - * the notifier once we get into the modal loop. This will force - * the notifier to recompute the timeout value and schedule a timer - * if one is needed. - */ + /* + * 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); - } + Tcl_AlertNotifier((ClientData)tsdPtr); } } @@ -430,102 +416,107 @@ NotifierProc( int Tcl_WaitForEvent( - const Tcl_Time *timePtr) /* Maximum block time, or NULL. */ + Tcl_Time *timePtr) /* Maximum block time, or NULL. */ { - if (tclNotifierHooks.waitForEventProc) { - return tclNotifierHooks.waitForEventProc(timePtr); - } else { - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - MSG msg; - DWORD timeout, result; - int status; + 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 (timePtr) { /* - * Compute the timeout in milliseconds. + * TIP #233 (Virtualized Time). Convert virtual domain delay to + * real-time. */ - if (timePtr) { - /* - * TIP #233 (Virtualized Time). Convert virtual domain delay to - * real-time. - */ + Tcl_Time myTime; - Tcl_Time myTime; + myTime.sec = timePtr->sec; + myTime.usec = timePtr->usec; - myTime.sec = timePtr->sec; - myTime.usec = timePtr->usec; + if (myTime.sec != 0 || myTime.usec != 0) { + (*tclScaleTimeProcPtr) (&myTime, tclTimeClientData); + } - if (myTime.sec != 0 || myTime.usec != 0) { - tclScaleTimeProcPtr(&myTime, tclTimeClientData); - } + timeout = myTime.sec * 1000 + myTime.usec / 1000; + } else { + timeout = INFINITE; + } - timeout = myTime.sec * 1000 + myTime.usec / 1000; - } else { - timeout = INFINITE; - } + /* + * Check to see if there are any messages in the queue before waiting + * because MsgWaitForMultipleObjects will not wake up if there are events + * currently sitting in the queue. + */ + if (!PeekMessage(&msg, NULL, 0, 0, PM_NOREMOVE)) { /* - * 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. + * Wait for something to happen (a signal from another thread, a + * message, or timeout) or loop servicing asynchronous procedure calls + * queued to this thread. */ - if (!PeekMessage(&msg, NULL, 0, 0, PM_NOREMOVE)) { - /* - * Wait for something to happen (a signal from another thread, a - * message, or timeout) or loop servicing asynchronous procedure - * calls queued to this thread. - */ - - again: - result = MsgWaitForMultipleObjectsEx(1, &tsdPtr->event, timeout, - QS_ALLINPUT, MWMO_ALERTABLE); - if (result == WAIT_IO_COMPLETION) { - goto again; - } else if (result == WAIT_FAILED) { - status = -1; - goto end; - } + again: + result = MsgWaitForMultipleObjectsEx(1, &tsdPtr->event, timeout, + QS_ALLINPUT, MWMO_ALERTABLE); + if (result == WAIT_IO_COMPLETION) { + goto again; + } else if (result == WAIT_FAILED) { + status = -1; + goto end; } + } + + /* + * Check to see if there are any messages to process. + */ + if (PeekMessage(&msg, NULL, 0, 0, PM_NOREMOVE)) { /* - * Check to see if there are any messages to process. + * Retrieve and dispatch the first message. */ - if (PeekMessage(&msg, NULL, 0, 0, PM_NOREMOVE)) { + 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) { /* - * Retrieve and dispatch the first message. + * We got an error from the system. I have no idea why this would + * happen, so we'll just unwind. */ - 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; - } + status = -1; } else { - status = 0; + TranslateMessage(&msg); + DispatchMessage(&msg); + status = 1; } - - end: - ResetEvent(tsdPtr->event); - return status; + } else { + status = 0; } + + end: + ResetEvent(tsdPtr->event); + return status; } /* @@ -579,11 +570,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 (;;) { - SleepEx(sleepTime, TRUE); + Sleep(sleepTime); Tcl_GetTime(&now); if (now.sec > desired.sec) { break; @@ -594,7 +585,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 117ed71..ee088a5 100644 --- a/win/tclWinPipe.c +++ b/win/tclWinPipe.c @@ -12,8 +12,6 @@ #include "tclWinInt.h" -#include <sys/stat.h> - /* * The following variable is used to tell whether this module has been * initialized. @@ -131,9 +129,9 @@ typedef struct PipeInfo { */ char *writeBuf; /* Current background output buffer. Access is * synchronized with the writable object. */ - size_t writeBufLen; /* Size of write buffer. Access is + int writeBufLen; /* Size of write buffer. Access is * synchronized with the writable object. */ - size_t toWrite; /* Current amount to be written. Access is + int toWrite; /* Current amount to be written. Access is * synchronized with the writable object. */ int readFlags; /* Flags that are shared with the reader * thread. Access is synchronized with the @@ -173,35 +171,38 @@ typedef struct PipeEvent { * Declarations for functions used only in this file. */ -static Tcl_DriverBlockModeProc PipeBlockModeProc; -static Tcl_DriverClose2Proc PipeClose2Proc; -static Tcl_DriverGetHandleProc PipeGetHandleProc; -static Tcl_DriverInputProc PipeInputProc; -static Tcl_DriverOutputProc PipeOutputProc; -static Tcl_DriverThreadActionProc PipeThreadActionProc; -static Tcl_DriverWatchProc PipeWatchProc; - -static Tcl_EventCheckProc PipeCheckProc; -static Tcl_EventProc PipeEventProc; -static Tcl_EventSetupProc PipeSetupProc; - static int ApplicationType(Tcl_Interp *interp, const char *fileName, char *fullName); -static void BuildCommandLine(const char *executable, size_t argc, +static void BuildCommandLine(const char *executable, int argc, const char **argv, Tcl_DString *linePtr); static BOOL HasConsole(void); +static int PipeBlockModeProc(ClientData instanceData, int mode); +static void PipeCheckProc(ClientData clientData, int flags); +static int PipeClose2Proc(ClientData instanceData, + Tcl_Interp *interp, int flags); +static int PipeEventProc(Tcl_Event *evPtr, int flags); +static int PipeGetHandleProc(ClientData instanceData, + int direction, ClientData *handlePtr); static void PipeInit(void); +static int PipeInputProc(ClientData instanceData, char *buf, + int toRead, int *errorCode); +static int PipeOutputProc(ClientData instanceData, + const char *buf, int toWrite, int *errorCode); static DWORD WINAPI PipeReaderThread(LPVOID arg); +static void PipeSetupProc(ClientData clientData, int flags); +static void PipeWatchProc(ClientData instanceData, int mask); static DWORD WINAPI PipeWriterThread(LPVOID arg); -static int TempFileName(TCHAR name[MAX_PATH]); +static int TempFileName(WCHAR name[MAX_PATH]); static int WaitForRead(PipeInfo *infoPtr, int blocking); +static void PipeThreadActionProc(ClientData instanceData, + int action); /* * This structure describes the channel type structure for command pipe based * I/O. */ -static const Tcl_ChannelType pipeChannelType = { +static Tcl_ChannelType pipeChannelType = { "pipe", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ TCL_CLOSE2PROC, /* Close proc. */ @@ -218,7 +219,7 @@ static const Tcl_ChannelType pipeChannelType = { NULL, /* handler proc. */ NULL, /* wide seek proc */ PipeThreadActionProc, /* thread action proc */ - NULL /* truncate */ + NULL, /* truncate */ }; /* @@ -403,7 +404,7 @@ PipeCheckProc( if (needEvent) { infoPtr->flags |= PIPE_PENDING; - evPtr = ckalloc(sizeof(PipeEvent)); + evPtr = (PipeEvent *) ckalloc(sizeof(PipeEvent)); evPtr->header.proc = PipeEventProc; evPtr->infoPtr = infoPtr; Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL); @@ -434,7 +435,7 @@ TclWinMakeFile( { WinFile *filePtr; - filePtr = ckalloc(sizeof(WinFile)); + filePtr = (WinFile *) ckalloc(sizeof(WinFile)); filePtr->type = WIN_FILE; filePtr->handle = handle; @@ -463,18 +464,27 @@ TclWinMakeFile( static int TempFileName( - TCHAR name[MAX_PATH]) /* Buffer in which name for temporary file + WCHAR name[MAX_PATH]) /* Buffer in which name for temporary file * gets stored. */ { - const TCHAR *prefix = TEXT("TCL"); - if (GetTempPath(MAX_PATH, name) != 0) { - if (GetTempFileName(name, prefix, 0, name) != 0) { + TCHAR *prefix; + + prefix = (tclWinProcs->useWide) ? (TCHAR *) L"TCL" : (TCHAR *) "TCL"; + if ((*tclWinProcs->getTempPathProc)(MAX_PATH, name) != 0) { + if ((*tclWinProcs->getTempFileNameProc)((TCHAR *) name, prefix, 0, + name) != 0) { return 1; } } - name[0] = '.'; - name[1] = '\0'; - return GetTempFileName(name, prefix, 0, name); + if (tclWinProcs->useWide) { + ((WCHAR *) name)[0] = '.'; + ((WCHAR *) name)[1] = '\0'; + } else { + ((char *) name)[0] = '.'; + ((char *) name)[1] = '\0'; + } + return (*tclWinProcs->getTempFileNameProc)((TCHAR *) name, prefix, 0, + name); } /* @@ -578,7 +588,7 @@ TclpOpenFile( break; } - nativePath = Tcl_WinUtfToTChar(path, TCL_STRLEN, &ds); + nativePath = Tcl_WinUtfToTChar(path, -1, &ds); /* * If the file is not being created, use the existing file attributes. @@ -586,7 +596,7 @@ TclpOpenFile( flags = 0; if (!(mode & O_CREAT)) { - flags = GetFileAttributes(nativePath); + flags = (*tclWinProcs->getFileAttributesProc)(nativePath); if (flags == 0xFFFFFFFF) { flags = 0; } @@ -602,8 +612,8 @@ TclpOpenFile( * Now we get to create the file. */ - handle = CreateFile(nativePath, accessMode, shareMode, - NULL, createMode, flags, NULL); + handle = (*tclWinProcs->createFileProc)(nativePath, accessMode, + shareMode, NULL, createMode, flags, NULL); Tcl_DStringFree(&ds); if (handle == INVALID_HANDLE_VALUE) { @@ -650,7 +660,7 @@ TclFile TclpCreateTempFile( const char *contents) /* String to write into temp file, or NULL. */ { - TCHAR name[MAX_PATH]; + WCHAR name[MAX_PATH]; const char *native; Tcl_DString dstring; HANDLE handle; @@ -659,7 +669,7 @@ TclpCreateTempFile( return NULL; } - handle = CreateFile(name, + handle = (*tclWinProcs->createFileProc)((TCHAR *) name, GENERIC_READ | GENERIC_WRITE, 0, NULL, CREATE_ALWAYS, FILE_ATTRIBUTE_TEMPORARY|FILE_FLAG_DELETE_ON_CLOSE, NULL); if (handle == INVALID_HANDLE_VALUE) { @@ -673,13 +683,13 @@ TclpCreateTempFile( if (contents != NULL) { DWORD result, length; const char *p; - size_t toCopy; + int toCopy; /* * Convert the contents from UTF to native encoding */ - native = Tcl_UtfToExternalDString(NULL,contents,TCL_STRLEN, &dstring); + native = Tcl_UtfToExternalDString(NULL, contents, -1, &dstring); toCopy = Tcl_DStringLength(&dstring); for (p = native; toCopy > 0; p++, toCopy--) { @@ -721,7 +731,7 @@ TclpCreateTempFile( TclWinConvertError(GetLastError()); CloseHandle(handle); - DeleteFile(name); + (*tclWinProcs->deleteFileProc)((TCHAR *) name); return NULL; } @@ -744,13 +754,13 @@ TclpCreateTempFile( Tcl_Obj * TclpTempFileName(void) { - TCHAR fileName[MAX_PATH]; + WCHAR fileName[MAX_PATH]; if (TempFileName(fileName) == 0) { return NULL; } - return TclpNativeToNormalized(fileName); + return TclpNativeToNormalized((ClientData) fileName); } /* @@ -826,7 +836,7 @@ TclpCloseFile( if (filePtr->handle != NULL && CloseHandle(filePtr->handle) == FALSE) { TclWinConvertError(GetLastError()); - ckfree(filePtr); + ckfree((char *) filePtr); return -1; } } @@ -836,7 +846,7 @@ TclpCloseFile( Tcl_Panic("TclpCloseFile: unexpected file type"); } - ckfree(filePtr); + ckfree((char *) filePtr); return 0; } @@ -911,7 +921,7 @@ TclpCreateProcess( * occurred when creating the child process. * Error messages from the child process * itself are sent to errorFile. */ - size_t argc, /* Number of arguments in following array. */ + int argc, /* Number of arguments in following array. */ const char **argv, /* Array of argument strings. argv[0] contains * the name of the executable converted to * native format (using the @@ -937,7 +947,7 @@ TclpCreateProcess( { int result, applType, createFlags; Tcl_DString cmdLine; /* Complete command line (TCHAR). */ - STARTUPINFO startInfo; + STARTUPINFOA startInfo; PROCESS_INFORMATION procInfo; SECURITY_ATTRIBUTES secAtts; HANDLE hProcess, h, inputHandle, outputHandle, errorHandle; @@ -1027,9 +1037,8 @@ TclpCreateProcess( } if (startInfo.hStdInput == INVALID_HANDLE_VALUE) { TclWinConvertError(GetLastError()); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "couldn't duplicate input handle: %s", - Tcl_PosixError(interp))); + Tcl_AppendResult(interp, "couldn't duplicate input handle: ", + Tcl_PosixError(interp), (char *) NULL); goto end; } @@ -1063,9 +1072,8 @@ TclpCreateProcess( } if (startInfo.hStdOutput == INVALID_HANDLE_VALUE) { TclWinConvertError(GetLastError()); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "couldn't duplicate output handle: %s", - Tcl_PosixError(interp))); + Tcl_AppendResult(interp, "couldn't duplicate output handle: ", + Tcl_PosixError(interp), (char *) NULL); goto end; } @@ -1083,9 +1091,8 @@ TclpCreateProcess( } if (startInfo.hStdError == INVALID_HANDLE_VALUE) { TclWinConvertError(GetLastError()); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "couldn't duplicate error handle: %s", - Tcl_PosixError(interp))); + Tcl_AppendResult(interp, "couldn't duplicate error handle: ", + Tcl_PosixError(interp), (char *) NULL); goto end; } @@ -1117,7 +1124,7 @@ TclpCreateProcess( startInfo.wShowWindow = SW_HIDE; startInfo.dwFlags |= STARTF_USESHOWWINDOW; createFlags = CREATE_NEW_CONSOLE; - TclDStringAppendLiteral(&cmdLine, "cmd.exe /c"); + Tcl_DStringAppend(&cmdLine, "cmd.exe /c", -1); } else { createFlags = DETACHED_PROCESS; } @@ -1129,12 +1136,82 @@ TclpCreateProcess( } if (applType == APPL_DOS) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "DOS application process not supported on this platform", - TCL_STRLEN)); - Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC", "DOS_APP", - NULL); - goto end; + /* + * 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); } } @@ -1158,12 +1235,12 @@ TclpCreateProcess( BuildCommandLine(execPath, argc, argv, &cmdLine); - if (CreateProcess(NULL, (TCHAR *) Tcl_DStringValue(&cmdLine), - NULL, NULL, TRUE, (DWORD) createFlags, NULL, NULL, &startInfo, - &procInfo) == 0) { + if ((*tclWinProcs->createProcessProc)(NULL, + (TCHAR *) Tcl_DStringValue(&cmdLine), NULL, NULL, TRUE, + (DWORD) createFlags, NULL, NULL, &startInfo, &procInfo) == 0) { TclWinConvertError(GetLastError()); - Tcl_SetObjResult(interp, Tcl_ObjPrintf("couldn't execute \"%s\": %s", - argv[0], Tcl_PosixError(interp))); + Tcl_AppendResult(interp, "couldn't execute \"", argv[0], + "\": ", Tcl_PosixError(interp), (char *) NULL); goto end; } @@ -1291,7 +1368,7 @@ ApplicationType( IMAGE_DOS_HEADER header; Tcl_DString nameBuf, ds; const TCHAR *nativeName; - TCHAR nativeFullPath[MAX_PATH]; + WCHAR nativeFullPath[MAX_PATH]; static const char extensions[][5] = {"", ".com", ".exe", ".bat"}; /* @@ -1309,16 +1386,16 @@ ApplicationType( applType = APPL_NONE; Tcl_DStringInit(&nameBuf); - Tcl_DStringAppend(&nameBuf, originalName, TCL_STRLEN); + Tcl_DStringAppend(&nameBuf, originalName, -1); nameLen = Tcl_DStringLength(&nameBuf); for (i = 0; i < (int) (sizeof(extensions) / sizeof(extensions[0])); i++) { Tcl_DStringSetLength(&nameBuf, nameLen); - Tcl_DStringAppend(&nameBuf, extensions[i], TCL_STRLEN); + Tcl_DStringAppend(&nameBuf, extensions[i], -1); nativeName = Tcl_WinUtfToTChar(Tcl_DStringValue(&nameBuf), Tcl_DStringLength(&nameBuf), &ds); - found = SearchPath(NULL, nativeName, NULL, MAX_PATH, - nativeFullPath, &rest); + found = (*tclWinProcs->searchPathProc)(NULL, nativeName, NULL, + MAX_PATH, nativeFullPath, &rest); Tcl_DStringFree(&ds); if (found == 0) { continue; @@ -1329,11 +1406,11 @@ ApplicationType( * known type. */ - attr = GetFileAttributes(nativeFullPath); + attr = (*tclWinProcs->getFileAttributesProc)((TCHAR *) nativeFullPath); if ((attr == 0xffffffff) || (attr & FILE_ATTRIBUTE_DIRECTORY)) { continue; } - strcpy(fullName, Tcl_WinTCharToUtf(nativeFullPath, TCL_STRLEN, &ds)); + strcpy(fullName, Tcl_WinTCharToUtf((TCHAR *) nativeFullPath, -1, &ds)); Tcl_DStringFree(&ds); ext = strrchr(fullName, '.'); @@ -1342,7 +1419,7 @@ ApplicationType( break; } - hFile = CreateFile(nativeFullPath, + hFile = (*tclWinProcs->createFileProc)((TCHAR *) nativeFullPath, GENERIC_READ, FILE_SHARE_READ, NULL, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL); if (hFile == INVALID_HANDLE_VALUE) { @@ -1409,8 +1486,8 @@ ApplicationType( if (applType == APPL_NONE) { TclWinConvertError(GetLastError()); - Tcl_SetObjResult(interp, Tcl_ObjPrintf("couldn't execute \"%s\": %s", - originalName, Tcl_PosixError(interp))); + Tcl_AppendResult(interp, "couldn't execute \"", originalName, + "\": ", Tcl_PosixError(interp), (char *) NULL); return APPL_NONE; } @@ -1422,8 +1499,9 @@ ApplicationType( * application name from the arguments. */ - GetShortPathName(nativeFullPath, nativeFullPath, MAX_PATH); - strcpy(fullName, Tcl_WinTCharToUtf(nativeFullPath, TCL_STRLEN, &ds)); + (*tclWinProcs->getShortPathNameProc)((TCHAR *) nativeFullPath, + nativeFullPath, MAX_PATH); + strcpy(fullName, Tcl_WinTCharToUtf((TCHAR *) nativeFullPath, -1, &ds)); Tcl_DStringFree(&ds); } return applType; @@ -1452,7 +1530,7 @@ static void BuildCommandLine( const char *executable, /* Full path of executable (including * extension). Replacement for argv[0]. */ - size_t argc, /* Number of arguments. */ + int argc, /* Number of arguments. */ const char **argv, /* Argument strings in UTF. */ Tcl_DString *linePtr) /* Initialized Tcl_DString that receives the * command line (TCHAR). */ @@ -1467,9 +1545,9 @@ BuildCommandLine( * Prime the path. Add a space separator if we were primed with something. */ - TclDStringAppendDString(&ds, linePtr); + Tcl_DStringAppend(&ds, Tcl_DStringValue(linePtr), -1); if (Tcl_DStringLength(linePtr) > 0) { - TclDStringAppendLiteral(&ds, " "); + Tcl_DStringAppend(&ds, " ", 1); } for (i = 0; i < argc; i++) { @@ -1477,7 +1555,7 @@ BuildCommandLine( arg = executable; } else { arg = argv[i]; - TclDStringAppendLiteral(&ds, " "); + Tcl_DStringAppend(&ds, " ", 1); } quote = 0; @@ -1486,7 +1564,6 @@ 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. */ @@ -1496,7 +1573,7 @@ BuildCommandLine( } } if (quote) { - TclDStringAppendLiteral(&ds, "\""); + Tcl_DStringAppend(&ds, "\"", 1); } start = arg; for (special = arg; ; ) { @@ -1525,7 +1602,7 @@ BuildCommandLine( } if (*special == '"') { Tcl_DStringAppend(&ds, start, (int) (special - start)); - TclDStringAppendLiteral(&ds, "\\\""); + Tcl_DStringAppend(&ds, "\\\"", 2); start = special + 1; } if (*special == '\0') { @@ -1535,7 +1612,7 @@ BuildCommandLine( } Tcl_DStringAppend(&ds, start, (int) (special - start)); if (quote) { - TclDStringAppendLiteral(&ds, "\""); + Tcl_DStringAppend(&ds, "\"", 1); } } Tcl_DStringFree(linePtr); @@ -1571,7 +1648,7 @@ TclpCreateCommandChannel( { char channelName[16 + TCL_INTEGER_SPACE]; DWORD id; - PipeInfo *infoPtr = ckalloc(sizeof(PipeInfo)); + PipeInfo *infoPtr = (PipeInfo *) ckalloc((unsigned) sizeof(PipeInfo)); PipeInit(); @@ -1586,7 +1663,7 @@ TclpCreateCommandChannel( infoPtr->writeBuf = 0; infoPtr->writeBufLen = 0; infoPtr->writeError = 0; - infoPtr->channel = NULL; + infoPtr->channel = (Tcl_Channel) NULL; infoPtr->validMask = 0; @@ -1628,9 +1705,9 @@ TclpCreateCommandChannel( * unique, in case channels share handles (stdin/stdout). */ - sprintf(channelName, "file%" TCL_I_MODIFIER "x", (size_t) infoPtr); + sprintf(channelName, "file%" TCL_I_MODIFIER "x", (size_t)infoPtr); infoPtr->channel = Tcl_CreateChannel(&pipeChannelType, channelName, - infoPtr, infoPtr->validMask); + (ClientData) infoPtr, infoPtr->validMask); /* * Pipes have AUTO translation mode on Windows and ^Z eof char, which @@ -1638,58 +1715,16 @@ TclpCreateCommandChannel( * Windows programs that expect a ^Z at EOF. */ - Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto"); - Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "\032 {}"); + Tcl_SetChannelOption((Tcl_Interp *) NULL, infoPtr->channel, + "-translation", "auto"); + Tcl_SetChannelOption((Tcl_Interp *) NULL, infoPtr->channel, + "-eofchar", "\032 {}"); return infoPtr->channel; } /* *---------------------------------------------------------------------- * - * Tcl_CreatePipe -- - * - * System dependent interface to create a pipe for the [chan pipe] - * command. Stolen from TclX. - * - * Results: - * TCL_OK or TCL_ERROR. - * - *---------------------------------------------------------------------- - */ - -int -Tcl_CreatePipe( - Tcl_Interp *interp, /* Errors returned in result.*/ - Tcl_Channel *rchan, /* Where to return the read side. */ - Tcl_Channel *wchan, /* Where to return the write side. */ - 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 @@ -1711,8 +1746,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. @@ -1723,17 +1758,14 @@ TclGetAndDetachPids( return; } - pipePtr = Tcl_GetChannelInstanceData(chan); - TclNewObj(pidsObj); + pipePtr = (PipeInfo *) Tcl_GetChannelInstanceData(chan); for (i = 0; i < pipePtr->numPids; i++) { - Tcl_ListObjAppendElement(NULL, pidsObj, - Tcl_NewWideIntObj((unsigned) - TclpGetPid(pipePtr->pidPtr[i]))); - Tcl_DetachPids(1, &pipePtr->pidPtr[i]); + wsprintfA(buf, "%lu", TclpGetPid(pipePtr->pidPtr[i])); + Tcl_AppendElement(interp, buf); + Tcl_DetachPids(1, &(pipePtr->pidPtr[i])); } - Tcl_SetObjResult(interp, pidsObj); if (pipePtr->numPids > 0) { - ckfree(pipePtr->pidPtr); + ckfree((char *) pipePtr->pidPtr); pipePtr->numPids = 0; } } @@ -1878,26 +1910,12 @@ 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 but blocked during exit, bail out since the worker - * thread is not interruptible and we want TIP#398-fast-exit. + * Wait for the writer thread to finish the current buffer, then + * terminate the thread and close the handles. If the channel is + * nonblocking, there should be no pending write operations. */ - if (TclInExit() - && (pipePtr->flags & PIPE_ASYNC)) { - - /* give it a chance to leave honorably */ - SetEvent(pipePtr->stopWriter); - if (WaitForSingleObject(pipePtr->writable, 0) == WAIT_TIMEOUT) { - return EAGAIN; - } - - } else { - - WaitForSingleObject(pipePtr->writable, INFINITE); - - } + WaitForSingleObject(pipePtr->writable, INFINITE); /* * The thread may already have closed on it's own. Check its exit @@ -2007,11 +2025,12 @@ PipeClose2Proc( */ if (pipePtr->errorFile) { - WinFile *filePtr = (WinFile *) pipePtr->errorFile; + WinFile *filePtr; + filePtr = (WinFile*)pipePtr->errorFile; errChan = Tcl_MakeFileChannel((ClientData) filePtr->handle, TCL_READABLE); - ckfree(filePtr); + ckfree((char *) filePtr); } else { errChan = NULL; } @@ -2021,14 +2040,14 @@ PipeClose2Proc( } if (pipePtr->numPids > 0) { - ckfree(pipePtr->pidPtr); + ckfree((char *) pipePtr->pidPtr); } if (pipePtr->writeBuf != NULL) { ckfree(pipePtr->writeBuf); } - ckfree(pipePtr); + ckfree((char*) pipePtr); if (errorCode == 0) { return result; @@ -2054,11 +2073,11 @@ PipeClose2Proc( *---------------------------------------------------------------------- */ -static ssize_t +static int PipeInputProc( ClientData instanceData, /* Pipe state. */ char *buf, /* Where to store data read. */ - size_t bufSize, /* How much space is available in the + int bufSize, /* How much space is available in the * buffer? */ int *errorCode) /* Where to store error code. */ { @@ -2148,11 +2167,11 @@ PipeInputProc( *---------------------------------------------------------------------- */ -static ssize_t +static int PipeOutputProc( ClientData instanceData, /* Pipe state. */ const char *buf, /* The data buffer. */ - size_t toWrite, /* How many bytes to write? */ + int toWrite, /* How many bytes to write? */ int *errorCode) /* Where to store error code. */ { PipeInfo *infoPtr = (PipeInfo *) instanceData; @@ -2196,7 +2215,7 @@ PipeOutputProc( ckfree(infoPtr->writeBuf); } infoPtr->writeBufLen = toWrite; - infoPtr->writeBuf = ckalloc(toWrite); + infoPtr->writeBuf = ckalloc((unsigned int) toWrite); } memcpy(infoPtr->writeBuf, buf, (size_t) toWrite); infoPtr->toWrite = toWrite; @@ -2575,7 +2594,7 @@ Tcl_WaitPid( */ CloseHandle(infoPtr->hProcess); - ckfree(infoPtr); + ckfree((char*)infoPtr); return result; } @@ -2601,9 +2620,9 @@ Tcl_WaitPid( void TclWinAddProcess( void *hProcess, /* Handle to process */ - unsigned long id) /* Global process identifier */ + unsigned long id) /* Global process identifier */ { - ProcInfo *procPtr = ckalloc(sizeof(ProcInfo)); + ProcInfo *procPtr = (ProcInfo *) ckalloc(sizeof(ProcInfo)); PipeInit(); @@ -2637,7 +2656,7 @@ int Tcl_PidObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - size_t objc, /* Number of arguments. */ + int objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* Argument strings. */ { Tcl_Channel chan; @@ -2645,13 +2664,15 @@ 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) { - Tcl_SetObjResult(interp, Tcl_NewWideIntObj((unsigned) getpid())); + wsprintfA(buf, "%lu", (unsigned long) getpid()); + Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, -1)); } else { chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], NULL), NULL); @@ -2666,9 +2687,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_NewWideIntObj((unsigned) - TclpGetPid(pipePtr->pidPtr[i]))); + Tcl_NewStringObj(buf, -1)); } Tcl_SetObjResult(interp, resultPtr); } @@ -2960,10 +2981,6 @@ PipeWriterThread( * an error, so exit. */ - if (waitResult == WAIT_OBJECT_0) { - SetEvent(infoPtr->writable); - } - break; } @@ -3064,100 +3081,6 @@ PipeThreadActionProc( } /* - *---------------------------------------------------------------------- - * - * TclpOpenTemporaryFile -- - * - * Creates a temporary file, possibly based on the supplied bits and - * pieces of template supplied in the first three arguments. If the - * fourth argument is non-NULL, it contains a Tcl_Obj to store the name - * of the temporary file in (and it is caller's responsibility to clean - * up). If the fourth argument is NULL, try to arrange for the temporary - * file to go away once it is no longer needed. - * - * Results: - * A read-write Tcl Channel open on the file. - * - *---------------------------------------------------------------------- - */ - -Tcl_Channel -TclpOpenTemporaryFile( - Tcl_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 48f7894..b2bf1d7 100644 --- a/win/tclWinPort.h +++ b/win/tclWinPort.h @@ -14,24 +14,11 @@ #ifndef _TCLWINPORT #define _TCLWINPORT -#if !defined(_WIN64) && defined(BUILD_tcl) +#ifndef _WIN64 /* 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 @@ -47,10 +34,6 @@ typedef DWORD_PTR * PDWORD_PTR; */ #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 @@ -62,41 +45,28 @@ typedef DWORD_PTR * PDWORD_PTR; #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 <wchar.h> +#include <time.h> #include <io.h> +#include <stdio.h> +#include <stdlib.h> #include <errno.h> #include <fcntl.h> #include <float.h> #include <malloc.h> #include <process.h> #include <signal.h> +#include <string.h> #include <limits.h> -#ifndef strncasecmp -# define strncasecmp strnicmp -#endif -#ifndef strcasecmp -# define strcasecmp stricmp +#ifndef __GNUC__ +# define strncasecmp _strnicmp +# define strcasecmp _stricmp #endif /* @@ -114,169 +84,109 @@ typedef DWORD_PTR * PDWORD_PTR; # endif /* __BORLANDC__ */ #endif /* __MWERKS__ */ -#include <time.h> +/* + * Define EINPROGRESS in terms of WSAEINPROGRESS. + */ + +#undef EINPROGRESS +#define EINPROGRESS WSAEINPROGRESS + +/* + * Define ENOTSUP to a value that will never occur. + */ + +#undef ENOTSUP +#define ENOTSUP -1030507 + +/* Those codes, from Visual Studio 2010, conflict with other values */ +#undef ENODATA +#undef ENOMSG +#undef ENOSR +#undef ENOSTR +#undef EPROTO /* * The following defines redefine the Windows Socket errors as * BSD errors so Tcl_PosixError can do the right thing. */ -#ifndef ENOTEMPTY -# define ENOTEMPTY 41 /* Directory not empty */ -#endif -#ifndef EREMOTE -# define EREMOTE 66 /* The object is remote */ -#endif -#ifndef EPFNOSUPPORT -# define EPFNOSUPPORT 96 /* Protocol family not supported */ -#endif -#ifndef EADDRINUSE -# define EADDRINUSE 100 /* Address already in use */ -#endif -#ifndef EADDRNOTAVAIL -# define EADDRNOTAVAIL 101 /* Can't assign requested address */ -#endif -#ifndef EAFNOSUPPORT -# define EAFNOSUPPORT 102 /* Address family not supported */ -#endif -#ifndef EALREADY -# define EALREADY 103 /* Operation already in progress */ -#endif -#ifndef EBADMSG -# define EBADMSG 104 /* Not a data message */ -#endif -#ifndef ECANCELED -# define ECANCELED 105 /* Canceled */ -#endif -#ifndef ECONNABORTED -# define ECONNABORTED 106 /* Software caused connection abort */ -#endif -#ifndef ECONNREFUSED -# define ECONNREFUSED 107 /* Connection refused */ -#endif -#ifndef ECONNRESET -# define ECONNRESET 108 /* Connection reset by peer */ -#endif -#ifndef EDESTADDRREQ -# define EDESTADDRREQ 109 /* Destination address required */ -#endif -#ifndef EHOSTUNREACH -# define EHOSTUNREACH 110 /* No route to host */ -#endif -#ifndef EIDRM -# define EIDRM 111 /* Identifier removed */ -#endif -#ifndef EINPROGRESS -# define EINPROGRESS 112 /* Operation now in progress */ -#endif -#ifndef EISCONN -# define EISCONN 113 /* Socket is already connected */ -#endif -#ifndef ELOOP -# define ELOOP 114 /* Symbolic link loop */ -#endif -#ifndef EMSGSIZE -# define EMSGSIZE 115 /* Message too long */ -#endif -#ifndef ENETDOWN -# define ENETDOWN 116 /* Network is down */ -#endif -#ifndef ENETRESET -# define ENETRESET 117 /* Network dropped connection on reset */ -#endif -#ifndef ENETUNREACH -# define ENETUNREACH 118 /* Network is unreachable */ -#endif -#ifndef ENOBUFS -# define ENOBUFS 119 /* No buffer space available */ -#endif -#ifndef ENODATA -# define ENODATA 120 /* No data available */ -#endif -#ifndef ENOLINK -# define ENOLINK 121 /* Link has be severed */ -#endif -#ifndef ENOMSG -# define ENOMSG 122 /* No message of desired type */ -#endif -#ifndef ENOPROTOOPT -# define ENOPROTOOPT 123 /* Protocol not available */ -#endif -#ifndef ENOSR -# define ENOSR 124 /* Out of stream resources */ -#endif -#ifndef ENOSTR -# define ENOSTR 125 /* Not a stream device */ -#endif -#ifndef ENOTCONN -# define ENOTCONN 126 /* Socket is not connected */ -#endif -#ifndef ENOTRECOVERABLE -# define ENOTRECOVERABLE 127 /* Not recoverable */ -#endif -#ifndef ENOTSOCK -# define ENOTSOCK 128 /* Socket operation on non-socket */ -#endif -#ifndef ENOTSUP -# define ENOTSUP 129 /* Operation not supported */ -#endif -#ifndef EOPNOTSUPP -# define EOPNOTSUPP 130 /* Operation not supported on socket */ -#endif -#ifndef EOTHER -# define EOTHER 131 /* Other error */ -#endif -#ifndef EOVERFLOW -# define EOVERFLOW 132 /* File too big */ -#endif -#ifndef EOWNERDEAD -# define EOWNERDEAD 133 /* Owner dead */ -#endif -#ifndef EPROTO -# define EPROTO 134 /* Protocol error */ -#endif -#ifndef EPROTONOSUPPORT -# define EPROTONOSUPPORT 135 /* Protocol not supported */ -#endif -#ifndef EPROTOTYPE -# define EPROTOTYPE 136 /* Protocol wrong type for socket */ -#endif -#ifndef ETIME -# define ETIME 137 /* Timer expired */ -#endif -#ifndef ETIMEDOUT -# define ETIMEDOUT 138 /* Connection timed out */ -#endif -#ifndef ETXTBSY -# define ETXTBSY 139 /* Text file or pseudo-device busy */ -#endif -#ifndef EWOULDBLOCK -# define EWOULDBLOCK 140 /* Operation would block */ -#endif +#undef EWOULDBLOCK +#define EWOULDBLOCK EAGAIN +#undef EALREADY +#define EALREADY 149 /* operation already in progress */ +#undef ENOTSOCK +#define ENOTSOCK 95 /* Socket operation on non-socket */ +#undef EDESTADDRREQ +#define EDESTADDRREQ 96 /* Destination address required */ +#undef EMSGSIZE +#define EMSGSIZE 97 /* Message too long */ +#undef EPROTOTYPE +#define EPROTOTYPE 98 /* Protocol wrong type for socket */ +#undef ENOPROTOOPT +#define ENOPROTOOPT 99 /* Protocol not available */ +#undef EPROTONOSUPPORT +#define EPROTONOSUPPORT 120 /* Protocol not supported */ +#undef ESOCKTNOSUPPORT +#define ESOCKTNOSUPPORT 121 /* Socket type not supported */ +#undef EOPNOTSUPP +#define EOPNOTSUPP 122 /* Operation not supported on socket */ +#undef EPFNOSUPPORT +#define EPFNOSUPPORT 123 /* Protocol family not supported */ +#undef EAFNOSUPPORT +#define EAFNOSUPPORT 124 /* Address family not supported */ +#undef EADDRINUSE +#define EADDRINUSE 125 /* Address already in use */ +#undef EADDRNOTAVAIL +#define EADDRNOTAVAIL 126 /* Can't assign requested address */ +#undef ENETDOWN +#define ENETDOWN 127 /* Network is down */ +#undef ENETUNREACH +#define ENETUNREACH 128 /* Network is unreachable */ +#undef ENETRESET +#define ENETRESET 129 /* Network dropped connection on reset */ +#undef ECONNABORTED +#define ECONNABORTED 130 /* Software caused connection abort */ +#undef ECONNRESET +#define ECONNRESET 131 /* Connection reset by peer */ +#undef ENOBUFS +#define ENOBUFS 132 /* No buffer space available */ +#undef EISCONN +#define EISCONN 133 /* Socket is already connected */ +#undef ENOTCONN +#define ENOTCONN 134 /* Socket is not connected */ +#undef ESHUTDOWN +#define ESHUTDOWN 143 /* Can't send after socket shutdown */ +#undef ETOOMANYREFS +#define ETOOMANYREFS 144 /* Too many references: can't splice */ +#undef ETIMEDOUT +#define ETIMEDOUT 145 /* Connection timed out */ +#undef ECONNREFUSED +#define ECONNREFUSED 146 /* Connection refused */ +#undef ELOOP +#define ELOOP 90 /* Symbolic link loop */ +#undef EHOSTDOWN +#define EHOSTDOWN 147 /* Host is down */ +#undef EHOSTUNREACH +#define EHOSTUNREACH 148 /* No route to host */ +#undef ENOTEMPTY +#define ENOTEMPTY 93 /* directory not empty */ +#undef EUSERS +#define EUSERS 94 /* Too many users (for UFS) */ +#undef EDQUOT +#define EDQUOT 69 /* Disc quota exceeded */ +#undef ESTALE +#define ESTALE 151 /* Stale NFS file handle */ +#undef EREMOTE +#define EREMOTE 66 /* The object is remote */ +/* + * It is very hard to determine how Windows reacts to attempting to + * set a file pointer outside the input datatype's representable + * region. So we fake the error code ourselves. + */ -/* Visual Studio doesn't have these, so just choose some high numbers */ -#ifndef ESOCKTNOSUPPORT -# define ESOCKTNOSUPPORT 240 /* Socket type not supported */ -#endif -#ifndef ESHUTDOWN -# define ESHUTDOWN 241 /* Can't send after socket shutdown */ -#endif -#ifndef ETOOMANYREFS -# define ETOOMANYREFS 242 /* Too many references: can't splice */ -#endif -#ifndef EHOSTDOWN -# define EHOSTDOWN 243 /* Host is down */ -#endif -#ifndef EUSERS -# define EUSERS 244 /* Too many users (for UFS) */ -#endif -#ifndef EDQUOT -# define EDQUOT 245 /* Disc quota exceeded */ -#endif -#ifndef ESTALE -# define ESTALE 246 /* Stale NFS file handle */ -#endif +#undef EOVERFLOW +#define EOVERFLOW EFBIG /* The object couldn't fit in the datatype */ /* * Signals not known to the standard ANSI signal.h. These are used @@ -436,17 +346,17 @@ typedef DWORD_PTR * PDWORD_PTR; * EDEADLK as the same value, which confuses Tcl_ErrnoId(). */ -#if defined(_MSC_VER) || defined(__MINGW32__) +#if defined(_MSC_VER) || defined(__MSVCRT__) # define environ _environ # if defined(_MSC_VER) && (_MSC_VER < 1600) # define hypot _hypot # endif # define exception _exception # undef EDEADLOCK -# if defined(__MINGW32__) && !defined(__MSVCRT__) +# if defined(_MSC_VER) && (_MSC_VER >= 1700) # define timezone _timezone # endif -#endif /* _MSC_VER || __MINGW32__ */ +#endif /* _MSC_VER || __MSVCRT__ */ /* * Borland's timezone and environ functions. @@ -469,12 +379,20 @@ typedef DWORD_PTR * PDWORD_PTR; * 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 @@ -507,7 +425,7 @@ typedef DWORD_PTR * PDWORD_PTR; * Msvcrt's putenv() copies the string rather than takes ownership of it. */ -#if defined(_MSC_VER) || defined(__MINGW32__) +#if defined(_MSC_VER) || defined(__MSVCRT__) # define HAVE_PUTENV_THAT_COPIES 1 #endif @@ -530,15 +448,6 @@ typedef DWORD_PTR * PDWORD_PTR; #define TclpSysRealloc(ptr, size) ((void*)HeapReAlloc(GetProcessHeap(), \ (DWORD)0, (LPVOID)ptr, (DWORD)size)) -/* - * 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 setsockopt TclWinSetSockOpt /* This type is not defined in the Windows headers */ #define socklen_t int diff --git a/win/tclWinReg.c b/win/tclWinReg.c index 5b474c0..a6ce2ce 100644 --- a/win/tclWinReg.c +++ b/win/tclWinReg.c @@ -12,57 +12,36 @@ * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ -#undef STATIC_BUILD -#undef USE_TCL_STUBS -#define USE_TCL_STUBS - #include "tclInt.h" +#include "tclPort.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. + * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the + * Registry_Init declaration is in the source file itself, which is only + * accessed when we are building a library. */ -#ifndef KEY_WOW64_64KEY -# define KEY_WOW64_64KEY (0x0100) -#endif -#ifndef KEY_WOW64_32KEY -# define KEY_WOW64_32KEY (0x0200) -#endif +#undef TCL_STORAGE_CLASS +#define TCL_STORAGE_CLASS DLLEXPORT /* * The maximum length of a sub-key name. */ #ifndef MAX_KEY_LENGTH -# define MAX_KEY_LENGTH 256 +#define MAX_KEY_LENGTH 256 #endif /* - * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the - * Registry_Init declaration is in the source file itself, which is only - * accessed when we are building a library. - */ - -#undef TCL_STORAGE_CLASS -#define TCL_STORAGE_CLASS DLLEXPORT - -/* * 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 @@ -76,7 +55,7 @@ * system predefined keys. */ -static const char *const rootKeyNames[] = { +static CONST char *rootKeyNames[] = { "HKEY_LOCAL_MACHINE", "HKEY_USERS", "HKEY_CLASSES_ROOT", "HKEY_CURRENT_USER", "HKEY_CURRENT_CONFIG", "HKEY_PERFORMANCE_DATA", "HKEY_DYN_DATA", NULL @@ -87,7 +66,7 @@ static const HKEY rootKeys[] = { HKEY_CURRENT_CONFIG, HKEY_PERFORMANCE_DATA, HKEY_DYN_DATA }; -static const char REGISTRY_ASSOC_KEY[] = "registry::command"; +static CONST char REGISTRY_ASSOC_KEY[] = "registry::command"; /* * The following table maps from registry types to strings. Note that the @@ -95,7 +74,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 *const typeNames[] = { +static CONST char *typeNames[] = { "none", "sz", "expand_sz", "binary", "dword", "dword_big_endian", "link", "multi_sz", "resource_list", NULL }; @@ -103,26 +82,100 @@ static const char *const 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 *regQueryValueExProc)(HKEY, CONST TCHAR *, DWORD *, DWORD *, + BYTE *, DWORD *); + LONG (WINAPI *regSetValueExProc)(HKEY, CONST TCHAR *, DWORD, DWORD, + CONST BYTE*, DWORD); +} RegWinProcs; + +static RegWinProcs *regWinProcs; + +static RegWinProcs asciiProcs = { + 0, + + (LONG (WINAPI *)(CONST TCHAR *, HKEY, PHKEY)) RegConnectRegistryA, + (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD, TCHAR *, + DWORD, REGSAM, SECURITY_ATTRIBUTES *, HKEY *, + DWORD *)) RegCreateKeyExA, + (LONG (WINAPI *)(HKEY, CONST TCHAR *)) RegDeleteKeyA, + (LONG (WINAPI *)(HKEY, CONST TCHAR *)) RegDeleteValueA, + (LONG (WINAPI *)(HKEY, DWORD, TCHAR *, DWORD)) RegEnumKeyA, + (LONG (WINAPI *)(HKEY, DWORD, TCHAR *, DWORD *, DWORD *, + TCHAR *, DWORD *, FILETIME *)) RegEnumKeyExA, + (LONG (WINAPI *)(HKEY, DWORD, TCHAR *, DWORD *, DWORD *, + DWORD *, BYTE *, DWORD *)) RegEnumValueA, + (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD, REGSAM, + HKEY *)) RegOpenKeyExA, + (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD *, DWORD *, + BYTE *, DWORD *)) RegQueryValueExA, + (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD, DWORD, + CONST BYTE*, DWORD)) RegSetValueExA, +}; + +static RegWinProcs unicodeProcs = { + 1, + + (LONG (WINAPI *)(CONST TCHAR *, HKEY, PHKEY)) RegConnectRegistryW, + (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD, TCHAR *, + DWORD, REGSAM, SECURITY_ATTRIBUTES *, HKEY *, + DWORD *)) RegCreateKeyExW, + (LONG (WINAPI *)(HKEY, CONST TCHAR *)) RegDeleteKeyW, + (LONG (WINAPI *)(HKEY, CONST TCHAR *)) RegDeleteValueW, + (LONG (WINAPI *)(HKEY, DWORD, TCHAR *, DWORD)) RegEnumKeyW, + (LONG (WINAPI *)(HKEY, DWORD, TCHAR *, DWORD *, DWORD *, + TCHAR *, DWORD *, FILETIME *)) RegEnumKeyExW, + (LONG (WINAPI *)(HKEY, DWORD, TCHAR *, DWORD *, DWORD *, + DWORD *, BYTE *, DWORD *)) RegEnumValueW, + (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD, REGSAM, + HKEY *)) RegOpenKeyExW, + (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD *, DWORD *, + BYTE *, DWORD *)) RegQueryValueExW, + (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD, DWORD, + CONST BYTE*, DWORD)) RegSetValueExW, +}; + + +/* * Declarations for functions defined in this file. */ static void AppendSystemError(Tcl_Interp *interp, DWORD error); -static int BroadcastValue(Tcl_Interp *interp, size_t objc, - Tcl_Obj *const objv[]); +static int BroadcastValue(Tcl_Interp *interp, int objc, + Tcl_Obj * CONST objv[]); static DWORD ConvertDWORD(DWORD type, DWORD value); static void DeleteCmd(ClientData clientData); -static int DeleteKey(Tcl_Interp *interp, Tcl_Obj *keyNameObj, - REGSAM mode); +static int DeleteKey(Tcl_Interp *interp, Tcl_Obj *keyNameObj); static int DeleteValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj, - Tcl_Obj *valueNameObj, REGSAM mode); + Tcl_Obj *valueNameObj); static int GetKeyNames(Tcl_Interp *interp, Tcl_Obj *keyNameObj, - Tcl_Obj *patternObj, REGSAM mode); + Tcl_Obj *patternObj); static int GetType(Tcl_Interp *interp, Tcl_Obj *keyNameObj, - Tcl_Obj *valueNameObj, REGSAM mode); + Tcl_Obj *valueNameObj); static int GetValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj, - Tcl_Obj *valueNameObj, REGSAM mode); + Tcl_Obj *valueNameObj); static int GetValueNames(Tcl_Interp *interp, Tcl_Obj *keyNameObj, - Tcl_Obj *patternObj, REGSAM mode); + Tcl_Obj *patternObj); static int OpenKey(Tcl_Interp *interp, Tcl_Obj *keyNameObj, REGSAM mode, int flags, HKEY *keyPtr); static DWORD OpenSubKey(char *hostName, HKEY rootKey, @@ -132,13 +185,13 @@ static int ParseKeyName(Tcl_Interp *interp, char *name, char **hostNamePtr, HKEY *rootKeyPtr, char **keyNamePtr); static DWORD RecursiveDeleteKey(HKEY hStartKey, - const TCHAR * pKeyName, REGSAM mode); + CONST TCHAR * pKeyName); static int RegistryObjCmd(ClientData clientData, - Tcl_Interp *interp, size_t objc, - Tcl_Obj *const objv[]); + Tcl_Interp *interp, int objc, + Tcl_Obj * CONST objv[]); static int SetValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj, Tcl_Obj *valueNameObj, Tcl_Obj *dataObj, - Tcl_Obj *typeObj, REGSAM mode); + Tcl_Obj *typeObj); EXTERN int Registry_Init(Tcl_Interp *interp); EXTERN int Registry_Unload(Tcl_Interp *interp, int flags); @@ -165,14 +218,25 @@ Registry_Init( { Tcl_Command cmd; - if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) { + if (Tcl_InitStubs(interp, "8.1", 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, - interp, DeleteCmd); - Tcl_SetAssocData(interp, REGISTRY_ASSOC_KEY, NULL, cmd); - return Tcl_PkgProvide(interp, "registry", "1.3.0"); + (ClientData)interp, DeleteCmd); + Tcl_SetAssocData(interp, REGISTRY_ASSOC_KEY, NULL, (ClientData)cmd); + return Tcl_PkgProvide(interp, "registry", "1.2.2"); } /* @@ -203,16 +267,16 @@ Registry_Unload( * Unregister the registry package. There is no Tcl_PkgForget() */ - objv[0] = Tcl_NewStringObj("package", TCL_STRLEN); - objv[1] = Tcl_NewStringObj("forget", TCL_STRLEN); - objv[2] = Tcl_NewStringObj("registry", TCL_STRLEN); + objv[0] = Tcl_NewStringObj("package", -1); + objv[1] = Tcl_NewStringObj("forget", -1); + objv[2] = Tcl_NewStringObj("registry", -1); Tcl_EvalObjv(interp, 3, objv, TCL_EVAL_GLOBAL); /* * Delete the originally registered command. */ - cmd = Tcl_GetAssocData(interp, REGISTRY_ASSOC_KEY, NULL); + cmd = (Tcl_Command)Tcl_GetAssocData(interp, REGISTRY_ASSOC_KEY, NULL); if (cmd != NULL) { Tcl_DeleteCommandFromToken(interp, cmd); } @@ -242,8 +306,7 @@ DeleteCmd( ClientData clientData) { Tcl_Interp *interp = clientData; - - Tcl_SetAssocData(interp, REGISTRY_ASSOC_KEY, NULL, NULL); + Tcl_SetAssocData(interp, REGISTRY_ASSOC_KEY, NULL, (ClientData)NULL); } /* @@ -266,126 +329,90 @@ static int RegistryObjCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - size_t objc, /* Number of arguments. */ - Tcl_Obj *const objv[]) /* Argument values. */ + int objc, /* Number of arguments. */ + Tcl_Obj * CONST objv[]) /* Argument values. */ { - size_t n = 1, argc; int index; - REGSAM mode = 0; - const char *errString = NULL; + char *errString = NULL; - static const char *const subcommands[] = { + static CONST char *subcommands[] = { "broadcast", "delete", "get", "keys", "set", "type", "values", NULL }; enum SubCmdIdx { BroadcastIdx, DeleteIdx, GetIdx, KeysIdx, SetIdx, TypeIdx, ValuesIdx }; - static const char *const modes[] = { - "-32bit", "-64bit", NULL - }; if (objc < 2) { - wrongArgs: - Tcl_WrongNumArgs(interp, 1, objv, "?-32bit|-64bit? option ?arg ...?"); + Tcl_WrongNumArgs(interp, objc, objv, "option ?arg arg ...?"); return TCL_ERROR; } - if (Tcl_GetString(objv[n])[0] == '-') { - if (Tcl_GetIndexFromObj(interp, objv[n++], modes, "mode", 0, - &index) != TCL_OK) { - return TCL_ERROR; - } - switch (index) { - case 0: /* -32bit */ - mode |= KEY_WOW64_32KEY; - break; - case 1: /* -64bit */ - mode |= KEY_WOW64_64KEY; - break; - } - if (objc < 3) { - goto wrongArgs; - } - } - - if (Tcl_GetIndexFromObj(interp, objv[n++], subcommands, "option", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObj(interp, objv[1], subcommands, "option", 0, &index) + != TCL_OK) { return TCL_ERROR; } - argc = (objc - n); switch (index) { case BroadcastIdx: /* broadcast */ - if (argc == 1 || argc == 3) { - int res = BroadcastValue(interp, argc, objv + n); - - if (res != TCL_BREAK) { - return res; - } - } - errString = "keyName ?-timeout milliseconds?"; + return BroadcastValue(interp, objc, objv); break; case DeleteIdx: /* delete */ - if (argc == 1) { - return DeleteKey(interp, objv[n], mode); - } else if (argc == 2) { - return DeleteValue(interp, objv[n], objv[n+1], mode); + if (objc == 3) { + return DeleteKey(interp, objv[2]); + } else if (objc == 4) { + return DeleteValue(interp, objv[2], objv[3]); } errString = "keyName ?valueName?"; break; case GetIdx: /* get */ - if (argc == 2) { - return GetValue(interp, objv[n], objv[n+1], mode); + if (objc == 4) { + return GetValue(interp, objv[2], objv[3]); } errString = "keyName valueName"; break; case KeysIdx: /* keys */ - if (argc == 1) { - return GetKeyNames(interp, objv[n], NULL, mode); - } else if (argc == 2) { - return GetKeyNames(interp, objv[n], objv[n+1], mode); + if (objc == 3) { + return GetKeyNames(interp, objv[2], NULL); + } else if (objc == 4) { + return GetKeyNames(interp, objv[2], objv[3]); } errString = "keyName ?pattern?"; break; case SetIdx: /* set */ - if (argc == 1) { + if (objc == 3) { HKEY key; /* * Create the key and then close it immediately. */ - mode |= KEY_ALL_ACCESS; - if (OpenKey(interp, objv[n], mode, 1, &key) != TCL_OK) { + if (OpenKey(interp, objv[2], KEY_ALL_ACCESS, 1, &key) != TCL_OK) { return TCL_ERROR; } RegCloseKey(key); return TCL_OK; - } else if (argc == 3) { - return SetValue(interp, objv[n], objv[n+1], objv[n+2], NULL, - mode); - } else if (argc == 4) { - return SetValue(interp, objv[n], objv[n+1], objv[n+2], objv[n+3], - mode); + } else if (objc == 5 || objc == 6) { + Tcl_Obj *typeObj = (objc == 5) ? NULL : objv[5]; + return SetValue(interp, objv[2], objv[3], objv[4], typeObj); } errString = "keyName ?valueName data ?type??"; break; case TypeIdx: /* type */ - if (argc == 2) { - return GetType(interp, objv[n], objv[n+1], mode); + if (objc == 4) { + return GetType(interp, objv[2], objv[3]); } errString = "keyName valueName"; break; case ValuesIdx: /* values */ - if (argc == 1) { - return GetValueNames(interp, objv[n], NULL, mode); - } else if (argc == 2) { - return GetValueNames(interp, objv[n], objv[n+1], mode); + if (objc == 3) { + return GetValueNames(interp, objv[2], NULL); + } else if (objc == 4) { + return GetValueNames(interp, objv[2], objv[3]); } errString = "keyName ?pattern?"; break; } - Tcl_WrongNumArgs(interp, (mode ? 3 : 2), objv, errString); + Tcl_WrongNumArgs(interp, 2, objv, errString); return TCL_ERROR; } @@ -408,23 +435,21 @@ RegistryObjCmd( static int DeleteKey( Tcl_Interp *interp, /* Current interpreter. */ - Tcl_Obj *keyNameObj, /* Name of key to delete. */ - REGSAM mode) /* Mode flags to pass. */ + Tcl_Obj *keyNameObj) /* Name of key to delete. */ { char *tail, *buffer, *hostName, *keyName; - const TCHAR *nativeTail; + CONST char *nativeTail; HKEY rootKey, subkey; DWORD result; - size_t length; + 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(length + 1); + buffer = ckalloc((unsigned int) length + 1); strcpy(buffer, keyName); if (ParseKeyName(interp, buffer, &hostName, &rootKey, @@ -435,8 +460,7 @@ DeleteKey( if (*keyName == '\0') { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "bad key: cannot delete root keys", TCL_STRLEN)); - Tcl_SetErrorCode(interp, "WIN_REG", "DEL_ROOT_KEY", NULL); + "bad key: cannot delete root keys", -1)); ckfree(buffer); return TCL_ERROR; } @@ -449,15 +473,15 @@ DeleteKey( keyName = NULL; } - mode |= KEY_ENUMERATE_SUB_KEYS | DELETE; - result = OpenSubKey(hostName, rootKey, keyName, mode, 0, &subkey); + result = OpenSubKey(hostName, rootKey, keyName, + KEY_ENUMERATE_SUB_KEYS | DELETE, 0, &subkey); if (result != ERROR_SUCCESS) { ckfree(buffer); if (result == ERROR_FILE_NOT_FOUND) { return TCL_OK; } - Tcl_SetObjResult(interp, - Tcl_NewStringObj("unable to delete key: ", TCL_STRLEN)); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "unable to delete key: ", -1)); AppendSystemError(interp, result); return TCL_ERROR; } @@ -466,13 +490,13 @@ DeleteKey( * Now we recursively delete the key and everything below it. */ - nativeTail = Tcl_WinUtfToTChar(tail, TCL_STRLEN, &buf); - result = RecursiveDeleteKey(subkey, nativeTail, saveMode); + nativeTail = Tcl_WinUtfToTChar(tail, -1, &buf); + result = RecursiveDeleteKey(subkey, nativeTail); Tcl_DStringFree(&buf); if (result != ERROR_SUCCESS && result != ERROR_FILE_NOT_FOUND) { Tcl_SetObjResult(interp, - Tcl_NewStringObj("unable to delete key: ", TCL_STRLEN)); + Tcl_NewStringObj("unable to delete key: ", -1)); AppendSystemError(interp, result); result = TCL_ERROR; } else { @@ -504,12 +528,11 @@ static int DeleteValue( Tcl_Interp *interp, /* Current interpreter. */ Tcl_Obj *keyNameObj, /* Name of key. */ - Tcl_Obj *valueNameObj, /* Name of value to delete. */ - REGSAM mode) /* Mode flags to pass. */ + Tcl_Obj *valueNameObj) /* Name of value to delete. */ { HKEY key; char *valueName; - size_t length; + int length; DWORD result; Tcl_DString ds; @@ -517,19 +540,19 @@ DeleteValue( * Attempt to open the key for deletion. */ - mode |= KEY_SET_VALUE; - if (OpenKey(interp, keyNameObj, mode, 0, &key) != TCL_OK) { + if (OpenKey(interp, keyNameObj, KEY_SET_VALUE, 0, &key) + != TCL_OK) { return TCL_ERROR; } valueName = Tcl_GetStringFromObj(valueNameObj, &length); Tcl_WinUtfToTChar(valueName, length, &ds); - result = RegDeleteValue(key, (const TCHAR *)Tcl_DStringValue(&ds)); + result = (*regWinProcs->regDeleteValueProc)(key, Tcl_DStringValue(&ds)); Tcl_DStringFree(&ds); if (result != ERROR_SUCCESS) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "unable to delete value \"%s\" from key \"%s\": ", - Tcl_GetString(valueNameObj), Tcl_GetString(keyNameObj))); + Tcl_AppendResult(interp, "unable to delete value \"", + Tcl_GetString(valueNameObj), "\" from key \"", + Tcl_GetString(keyNameObj), "\": ", NULL); AppendSystemError(interp, result); result = TCL_ERROR; } else { @@ -562,13 +585,11 @@ static int GetKeyNames( Tcl_Interp *interp, /* Current interpreter. */ Tcl_Obj *keyNameObj, /* Key to enumerate. */ - Tcl_Obj *patternObj, /* Optional match pattern. */ - REGSAM mode) /* Mode flags to pass. */ + Tcl_Obj *patternObj) /* Optional match pattern. */ { - const char *pattern; /* Pattern being matched against subkeys */ + char *pattern; /* Pattern being matched against subkeys */ HKEY key; /* Handle to the key being examined */ - TCHAR buffer[MAX_KEY_LENGTH]; - /* Buffer to hold the subkey name */ + TCHAR buffer[MAX_KEY_LENGTH*2]; /* Buffer to hold the subkey name */ DWORD bufSize; /* Size of the buffer */ DWORD index; /* Position of the current subkey */ char *name; /* Subkey name */ @@ -582,37 +603,39 @@ GetKeyNames( pattern = NULL; } - /* - * Attempt to open the key for enumeration. - */ + /* Attempt to open the key for enumeration. */ - mode |= KEY_QUERY_VALUE | KEY_ENUMERATE_SUB_KEYS; - if (OpenKey(interp, keyNameObj, mode, 0, &key) != TCL_OK) { + if (OpenKey(interp, keyNameObj, + KEY_QUERY_VALUE | KEY_ENUMERATE_SUB_KEYS, + 0, &key) != TCL_OK) { return TCL_ERROR; } - /* - * Enumerate the subkeys. - */ + /* Enumerate the subkeys */ resultPtr = Tcl_NewObj(); for (index = 0;; ++index) { bufSize = MAX_KEY_LENGTH; - result = RegEnumKeyEx(key, index, buffer, &bufSize, - NULL, NULL, NULL, NULL); + result = (*regWinProcs->regEnumKeyExProc) + (key, index, buffer, &bufSize, NULL, NULL, NULL, NULL); if (result != ERROR_SUCCESS) { if (result == ERROR_NO_MORE_ITEMS) { result = TCL_OK; } else { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "unable to enumerate subkeys of \"%s\": ", - Tcl_GetString(keyNameObj))); + Tcl_SetObjResult(interp, Tcl_NewObj()); + Tcl_AppendResult(interp, + "unable to enumerate subkeys of \"", + Tcl_GetString(keyNameObj), "\": ", NULL); AppendSystemError(interp, result); result = TCL_ERROR; } break; } - Tcl_WinTCharToUtf(buffer, bufSize * sizeof(TCHAR), &ds); + if (regWinProcs->useWide) { + Tcl_WinTCharToUtf((TCHAR *) buffer, bufSize * sizeof(WCHAR), &ds); + } else { + Tcl_WinTCharToUtf((TCHAR *) buffer, bufSize, &ds); + } name = Tcl_DStringValue(&ds); if (pattern && !Tcl_StringMatch(name, pattern)) { Tcl_DStringFree(&ds); @@ -656,22 +679,22 @@ static int GetType( Tcl_Interp *interp, /* Current interpreter. */ Tcl_Obj *keyNameObj, /* Name of key. */ - Tcl_Obj *valueNameObj, /* Name of value to get. */ - REGSAM mode) /* Mode flags to pass. */ + Tcl_Obj *valueNameObj) /* Name of value to get. */ { HKEY key; - DWORD result, type; + DWORD result; + DWORD type; Tcl_DString ds; - const char *valueName; - const TCHAR *nativeValue; - size_t length; + char *valueName; + CONST char *nativeValue; + int length; /* * Attempt to open the key for reading. */ - mode |= KEY_QUERY_VALUE; - if (OpenKey(interp, keyNameObj, mode, 0, &key) != TCL_OK) { + if (OpenKey(interp, keyNameObj, KEY_QUERY_VALUE, 0, &key) + != TCL_OK) { return TCL_ERROR; } @@ -681,15 +704,15 @@ GetType( valueName = Tcl_GetStringFromObj(valueNameObj, &length); nativeValue = Tcl_WinUtfToTChar(valueName, length, &ds); - result = RegQueryValueEx(key, nativeValue, NULL, &type, + result = (*regWinProcs->regQueryValueExProc)(key, nativeValue, NULL, &type, NULL, NULL); Tcl_DStringFree(&ds); RegCloseKey(key); if (result != ERROR_SUCCESS) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "unable to get type of value \"%s\" from key \"%s\": ", - Tcl_GetString(valueNameObj), Tcl_GetString(keyNameObj))); + Tcl_AppendResult(interp, "unable to get type of value \"", + Tcl_GetString(valueNameObj), "\" from key \"", + Tcl_GetString(keyNameObj), "\": ", NULL); AppendSystemError(interp, result); return TCL_ERROR; } @@ -702,8 +725,7 @@ GetType( if (type > lastType) { Tcl_SetObjResult(interp, Tcl_NewIntObj((int) type)); } else { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - typeNames[type], TCL_STRLEN)); + Tcl_SetObjResult(interp, Tcl_NewStringObj(typeNames[type], -1)); } return TCL_OK; } @@ -729,22 +751,20 @@ static int GetValue( Tcl_Interp *interp, /* Current interpreter. */ Tcl_Obj *keyNameObj, /* Name of key. */ - Tcl_Obj *valueNameObj, /* Name of value to get. */ - REGSAM mode) /* Mode flags to pass. */ + Tcl_Obj *valueNameObj) /* Name of value to get. */ { HKEY key; - const char *valueName; - const TCHAR *nativeValue; + char *valueName; + CONST char *nativeValue; DWORD result, length, type; Tcl_DString data, buf; - size_t nameLen; + int nameLen; /* * Attempt to open the key for reading. */ - mode |= KEY_QUERY_VALUE; - if (OpenKey(interp, keyNameObj, mode, 0, &key) != TCL_OK) { + if (OpenKey(interp, keyNameObj, KEY_QUERY_VALUE, 0, &key) != TCL_OK) { return TCL_ERROR; } @@ -760,12 +780,12 @@ GetValue( Tcl_DStringInit(&data); Tcl_DStringSetLength(&data, TCL_DSTRING_STATIC_SIZE - 1); - length = TCL_DSTRING_STATIC_SIZE/sizeof(TCHAR) - 1; + length = TCL_DSTRING_STATIC_SIZE / (regWinProcs->useWide ? 2 : 1) - 1; valueName = Tcl_GetStringFromObj(valueNameObj, &nameLen); nativeValue = Tcl_WinUtfToTChar(valueName, nameLen, &buf); - result = RegQueryValueEx(key, nativeValue, NULL, &type, + result = (*regWinProcs->regQueryValueExProc)(key, nativeValue, NULL, &type, (BYTE *) Tcl_DStringValue(&data), &length); while (result == ERROR_MORE_DATA) { /* @@ -774,17 +794,17 @@ GetValue( * HKEY_PERFORMANCE_DATA */ - length = Tcl_DStringLength(&data) * (2 / sizeof(TCHAR)); - Tcl_DStringSetLength(&data, (int) length * sizeof(TCHAR)); - result = RegQueryValueEx(key, nativeValue, + length = Tcl_DStringLength(&data) * (regWinProcs->useWide ? 1 : 2); + Tcl_DStringSetLength(&data, (int) length * (regWinProcs->useWide ? 2 : 1)); + result = (*regWinProcs->regQueryValueExProc)(key, (char *) nativeValue, NULL, &type, (BYTE *) Tcl_DStringValue(&data), &length); } Tcl_DStringFree(&buf); RegCloseKey(key); if (result != ERROR_SUCCESS) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "unable to get value \"%s\" from key \"%s\": ", - Tcl_GetString(valueNameObj), Tcl_GetString(keyNameObj))); + Tcl_AppendResult(interp, "unable to get value \"", + Tcl_GetString(valueNameObj), "\" from key \"", + Tcl_GetString(keyNameObj), "\": ", NULL); AppendSystemError(interp, result); Tcl_DStringFree(&data); return TCL_ERROR; @@ -799,7 +819,7 @@ GetValue( if (type == REG_DWORD || type == REG_DWORD_BIG_ENDIAN) { Tcl_SetObjResult(interp, Tcl_NewIntObj((int) ConvertDWORD(type, - *((DWORD *) Tcl_DStringValue(&data))))); + *((DWORD*) Tcl_DStringValue(&data))))); } else if (type == REG_MULTI_SZ) { char *p = Tcl_DStringValue(&data); char *end = Tcl_DStringValue(&data) + length; @@ -811,23 +831,24 @@ GetValue( * we get bogus data. */ - while ((p < end) && *((Tcl_UniChar *) p) != 0) { - Tcl_UniChar *up; - - Tcl_WinTCharToUtf((TCHAR *) p, TCL_STRLEN, &buf); + while (p < end && ((regWinProcs->useWide) + ? *((Tcl_UniChar *)p) : *p) != 0) { + Tcl_WinTCharToUtf((TCHAR *) p, -1, &buf); Tcl_ListObjAppendElement(interp, resultPtr, Tcl_NewStringObj(Tcl_DStringValue(&buf), Tcl_DStringLength(&buf))); - up = (Tcl_UniChar *) p; - - while (*up++ != 0) {/* empty body */} - p = (char *) up; + if (regWinProcs->useWide) { + Tcl_UniChar* up = (Tcl_UniChar*) p; + while (*up++ != 0) {} + p = (char*) up; + } else { + while (*p++ != '\0') {} + } Tcl_DStringFree(&buf); } Tcl_SetObjResult(interp, resultPtr); } else if ((type == REG_SZ) || (type == REG_EXPAND_SZ)) { - Tcl_WinTCharToUtf((TCHAR *) Tcl_DStringValue(&data), TCL_STRLEN, - &buf); + Tcl_WinTCharToUtf((TCHAR *) Tcl_DStringValue(&data), -1, &buf); Tcl_DStringResult(interp, &buf); } else { /* @@ -864,27 +885,27 @@ static int GetValueNames( Tcl_Interp *interp, /* Current interpreter. */ Tcl_Obj *keyNameObj, /* Key to enumerate. */ - Tcl_Obj *patternObj, /* Optional match pattern. */ - REGSAM mode) /* Mode flags to pass. */ + Tcl_Obj *patternObj) /* Optional match pattern. */ { HKEY key; Tcl_Obj *resultPtr; DWORD index, size, result; Tcl_DString buffer, ds; - const char *pattern, *name; + char *pattern, *name; /* * Attempt to open the key for enumeration. */ - mode |= KEY_QUERY_VALUE; - if (OpenKey(interp, keyNameObj, mode, 0, &key) != TCL_OK) { + if (OpenKey(interp, keyNameObj, KEY_QUERY_VALUE, 0, &key) + != TCL_OK) { return TCL_ERROR; } resultPtr = Tcl_NewObj(); Tcl_DStringInit(&buffer); - Tcl_DStringSetLength(&buffer, (int) (MAX_KEY_LENGTH * sizeof(TCHAR))); + Tcl_DStringSetLength(&buffer, + (int) ((regWinProcs->useWide) ? MAX_KEY_LENGTH*2 : MAX_KEY_LENGTH)); index = 0; result = TCL_OK; @@ -901,9 +922,13 @@ GetValueNames( */ size = MAX_KEY_LENGTH; - while (RegEnumValue(key,index, (TCHAR *)Tcl_DStringValue(&buffer), - &size, NULL, NULL, NULL, NULL) == ERROR_SUCCESS) { - size *= sizeof(TCHAR); + while ((*regWinProcs->regEnumValueProc)(key, index, + Tcl_DStringValue(&buffer), &size, NULL, NULL, NULL, NULL) + == ERROR_SUCCESS) { + + if (regWinProcs->useWide) { + size *= 2; + } Tcl_WinTCharToUtf((TCHAR *) Tcl_DStringValue(&buffer), (int) size, &ds); @@ -953,12 +978,12 @@ OpenKey( HKEY *keyPtr) /* Returned HKEY. */ { char *keyName, *buffer, *hostName; - size_t length; + int length; HKEY rootKey; DWORD result; keyName = Tcl_GetStringFromObj(keyNameObj, &length); - buffer = ckalloc(length + 1); + buffer = ckalloc((unsigned int) length + 1); strcpy(buffer, keyName); result = ParseKeyName(interp, buffer, &hostName, &rootKey, &keyName); @@ -966,7 +991,7 @@ OpenKey( result = OpenSubKey(hostName, rootKey, keyName, mode, flags, keyPtr); if (result != ERROR_SUCCESS) { Tcl_SetObjResult(interp, - Tcl_NewStringObj("unable to open key: ", TCL_STRLEN)); + Tcl_NewStringObj("unable to open key: ", -1)); AppendSystemError(interp, result); result = TCL_ERROR; } else { @@ -1013,8 +1038,8 @@ OpenSubKey( */ if (hostName) { - hostName = (char *) Tcl_WinUtfToTChar(hostName, TCL_STRLEN, &buf); - result = RegConnectRegistry((TCHAR *)hostName, rootKey, + hostName = (char *) Tcl_WinUtfToTChar(hostName, -1, &buf); + result = (*regWinProcs->regConnectRegistryProc)(hostName, rootKey, &rootKey); Tcl_DStringFree(&buf); if (result != ERROR_SUCCESS) { @@ -1027,22 +1052,20 @@ OpenSubKey( * this key must be closed by the caller. */ - keyName = (char *) Tcl_WinUtfToTChar(keyName, TCL_STRLEN, &buf); + keyName = (char *) Tcl_WinUtfToTChar(keyName, -1, &buf); if (flags & REG_CREATE) { DWORD create; - - result = RegCreateKeyEx(rootKey, (TCHAR *)keyName, 0, NULL, + result = (*regWinProcs->regCreateKeyExProc)(rootKey, keyName, 0, NULL, REG_OPTION_NON_VOLATILE, mode, NULL, keyPtr, &create); } else if (rootKey == HKEY_PERFORMANCE_DATA) { /* * Here we fudge it for this special root key. See MSDN for more info * on HKEY_PERFORMANCE_DATA and the peculiarities surrounding it. */ - *keyPtr = HKEY_PERFORMANCE_DATA; result = ERROR_SUCCESS; } else { - result = RegOpenKeyEx(rootKey, (TCHAR *)keyName, 0, mode, + result = (*regWinProcs->regOpenKeyExProc)(rootKey, keyName, 0, mode, keyPtr); } Tcl_DStringFree(&buf); @@ -1106,9 +1129,8 @@ ParseKeyName( rootName = name; } if (!rootName) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "bad key \"%s\": must start with a valid root", name)); - Tcl_SetErrorCode(interp, "WIN_REG", "NO_ROOT_KEY", NULL); + Tcl_AppendResult(interp, "bad key \"", name, + "\": must start with a valid root", NULL); return TCL_ERROR; } @@ -1128,7 +1150,7 @@ ParseKeyName( * Look for a matching root name. */ - rootObj = Tcl_NewStringObj(rootName, TCL_STRLEN); + rootObj = Tcl_NewStringObj(rootName, -1); result = Tcl_GetIndexFromObj(interp, rootObj, rootKeyNames, "root name", TCL_EXACT, &index); Tcl_DecrRefCount(rootObj); @@ -1160,16 +1182,12 @@ ParseKeyName( static DWORD RecursiveDeleteKey( HKEY startKey, /* Parent of key to be deleted. */ - const TCHAR *keyName, /* Name of key to be deleted in external + CONST char *keyName) /* Name of key to be deleted in external * encoding, not UTF. */ - REGSAM mode) /* Mode flags to pass. */ { DWORD result, size; Tcl_DString subkey; HKEY hKey; - REGSAM saveMode = mode; - static int checkExProc = 0; - static FARPROC regDeleteKeyExProc = NULL; /* * Do not allow NULL or empty key name. @@ -1179,50 +1197,29 @@ RecursiveDeleteKey( return ERROR_BADKEY; } - mode |= KEY_ENUMERATE_SUB_KEYS | DELETE | KEY_QUERY_VALUE; - result = RegOpenKeyEx(startKey, keyName, 0, mode, &hKey); + result = (*regWinProcs->regOpenKeyExProc)(startKey, keyName, 0, + KEY_ENUMERATE_SUB_KEYS | DELETE | KEY_QUERY_VALUE, &hKey); if (result != ERROR_SUCCESS) { return result; } Tcl_DStringInit(&subkey); - Tcl_DStringSetLength(&subkey, (int) (MAX_KEY_LENGTH * sizeof(TCHAR))); + Tcl_DStringSetLength(&subkey, + (int) ((regWinProcs->useWide) ? MAX_KEY_LENGTH * 2 : MAX_KEY_LENGTH)); - mode = saveMode; while (result == ERROR_SUCCESS) { /* * Always get index 0 because key deletion changes ordering. */ size = MAX_KEY_LENGTH; - result = RegEnumKeyEx(hKey, 0, (TCHAR *)Tcl_DStringValue(&subkey), - &size, NULL, NULL, NULL, NULL); + result=(*regWinProcs->regEnumKeyExProc)(hKey, 0, + Tcl_DStringValue(&subkey), &size, NULL, NULL, NULL, NULL); if (result == ERROR_NO_MORE_ITEMS) { - /* - * RegDeleteKeyEx doesn't exist on non-64bit XP platforms, so we - * can't compile with it in. We need to check for it at runtime - * and use it if we find it. - */ - - if (mode && !checkExProc) { - 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); - } + result = (*regWinProcs->regDeleteKeyProc)(startKey, keyName); break; } else if (result == ERROR_SUCCESS) { - result = RecursiveDeleteKey(hKey, - (const TCHAR *) Tcl_DStringValue(&subkey), mode); + result = RecursiveDeleteKey(hKey, Tcl_DStringValue(&subkey)); } } Tcl_DStringFree(&subkey); @@ -1254,27 +1251,25 @@ SetValue( Tcl_Obj *keyNameObj, /* Name of key. */ Tcl_Obj *valueNameObj, /* Name of value to set. */ Tcl_Obj *dataObj, /* Data to be written. */ - Tcl_Obj *typeObj, /* Type of data to be written. */ - REGSAM mode) /* Mode flags to pass. */ + Tcl_Obj *typeObj) /* Type of data to be written. */ { int type; - size_t length; DWORD result; HKEY key; - const char *valueName; + int length; + 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); } - mode |= KEY_ALL_ACCESS; - if (OpenKey(interp, keyNameObj, mode, 1, &key) != TCL_OK) { + if (OpenKey(interp, keyNameObj, KEY_ALL_ACCESS, 1, &key) != TCL_OK) { return TCL_ERROR; } @@ -1290,12 +1285,12 @@ SetValue( return TCL_ERROR; } - value = ConvertDWORD((DWORD) type, (DWORD) value); - result = RegSetValueEx(key, (TCHAR *) valueName, 0, + value = ConvertDWORD((DWORD)type, (DWORD)value); + result = (*regWinProcs->regSetValueExProc)(key, valueName, 0, (DWORD) type, (BYTE *) &value, sizeof(DWORD)); } else if (type == REG_MULTI_SZ) { Tcl_DString data, buf; - size_t objc, i; + int objc, i; Tcl_Obj **objv; if (Tcl_ListObjGetElements(interp, dataObj, &objc, &objv) != TCL_OK) { @@ -1312,39 +1307,42 @@ SetValue( Tcl_DStringInit(&data); for (i = 0; i < objc; i++) { - const char *bytes = Tcl_GetStringFromObj(objv[i], &length); - - Tcl_DStringAppend(&data, bytes, length); + Tcl_DStringAppend(&data, Tcl_GetString(objv[i]), -1); /* - * Add a null character to separate this value from the next. + * Add a null character to separate this value from the next. We + * accomplish this by growing the string by one byte. Since the + * DString always tacks on an extra null byte, the new byte will + * already be set to null. */ - Tcl_DStringAppend(&data, "", 1); /* NUL-terminated string */ + Tcl_DStringSetLength(&data, Tcl_DStringLength(&data)+1); } Tcl_WinUtfToTChar(Tcl_DStringValue(&data), Tcl_DStringLength(&data)+1, &buf); - result = RegSetValueEx(key, (TCHAR *) valueName, 0, - (DWORD) type, (BYTE *) Tcl_DStringValue(&buf), + result = (*regWinProcs->regSetValueExProc)(key, valueName, 0, + (DWORD) type, (BYTE *) Tcl_DStringValue(&buf), (DWORD) Tcl_DStringLength(&buf)); Tcl_DStringFree(&data); Tcl_DStringFree(&buf); } else if (type == REG_SZ || type == REG_EXPAND_SZ) { Tcl_DString buf; - const char *data = Tcl_GetStringFromObj(dataObj, &length); + CONST char *data = Tcl_GetStringFromObj(dataObj, &length); - data = (char *) Tcl_WinUtfToTChar(data, length, &buf); + data = Tcl_WinUtfToTChar(data, length, &buf); /* * Include the null in the length, padding if needed for Unicode. */ - Tcl_DStringSetLength(&buf, Tcl_DStringLength(&buf)+1); + if (regWinProcs->useWide) { + Tcl_DStringSetLength(&buf, Tcl_DStringLength(&buf)+1); + } length = Tcl_DStringLength(&buf) + 1; - result = RegSetValueEx(key, (TCHAR *) valueName, 0, - (DWORD) type, (BYTE *) data, (DWORD) length); + result = (*regWinProcs->regSetValueExProc)(key, valueName, 0, + (DWORD) type, (BYTE *) data, (DWORD) length); Tcl_DStringFree(&buf); } else { BYTE *data; @@ -1354,8 +1352,8 @@ SetValue( */ data = (BYTE *) Tcl_GetByteArrayFromObj(dataObj, &length); - result = RegSetValueEx(key, (TCHAR *) valueName, 0, - (DWORD) type, data, (DWORD) length); + result = (*regWinProcs->regSetValueExProc)(key, valueName, 0, + (DWORD) type, data, (DWORD) length); } Tcl_DStringFree(&nameBuf); @@ -1363,7 +1361,7 @@ SetValue( if (result != ERROR_SUCCESS) { Tcl_SetObjResult(interp, - Tcl_NewStringObj("unable to set value: ", TCL_STRLEN)); + Tcl_NewStringObj("unable to set value: ", -1)); AppendSystemError(interp, result); return TCL_ERROR; } @@ -1390,28 +1388,34 @@ SetValue( static int BroadcastValue( Tcl_Interp *interp, /* Current interpreter. */ - size_t objc, /* Number of arguments. */ - Tcl_Obj *const objv[]) /* Argument values. */ + int objc, /* Number of arguments. */ + Tcl_Obj *CONST objv[]) /* Argument values. */ { LRESULT result; DWORD_PTR sendResult; UINT timeout = 3000; - size_t len; - const char *str; + int len; + CONST char *str; Tcl_Obj *objPtr; - if (objc == 3) { - str = Tcl_GetStringFromObj(objv[1], &len); + if ((objc != 3) && (objc != 5)) { + Tcl_WrongNumArgs(interp, 2, objv, "keyName ?-timeout millisecs?"); + return TCL_ERROR; + } + + if (objc > 3) { + str = Tcl_GetStringFromObj(objv[3], &len); if ((len < 2) || (*str != '-') || strncmp(str, "-timeout", (size_t) len)) { - return TCL_BREAK; + Tcl_WrongNumArgs(interp, 2, objv, "keyName ?-timeout millisecs?"); + return TCL_ERROR; } - if (Tcl_GetIntFromObj(interp, objv[2], (int *) &timeout) != TCL_OK) { + if (Tcl_GetIntFromObj(interp, objv[4], (int *) &timeout) != TCL_OK) { return TCL_ERROR; } } - str = Tcl_GetStringFromObj(objv[0], &len); + str = Tcl_GetStringFromObj(objv[2], &len); if (len == 0) { str = NULL; } @@ -1420,7 +1424,7 @@ BroadcastValue( * Use the ignore the result. */ - result = SendMessageTimeoutA(HWND_BROADCAST, WM_SETTINGCHANGE, + result = SendMessageTimeout(HWND_BROADCAST, WM_SETTINGCHANGE, (WPARAM) 0, (LPARAM) str, SMTO_ABORTIFHUNG, timeout, &sendResult); objPtr = Tcl_NewObj(); @@ -1453,9 +1457,9 @@ AppendSystemError( Tcl_Interp *interp, /* Current interpreter. */ DWORD error) /* Result code from error. */ { - size_t length; - TCHAR *tMsgPtr, **tMsgPtrPtr = &tMsgPtr; - const char *msg; + int length; + WCHAR *wMsgPtr, **wMsgPtrPtr = &wMsgPtr; + char *msg; char id[TCL_INTEGER_SPACE], msgBuf[24 + TCL_INTEGER_SPACE]; Tcl_DString ds; Tcl_Obj *resultPtr = Tcl_GetObjResult(interp); @@ -1463,34 +1467,52 @@ AppendSystemError( if (Tcl_IsShared(resultPtr)) { resultPtr = Tcl_DuplicateObj(resultPtr); } - length = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM + length = FormatMessageW(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_ALLOCATE_BUFFER, NULL, error, - MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (TCHAR *) tMsgPtrPtr, + MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (WCHAR *) wMsgPtrPtr, 0, NULL); if (length == 0) { - sprintf(msgBuf, "unknown error: %ld", error); - msg = msgBuf; - } else { char *msgPtr; - Tcl_WinTCharToUtf(tMsgPtr, TCL_STRLEN, &ds); - LocalFree(tMsgPtr); + length = FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM + | FORMAT_MESSAGE_ALLOCATE_BUFFER, NULL, error, + MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (char *) &msgPtr, + 0, NULL); + if (length > 0) { + wMsgPtr = (WCHAR *) LocalAlloc(LPTR, (length + 1) * sizeof(WCHAR)); + MultiByteToWideChar(CP_ACP, 0, msgPtr, length + 1, wMsgPtr, + length + 1); + LocalFree(msgPtr); + } + } + if (length == 0) { + if (error == ERROR_CALL_NOT_IMPLEMENTED) { + msg = "function not supported under Win32s"; + } else { + sprintf(msgBuf, "unknown error: %ld", error); + msg = msgBuf; + } + } else { + Tcl_Encoding encoding; + + encoding = Tcl_GetEncoding(NULL, "unicode"); + Tcl_ExternalToUtfDString(encoding, (char *) wMsgPtr, -1, &ds); + Tcl_FreeEncoding(encoding); + LocalFree(wMsgPtr); - msgPtr = Tcl_DStringValue(&ds); + msg = Tcl_DStringValue(&ds); length = Tcl_DStringLength(&ds); /* * Trim the trailing CR/LF from the system message. */ - if (msgPtr[length-1] == '\n') { - --length; + if (msg[length-1] == '\n') { + msg[--length] = 0; } - if (msgPtr[length-1] == '\r') { - --length; + if (msg[length-1] == '\r') { + msg[--length] = 0; } - msgPtr[length] = 0; - msg = msgPtr; } sprintf(id, "%ld", error); @@ -1525,15 +1547,14 @@ ConvertDWORD( DWORD type, /* Either REG_DWORD or REG_DWORD_BIG_ENDIAN */ DWORD value) /* The value to be converted. */ { - const DWORD order = 1; + DWORD order = 1; DWORD localType; /* * Check to see if the low bit is in the first byte. */ - localType = (*((const char *) &order) == 1) - ? REG_DWORD : REG_DWORD_BIG_ENDIAN; + localType = (*((char*) &order) == 1) ? REG_DWORD : REG_DWORD_BIG_ENDIAN; return (type != localType) ? (DWORD) SWAPLONG(value) : value; } diff --git a/win/tclWinSerial.c b/win/tclWinSerial.c index cf25185..83f1866 100644 --- a/win/tclWinSerial.c +++ b/win/tclWinSerial.c @@ -14,8 +14,6 @@ #include "tclWinInt.h" -#include <sys/stat.h> - /* * The following variable is used to tell whether this module has been * initialized. @@ -113,11 +111,11 @@ typedef struct SerialInfo { * synchronized with the evWritable object. */ char *writeBuf; /* Current background output buffer. Access is * synchronized with the evWritable object. */ - size_t writeBufLen; /* Size of write buffer. Access is + int writeBufLen; /* Size of write buffer. Access is * synchronized with the evWritable object. */ - size_t toWrite; /* Current amount to be written. Access is + int toWrite; /* Current amount to be written. Access is * synchronized with the evWritable object. */ - size_t writeQueue; /* Number of bytes pending in output queue. + int writeQueue; /* Number of bytes pending in output queue. * Offset to DCB.cbInQue. Used to query * [fconfigure -queue] */ } SerialInfo; @@ -163,25 +161,31 @@ static COMMTIMEOUTS no_timeout = { * Declarations for functions used only in this file. */ -static Tcl_DriverBlockModeProc SerialBlockProc; -static Tcl_DriverCloseProc SerialCloseProc; -static Tcl_DriverGetHandleProc SerialGetHandleProc; -static Tcl_DriverGetOptionProc SerialGetOptionProc; -static Tcl_DriverInputProc SerialInputProc; -static Tcl_DriverOutputProc SerialOutputProc; -static Tcl_DriverSetOptionProc SerialSetOptionProc; -static Tcl_DriverThreadActionProc SerialThreadActionProc; -static Tcl_DriverWatchProc SerialWatchProc; - -static Tcl_EventCheckProc SerialCheckProc; -static Tcl_EventProc SerialEventProc; -static Tcl_EventSetupProc SerialSetupProc; - -static Tcl_ExitProc SerialExitHandler; -static Tcl_ExitProc ProcExitHandler; - +static int SerialBlockProc(ClientData instanceData, int mode); +static void SerialCheckProc(ClientData clientData, int flags); +static int SerialCloseProc(ClientData instanceData, + Tcl_Interp *interp); +static int SerialEventProc(Tcl_Event *evPtr, int flags); +static void SerialExitHandler(ClientData clientData); +static int SerialGetHandleProc(ClientData instanceData, + int direction, ClientData *handlePtr); static ThreadSpecificData *SerialInit(void); +static int SerialInputProc(ClientData instanceData, char *buf, + int toRead, int *errorCode); +static int SerialOutputProc(ClientData instanceData, + CONST char *buf, int toWrite, int *errorCode); +static void SerialSetupProc(ClientData clientData, int flags); +static void SerialWatchProc(ClientData instanceData, int mask); +static void ProcExitHandler(ClientData clientData); +static int SerialGetOptionProc(ClientData instanceData, + Tcl_Interp *interp, CONST char *optionName, + Tcl_DString *dsPtr); +static int SerialSetOptionProc(ClientData instanceData, + Tcl_Interp *interp, CONST char *optionName, + CONST char *value); static DWORD WINAPI SerialWriterThread(LPVOID arg); +static void SerialThreadActionProc(ClientData instanceData, + int action); static int SerialBlockingRead(SerialInfo *infoPtr, LPVOID buf, DWORD bufSize, LPDWORD lpRead, LPOVERLAPPED osPtr); static int SerialBlockingWrite(SerialInfo *infoPtr, LPVOID buf, @@ -193,7 +197,7 @@ static int SerialBlockingWrite(SerialInfo *infoPtr, LPVOID buf, * based IO. */ -static const Tcl_ChannelType serialChannelType = { +static Tcl_ChannelType serialChannelType = { "serial", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ SerialCloseProc, /* Close proc. */ @@ -210,7 +214,7 @@ static const Tcl_ChannelType serialChannelType = { NULL, /* handler proc. */ NULL, /* wide seek proc */ SerialThreadActionProc, /* thread action proc */ - NULL /* truncate */ + NULL, /* truncate */ }; /* @@ -370,7 +374,7 @@ SerialGetMilliseconds(void) { Tcl_Time time; - Tcl_GetTime(&time); + TclpGetTime(&time); return (time.sec * 1000 + time.usec / 1000); } @@ -523,7 +527,7 @@ SerialCheckProc( if (needEvent) { infoPtr->flags |= SERIAL_PENDING; - evPtr = ckalloc(sizeof(SerialEvent)); + evPtr = (SerialEvent *) ckalloc(sizeof(SerialEvent)); evPtr->header.proc = SerialEventProc; evPtr->infoPtr = infoPtr; Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL); @@ -702,7 +706,7 @@ SerialCloseProc( ckfree(serialPtr->writeBuf); serialPtr->writeBuf = NULL; } - ckfree(serialPtr); + ckfree((char*) serialPtr); if (errorCode == 0) { return result; @@ -882,11 +886,11 @@ SerialBlockingWrite( *---------------------------------------------------------------------- */ -static ssize_t +static int SerialInputProc( ClientData instanceData, /* Serial state. */ char *buf, /* Where to store data read. */ - size_t bufSize, /* How much space is available in the + int bufSize, /* How much space is available in the * buffer? */ int *errorCode) /* Where to store error code. */ { @@ -989,11 +993,11 @@ SerialInputProc( *---------------------------------------------------------------------- */ -static ssize_t +static int SerialOutputProc( ClientData instanceData, /* Serial state. */ - const char *buf, /* The data buffer. */ - size_t toWrite, /* How many bytes to write? */ + CONST char *buf, /* The data buffer. */ + int toWrite, /* How many bytes to write? */ int *errorCode) /* Where to store error code. */ { SerialInfo *infoPtr = (SerialInfo *) instanceData; @@ -1030,7 +1034,7 @@ SerialOutputProc( * the channel is in non-blocking mode. */ - errno = EAGAIN; + errno = EWOULDBLOCK; goto error1; } @@ -1067,7 +1071,7 @@ SerialOutputProc( ckfree(infoPtr->writeBuf); } infoPtr->writeBufLen = toWrite; - infoPtr->writeBuf = ckalloc(toWrite); + infoPtr->writeBuf = ckalloc((unsigned int) toWrite); } memcpy(infoPtr->writeBuf, buf, (size_t) toWrite); infoPtr->toWrite = toWrite; @@ -1406,40 +1410,45 @@ 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) { SerialInit(); /* + * If an open channel is specified, close it + */ + + if ( handle != INVALID_HANDLE_VALUE && CloseHandle(handle) == FALSE) { + return INVALID_HANDLE_VALUE; + } + + /* * Multithreaded I/O needs the overlapped flag set otherwise * ClearCommError blocks under Windows NT/2000 until serial output is * finished */ - if (CloseHandle(handle) == FALSE) { - return INVALID_HANDLE_VALUE; - } - handle = CreateFile(name, access, 0, 0, OPEN_EXISTING, - FILE_FLAG_OVERLAPPED, 0); + handle = (*tclWinProcs->createFileProc)(name, access, 0, 0, + OPEN_EXISTING, FILE_FLAG_OVERLAPPED, 0); + return handle; } @@ -1472,7 +1481,7 @@ TclWinOpenSerialChannel( SerialInit(); - infoPtr = ckalloc(sizeof(SerialInfo)); + infoPtr = (SerialInfo *) ckalloc((unsigned) sizeof(SerialInfo)); memset(infoPtr, 0, sizeof(SerialInfo)); infoPtr->validMask = permissions; @@ -1493,10 +1502,10 @@ TclWinOpenSerialChannel( * are shared between multiple channels (stdin/stdout). */ - sprintf(channelName, "file%" TCL_I_MODIFIER "x", (size_t) infoPtr); + sprintf(channelName, "file%" TCL_I_MODIFIER "x", (size_t)infoPtr); infoPtr->channel = Tcl_CreateChannel(&serialChannelType, channelName, - infoPtr, permissions); + (ClientData) infoPtr, permissions); SetupComm(handle, infoPtr->sysBufRead, infoPtr->sysBufWrite); @@ -1639,17 +1648,19 @@ 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 = (SerialInfo *) instanceData; + SerialInfo *infoPtr; DCB dcb; BOOL result, flag; size_t len, vlen; Tcl_DString ds; - const TCHAR *native; - size_t argc; - const char **argv; + CONST TCHAR *native; + int argc; + CONST char **argv; + + infoPtr = (SerialInfo *) instanceData; /* * Parse options. This would be far easier if we had Tcl_Objs to work with @@ -1665,18 +1676,19 @@ SerialSetOptionProc( if ((len > 2) && (strncmp(optionName, "-mode", len) == 0)) { if (!GetCommState(infoPtr->handle, &dcb)) { - goto getStateFailed; + if (interp != NULL) { + Tcl_AppendResult(interp, "can't get comm state", NULL); + } + return TCL_ERROR; } - native = Tcl_WinUtfToTChar(value, TCL_STRLEN, &ds); - result = BuildCommDCB(native, &dcb); + native = Tcl_WinUtfToTChar(value, -1, &ds); + result = (*tclWinProcs->buildCommDCBProc)(native, &dcb); Tcl_DStringFree(&ds); if (result == FALSE) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "bad value \"%s\" for -mode: should be baud,parity,data,stop", - value)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "SERIALMODE", NULL); + Tcl_AppendResult(interp, "bad value \"", value, + "\" for -mode: should be baud,parity,data,stop", NULL); } return TCL_ERROR; } @@ -1691,7 +1703,10 @@ SerialSetOptionProc( dcb.fAbortOnError = FALSE; if (!SetCommState(infoPtr->handle, &dcb)) { - goto setStateFailed; + if (interp != NULL) { + Tcl_AppendResult(interp, "can't set comm state", NULL); + } + return TCL_ERROR; } return TCL_OK; } @@ -1702,7 +1717,10 @@ SerialSetOptionProc( if ((len > 1) && (strncmp(optionName, "-handshake", len) == 0)) { if (!GetCommState(infoPtr->handle, &dcb)) { - goto getStateFailed; + if (interp != NULL) { + Tcl_AppendResult(interp, "can't get comm state", NULL); + } + return TCL_ERROR; } /* @@ -1737,16 +1755,18 @@ SerialSetOptionProc( dcb.fDtrControl = DTR_CONTROL_HANDSHAKE; } else { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "bad value \"%s\" for -handshake: must be one of" - " xonxoff, rtscts, dtrdsr or none", value)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "HANDSHAKE", NULL); + Tcl_AppendResult(interp, "bad value \"", value, + "\" for -handshake: must be one of xonxoff, rtscts, " + "dtrdsr or none", NULL); } return TCL_ERROR; } if (!SetCommState(infoPtr->handle, &dcb)) { - goto setStateFailed; + if (interp != NULL) { + Tcl_AppendResult(interp, "can't set comm state", NULL); + } + return TCL_ERROR; } return TCL_OK; } @@ -1757,7 +1777,10 @@ SerialSetOptionProc( if ((len > 1) && (strncmp(optionName, "-xchar", len) == 0)) { if (!GetCommState(infoPtr->handle, &dcb)) { - goto getStateFailed; + if (interp != NULL) { + Tcl_AppendResult(interp, "can't get comm state", NULL); + } + return TCL_ERROR; } if (Tcl_SplitList(interp, value, &argc, &argv) == TCL_ERROR) { @@ -1766,13 +1789,11 @@ SerialSetOptionProc( if (argc != 2) { badXchar: if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "bad value for -xchar: should be a list of" - " two elements with each a single character", - TCL_STRLEN)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "XCHAR", NULL); + Tcl_AppendResult(interp, "bad value for -xchar: should be " + "a list of two elements with each a single character", + NULL); } - ckfree(argv); + ckfree((char *) argv); return TCL_ERROR; } @@ -1803,10 +1824,13 @@ SerialSetOptionProc( } dcb.XoffChar = (char) character; } - ckfree(argv); + ckfree((char *) argv); if (!SetCommState(infoPtr->handle, &dcb)) { - goto setStateFailed; + if (interp != NULL) { + Tcl_AppendResult(interp, "can't set comm state", NULL); + } + return TCL_ERROR; } return TCL_OK; } @@ -1823,12 +1847,11 @@ SerialSetOptionProc( } if ((argc % 2) == 1) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "bad value \"%s\" for -ttycontrol: should be " - "a list of signal,value pairs", value)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "TTYCONTROL", NULL); + Tcl_AppendResult(interp, "bad value \"", value, + "\" for -ttycontrol: should be a list of " + "signal,value pairs", NULL); } - ckfree(argv); + ckfree((char *) argv); return TCL_ERROR; } @@ -1841,10 +1864,7 @@ SerialSetOptionProc( if (!EscapeCommFunction(infoPtr->handle, (DWORD) (flag ? SETDTR : CLRDTR))) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "can't set DTR signal", TCL_STRLEN)); - Tcl_SetErrorCode(interp, "TCL", "OPERATION", - "FCONFIGURE", "TTY_SIGNAL", NULL); + Tcl_AppendResult(interp, "can't set DTR signal", NULL); } result = TCL_ERROR; break; @@ -1853,10 +1873,7 @@ SerialSetOptionProc( if (!EscapeCommFunction(infoPtr->handle, (DWORD) (flag ? SETRTS : CLRRTS))) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "can't set RTS signal", TCL_STRLEN)); - Tcl_SetErrorCode(interp, "TCL", "OPERATION", - "FCONFIGURE", "TTY_SIGNAL", NULL); + Tcl_AppendResult(interp, "can't set RTS signal", NULL); } result = TCL_ERROR; break; @@ -1865,20 +1882,15 @@ SerialSetOptionProc( if (!EscapeCommFunction(infoPtr->handle, (DWORD) (flag ? SETBREAK : CLRBREAK))) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "can't set BREAK signal", TCL_STRLEN)); - Tcl_SetErrorCode(interp, "TCL", "OPERATION", - "FCONFIGURE", "TTY_SIGNAL", NULL); + Tcl_AppendResult(interp,"can't set BREAK signal",NULL); } result = TCL_ERROR; break; } } else { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "bad signal name \"%s\" for -ttycontrol: must be" - " DTR, RTS or BREAK", argv[i])); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "TTY_SIGNAL", + Tcl_AppendResult(interp, "bad signal name \"", argv[i], + "\" for -ttycontrol: must be DTR, RTS or BREAK", NULL); } result = TCL_ERROR; @@ -1886,7 +1898,7 @@ SerialSetOptionProc( } } - ckfree(argv); + ckfree((char *) argv); return result; } @@ -1912,24 +1924,20 @@ SerialSetOptionProc( inSize = atoi(argv[0]); outSize = atoi(argv[1]); } - ckfree(argv); + ckfree((char *) argv); if ((argc < 1) || (argc > 2) || (inSize <= 0) || (outSize <= 0)) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "bad value \"%s\" for -sysbuffer: should be " - "a list of one or two integers > 0", value)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "SYS_BUFFER", NULL); + Tcl_AppendResult(interp, "bad value \"", value, + "\" for -sysbuffer: should be a list of one or two " + "integers > 0", NULL); } return TCL_ERROR; } if (!SetupComm(infoPtr->handle, inSize, outSize)) { if (interp != NULL) { - TclWinConvertError(GetLastError()); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't setup comm buffers: %s", - Tcl_PosixError(interp))); + Tcl_AppendResult(interp, "can't setup comm buffers", NULL); } return TCL_ERROR; } @@ -1942,12 +1950,18 @@ SerialSetOptionProc( */ if (!GetCommState(infoPtr->handle, &dcb)) { - goto getStateFailed; + if (interp != NULL) { + Tcl_AppendResult(interp, "can't get comm state", NULL); + } + return TCL_ERROR; } dcb.XonLim = (WORD) (infoPtr->sysBufRead*1/2); dcb.XoffLim = (WORD) (infoPtr->sysBufRead*1/4); if (!SetCommState(infoPtr->handle, &dcb)) { - goto setStateFailed; + if (interp != NULL) { + Tcl_AppendResult(interp, "can't set comm state", NULL); + } + return TCL_ERROR; } return TCL_OK; } @@ -1977,10 +1991,7 @@ SerialSetOptionProc( tout.ReadTotalTimeoutConstant = msec; if (!SetCommTimeouts(infoPtr->handle, &tout)) { if (interp != NULL) { - TclWinConvertError(GetLastError()); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't set comm timeouts: %s", - Tcl_PosixError(interp))); + Tcl_AppendResult(interp, "can't set comm timeouts", NULL); } return TCL_ERROR; } @@ -1990,22 +2001,6 @@ 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; } /* @@ -2033,7 +2028,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; @@ -2058,14 +2053,12 @@ SerialGetOptionProc( } if (len==0 || (len>2 && (strncmp(optionName, "-mode", len) == 0))) { char parity; - const char *stop; + char *stop; char buf[2 * TCL_INTEGER_SPACE + 16]; if (!GetCommState(infoPtr->handle, &dcb)) { if (interp != NULL) { - TclWinConvertError(GetLastError()); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't get comm state: %s", Tcl_PosixError(interp))); + Tcl_AppendResult(interp, "can't get comm state", NULL); } return TCL_ERROR; } @@ -2133,9 +2126,7 @@ SerialGetOptionProc( if (!GetCommState(infoPtr->handle, &dcb)) { if (interp != NULL) { - TclWinConvertError(GetLastError()); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't get comm state: %s", Tcl_PosixError(interp))); + Tcl_AppendResult(interp, "can't get comm state", NULL); } return TCL_ERROR; } @@ -2211,9 +2202,7 @@ SerialGetOptionProc( if (!GetCommModemStatus(infoPtr->handle, &status)) { if (interp != NULL) { - TclWinConvertError(GetLastError()); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't get tty status: %s", Tcl_PosixError(interp))); + Tcl_AppendResult(interp, "can't get tty status", NULL); } return TCL_ERROR; } @@ -2223,9 +2212,10 @@ SerialGetOptionProc( if (valid) { return TCL_OK; + } else { + return Tcl_BadChannelOption(interp, optionName, + "mode pollinterval lasterror queue sysbuffer ttystatus xchar"); } - return Tcl_BadChannelOption(interp, optionName, - "mode pollinterval lasterror queue sysbuffer ttystatus xchar"); } /* diff --git a/win/tclWinSock.c b/win/tclWinSock.c index 15b4029..8f565b9 100644 --- a/win/tclWinSock.c +++ b/win/tclWinSock.c @@ -20,11 +20,11 @@ * 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. + * 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 @@ -47,13 +47,6 @@ #include "tclWinInt.h" -/* - * Which version of the winsock API do we want? - */ - -#define WSA_VERSION_MAJOR 1 -#define WSA_VERSION_MINOR 1 - #ifdef _MSC_VER # pragma comment (lib, "ws2_32") #endif @@ -81,7 +74,6 @@ */ static int initialized = 0; -static const TCHAR classname[] = TEXT("TclSocket"); TCL_DECLARE_MUTEX(socketMutex) /* @@ -97,65 +89,43 @@ static ProcessGlobalValue hostName = { * The following defines declare the messages used on socket windows. */ -#define SOCKET_MESSAGE WM_USER+1 -#define SOCKET_SELECT WM_USER+2 -#define SOCKET_TERMINATE WM_USER+3 -#define SELECT TRUE -#define UNSELECT FALSE - -/* - * This is needed to comply with the strict aliasing rules of GCC, but it also - * simplifies casting between the different sockaddr types. - */ - -typedef union { - struct sockaddr sa; - struct sockaddr_in sa4; - struct sockaddr_in6 sa6; - struct sockaddr_storage sas; -} address; - -#ifndef IN6_ARE_ADDR_EQUAL -#define IN6_ARE_ADDR_EQUAL IN6_ADDR_EQUAL -#endif - -typedef struct SocketInfo SocketInfo; - -typedef struct TcpFdList { - SocketInfo *infoPtr; - SOCKET fd; - struct TcpFdList *next; -} TcpFdList; +#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 is used to store the data associated with each * socket. + * All members modified by the notifier thread are defined as volatile. */ -struct SocketInfo { +typedef struct SocketInfo { Tcl_Channel channel; /* Channel associated with this socket. */ - struct TcpFdList *sockets; /* Windows SOCKET handle. */ - int flags; /* Bit field comprised of the flags described + SOCKET socket; /* Windows SOCKET handle. */ + volatile int flags; /* Bit field comprised of the flags described * below. */ int watchEvents; /* OR'ed combination of FD_READ, FD_WRITE, * FD_CLOSE, FD_ACCEPT and FD_CONNECT that * indicate which events are interesting. */ - int readyEvents; /* OR'ed combination of FD_READ, FD_WRITE, + volatile int readyEvents; /* OR'ed combination of FD_READ, FD_WRITE, * FD_CLOSE, FD_ACCEPT and FD_CONNECT that * indicate which events have occurred. */ int selectEvents; /* OR'ed combination of FD_READ, FD_WRITE, * FD_CLOSE, FD_ACCEPT and FD_CONNECT that * indicate which events are currently being * selected. */ - int acceptEventCount; /* Count of the current number of FD_ACCEPTs + volatile int acceptEventCount; + /* Count of the current number of FD_ACCEPTs * that have arrived and not yet processed. */ Tcl_TcpAcceptProc *acceptProc; /* Proc to call on accept. */ ClientData acceptProcData; /* The data for the accept proc. */ - int lastError; /* Error code from last message. */ + volatile 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 @@ -199,6 +169,10 @@ typedef struct { * socketThread has been initialized and has * started. */ HANDLE socketListLock; /* Win32 Event to lock the socketList */ + SocketInfo *pendingSocketInfo; + /* This socket is opened but not jet in the + * list. This value is also checked by + * the event structure. */ SocketInfo *socketList; /* Every open socket in this thread has an * entry on this list. */ } ThreadSpecificData; @@ -213,13 +187,15 @@ 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(TcpFdList *fds, SOCKET newSocket, address addr); +static void TcpAccept(SocketInfo *infoPtr); static int WaitForSocketEvent(SocketInfo *infoPtr, int events, int *errorCodePtr); static DWORD WINAPI SocketThread(LPVOID arg); @@ -229,10 +205,8 @@ static void TcpThreadActionProc(ClientData instanceData, static Tcl_EventCheckProc SocketCheckProc; 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; @@ -245,7 +219,7 @@ static Tcl_DriverGetHandleProc TcpGetHandleProc; * based IO. */ -static const Tcl_ChannelType tcpChannelType = { +static Tcl_ChannelType tcpChannelType = { "tcp", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ TcpCloseProc, /* Close proc. */ @@ -256,13 +230,13 @@ static const Tcl_ChannelType tcpChannelType = { TcpGetOptionProc, /* Get option proc. */ TcpWatchProc, /* Set up notifier to watch this channel. */ TcpGetHandleProc, /* Get an OS handle from channel. */ - TcpClose2Proc, /* Close2proc. */ + NULL, /* close2proc. */ TcpBlockProc, /* Set socket into (non-)blocking mode. */ NULL, /* flush proc. */ NULL, /* handler proc. */ NULL, /* wide seek proc */ TcpThreadActionProc, /* thread action proc */ - NULL /* truncate */ + NULL, /* truncate */ }; /* @@ -288,13 +262,13 @@ static const Tcl_ChannelType tcpChannelType = { static void InitSockets(void) { - DWORD id, err; - WSADATA wsaData; - ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey); + DWORD id; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + TclThreadDataKeyGet(&dataKey); if (!initialized) { initialized = 1; - TclCreateLateExitHandler(SocketExitHandler, NULL); + TclCreateLateExitHandler(SocketExitHandler, (ClientData) NULL); /* * Create the async notification window with a new class. We must @@ -309,89 +283,57 @@ InitSockets(void) windowClass.hInstance = TclWinGetTclInstance(); windowClass.hbrBackground = NULL; windowClass.lpszMenuName = NULL; - windowClass.lpszClassName = classname; + windowClass.lpszClassName = "TclSocket"; windowClass.lpfnWndProc = SocketProc; windowClass.hIcon = NULL; windowClass.hCursor = NULL; - if (!RegisterClass(&windowClass)) { + if (!RegisterClassA(&windowClass)) { TclWinConvertError(GetLastError()); 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. - */ - - err = WSAStartup((WORD) MAKEWORD(WSA_VERSION_MAJOR,WSA_VERSION_MINOR), - &wsaData); - if (err != 0) { - TclWinConvertError(err); - goto initFailure; - } - - /* - * Note the byte positions ae 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)) { - TclWinConvertError(WSAVERNOTSUPPORTED); - WSACleanup(); - goto initFailure; - } } /* * Check for per-thread initialization. */ - if (tsdPtr != NULL) { - return; - } - - /* - * OK, this thread has never done anything with sockets before. Construct - * a worker thread to handle asynchronous events related to sockets - * assigned to _this_ thread. - */ + if (tsdPtr == NULL) { + tsdPtr = TCL_TSD_INIT(&dataKey); + tsdPtr->pendingSocketInfo = NULL; + tsdPtr->socketList = NULL; + tsdPtr->hwnd = NULL; + tsdPtr->threadId = Tcl_GetCurrentThread(); + tsdPtr->readyEvent = CreateEvent(NULL, FALSE, FALSE, NULL); + if (tsdPtr->readyEvent == NULL) { + goto initFailure; + } + tsdPtr->socketListLock = CreateEvent(NULL, FALSE, TRUE, NULL); + if (tsdPtr->socketListLock == NULL) { + goto initFailure; + } + tsdPtr->socketThread = CreateThread(NULL, 256, SocketThread, tsdPtr, + 0, &id); + if (tsdPtr->socketThread == NULL) { + goto initFailure; + } - 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; - } + SetThreadPriority(tsdPtr->socketThread, THREAD_PRIORITY_HIGHEST); - SetThreadPriority(tsdPtr->socketThread, THREAD_PRIORITY_HIGHEST); + /* + * Wait for the thread to signal when the window has been created and + * if it is ready to go. + */ - /* - * Wait for the thread to signal when the window has been created and if - * it is ready to go. - */ + WaitForSingleObject(tsdPtr->readyEvent, INFINITE); - WaitForSingleObject(tsdPtr->readyEvent, INFINITE); + if (tsdPtr->hwnd == NULL) { + goto initFailure; /* Trouble creating the window */ + } - if (tsdPtr->hwnd == NULL) { - goto initFailure; /* Trouble creating the window. */ + Tcl_CreateEventSource(SocketSetupProc, SocketCheckProc, NULL); } - - Tcl_CreateEventSource(SocketSetupProc, SocketCheckProc, NULL); return; initFailure: @@ -421,7 +363,6 @@ static int SocketsEnabled(void) { int enabled; - Tcl_MutexLock(&socketMutex); enabled = (initialized == 1); Tcl_MutexUnlock(&socketMutex); @@ -452,15 +393,13 @@ SocketExitHandler( ClientData clientData) /* Not used. */ { Tcl_MutexLock(&socketMutex); - /* * Make sure the socket event handling window is cleaned-up for, at * most, this thread. */ TclpFinalizeSockets(); - UnregisterClass(classname, TclWinGetTclInstance()); - WSACleanup(); + UnregisterClass("TclSocket", TclWinGetTclInstance()); initialized = 0; Tcl_MutexUnlock(&socketMutex); } @@ -487,40 +426,34 @@ SocketExitHandler( void TclpFinalizeSockets(void) { - ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey); - - /* - * Careful! This is a finalizer! - */ - - if (tsdPtr == NULL) { - return; - } - - if (tsdPtr->socketThread != NULL) { - if (tsdPtr->hwnd != NULL) { - PostMessage(tsdPtr->hwnd, SOCKET_TERMINATE, 0, 0); - - /* - * Wait for the thread to exit. This ensures that we are - * completely cleaned up before we leave this function. - */ + ThreadSpecificData *tsdPtr; - WaitForSingleObject(tsdPtr->readyEvent, INFINITE); - tsdPtr->hwnd = NULL; + tsdPtr = (ThreadSpecificData *) TclThreadDataKeyGet(&dataKey); + if (tsdPtr != NULL) { + if (tsdPtr->socketThread != NULL) { + if (tsdPtr->hwnd != NULL) { + if (PostMessage(tsdPtr->hwnd, SOCKET_TERMINATE, 0, 0)) { + /* + * Wait for the thread to exit. This ensures that we are + * completely cleaned up before we leave this function. + */ + WaitForSingleObject(tsdPtr->readyEvent, INFINITE); + } + tsdPtr->hwnd = NULL; + } + CloseHandle(tsdPtr->socketThread); + tsdPtr->socketThread = NULL; } - CloseHandle(tsdPtr->socketThread); - tsdPtr->socketThread = NULL; - } - if (tsdPtr->readyEvent != NULL) { - CloseHandle(tsdPtr->readyEvent); - tsdPtr->readyEvent = NULL; - } - if (tsdPtr->socketListLock != NULL) { - CloseHandle(tsdPtr->socketListLock); - tsdPtr->socketListLock = NULL; + if (tsdPtr->readyEvent != NULL) { + CloseHandle(tsdPtr->readyEvent); + tsdPtr->readyEvent = NULL; + } + if (tsdPtr->socketListLock != NULL) { + CloseHandle(tsdPtr->socketListLock); + tsdPtr->socketListLock = NULL; + } + Tcl_DeleteEventSource(SocketSetupProc, SocketCheckProc, NULL); } - Tcl_DeleteEventSource(SocketSetupProc, SocketCheckProc, NULL); } /* @@ -558,8 +491,8 @@ TclpHasSockets( return TCL_OK; } if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "sockets are not available on this system", TCL_STRLEN)); + Tcl_AppendResult(interp, "sockets are not available on this system", + NULL); } return TCL_ERROR; } @@ -651,9 +584,9 @@ SocketCheckProc( if ((infoPtr->readyEvents & infoPtr->watchEvents) && !(infoPtr->flags & SOCKET_PENDING)) { infoPtr->flags |= SOCKET_PENDING; - evPtr = ckalloc(sizeof(SocketEvent)); + evPtr = (SocketEvent *) ckalloc(sizeof(SocketEvent)); evPtr->header.proc = SocketEventProc; - evPtr->socket = infoPtr->sockets->fd; + evPtr->socket = infoPtr->socket; Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL); } } @@ -689,12 +622,9 @@ SocketEventProc( { SocketInfo *infoPtr; SocketEvent *eventPtr = (SocketEvent *) evPtr; - int mask = 0, events; + int mask = 0; + int events; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - TcpFdList *fds; - SOCKET newSocket; - address addr; - int len; if (!(flags & TCL_FILE_EVENTS)) { return 0; @@ -707,17 +637,17 @@ SocketEventProc( WaitForSingleObject(tsdPtr->socketListLock, INFINITE); for (infoPtr = tsdPtr->socketList; infoPtr != NULL; infoPtr = infoPtr->nextPtr) { - if (infoPtr->sockets->fd == eventPtr->socket) { + if (infoPtr->socket == eventPtr->socket) { break; } } + SetEvent(tsdPtr->socketListLock); /* * Discard events that have gone stale. */ if (!infoPtr) { - SetEvent(tsdPtr->socketListLock); return 1; } @@ -728,72 +658,10 @@ SocketEventProc( */ if (infoPtr->readyEvents & FD_ACCEPT) { - 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); + TcpAccept(infoPtr); return 1; } - SetEvent(tsdPtr->socketListLock); - /* * Mask off unwanted events and compute the read/write mask so we can * notify the channel. @@ -813,48 +681,55 @@ SocketEventProc( */ Tcl_Time blockTime = { 0, 0 }; - Tcl_SetMaxBlockTime(&blockTime); mask |= TCL_READABLE|TCL_WRITABLE; } else if (events & FD_READ) { - fd_set readFds; - struct timeval timeout; - /* - * We must check to see if data is really available, since someone - * could have consumed the data in the meantime. Turn off async - * notification so select will work correctly. If the socket is still - * readable, notify the channel driver, otherwise reset the async - * select handler and keep waiting. + * Throw the readable event if an async connect failed. */ - SendMessage(tsdPtr->hwnd, SOCKET_SELECT, - (WPARAM) UNSELECT, (LPARAM) infoPtr); - - FD_ZERO(&readFds); - FD_SET(infoPtr->sockets->fd, &readFds); - timeout.tv_usec = 0; - timeout.tv_sec = 0; + if (infoPtr->lastError) { - if (select(0, &readFds, NULL, NULL, &timeout) != 0) { mask |= TCL_READABLE; + } else { - infoPtr->readyEvents &= ~(FD_READ); - SendMessage(tsdPtr->hwnd, SOCKET_SELECT, - (WPARAM) SELECT, (LPARAM) infoPtr); - } - } - if (events & (FD_WRITE | FD_CONNECT)) { - mask |= TCL_WRITABLE; - if (events & FD_CONNECT && infoPtr->lastError != NO_ERROR) { + fd_set readFds; + struct timeval timeout; + /* - * Connect errors should also fire the readable handler. + * We must check to see if data is really available, since someone + * could have consumed the data in the meantime. Turn off async + * notification so select will work correctly. If the socket is still + * readable, notify the channel driver, otherwise reset the async + * select handler and keep waiting. */ - mask |= TCL_READABLE; + SendMessage(tsdPtr->hwnd, SOCKET_SELECT, + (WPARAM) UNSELECT, (LPARAM) infoPtr); + + FD_ZERO(&readFds); + FD_SET(infoPtr->socket, &readFds); + timeout.tv_usec = 0; + timeout.tv_sec = 0; + + if (select(0, &readFds, NULL, NULL, &timeout) != 0) { + mask |= TCL_READABLE; + } else { + infoPtr->readyEvents &= ~(FD_READ); + SendMessage(tsdPtr->hwnd, SOCKET_SELECT, + (WPARAM) SELECT, (LPARAM) infoPtr); + } } } + /* + * writable event + */ + + if (events & FD_WRITE) { + mask |= TCL_WRITABLE; + } + if (mask) { Tcl_NotifyChannel(infoPtr->channel, mask); } @@ -883,7 +758,7 @@ TcpBlockProc( int mode) /* TCL_MODE_BLOCKING or * TCL_MODE_NONBLOCKING. */ { - SocketInfo *infoPtr = instanceData; + SocketInfo *infoPtr = (SocketInfo *) instanceData; if (mode == TCL_MODE_NONBLOCKING) { infoPtr->flags |= SOCKET_ASYNC; @@ -917,10 +792,10 @@ TcpCloseProc( ClientData instanceData, /* The socket to close. */ Tcl_Interp *interp) /* Unused. */ { - SocketInfo *infoPtr = instanceData; + SocketInfo *infoPtr = (SocketInfo *) instanceData; /* TIP #218 */ int errorCode = 0; - /* ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); */ + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); /* * Check that WinSock is initialized; do not call it if not, to prevent @@ -935,134 +810,43 @@ TcpCloseProc( * background. */ - 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); + if (closesocket(infoPtr->socket) == SOCKET_ERROR) { + TclWinConvertWSAError((DWORD) WSAGetLastError()); + errorCode = Tcl_GetErrno(); } } /* - * TIP #218. Removed the code removing the structure from the global - * socket list. This is now done by the thread action callbacks, and only - * there. This happens before this code is called. We can free without - * fear of damaging the list. + * Clear an eventual tsd info list pointer. + * This may be called, if an async socket connect fails or is closed + * between connect and thread action callback. */ + if (tsdPtr->pendingSocketInfo != NULL + && tsdPtr->pendingSocketInfo == infoPtr) { - 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; + /* get infoPtr lock, because this concerns the notifier thread */ + WaitForSingleObject(tsdPtr->socketListLock, INFINITE); - /* - * Shutdown the OS socket handle. - */ + tsdPtr->pendingSocketInfo = NULL; - 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", TCL_STRLEN)); - } - return TCL_ERROR; + /* Free list lock */ + SetEvent(tsdPtr->socketListLock); } /* - * Single fd operation: Tcl_OpenTcpServer() does not set TCL_READABLE or - * TCL_WRITABLE so this should never be called for a server socket. + * TIP #218. Removed the code removing the structure from the global + * socket list. This is now done by the thread action callbacks, and only + * there. This happens before this code is called. We can free without + * fear of damaging the list. */ - if (shutdown(infoPtr->sockets->fd, sd) == SOCKET_ERROR) { - TclWinConvertError((DWORD) WSAGetLastError()); - errorCode = Tcl_GetErrno(); - } - + ckfree((char *) infoPtr); 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. @@ -1080,11 +864,12 @@ static SocketInfo * NewSocketInfo( SOCKET socket) { - SocketInfo *infoPtr = ckalloc(sizeof(SocketInfo)); - + SocketInfo *infoPtr; /* ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); */ + + infoPtr = (SocketInfo *) ckalloc((unsigned) sizeof(SocketInfo)); infoPtr->channel = 0; - infoPtr->sockets = NULL; + infoPtr->socket = socket; infoPtr->flags = 0; infoPtr->watchEvents = 0; infoPtr->readyEvents = 0; @@ -1102,8 +887,6 @@ NewSocketInfo( infoPtr->nextPtr = NULL; - AddSocketInfoFd(infoPtr, socket); - return infoPtr; } @@ -1137,17 +920,12 @@ CreateSocket( * asynchronously. */ { u_long flag = 1; /* Indicates nonblocking mode. */ - int asyncConnect = 0; /* Will be 1 if async connect is in - * progress. */ - 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; + SOCKADDR_IN sockaddr; /* Socket address */ + SOCKADDR_IN mysockaddr; /* Socket address for client */ SOCKET sock = INVALID_SOCKET; - SocketInfo *infoPtr = NULL; /* The returned value. */ - ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey); + SocketInfo *infoPtr=NULL; /* The returned value. */ + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + TclThreadDataKeyGet(&dataKey); /* * Check that WinSock is initialized; do not call it if not, to prevent @@ -1159,245 +937,270 @@ CreateSocket( return NULL; } - /* - * Construct the addresses for each end of the socket. - */ - - if (!TclCreateSocketAddress(interp, &addrlist, host, port, server, - &errorMsg)) { + if (!CreateSocketAddress(&sockaddr, host, port)) { goto error; } - if (!TclCreateSocketAddress(interp, &myaddrlist, myaddr, myport, 1, - &errorMsg)) { + if ((myaddr != NULL || myport != 0) && + !CreateSocketAddress(&mysockaddr, myaddr, myport)) { goto error; } - if (server) { - 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; - } - - /* - * 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); + sock = socket(AF_INET, SOCK_STREAM, 0); + if (sock == INVALID_SOCKET) { + goto error; + } - /* - * Set kernel space buffering - */ + /* + * Win-NT has a misfeature that sockets are inherited in child processes + * by default. Turn off the inherit bit. + */ - TclSockMinimumBuffers((void *)sock, TCP_BUFFER_SIZE); + SetHandleInformation((HANDLE) sock, HANDLE_FLAG_INHERIT, 0); - /* - * 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. - */ + /* + * Set kernel space buffering + */ - if (port == 0 && chosenport != 0) { - ((struct sockaddr_in *) addrPtr->ai_addr)->sin_port = - htons(chosenport); - } + TclSockMinimumBuffers((void *)sock, TCP_BUFFER_SIZE); - /* - * Bind to the specified port. Note that we must not call - * setsockopt with SO_REUSEADDR because Microsoft allows addresses - * to be reused even if they are still in use. - * - * Bind should not be affected by the socket having already been - * set into nonblocking mode. If there is trouble, this is one - * place to look for bugs. - */ + if (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. + */ - 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); + if (bind(sock, (SOCKADDR *) &sockaddr, sizeof(SOCKADDR_IN)) + == SOCKET_ERROR) { + goto error; + } - /* - * Synchronize port numbers when binding to port 0 of multiple - * addresses. - */ + /* + * 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 (getsockname(sock, &sockname.sa, &namelen) >= 0) { - chosenport = ntohs(sockname.sa4.sin_port); - } - } + if (listen(sock, SOMAXCONN) == SOCKET_ERROR) { + goto error; + } - /* - * Set the maximum number of pending connect requests to the max - * value allowed on each platform (Win32 and Win32s may be - * different, and there may be differences between TCP/IP stacks). - */ + /* + * Add this socket to the global list of sockets. + */ - if (listen(sock, SOMAXCONN) == SOCKET_ERROR) { - TclWinConvertError((DWORD) WSAGetLastError()); - closesocket(sock); - continue; - } + infoPtr = NewSocketInfo(sock); - if (infoPtr == NULL) { - /* - * Add this socket to the global list of sockets. - */ + /* + * Set up the select mask for connection request events. + */ - infoPtr = NewSocketInfo(sock); + infoPtr->selectEvents = FD_ACCEPT; + infoPtr->watchEvents |= FD_ACCEPT; - /* - * Set up the select mask for connection request events. - */ + /* + * Register for interest in events in the select mask. Note that this + * automatically places the socket into non-blocking mode. + */ + + ioctlsocket(sock, (long) FIONBIO, &flag); + SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT, + (LPARAM) infoPtr); - infoPtr->selectEvents = FD_ACCEPT; - infoPtr->watchEvents |= FD_ACCEPT; + } else { + /* + * Try to bind to a local port, if specified. + */ - } else { - AddSocketInfoFd( infoPtr, sock ); + if (myaddr != NULL || myport != 0) { + if (bind(sock, (SOCKADDR *) &mysockaddr, sizeof(SOCKADDR_IN)) + == SOCKET_ERROR) { + goto error; } } - } 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. - */ - if (myaddrPtr->ai_family != addrPtr->ai_family) { - continue; - } + /* + * Allocate socket info structure + */ - sock = socket(myaddrPtr->ai_family, SOCK_STREAM, 0); - if (sock == INVALID_SOCKET) { - TclWinConvertError((DWORD) WSAGetLastError()); - continue; - } + infoPtr = NewSocketInfo(sock); - /* - * Win-NT has a misfeature that sockets are inherited in child - * processes by default. Turn off the inherit bit. - */ + /* + * Set the socket into nonblocking mode if the connect should be done + * in the background. Activate connect notification. + */ - SetHandleInformation((HANDLE) sock, HANDLE_FLAG_INHERIT, 0); + if (async) { - /* - * Set kernel space buffering - */ + /* get infoPtr lock */ + WaitForSingleObject(tsdPtr->socketListLock, INFINITE); - TclSockMinimumBuffers((void *) sock, TCP_BUFFER_SIZE); + /* + * Buffer new infoPtr in the tsd memory as long as it is not in + * the info list. This allows the event procedure to process the + * event. + * Bugfig for 336441ed59 to not ignore notifications until the + * infoPtr is in the list.. + */ - /* - * Try to bind to a local port. - */ + tsdPtr->pendingSocketInfo = infoPtr; - if (bind(sock, myaddrPtr->ai_addr, myaddrPtr->ai_addrlen) - == SOCKET_ERROR) { - TclWinConvertError((DWORD) WSAGetLastError()); - goto looperror; - } + /* + * Set connect mask to connect events + * This is activated by a SOCKET_SELECT message to the notifier + * thread. + */ - /* - * Set the socket into nonblocking mode if the connect should - * be done in the background. - */ + infoPtr->selectEvents |= FD_CONNECT | FD_READ | FD_WRITE | FD_CLOSE; + infoPtr->flags |= SOCKET_ASYNC_CONNECT; + + /* + * Free list lock + */ + SetEvent(tsdPtr->socketListLock); - if (async && ioctlsocket(sock, (long) FIONBIO, &flag) - == SOCKET_ERROR) { - TclWinConvertError((DWORD) WSAGetLastError()); - goto looperror; - } + /* + * Activate accept notification and put in async mode + * Bug 336441ed59: activate notification before connect + * so we do not miss a notification of a fialed connect. + */ + ioctlsocket(sock, (long) FIONBIO, &flag); + SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT, + (LPARAM) infoPtr); - /* - * Attempt to connect to the remote socket. - */ + } - if (connect(sock, addrPtr->ai_addr, addrPtr->ai_addrlen) - == SOCKET_ERROR) { - TclWinConvertError((DWORD) WSAGetLastError()); - if (Tcl_GetErrno() != EAGAIN) { - goto looperror; - } + /* + * Attempt to connect to the remote socket. + */ - /* - * The connection is progressing in the background. - */ + if (connect(sock, (SOCKADDR *) &sockaddr, + sizeof(SOCKADDR_IN)) == SOCKET_ERROR) { + TclWinConvertWSAError((DWORD) WSAGetLastError()); + if (Tcl_GetErrno() != EWOULDBLOCK) { + goto error; + } - asyncConnect = 1; - } - goto connected; + /* + * The connection is progressing in the background. + */ - looperror: - if (sock != INVALID_SOCKET) { - closesocket(sock); - sock = INVALID_SOCKET; - } - } - } - goto error; + } else { - connected: - /* - * Add this socket to the global list of sockets. - */ + /* + * Set up the select mask for read/write events. If the connect + * attempt has not completed, include connect events. + */ - infoPtr = NewSocketInfo(sock); + infoPtr->selectEvents = FD_READ | FD_WRITE | FD_CLOSE; - /* - * Set up the select mask for read/write events. If the connect - * attempt has not completed, include connect events. - */ + /* + * Register for interest in events in the select mask. Note that this + * automatically places the socket into non-blocking mode. + */ - infoPtr->selectEvents = FD_READ | FD_WRITE | FD_CLOSE; - if (asyncConnect) { - infoPtr->flags |= SOCKET_ASYNC_CONNECT; - infoPtr->selectEvents |= FD_CONNECT; + ioctlsocket(sock, (long) FIONBIO, &flag); + SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT, + (LPARAM) infoPtr); } } + return infoPtr; + error: - if (addrlist == NULL) { - freeaddrinfo(addrlist); + TclWinConvertWSAError((DWORD) WSAGetLastError()); + if (interp != NULL) { + Tcl_AppendResult(interp, "couldn't open socket: ", + Tcl_PosixError(interp), NULL); } - if (myaddrlist == NULL) { - freeaddrinfo(myaddrlist); + if (infoPtr != NULL) { + /* + * Free the allocated socket info structure and close the socket + */ + TcpCloseProc(infoPtr, interp); + } else if (sock != INVALID_SOCKET) { + /* + * No socket structure jet - just close + */ + closesocket(sock); } + return NULL; +} + +/* + *---------------------------------------------------------------------- + * + * 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 */ /* - * Register for interest in events in the select mask. Note that this - * automatically places the socket into non-blocking mode. + * 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 (infoPtr != NULL) { - ioctlsocket(sock, (long) FIONBIO, &flag); - SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT, - (LPARAM) infoPtr); - - return infoPtr; + if (!SocketsEnabled()) { + Tcl_SetErrno(EFAULT); + return 0; } - if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "couldn't open socket: %s", - (errorMsg ? errorMsg : Tcl_PosixError(interp)))); + ZeroMemory(sockaddrPtr, sizeof(SOCKADDR_IN)); + sockaddrPtr->sin_family = AF_INET; + sockaddrPtr->sin_port = htons((unsigned short) (port & 0xFFFF)); + if (host == NULL) { + addr.s_addr = INADDR_ANY; + } else { + addr.s_addr = inet_addr(host); + if (addr.s_addr == INADDR_NONE) { + hostent = gethostbyname(host); + if (hostent != NULL) { + memcpy(&addr, hostent->h_addr, (size_t) hostent->h_length); + } else { +#ifdef EHOSTUNREACH + Tcl_SetErrno(EHOSTUNREACH); +#else +#ifdef ENXIO + Tcl_SetErrno(ENXIO); +#endif +#endif + return 0; /* Error. */ + } + } } - if (sock != INVALID_SOCKET) { - closesocket(sock); - } - return NULL; + /* + * 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. */ } /* @@ -1425,7 +1228,8 @@ WaitForSocketEvent( { int result = 1; int oldMode; - ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey); + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + TclThreadDataKeyGet(&dataKey); /* * Be sure to disable event servicing so we are truly modal. @@ -1435,12 +1239,17 @@ WaitForSocketEvent( /* * Reset WSAAsyncSelect so we have a fresh set of events pending. + * Don't do that if we are waiting for a connect as we may miss + * a connect (bug 336441ed59). */ - SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) UNSELECT, - (LPARAM) infoPtr); - SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT, - (LPARAM) infoPtr); + if ( 0 == (events & FD_CONNECT) ) { + SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) UNSELECT, + (LPARAM) infoPtr); + + SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT, + (LPARAM) infoPtr); + } while (1) { if (infoPtr->lastError) { @@ -1450,7 +1259,7 @@ WaitForSocketEvent( } else if (infoPtr->readyEvents & events) { break; } else if (infoPtr->flags & SOCKET_ASYNC) { - *errorCodePtr = EAGAIN; + *errorCodePtr = EWOULDBLOCK; result = 0; break; } @@ -1509,18 +1318,19 @@ Tcl_OpenTcpClient( return NULL; } - sprintf(channelName, "sock%" TCL_I_MODIFIER "u", (size_t) infoPtr->sockets->fd); + sprintf(channelName, "sock%" TCL_I_MODIFIER "u", (size_t)infoPtr->socket); infoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName, - 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; + (ClientData) infoPtr, (TCL_READABLE | TCL_WRITABLE)); + if (Tcl_SetChannelOption(interp, infoPtr->channel, "-translation", + "auto crlf") == TCL_ERROR) { + Tcl_Close((Tcl_Interp *) NULL, infoPtr->channel); + return (Tcl_Channel) NULL; + } + if (Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "") + == TCL_ERROR) { + Tcl_Close((Tcl_Interp *) NULL, infoPtr->channel); + return (Tcl_Channel) NULL; } return infoPtr->channel; } @@ -1555,7 +1365,7 @@ Tcl_MakeTcpClientChannel( return NULL; } - tsdPtr = TclThreadDataKeyGet(&dataKey); + tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); /* * Set kernel space buffering and non-blocking. @@ -1570,11 +1380,12 @@ 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); - sprintf(channelName, "sock%" TCL_I_MODIFIER "u", (size_t) infoPtr->sockets->fd); + sprintf(channelName, "sock%" TCL_I_MODIFIER "u", (size_t)infoPtr->socket); infoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName, - infoPtr, (TCL_READABLE | TCL_WRITABLE)); + (ClientData) infoPtr, (TCL_READABLE | TCL_WRITABLE)); Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto crlf"); return infoPtr->channel; } @@ -1625,14 +1436,14 @@ Tcl_OpenTcpServer( infoPtr->acceptProc = acceptProc; infoPtr->acceptProcData = acceptProcData; - sprintf(channelName, "sock%" TCL_I_MODIFIER "u", (size_t) infoPtr->sockets->fd); + sprintf(channelName, "sock%" TCL_I_MODIFIER "u", (size_t)infoPtr->socket); infoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName, - infoPtr, 0); + (ClientData) infoPtr, 0); if (Tcl_SetChannelOption(interp, infoPtr->channel, "-eofchar", "") == TCL_ERROR) { - Tcl_Close(NULL, infoPtr->channel); - return NULL; + Tcl_Close((Tcl_Interp *) NULL, infoPtr->channel); + return (Tcl_Channel) NULL; } return infoPtr->channel; @@ -1643,9 +1454,8 @@ Tcl_OpenTcpServer( * * TcpAccept -- * - * Creates a channel for a newly accepted socket connection. This is - * called by SocketEventProc and it in turns calls the registered - * accept function. + * Accept a TCP socket connection. This is called by SocketEventProc and + * it in turns calls the registered accept function. * * Results: * None. @@ -1658,16 +1468,58 @@ Tcl_OpenTcpServer( static void TcpAccept( - TcpFdList *fds, /* Server socket that accepted newSocket. */ - SOCKET newSocket, /* Newly accepted socket. */ - address addr) /* Address of new socket. */ + SocketInfo *infoPtr) /* Socket to accept. */ { + SOCKET newSocket; SocketInfo *newInfoPtr; - SocketInfo *infoPtr = fds->infoPtr; - int len = sizeof(addr); + SOCKADDR_IN addr; + int len; char channelName[16 + TCL_INTEGER_SPACE]; - char host[NI_MAXHOST], port[NI_MAXSERV]; - ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey); + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + TclThreadDataKeyGet(&dataKey); + + /* + * Accept the incoming connection request. + */ + + len = sizeof(SOCKADDR_IN); + + newSocket = accept(infoPtr->socket, (SOCKADDR *)&addr, + &len); + + /* + * Protect access to sockets (acceptEventCount, readyEvents) in socketList + * by the lock. Fix for SF Tcl Bug 3056775. + */ + WaitForSingleObject(tsdPtr->socketListLock, INFINITE); + + /* + * Clear the ready mask so we can detect the next connection request. Note + * that connection requests are level triggered, so if there is a request + * already pending, a new event will be generated. + */ + + if (newSocket == INVALID_SOCKET) { + infoPtr->acceptEventCount = 0; + infoPtr->readyEvents &= ~(FD_ACCEPT); + + SetEvent(tsdPtr->socketListLock); + return; + } + + /* + * It is possible that more than one FD_ACCEPT has been sent, so an extra + * count must be kept. Decrement the count, and reset the readyEvent bit + * if the count is no longer > 0. + */ + + infoPtr->acceptEventCount--; + + if (infoPtr->acceptEventCount <= 0) { + infoPtr->readyEvents &= ~(FD_ACCEPT); + } + + SetEvent(tsdPtr->socketListLock); /* * Win-NT has a misfeature that sockets are inherited in child processes @@ -1677,7 +1529,7 @@ TcpAccept( SetHandleInformation((HANDLE) newSocket, HANDLE_FLAG_INHERIT, 0); /* - * Add this socket to the global list of sockets. + * Allocate socket info structure */ newInfoPtr = NewSocketInfo(newSocket); @@ -1687,20 +1539,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); - sprintf(channelName, "sock%" TCL_I_MODIFIER "u", (size_t) newInfoPtr->sockets->fd); + sprintf(channelName, "sock%" TCL_I_MODIFIER "u", (size_t)newInfoPtr->socket); newInfoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName, - newInfoPtr, (TCL_READABLE | TCL_WRITABLE)); + (ClientData) newInfoPtr, (TCL_READABLE | TCL_WRITABLE)); if (Tcl_SetChannelOption(NULL, newInfoPtr->channel, "-translation", "auto crlf") == TCL_ERROR) { - Tcl_Close(NULL, newInfoPtr->channel); + Tcl_Close((Tcl_Interp *) NULL, newInfoPtr->channel); return; } if (Tcl_SetChannelOption(NULL, newInfoPtr->channel, "-eofchar", "") == TCL_ERROR) { - Tcl_Close(NULL, newInfoPtr->channel); + Tcl_Close((Tcl_Interp *) NULL, newInfoPtr->channel); return; } @@ -1709,10 +1561,8 @@ TcpAccept( */ if (infoPtr->acceptProc != NULL) { - getnameinfo(&(addr.sa), len, host, sizeof(host), port, sizeof(port), - NI_NUMERICHOST|NI_NUMERICSERV); - infoPtr->acceptProc(infoPtr->acceptProcData, newInfoPtr->channel, - host, atoi(port)); + (infoPtr->acceptProc) (infoPtr->acceptProcData, newInfoPtr->channel, + inet_ntoa(addr.sin_addr), ntohs(addr.sin_port)); } } @@ -1733,17 +1583,18 @@ TcpAccept( *---------------------------------------------------------------------- */ -static ssize_t +static int TcpInputProc( ClientData instanceData, /* The socket state. */ char *buf, /* Where to store data. */ - size_t toRead, /* Maximum number of bytes to read. */ + int toRead, /* Maximum number of bytes to read. */ int *errorCodePtr) /* Where to store error codes. */ { - SocketInfo *infoPtr = instanceData; - ssize_t bytesRead; + SocketInfo *infoPtr = (SocketInfo *) instanceData; + int bytesRead; DWORD error; - ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey); + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + TclThreadDataKeyGet(&dataKey); *errorCodePtr = 0; @@ -1787,13 +1638,7 @@ TcpInputProc( while (1) { SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) UNSELECT, (LPARAM) infoPtr); - - /* - * Single fd operation: this proc is only called for a connected - * socket. - */ - - bytesRead = recv(infoPtr->sockets->fd, buf, toRead, 0); + bytesRead = recv(infoPtr->socket, buf, toRead, 0); infoPtr->readyEvents &= ~(FD_READ); /* @@ -1836,7 +1681,7 @@ TcpInputProc( */ if ((infoPtr->flags & SOCKET_ASYNC) || (error != WSAEWOULDBLOCK)) { - TclWinConvertError(error); + TclWinConvertWSAError(error); *errorCodePtr = Tcl_GetErrno(); bytesRead = -1; break; @@ -1853,7 +1698,8 @@ TcpInputProc( } } - SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM)SELECT, (LPARAM)infoPtr); + SendMessage(tsdPtr->hwnd, SOCKET_SELECT, + (WPARAM) SELECT, (LPARAM) infoPtr); return bytesRead; } @@ -1875,17 +1721,18 @@ TcpInputProc( *---------------------------------------------------------------------- */ -static ssize_t +static int TcpOutputProc( ClientData instanceData, /* The socket state. */ const char *buf, /* Where to get data. */ - size_t toWrite, /* Maximum number of bytes to write. */ + int toWrite, /* Maximum number of bytes to write. */ int *errorCodePtr) /* Where to store error codes. */ { - SocketInfo *infoPtr = instanceData; - ssize_t bytesWritten; + SocketInfo *infoPtr = (SocketInfo *) instanceData; + int bytesWritten; DWORD error; - ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey); + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + TclThreadDataKeyGet(&dataKey); *errorCodePtr = 0; @@ -1913,12 +1760,7 @@ TcpOutputProc( SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) UNSELECT, (LPARAM) infoPtr); - /* - * Single fd operation: this proc is only called for a connected - * socket. - */ - - bytesWritten = send(infoPtr->sockets->fd, buf, toWrite, 0); + bytesWritten = send(infoPtr->socket, buf, toWrite, 0); if (bytesWritten != SOCKET_ERROR) { /* * Since Windows won't generate a new write event until we hit an @@ -1944,12 +1786,12 @@ TcpOutputProc( if (error == WSAEWOULDBLOCK) { infoPtr->readyEvents &= ~(FD_WRITE); if (infoPtr->flags & SOCKET_ASYNC) { - *errorCodePtr = EAGAIN; + *errorCodePtr = EWOULDBLOCK; bytesWritten = -1; break; } } else { - TclWinConvertError(error); + TclWinConvertWSAError(error); *errorCodePtr = Tcl_GetErrno(); bytesWritten = -1; break; @@ -1966,7 +1808,8 @@ TcpOutputProc( } } - SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM)SELECT, (LPARAM)infoPtr); + SendMessage(tsdPtr->hwnd, SOCKET_SELECT, + (WPARAM) SELECT, (LPARAM) infoPtr); return bytesWritten; } @@ -1995,9 +1838,9 @@ TcpSetOptionProc( const char *value) /* New value for option. */ { #ifdef TCL_FEATURE_KEEPALIVE_NAGLE - SocketInfo *infoPtr = instanceData; + SocketInfo *infoPtr; SOCKET sock; -#endif /*TCL_FEATURE_KEEPALIVE_NAGLE*/ +#endif /* * Check that WinSock is initialized; do not call it if not, to prevent @@ -2007,15 +1850,14 @@ TcpSetOptionProc( if (!SocketsEnabled()) { if (interp) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "winsock is not initialized", TCL_STRLEN)); + Tcl_AppendResult(interp, "winsock is not initialized", NULL); } return TCL_ERROR; } #ifdef TCL_FEATURE_KEEPALIVE_NAGLE - #error "TCL_FEATURE_KEEPALIVE_NAGLE not reviewed for whether to treat infoPtr->sockets as single fd or list" - sock = infoPtr->sockets->fd; + infoPtr = (SocketInfo *) instanceData; + sock = infoPtr->socket; if (!strcasecmp(optionName, "-keepalive")) { BOOL val = FALSE; @@ -2030,11 +1872,10 @@ TcpSetOptionProc( rtn = setsockopt(sock, SOL_SOCKET, SO_KEEPALIVE, (const char *) &val, sizeof(BOOL)); if (rtn != 0) { - TclWinConvertError(WSAGetLastError()); + TclWinConvertWSAError(WSAGetLastError()); if (interp) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "couldn't set socket option: %s", - Tcl_PosixError(interp))); + Tcl_AppendResult(interp, "couldn't set socket option: ", + Tcl_PosixError(interp), NULL); } return TCL_ERROR; } @@ -2052,11 +1893,10 @@ TcpSetOptionProc( rtn = setsockopt(sock, IPPROTO_TCP, TCP_NODELAY, (const char *) &val, sizeof(BOOL)); if (rtn != 0) { - TclWinConvertError(WSAGetLastError()); + TclWinConvertWSAError(WSAGetLastError()); if (interp) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "couldn't set socket option: %s", - Tcl_PosixError(interp))); + Tcl_AppendResult(interp, "couldn't set socket option: ", + Tcl_PosixError(interp), NULL); } return TCL_ERROR; } @@ -2099,12 +1939,14 @@ TcpGetOptionProc( Tcl_DString *dsPtr) /* Where to store the computed value; * initialized by caller. */ { - SocketInfo *infoPtr = instanceData; - char host[NI_MAXHOST], port[NI_MAXSERV]; + SocketInfo *infoPtr; + SOCKADDR_IN sockname; + SOCKADDR_IN peername; + struct hostent *hostEntPtr; SOCKET sock; + int size = sizeof(SOCKADDR_IN); size_t len = 0; - int reverseDNS = 0; -#define SUPPRESS_RDNS_VAR "::tcl::unsupported::noReverseDNS" + char buf[TCL_INTEGER_SPACE]; /* * Check that WinSock is initialized; do not call it if not, to prevent @@ -2114,13 +1956,13 @@ TcpGetOptionProc( if (!SocketsEnabled()) { if (interp) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "winsock is not initialized", TCL_STRLEN)); + Tcl_AppendResult(interp, "winsock is not initialized", NULL); } return TCL_ERROR; } - sock = infoPtr->sockets->fd; + infoPtr = (SocketInfo *) instanceData; + sock = (int) infoPtr->socket; if (optionName != NULL) { len = strlen(optionName); } @@ -2132,40 +1974,40 @@ TcpGetOptionProc( int ret; optlen = sizeof(int); - ret = TclWinGetSockOpt(sock, SOL_SOCKET, SO_ERROR, + ret = TclWinGetSockOpt((int)sock, SOL_SOCKET, SO_ERROR, (char *)&err, &optlen); if (ret == SOCKET_ERROR) { err = WSAGetLastError(); } if (err) { - TclWinConvertError(err); - Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(Tcl_GetErrno()),TCL_STRLEN); + TclWinConvertWSAError(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))) { - address peername; - socklen_t size = sizeof(peername); - - if (getpeername(sock, (LPSOCKADDR) &(peername.sa), &size) == 0) { + if (getpeername(sock, (LPSOCKADDR) &peername, &size) == 0) { if (len == 0) { Tcl_DStringAppendElement(dsPtr, "-peername"); Tcl_DStringStartSublist(dsPtr); } + Tcl_DStringAppendElement(dsPtr, inet_ntoa(peername.sin_addr)); - 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 (peername.sin_addr.s_addr == 0) { + hostEntPtr = NULL; + } else { + hostEntPtr = gethostbyaddr((char *) &(peername.sin_addr), + sizeof(peername.sin_addr), AF_INET); + } + if (hostEntPtr != NULL) { + Tcl_DStringAppendElement(dsPtr, hostEntPtr->h_name); + } else { + Tcl_DStringAppendElement(dsPtr, inet_ntoa(peername.sin_addr)); + } + TclFormatInt(buf, ntohs(peername.sin_port)); + Tcl_DStringAppendElement(dsPtr, buf); if (len == 0) { Tcl_DStringEndSublist(dsPtr); } else { @@ -2180,11 +2022,10 @@ TcpGetOptionProc( */ if (len) { - TclWinConvertError((DWORD) WSAGetLastError()); + TclWinConvertWSAError((DWORD) WSAGetLastError()); if (interp) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't get peername: %s", - Tcl_PosixError(interp))); + Tcl_AppendResult(interp, "can't get peername: ", + Tcl_PosixError(interp), NULL); } return TCL_ERROR; } @@ -2193,53 +2034,25 @@ TcpGetOptionProc( if ((len == 0) || ((len > 1) && (optionName[1] == 's') && (strncmp(optionName, "-sockname", len) == 0))) { - TcpFdList *fds; - address sockname; - socklen_t size; - int found = 0; - - if (len == 0) { - Tcl_DStringAppendElement(dsPtr, "-sockname"); - Tcl_DStringStartSublist(dsPtr); - } - 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); + if (getsockname(sock, (LPSOCKADDR) &sockname, &size) == 0) { + if (len == 0) { + Tcl_DStringAppendElement(dsPtr, "-sockname"); + Tcl_DStringStartSublist(dsPtr); } - } - if (found) { + Tcl_DStringAppendElement(dsPtr, inet_ntoa(sockname.sin_addr)); + if (sockname.sin_addr.s_addr == 0) { + hostEntPtr = NULL; + } else { + hostEntPtr = gethostbyaddr((char *) &(sockname.sin_addr), + sizeof(peername.sin_addr), AF_INET); + } + if (hostEntPtr != NULL) { + Tcl_DStringAppendElement(dsPtr, hostEntPtr->h_name); + } else { + Tcl_DStringAppendElement(dsPtr, inet_ntoa(sockname.sin_addr)); + } + TclFormatInt(buf, ntohs(sockname.sin_port)); + Tcl_DStringAppendElement(dsPtr, buf); if (len == 0) { Tcl_DStringEndSublist(dsPtr); } else { @@ -2247,9 +2060,9 @@ TcpGetOptionProc( } } else { if (interp) { - TclWinConvertError((DWORD) WSAGetLastError()); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't get sockname: %s", Tcl_PosixError(interp))); + TclWinConvertWSAError((DWORD) WSAGetLastError()); + Tcl_AppendResult(interp, "can't get sockname: ", + Tcl_PosixError(interp), NULL); } return TCL_ERROR; } @@ -2283,7 +2096,8 @@ TcpGetOptionProc( Tcl_DStringAppendElement(dsPtr, "-nagle"); } optlen = sizeof(BOOL); - 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 { @@ -2332,11 +2146,11 @@ TcpWatchProc( * TCL_READABLE, TCL_WRITABLE and * TCL_EXCEPTION. */ { - SocketInfo *infoPtr = instanceData; + SocketInfo *infoPtr = (SocketInfo *) instanceData; /* * Update the watch events mask. Only if the socket is not a server - * socket. [Bug 557878] + * socket. Fix for SF Tcl Bug #557878. */ if (!infoPtr->acceptProc) { @@ -2355,7 +2169,6 @@ TcpWatchProc( if (infoPtr->readyEvents & infoPtr->watchEvents) { Tcl_Time blockTime = { 0, 0 }; - Tcl_SetMaxBlockTime(&blockTime); } } @@ -2384,9 +2197,9 @@ TcpGetHandleProc( int direction, /* Not used. */ ClientData *handlePtr) /* Where to store the handle. */ { - SocketInfo *statePtr = instanceData; + SocketInfo *statePtr = (SocketInfo *) instanceData; - *handlePtr = INT2PTR(statePtr->sockets->fd); + *handlePtr = (ClientData) statePtr->socket; return TCL_OK; } @@ -2411,14 +2224,14 @@ SocketThread( LPVOID arg) { MSG msg; - ThreadSpecificData *tsdPtr = arg; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *)(arg); /* * Create a dummy window receiving socket events. */ - tsdPtr->hwnd = CreateWindow(classname, classname, WS_TILED, 0, 0, 0, 0, - NULL, NULL, windowClass.hInstance, arg); + tsdPtr->hwnd = CreateWindow("TclSocket", "TclSocket", + WS_TILED, 0, 0, 0, 0, NULL, NULL, windowClass.hInstance, arg); /* * Signalize thread creator that we are done creating the window. @@ -2482,7 +2295,7 @@ SocketProc( int event, error; SOCKET socket; SocketInfo *infoPtr; - TcpFdList *fds = NULL; + int info_found = 0; ThreadSpecificData *tsdPtr = (ThreadSpecificData *) #ifdef _WIN64 GetWindowLongPtr(hwnd, GWLP_USERDATA); @@ -2527,80 +2340,91 @@ SocketProc( WaitForSingleObject(tsdPtr->socketListLock, INFINITE); for (infoPtr = tsdPtr->socketList; infoPtr != NULL; infoPtr = infoPtr->nextPtr) { - for (fds = infoPtr->sockets; fds != NULL; fds = fds->next) { - if (fds->fd == 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 (infoPtr->socket == socket) { + info_found = 1; + break; + } + } + /* + * Check if there is a pending info structure not jet in the + * list + */ + if ( !info_found + && tsdPtr->pendingSocketInfo != NULL + && tsdPtr->pendingSocketInfo->socket ==socket ) { + infoPtr = tsdPtr->pendingSocketInfo; + info_found = 1; + } + if (info_found) { - 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. - */ - - infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT); - - /* - * Remember any error that occurred so we can report - * connection failures. - */ - - 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) { - TclWinConvertError((DWORD) error); - infoPtr->lastError = Tcl_GetErrno(); - } - infoPtr->readyEvents |= FD_WRITE; - } - infoPtr->readyEvents |= event; + /* + * 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. + */ - /* - * Wake up the Main Thread. - */ + 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. + */ + + infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT); - SetEvent(tsdPtr->readyEvent); - Tcl_ThreadAlert(tsdPtr->threadId); - break; + /* + * Remember any error that occurred so we can report + * connection failures. + */ + + if (error != ERROR_SUCCESS) { + /* Async Connect error */ + TclWinConvertWSAError((DWORD) error); + infoPtr->lastError = Tcl_GetErrno(); + /* Fire also readable event on connect failure */ + infoPtr->readyEvents |= FD_READ; } + + /* fire writable event on connect */ + infoPtr->readyEvents |= FD_WRITE; + } + + infoPtr->readyEvents |= event; + + /* + * Wake up the Main Thread. + */ + + SetEvent(tsdPtr->readyEvent); + Tcl_ThreadAlert(tsdPtr->threadId); } SetEvent(tsdPtr->socketListLock); break; case SOCKET_SELECT: infoPtr = (SocketInfo *) lParam; - 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 - */ + if (wParam == SELECT) { + /* + * Start notification by windows messages on socket events + */ - WSAAsyncSelect(fds->fd, hwnd, 0, 0); - } + WSAAsyncSelect(infoPtr->socket, hwnd, + SOCKET_MESSAGE, infoPtr->selectEvents); + } else { + /* + * UNSELECT: Clear the selection mask + */ + + WSAAsyncSelect(infoPtr->socket, hwnd, 0, 0); } break; @@ -2655,16 +2479,17 @@ InitializeHostName( int *lengthPtr, Tcl_Encoding *encodingPtr) { - TCHAR tbuf[MAX_COMPUTERNAME_LENGTH + 1]; - DWORD length = MAX_COMPUTERNAME_LENGTH + 1; + WCHAR wbuf[MAX_COMPUTERNAME_LENGTH + 1]; + DWORD length = sizeof(wbuf) / sizeof(WCHAR); Tcl_DString ds; - if (GetComputerName(tbuf, &length) != 0) { + if ((*tclWinProcs->getComputerNameProc)(wbuf, &length) != 0) { /* * Convert string from native to UTF then change to lowercase. */ - Tcl_UtfToLower(Tcl_WinTCharToUtf(tbuf, TCL_STRLEN, &ds)); + Tcl_UtfToLower(Tcl_WinTCharToUtf((TCHAR *) wbuf, -1, &ds)); + } else { Tcl_DStringInit(&ds); if (TclpHasSockets(NULL) == TCL_OK) { @@ -2679,8 +2504,8 @@ InitializeHostName( Tcl_DStringSetLength(&inDs, 256); if (gethostname(Tcl_DStringValue(&inDs), Tcl_DStringLength(&inDs)) == 0) { - Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(&inDs), - TCL_STRLEN, &ds); + Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(&inDs), -1, + &ds); } Tcl_DStringFree(&inDs); } @@ -2688,7 +2513,7 @@ InitializeHostName( *encodingPtr = Tcl_GetEncoding(NULL, "utf-8"); *lengthPtr = Tcl_DStringLength(&ds); - *valuePtr = ckalloc((*lengthPtr) + 1); + *valuePtr = ckalloc((unsigned int) (*lengthPtr)+1); memcpy(*valuePtr, Tcl_DStringValue(&ds), (size_t)(*lengthPtr)+1); Tcl_DStringFree(&ds); } @@ -2712,80 +2537,34 @@ InitializeHostName( *---------------------------------------------------------------------- */ +#undef TclWinGetSockOpt int -TclWinGetSockOpt( - SOCKET s, - int level, - int optname, - char *optval, - int *optlen) +TclWinGetSockOpt(SOCKET s, int level, int optname, char *optval, + int *optlen) { - /* - * 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 getsockopt(s, level, optname, optval, optlen); } +#undef TclWinSetSockOpt int -TclWinSetSockOpt( - SOCKET s, - int level, - int optname, - const char *optval, +TclWinSetSockOpt(SOCKET s, int level, int optname, const char *optval, int optlen) { - /* - * 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 setsockopt(s, level, optname, optval, optlen); } char * -TclpInetNtoa( - struct in_addr addr) +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 NULL; - } - 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 getservbyname(name, proto); } @@ -2811,7 +2590,7 @@ TcpThreadActionProc( int action) { ThreadSpecificData *tsdPtr; - SocketInfo *infoPtr = instanceData; + SocketInfo *infoPtr = (SocketInfo *) instanceData; int notifyCmd; if (action == TCL_CHANNEL_THREAD_INSERT) { @@ -2829,6 +2608,11 @@ TcpThreadActionProc( WaitForSingleObject(tsdPtr->socketListLock, INFINITE); infoPtr->nextPtr = tsdPtr->socketList; tsdPtr->socketList = infoPtr; + + if (infoPtr == tsdPtr->pendingSocketInfo) { + tsdPtr->pendingSocketInfo = NULL; + } + SetEvent(tsdPtr->socketListLock); notifyCmd = SELECT; diff --git a/win/tclWinTest.c b/win/tclWinTest.c index 136c4db..e493fbf 100644 --- a/win/tclWinTest.c +++ b/win/tclWinTest.c @@ -9,9 +9,6 @@ * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ -#ifndef USE_TCL_STUBS -# define USE_TCL_STUBS -#endif #include "tclInt.h" /* @@ -32,6 +29,7 @@ * 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, @@ -186,7 +184,7 @@ TestvolumetypeCmd( #define VOL_BUF_SIZE 32 int found; char volType[VOL_BUF_SIZE]; - const char *path; + char *path; if (objc > 2) { Tcl_WrongNumArgs(interp, 1, objv, "?name?"); @@ -341,7 +339,7 @@ TestExceptionCmd( int objc, /* Argument count */ Tcl_Obj *const objv[]) /* Argument vector */ { - static const char *const cmds[] = { + static const char *cmds[] = { "access_violation", "datatype_misalignment", "array_bounds", "float_denormal", "float_divbyzero", "float_inexact", "float_invalidop", "float_overflow", "float_stack", "float_underflow", @@ -398,6 +396,28 @@ TestplatformChmod( const char *nativePath, int pmode) { + typedef DWORD (WINAPI *getSidLengthRequiredDef)(UCHAR); + typedef BOOL (WINAPI *initializeSidDef)(PSID, PSID_IDENTIFIER_AUTHORITY, + BYTE); + typedef PDWORD (WINAPI *getSidSubAuthorityDef)(PSID, DWORD); + typedef DWORD (WINAPI *setNamedSecurityInfoADef)(IN LPSTR, + IN SE_OBJECT_TYPE, IN SECURITY_INFORMATION, IN PSID, IN PSID, + IN PACL, IN PACL); + typedef BOOL (WINAPI *getAceDef)(PACL, DWORD, LPVOID *); + typedef BOOL (WINAPI *addAceDef)(PACL, DWORD, DWORD, LPVOID, DWORD); + typedef BOOL (WINAPI *equalSidDef)(PSID, PSID); + typedef BOOL (WINAPI *addAccessDeniedAceDef)(PACL, DWORD, DWORD, PSID); + typedef BOOL (WINAPI *initializeAclDef)(PACL, DWORD, DWORD); + typedef DWORD (WINAPI *getLengthSidDef)(PSID); + typedef BOOL (WINAPI *getAclInformationDef)(PACL, LPVOID, DWORD, + ACL_INFORMATION_CLASS); + typedef BOOL (WINAPI *getSecurityDescriptorDaclDef)(PSECURITY_DESCRIPTOR, + LPBOOL, PACL *, LPBOOL); + typedef BOOL (WINAPI *lookupAccountNameADef)(LPCSTR, LPCSTR, PSID, + PDWORD, LPSTR, LPDWORD, PSID_NAME_USE); + typedef BOOL (WINAPI *getFileSecurityADef)(LPCSTR, SECURITY_INFORMATION, + PSECURITY_DESCRIPTOR, DWORD, LPDWORD); + static const SECURITY_INFORMATION infoBits = OWNER_SECURITY_INFORMATION | GROUP_SECURITY_INFORMATION | DACL_SECURITY_INFORMATION; static const DWORD readOnlyMask = FILE_DELETE_CHILD | FILE_ADD_FILE @@ -408,6 +428,22 @@ TestplatformChmod( * References to security functions (only available on NT and later). */ + static getSidLengthRequiredDef getSidLengthRequiredProc; + static initializeSidDef initializeSidProc; + static getSidSubAuthorityDef getSidSubAuthorityProc; + static setNamedSecurityInfoADef setNamedSecurityInfoProc; + static getAceDef getAceProc; + static addAceDef addAceProc; + static equalSidDef equalSidProc; + static addAccessDeniedAceDef addAccessDeniedAceProc; + static initializeAclDef initializeAclProc; + static getLengthSidDef getLengthSidProc; + static getAclInformationDef getAclInformationProc; + static getSecurityDescriptorDaclDef getSecurityDescriptorDaclProc; + static lookupAccountNameADef lookupAccountNameProc; + static getFileSecurityADef getFileSecurityProc; + static int initialized = 0; + const BOOL set_readOnly = !(pmode & 0222); BOOL acl_readOnly_found = FALSE, curAclPresent, curAclDefaulted; SID_IDENTIFIER_AUTHORITY userSidAuthority = { @@ -419,14 +455,72 @@ TestplatformChmod( PACL curAcl, newAcl = 0; WORD j; SID *userSid = 0; - char *userDomain = 0; + TCHAR *userDomain = 0; int res = 0; /* + * One time initialization, dynamically load Windows NT features + */ + + if (!initialized) { + TCL_DECLARE_MUTEX(initializeMutex) + Tcl_MutexLock(&initializeMutex); + if (!initialized) { + HINSTANCE hInstance = LoadLibrary("Advapi32"); + + if (hInstance != NULL) { + setNamedSecurityInfoProc = (setNamedSecurityInfoADef) + GetProcAddress(hInstance, "SetNamedSecurityInfoA"); + 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 = GetFileAttributesA(nativePath); + attr = GetFileAttributes(nativePath); /* * nativePath not found @@ -438,10 +532,11 @@ TestplatformChmod( } /* - * If nativePath is not a directory, there is no special handling. + * If no ACL API is present or nativePath is not a directory, there is no + * special handling. */ - if (!(attr & FILE_ATTRIBUTE_DIRECTORY)) { + if (initialized < 0 || !(attr & FILE_ATTRIBUTE_DIRECTORY)) { goto done; } @@ -457,15 +552,15 @@ TestplatformChmod( * obtains the size of the security descriptor. */ - if (!GetFileSecurityA(nativePath, infoBits, NULL, 0, &secDescLen)) { + if (!getFileSecurityProc(nativePath, infoBits, NULL, 0, &secDescLen)) { DWORD secDescLen2 = 0; if (GetLastError() != ERROR_INSUFFICIENT_BUFFER) { goto done; } - secDesc = ckalloc(secDescLen); - if (!GetFileSecurityA(nativePath, infoBits, + secDesc = (BYTE *) ckalloc(secDescLen); + if (!getFileSecurityProc(nativePath, infoBits, (PSECURITY_DESCRIPTOR) secDesc, secDescLen, &secDescLen2) || (secDescLen < secDescLen2)) { goto done; @@ -476,22 +571,22 @@ TestplatformChmod( * Get the World SID. */ - userSid = ckalloc(GetSidLengthRequired((UCHAR) 1)); - InitializeSid(userSid, &userSidAuthority, (BYTE) 1); - *(GetSidSubAuthority(userSid, 0)) = SECURITY_WORLD_RID; + userSid = (SID *) ckalloc(getSidLengthRequiredProc((UCHAR) 1)); + initializeSidProc(userSid, &userSidAuthority, (BYTE) 1); + *(getSidSubAuthorityProc(userSid, 0)) = SECURITY_WORLD_RID; /* * If curAclPresent == false then curAcl and curAclDefaulted not valid. */ - if (!GetSecurityDescriptorDacl((PSECURITY_DESCRIPTOR) secDesc, + if (!getSecurityDescriptorDaclProc((PSECURITY_DESCRIPTOR) secDesc, &curAclPresent, &curAcl, &curAclDefaulted)) { goto done; } if (!curAclPresent || !curAcl) { ACLSize.AclBytesInUse = 0; ACLSize.AceCount = 0; - } else if (!GetAclInformation(curAcl, &ACLSize, sizeof(ACLSize), + } else if (!getAclInformationProc(curAcl, &ACLSize, sizeof(ACLSize), AclSizeInformation)) { goto done; } @@ -501,14 +596,14 @@ TestplatformChmod( */ newAclSize = ACLSize.AclBytesInUse + sizeof(ACCESS_DENIED_ACE) - + GetLengthSid(userSid) - sizeof(DWORD); - newAcl = ckalloc(newAclSize); + + getLengthSidProc(userSid) - sizeof(DWORD); + newAcl = (ACL *) ckalloc(newAclSize); /* * Initialize the new ACL. */ - if (!InitializeAcl(newAcl, newAclSize, ACL_REVISION)) { + if (!initializeAclProc(newAcl, newAclSize, ACL_REVISION)) { goto done; } @@ -516,7 +611,7 @@ TestplatformChmod( * Add denied to make readonly, this will be known as a "read-only tag". */ - if (set_readOnly && !AddAccessDeniedAce(newAcl, ACL_REVISION, + if (set_readOnly && !addAccessDeniedAceProc(newAcl, ACL_REVISION, readOnlyMask, userSid)) { goto done; } @@ -526,7 +621,7 @@ TestplatformChmod( LPVOID pACE2; ACE_HEADER *phACE2; - if (!GetAce(curAcl, j, &pACE2)) { + if (!getAceProc(curAcl, j, &pACE2)) { goto done; } @@ -549,7 +644,7 @@ TestplatformChmod( ACCESS_DENIED_ACE *pACEd = (ACCESS_DENIED_ACE *) phACE2; if (pACEd->Mask == readOnlyMask - && EqualSid(userSid, (PSID) &pACEd->SidStart)) { + && equalSidProc(userSid, (PSID) &pACEd->SidStart)) { acl_readOnly_found = TRUE; continue; } @@ -559,7 +654,7 @@ TestplatformChmod( * Copy the current ACE from the old to the new ACL. */ - if (!AddAce(newAcl, ACL_REVISION, MAXDWORD, (PACL *) pACE2, + if (!addAceProc(newAcl, ACL_REVISION, MAXDWORD, (PACL *)pACE2, ((PACE_HEADER) pACE2)->AceSize)) { goto done; } @@ -569,7 +664,7 @@ TestplatformChmod( * Apply the new ACL. */ - if (set_readOnly == acl_readOnly_found || SetNamedSecurityInfoA( + if (set_readOnly == acl_readOnly_found || setNamedSecurityInfoProc( (LPSTR) nativePath, SE_FILE_OBJECT, DACL_SECURITY_INFORMATION, NULL, NULL, newAcl, NULL) == ERROR_SUCCESS) { res = 0; @@ -577,13 +672,13 @@ TestplatformChmod( done: if (secDesc) { - ckfree(secDesc); + ckfree((char *) secDesc); } if (newAcl) { - ckfree(newAcl); + ckfree((char *) newAcl); } if (userSid) { - ckfree(userSid); + ckfree((char *) userSid); } if (userDomain) { ckfree(userDomain); diff --git a/win/tclWinThrd.c b/win/tclWinThrd.c index c856c41..2413a78 100644 --- a/win/tclWinThrd.c +++ b/win/tclWinThrd.c @@ -5,7 +5,6 @@ * * 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. @@ -14,7 +13,6 @@ #include "tclWinInt.h" #include <float.h> -#include <sys/stat.h> /* Workaround for mingw versions which don't provide this in float.h */ #ifndef _MCW_EM @@ -212,9 +210,9 @@ TclWinThreadStart( 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(). */ - size_t stackSize, /* Size of stack for the new thread. */ + int stackSize, /* Size of stack for the new thread. */ int flags) /* Flags controlling behaviour of the new * thread. */ { @@ -233,7 +231,7 @@ TclpThreadCreate( */ #if defined(_MSC_VER) || defined(__MSVCRT__) || defined(__BORLANDC__) - tHandle = (HANDLE) _beginthreadex(NULL, stackSize, + tHandle = (HANDLE) _beginthreadex(NULL, (unsigned) stackSize, (Tcl_ThreadCreateProc*) TclWinThreadStart, winThreadPtr, 0, (unsigned *)idPtr); #else @@ -336,7 +334,7 @@ TclpThreadExit( Tcl_ThreadId Tcl_GetCurrentThread(void) { - return (Tcl_ThreadId)(size_t)GetCurrentThreadId(); + return (Tcl_ThreadId) INT2PTR(GetCurrentThreadId()); } /* @@ -578,7 +576,7 @@ Tcl_MutexLock( */ if (*mutexPtr == NULL) { - csPtr = ckalloc(sizeof(CRITICAL_SECTION)); + csPtr = (CRITICAL_SECTION *) ckalloc(sizeof(CRITICAL_SECTION)); InitializeCriticalSection(csPtr); *mutexPtr = (Tcl_Mutex)csPtr; TclRememberMutex(mutexPtr); @@ -639,7 +637,7 @@ TclpFinalizeMutex( if (csPtr != NULL) { DeleteCriticalSection(csPtr); - ckfree(csPtr); + ckfree((char *) csPtr); *mutexPtr = NULL; } } @@ -670,7 +668,7 @@ void Tcl_ConditionWait( Tcl_Condition *condPtr, /* Really (WinCondition **) */ Tcl_Mutex *mutexPtr, /* Really (CRITICAL_SECTION **) */ - const Tcl_Time *timePtr) /* Timeout on waiting period */ + Tcl_Time *timePtr) /* Timeout on waiting period */ { WinCondition *winCondPtr; /* Per-condition queue head */ CRITICAL_SECTION *csPtr; /* Caller's Mutex, after casting */ @@ -709,7 +707,8 @@ Tcl_ConditionWait( * and initializing that may drop back into the Master Lock. */ - Tcl_CreateThreadExitHandler(FinalizeConditionEvent, tsdPtr); + Tcl_CreateThreadExitHandler(FinalizeConditionEvent, + (ClientData) tsdPtr); } } @@ -721,7 +720,7 @@ Tcl_ConditionWait( */ if (*condPtr == NULL) { - winCondPtr = ckalloc(sizeof(WinCondition)); + winCondPtr = (WinCondition *) ckalloc(sizeof(WinCondition)); InitializeCriticalSection(&winCondPtr->condLock); winCondPtr->firstPtr = NULL; winCondPtr->lastPtr = NULL; @@ -770,8 +769,7 @@ Tcl_ConditionWait( while (!timeout && (tsdPtr->flags & WIN_THREAD_BLOCKED)) { ResetEvent(tsdPtr->condEvent); LeaveCriticalSection(&winCondPtr->condLock); - if (WaitForSingleObjectEx(tsdPtr->condEvent, wtime, - TRUE) == WAIT_TIMEOUT) { + if (WaitForSingleObject(tsdPtr->condEvent, wtime) == WAIT_TIMEOUT) { timeout = 1; } EnterCriticalSection(&winCondPtr->condLock); @@ -932,7 +930,7 @@ TclpFinalizeCondition( if (winCondPtr != NULL) { DeleteCriticalSection(&winCondPtr->condLock); - ckfree(winCondPtr); + ckfree((char *) winCondPtr); *condPtr = NULL; } } @@ -975,7 +973,7 @@ TclpFreeAllocMutex( void * TclpGetAllocCache(void) { - void *result; + VOID *result; if (!once) { /* @@ -1040,61 +1038,6 @@ 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 new file mode 100644 index 0000000..41bc7aa --- /dev/null +++ b/win/tclWinThrd.h @@ -0,0 +1,19 @@ +/* + * tclWinThrd.h -- + * + * This header file defines things for thread support. + * + * Copyright (c) 1998 Sun Microsystems, Inc. + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + +#ifndef _TCLWINTHRD +#define _TCLWINTHRD + +#ifdef TCL_THREADS + +#endif /* TCL_THREADS */ + +#endif /* _TCLWINTHRD */ diff --git a/win/tclWinTime.c b/win/tclWinTime.c index 9cfbac0..0163723 100644 --- a/win/tclWinTime.c +++ b/win/tclWinTime.c @@ -12,6 +12,10 @@ #include "tclInt.h" +#define SECSPERDAY (60L * 60L * 24L) +#define SECSPERYEAR (SECSPERDAY * 365L) +#define SECSPER4YEAR (SECSPERYEAR * 4L + SECSPERDAY) + /* * Number of samples over which to estimate the performance counter. */ @@ -19,6 +23,25 @@ #define SAMPLES 64 /* + * The following arrays contain the day of year for the last day of each + * month, where index 1 is January. + */ + +static const int normalDays[] = { + -1, 30, 58, 89, 119, 150, 180, 211, 242, 272, 303, 333, 364 +}; + +static const int leapDays[] = { + -1, 30, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334, 365 +}; + +typedef struct ThreadSpecificData { + char tzName[64]; /* Time zone name */ + struct tm tm; /* time information */ +} ThreadSpecificData; +static Tcl_ThreadDataKey dataKey; + +/* * Data for managing high-resolution timers. */ @@ -64,7 +87,7 @@ typedef struct TimeInfo { } TimeInfo; static TimeInfo timeInfo = { - { NULL, 0, 0, NULL, NULL, 0 }, + { NULL }, 0, 0, (HANDLE) NULL, @@ -90,6 +113,7 @@ static TimeInfo timeInfo = { * Declarations for functions defined later in this file. */ +static struct tm * ComputeGMT(const time_t *tp); static void StopCalibration(ClientData clientData); static DWORD WINAPI CalibrationThread(LPVOID arg); static void UpdateTimeEachSecond(void); @@ -132,7 +156,7 @@ TclpGetSeconds(void) { Tcl_Time t; - tclGetTimeProcPtr(&t, tclTimeClientData); /* Tcl_GetTime inlined. */ + (*tclGetTimeProcPtr) (&t, tclTimeClientData); /* Tcl_GetTime inlined. */ return t.sec; } @@ -166,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; @@ -176,6 +200,35 @@ 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 @@ -199,7 +252,7 @@ void Tcl_GetTime( Tcl_Time *timePtr) /* Location to store time information. */ { - tclGetTimeProcPtr(timePtr, tclTimeClientData); + (*tclGetTimeProcPtr) (timePtr, tclTimeClientData); } /* @@ -256,7 +309,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. */ @@ -361,7 +414,7 @@ NativeGetTime( WaitForSingleObject(timeInfo.readyEvent, INFINITE); CloseHandle(timeInfo.readyEvent); - Tcl_CreateExitHandler(StopCalibration, NULL); + Tcl_CreateExitHandler(StopCalibration, (ClientData) NULL); } timeInfo.initialized = TRUE; } @@ -422,7 +475,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; } @@ -465,6 +518,314 @@ 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 + * true, then the returned date will be in Greenwich Mean Time (GMT). + * Otherwise, it will be in the local time zone. + * + * Results: + * Returns a static tm structure. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +struct tm * +TclpGetDate( + CONST time_t *t, + int useGMT) +{ + struct tm *tmPtr; + time_t time; + + if (!useGMT) { + tzset(); + + /* + * If we are in the valid range, let the C run-time library handle it. + * Otherwise we need to fake it. Note that this algorithm ignores + * daylight savings time before the epoch. + */ + + /* + * Hm, Borland's localtime manages to return NULL under certain + * circumstances (e.g. wintime.test, test 1.2). Nobody tests for this, + * since 'localtime' isn't supposed to do this, possibly leading to + * crashes. + * + * Patch: We only call this function if we are at least one day into + * the epoch, else we handle it ourselves (like we do for times < 0). + * H. Giese, June 2003 + */ + +#ifdef __BORLANDC__ +#define LOCALTIME_VALIDITY_BOUNDARY SECSPERDAY +#else +#define LOCALTIME_VALIDITY_BOUNDARY 0 +#endif + + if (*t >= LOCALTIME_VALIDITY_BOUNDARY) { + return TclpLocaltime(t); + } + + time = *t - timezone; + + /* + * If we aren't near to overflowing the long, just add the bias and + * use the normal calculation. Otherwise we will need to adjust the + * result at the end. + */ + + if (*t < (LONG_MAX - 2*SECSPERDAY) && *t > (LONG_MIN + 2*SECSPERDAY)) { + tmPtr = ComputeGMT(&time); + } else { + tmPtr = ComputeGMT(t); + + tzset(); + + /* + * Add the bias directly to the tm structure to avoid overflow. + * Propagate seconds overflow into minutes, hours and days. + */ + + time = tmPtr->tm_sec - timezone; + tmPtr->tm_sec = (int)(time % 60); + if (tmPtr->tm_sec < 0) { + tmPtr->tm_sec += 60; + time -= 60; + } + + time = tmPtr->tm_min + time/60; + tmPtr->tm_min = (int)(time % 60); + if (tmPtr->tm_min < 0) { + tmPtr->tm_min += 60; + time -= 60; + } + + time = tmPtr->tm_hour + time/60; + tmPtr->tm_hour = (int)(time % 24); + if (tmPtr->tm_hour < 0) { + tmPtr->tm_hour += 24; + time -= 24; + } + + time /= 24; + tmPtr->tm_mday += (int)time; + tmPtr->tm_yday += (int)time; + tmPtr->tm_wday = (tmPtr->tm_wday + (int)time) % 7; + } + } else { + tmPtr = ComputeGMT(t); + } + return tmPtr; +} + +/* + *---------------------------------------------------------------------- + * + * ComputeGMT -- + * + * This function computes GMT given the number of seconds since the epoch + * (midnight Jan 1 1970). + * + * Results: + * Returns a (per thread) statically allocated struct tm. + * + * Side effects: + * Updates the values of the static struct tm. + * + *---------------------------------------------------------------------- + */ + +static struct tm * +ComputeGMT( + const time_t *tp) +{ + struct tm *tmPtr; + long tmp, rem; + int isLeap; + const int *days; + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + + tmPtr = &tsdPtr->tm; + + /* + * Compute the 4 year span containing the specified time. + */ + + tmp = (long)(*tp / SECSPER4YEAR); + rem = (long)(*tp % SECSPER4YEAR); + + /* + * Correct for weird mod semantics so the remainder is always positive. + */ + + if (rem < 0) { + tmp--; + rem += SECSPER4YEAR; + } + + /* + * Compute the year after 1900 by taking the 4 year span and adjusting for + * the remainder. This works because 2000 is a leap year, and 1900/2100 + * are out of the range. + */ + + tmp = (tmp * 4) + 70; + isLeap = 0; + if (rem >= SECSPERYEAR) { /* 1971, etc. */ + tmp++; + rem -= SECSPERYEAR; + if (rem >= SECSPERYEAR) { /* 1972, etc. */ + tmp++; + rem -= SECSPERYEAR; + if (rem >= SECSPERYEAR + SECSPERDAY) { /* 1973, etc. */ + tmp++; + rem -= SECSPERYEAR + SECSPERDAY; + } else { + isLeap = 1; + } + } + } + tmPtr->tm_year = tmp; + + /* + * Compute the day of year and leave the seconds in the current day in the + * remainder. + */ + + tmPtr->tm_yday = rem / SECSPERDAY; + rem %= SECSPERDAY; + + /* + * Compute the time of day. + */ + + tmPtr->tm_hour = rem / 3600; + rem %= 3600; + tmPtr->tm_min = rem / 60; + tmPtr->tm_sec = rem % 60; + + /* + * Compute the month and day of month. + */ + + days = (isLeap) ? leapDays : normalDays; + for (tmp = 1; days[tmp] < tmPtr->tm_yday; tmp++) { + /* empty body */ + } + tmPtr->tm_mon = --tmp; + tmPtr->tm_mday = tmPtr->tm_yday - days[tmp]; + + /* + * Compute day of week. Epoch started on a Thursday. + */ + + tmPtr->tm_wday = (long)(*tp / SECSPERDAY) + 4; + if ((*tp % SECSPERDAY) < 0) { + tmPtr->tm_wday--; + } + tmPtr->tm_wday %= 7; + if (tmPtr->tm_wday < 0) { + tmPtr->tm_wday += 7; + } + + return tmPtr; +} + +/* + *---------------------------------------------------------------------- + * * CalibrationThread -- * * Thread that manages calibration of the hi-resolution time derived from @@ -792,6 +1153,68 @@ AccumulateSample( /* *---------------------------------------------------------------------- * + * TclpGmtime -- + * + * Wrapper around the 'gmtime' library function to make it thread safe. + * + * Results: + * Returns a pointer to a 'struct tm' in thread-specific data. + * + * Side effects: + * Invokes gmtime or gmtime_r as appropriate. + * + *---------------------------------------------------------------------- + */ + +struct tm * +TclpGmtime( + CONST time_t *timePtr) /* Pointer to the number of seconds since the + * local system's epoch */ +{ + /* + * The MS implementation of gmtime is thread safe because it returns the + * time in a block of thread-local storage, and Windows does not provide a + * Posix gmtime_r function. + */ + + return gmtime(timePtr); +} + +/* + *---------------------------------------------------------------------- + * + * TclpLocaltime -- + * + * Wrapper around the 'localtime' library function to make it thread + * safe. + * + * Results: + * Returns a pointer to a 'struct tm' in thread-specific data. + * + * Side effects: + * Invokes localtime or localtime_r as appropriate. + * + *---------------------------------------------------------------------- + */ + +struct tm * +TclpLocaltime( + CONST time_t *timePtr) /* Pointer to the number of seconds since the + * local system's epoch */ + +{ + /* + * The MS implementation of localtime is thread safe because it returns + * the time in a block of thread-local storage, and Windows does not + * provide a Posix localtime_r function. + */ + + return localtime(timePtr); +} + +/* + *---------------------------------------------------------------------- + * * Tcl_SetTimeProc -- * * TIP #233 (Virtualized Time): Registers two handlers for the diff --git a/win/tclooConfig.sh b/win/tclooConfig.sh deleted file mode 100644 index 5cb4d99..0000000 --- a/win/tclooConfig.sh +++ /dev/null @@ -1,19 +0,0 @@ -# tclooConfig.sh -- -# -# This shell script (for sh) is generated automatically by TclOO's configure -# script, or would be except it has no values that we substitute. It will -# create shell variables for most of the configuration options discovered by -# the configure script. This script is intended to be included by TEA-based -# configure scripts for TclOO extensions so that they don't have to figure -# this all out for themselves. -# -# The information in this file is specific to a single platform. - -# These are mostly empty because no special steps are ever needed from Tcl 8.6 -# onwards; all libraries and include files are just part of Tcl. -TCLOO_LIB_SPEC="" -TCLOO_STUB_LIB_SPEC="" -TCLOO_INCLUDE_SPEC="" -TCLOO_PRIVATE_INCLUDE_SPEC="" -TCLOO_CFLAGS="" -TCLOO_VERSION=0.7 diff --git a/win/tclsh.exe.manifest.in b/win/tclsh.exe.manifest.in new file mode 100644 index 0000000..8b06fce --- /dev/null +++ b/win/tclsh.exe.manifest.in @@ -0,0 +1,53 @@ +<?xml version="1.0" encoding="UTF-8" standalone="yes"?> +<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0" + xmlns:asmv3="urn:schemas-microsoft-com:asm.v3"> + <assemblyIdentity + version="@TCL_WIN_VERSION@" + processorArchitecture="@MACHINE@" + name="Tcl.tclsh" + type="win32" + /> + <description>Tcl command line shell (tclsh)</description> + <trustInfo xmlns="urn:schemas-microsoft-com:asm.v3"> + <security> + <requestedPrivileges> + <requestedExecutionLevel + level="asInvoker" + uiAccess="false" + /> + </requestedPrivileges> + </security> + </trustInfo> + <compatibility xmlns="urn:schemas-microsoft-com:compatibility.v1"> + <application> + <!-- Windows 10 --> + <supportedOS Id="{8e0f7a12-bfb3-4fe8-b9a5-48fd50a15a9a}"/> + <!-- Windows 8.1 --> + <supportedOS Id="{1f676c76-80e1-4239-95bb-83d0f6d0da78}"/> + <!-- Windows 8 --> + <supportedOS Id="{4a2f28e3-53b9-4441-ba9c-d69d4a4a6e38}"/> + <!-- Windows 7 --> + <supportedOS Id="{35138b9a-5d96-4fbd-8e2d-a2440225f93a}"/> + <!-- Windows Vista --> + <supportedOS Id="{e2011457-1546-43c5-a5fe-008deee3d3f0}"/> + </application> + </compatibility> + <asmv3:application> + <asmv3:windowsSettings + xmlns="http://schemas.microsoft.com/SMI/2005/WindowsSettings"> + <dpiAware>true</dpiAware> + </asmv3:windowsSettings> + </asmv3:application> + <dependency> + <dependentAssembly> + <assemblyIdentity + type="win32" + name="Microsoft.Windows.Common-Controls" + version="6.0.0.0" + processorArchitecture="@MACHINE@" + publicKeyToken="6595b64144ccf1df" + language="*" + /> + </dependentAssembly> + </dependency> +</assembly> diff --git a/win/tclsh.ico b/win/tclsh.ico Binary files differindex e254318..8bcaf48 100644 --- a/win/tclsh.ico +++ b/win/tclsh.ico diff --git a/win/tclsh.rc b/win/tclsh.rc index 16eaf83..161da50 100644 --- a/win/tclsh.rc +++ b/win/tclsh.rc @@ -1,3 +1,4 @@ +// // Version Resource Script // @@ -67,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" |