diff options
Diffstat (limited to 'unix')
39 files changed, 639 insertions, 809 deletions
diff --git a/unix/Makefile.in b/unix/Makefile.in index da057d8..93c3abd 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -54,7 +54,7 @@ DLL_INSTALL_DIR = @DLL_INSTALL_DIR@ SCRIPT_INSTALL_DIR = $(INSTALL_ROOT)$(TCL_LIBRARY) # Path name to use when installing Tcl modules. -MODULE_INSTALL_DIR = $(SCRIPT_INSTALL_DIR)/../tcl8 +MODULE_INSTALL_DIR = $(SCRIPT_INSTALL_DIR)/../tcl9 # Directory in which to install the include file tcl.h: INCLUDE_INSTALL_DIR = $(INSTALL_ROOT)$(includedir) @@ -124,7 +124,7 @@ ENV_FLAGS = # To enable memory debugging, call configure with --enable-symbols=mem # Warning: if you enable memory debugging, you must do it *everywhere*, -# including all the code that calls Tcl, and you must use ckalloc and ckfree +# including all the code that calls Tcl, and you must use Tcl_Alloc and Tcl_Free # everywhere instead of malloc and free. TCL_STUB_LIB_FILE = @TCL_STUB_LIB_FILE@ @@ -347,6 +347,8 @@ TOMMATH_OBJS = bn_s_mp_reverse.o bn_s_mp_mul_digs_fast.o \ bn_s_mp_mul_digs.o bn_s_mp_sqr.o bn_s_mp_sub.o STUB_LIB_OBJS = tclStubLib.o \ + tclStubCall.o \ + tclStubLibTbl.o \ tclTomMathStubLib.o \ tclOOStubLib.o \ ${COMPAT_OBJS} @@ -491,6 +493,8 @@ OO_SRCS = \ STUB_SRCS = \ $(GENERIC_DIR)/tclStubLib.c \ + $(GENERIC_DIR)/tclStubCall.c \ + $(GENERIC_DIR)/tclStubLibTbl.c \ $(GENERIC_DIR)/tclTomMathStubLib.c \ $(GENERIC_DIR)/tclOOStubLib.c @@ -952,26 +956,6 @@ valgrind: ${TCL_EXE} ${TCLTEST_EXE} $(TOP_DIR)/tests/all.tcl -singleproc 1 -constraints valgrind \ $(TESTFLAGS) -testresults/valgrind/%.result: ${TCL_EXE} ${TCLTEST_EXE} - @mkdir -p testresults/valgrind - $(SHELL_ENV) $(VALGRIND) $(VALGRINDARGS) ./${TCLTEST_EXE} \ - $(TOP_DIR)/tests/all.tcl -singleproc 1 -constraints valgrind \ - -file $(basename $(notdir $@)) > $@ 2>&1 -.PRECIOUS: testresults/valgrind/%.result - - -testresults/valgrind/%.success: testresults/valgrind/%.result - @printf '%s' valgrind >&2 - @printf ' %s' $(basename $(notdir $@)) >&2 - @printf '\n >&2' - @status=$$(./${TCLTEST_EXE} $(TOP_DIR)/tools/valgrind_check_success \ - file $(basename $@).result); \ - if [ "$$status" -eq 1 ]; then exit 0; else exit 1; fi - -valgrind_each: $(addprefix testresults/valgrind/,$(addsuffix .success,$(notdir\ - $(wildcard $(TOP_DIR)/tests/*.test)))) - - valgrindshell: ${TCL_EXE} $(SHELL_ENV) $(VALGRIND) $(VALGRINDARGS) ./${TCL_EXE} $(SCRIPT) @@ -1043,7 +1027,7 @@ install-libraries: libraries else true; \ fi; \ done; - @for i in 8.4 8.4/platform 8.5 8.6 8.7; \ + @for i in 9.0 9.0/platform; \ do \ if [ ! -d "$(MODULE_INSTALL_DIR)/$$i" ] ; then \ echo "Making directory $(MODULE_INSTALL_DIR)/$$i"; \ @@ -1063,23 +1047,23 @@ install-libraries: libraries done @echo "Installing package http 2.10b1 as a Tcl Module" @$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl \ - "$(MODULE_INSTALL_DIR)/8.6/http-2.10b1.tm" + "$(MODULE_INSTALL_DIR)/9.0/http-2.10b1.tm" @echo "Installing package opt0.4 files to $(SCRIPT_INSTALL_DIR)/opt0.4/" @for i in $(TOP_DIR)/library/opt/*.tcl; do \ $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)/opt0.4"; \ done @echo "Installing package msgcat 1.7.1 as a Tcl Module" @$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl \ - "$(MODULE_INSTALL_DIR)/8.7/msgcat-1.7.1.tm" + "$(MODULE_INSTALL_DIR)/9.0/msgcat-1.7.1.tm" @echo "Installing package tcltest 2.5.6 as a Tcl Module" @$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl \ - "$(MODULE_INSTALL_DIR)/8.5/tcltest-2.5.6.tm" + "$(MODULE_INSTALL_DIR)/9.0/tcltest-2.5.6.tm" @echo "Installing package platform 1.0.19 as a Tcl Module" @$(INSTALL_DATA) $(TOP_DIR)/library/platform/platform.tcl \ - "$(MODULE_INSTALL_DIR)/8.4/platform-1.0.19.tm" + "$(MODULE_INSTALL_DIR)/9.0/platform-1.0.19.tm" @echo "Installing package platform::shell 1.1.4 as a Tcl Module" @$(INSTALL_DATA) $(TOP_DIR)/library/platform/shell.tcl \ - "$(MODULE_INSTALL_DIR)/8.4/platform/shell-1.1.4.tm" + "$(MODULE_INSTALL_DIR)/9.0/platform/shell-1.1.4.tm" @echo "Installing encoding files to $(SCRIPT_INSTALL_DIR)/encoding/" @for i in $(TOP_DIR)/library/encoding/*.enc; do \ $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)/encoding"; \ @@ -1939,6 +1923,16 @@ Zzutil.o: $(ZLIB_DIR)/zutil.c tclStubLib.o: $(GENERIC_DIR)/tclStubLib.c $(CC) -c $(STUB_CC_SWITCHES) -DSTATIC_BUILD @CFLAGS_NOLTO@ $(GENERIC_DIR)/tclStubLib.c +tclStubCall.o: $(GENERIC_DIR)/tclStubCall.c + $(CC) -c $(STUB_CC_SWITCHES) -DSTATIC_BUILD \ + -DCFG_RUNTIME_DLLFILE="\"$(TCL_LIB_FILE)\"" \ + -DCFG_RUNTIME_LIBDIR="\"$(libdir)\"" \ + -DCFG_RUNTIME_BINDIR="\"$(bindir)\"" \ + $(GENERIC_DIR)/tclStubCall.c + +tclStubLibTbl.o: $(GENERIC_DIR)/tclStubLibTbl.c + $(CC) -c $(STUB_CC_SWITCHES) -DSTATIC_BUILD $(GENERIC_DIR)/tclStubLibTbl.c + tclTomMathStubLib.o: $(GENERIC_DIR)/tclTomMathStubLib.c $(CC) -c $(STUB_CC_SWITCHES) @CFLAGS_NOLTO@ $(GENERIC_DIR)/tclTomMathStubLib.c @@ -2248,6 +2242,8 @@ DISTROOT = /tmp/dist DISTNAME = tcl${VERSION}${PATCH_LEVEL} ZIPNAME = tcl${MAJOR_VERSION}${MINOR_VERSION}${PATCH_LEVEL}-src.zip DISTDIR = $(DISTROOT)/$(DISTNAME) +DIST_INSTALL_DATA = CPPROG='cp -p' $(INSTALL) -m 644 +DIST_INSTALL_SCRIPT = CPPROG='cp -p' $(INSTALL) -m 755 BUILTIN_PACKAGE_LIST = cookiejar http opt msgcat registry dde tcltest platform $(UNIX_DIR)/configure: $(UNIX_DIR)/configure.ac $(UNIX_DIR)/tcl.m4 \ @@ -2273,121 +2269,126 @@ $(TOP_DIR)/manifest.uuid: dist: $(UNIX_DIR)/configure $(UNIX_DIR)/tclConfig.h.in $(UNIX_DIR)/tcl.pc.in genstubs \ $(MAC_OSX_DIR)/configure $(TOP_DIR)/manifest.uuid dist-packages ${NATIVE_TCLSH} rm -rf $(DISTDIR) - mkdir -p $(DISTDIR)/unix - cp -p $(TOP_DIR)/manifest.uuid $(DISTDIR) - cp -p $(UNIX_DIR)/*.[ch] $(DISTDIR)/unix - cp -p $(UNIX_DIR)/Makefile.in $(DISTDIR)/unix - chmod 664 $(DISTDIR)/unix/Makefile.in - cp -p $(UNIX_DIR)/configure $(UNIX_DIR)/configure.ac \ + $(INSTALL_DATA_DIR) $(DISTDIR)/unix + $(DIST_INSTALL_DATA) $(TOP_DIR)/manifest.uuid $(DISTDIR) + $(DIST_INSTALL_DATA) $(UNIX_DIR)/*.[ch] $(DISTDIR)/unix + $(DIST_INSTALL_DATA) $(UNIX_DIR)/Makefile.in $(DISTDIR)/unix + $(DIST_INSTALL_DATA) $(UNIX_DIR)/configure.ac \ $(UNIX_DIR)/tcl.m4 $(UNIX_DIR)/aclocal.m4 \ $(UNIX_DIR)/tclConfig.sh.in $(UNIX_DIR)/tclooConfig.sh \ $(UNIX_DIR)/install-sh \ - $(UNIX_DIR)/README $(UNIX_DIR)/ldAix $(UNIX_DIR)/tcl.spec \ + $(UNIX_DIR)/README $(UNIX_DIR)/tcl.spec \ $(UNIX_DIR)/installManPage $(UNIX_DIR)/tclConfig.h.in \ $(UNIX_DIR)/tcl.pc.in $(DISTDIR)/unix - chmod 775 $(DISTDIR)/unix/configure - chmod 775 $(DISTDIR)/unix/ldAix - @mkdir $(DISTDIR)/generic - cp -p $(GENERIC_DIR)/*.[cdh] $(DISTDIR)/generic - cp -p $(GENERIC_DIR)/*.decls $(DISTDIR)/generic - cp -p $(GENERIC_DIR)/README $(DISTDIR)/generic - cp -p $(GENERIC_DIR)/tclGetDate.y $(DISTDIR)/generic - cp -p $(TOP_DIR)/changes $(TOP_DIR)/ChangeLog $(TOP_DIR)/README.md \ + $(DIST_INSTALL_SCRIPT) $(UNIX_DIR)/configure $(UNIX_DIR)/ldAix $(DISTDIR)/unix + $(INSTALL_DATA_DIR) $(DISTDIR)/generic + $(DIST_INSTALL_DATA) $(GENERIC_DIR)/*.[cdh] $(DISTDIR)/generic + $(DIST_INSTALL_DATA) $(GENERIC_DIR)/*.decls $(DISTDIR)/generic + $(DIST_INSTALL_DATA) $(GENERIC_DIR)/README $(DISTDIR)/generic + $(DIST_INSTALL_DATA) $(GENERIC_DIR)/tclGetDate.y $(DISTDIR)/generic + $(DIST_INSTALL_DATA) $(TOP_DIR)/changes $(TOP_DIR)/ChangeLog $(TOP_DIR)/README.md \ $(TOP_DIR)/ChangeLog.[12]??? $(TOP_DIR)/license.terms \ $(DISTDIR) - @mkdir $(DISTDIR)/library - cp -p $(TOP_DIR)/license.terms $(TOP_DIR)/library/*.tcl \ + $(INSTALL_DATA_DIR) $(DISTDIR)/library + $(DIST_INSTALL_DATA) $(TOP_DIR)/license.terms $(TOP_DIR)/library/*.tcl \ $(TOP_DIR)/library/manifest.txt \ $(TOP_DIR)/library/tclIndex $(DISTDIR)/library @for i in $(BUILTIN_PACKAGE_LIST); do \ - mkdir $(DISTDIR)/library/$$i;\ - cp -p $(TOP_DIR)/library/$$i/*.tcl $(DISTDIR)/library/$$i; \ + $(INSTALL_DATA_DIR) $(DISTDIR)/library/$$i;\ + $(DIST_INSTALL_DATA) $(TOP_DIR)/library/$$i/*.tcl $(DISTDIR)/library/$$i; \ done - cp -p $(TOP_DIR)/library/cookiejar/*.dat.gz $(DISTDIR)/library/cookiejar - @mkdir $(DISTDIR)/library/encoding - cp -p $(TOP_DIR)/library/encoding/*.enc $(DISTDIR)/library/encoding - @mkdir $(DISTDIR)/library/msgs - cp -p $(TOP_DIR)/library/msgs/*.msg $(DISTDIR)/library/msgs + $(DIST_INSTALL_DATA) $(TOP_DIR)/library/cookiejar/*.dat.gz $(DISTDIR)/library/cookiejar + $(INSTALL_DATA_DIR) $(DISTDIR)/library/encoding + $(DIST_INSTALL_DATA) $(TOP_DIR)/library/encoding/*.enc $(DISTDIR)/library/encoding + $(INSTALL_DATA_DIR) $(DISTDIR)/library/msgs + $(DIST_INSTALL_DATA) $(TOP_DIR)/library/msgs/*.msg $(DISTDIR)/library/msgs @echo cp -r $(TOP_DIR)/library/tzdata $(DISTDIR)/library/tzdata @( cd $(TOP_DIR); find library/tzdata -type f -print ) \ | ( cd $(TOP_DIR) ; xargs tar cf - ) \ | ( cd $(DISTDIR) ; tar xfp - ) - @mkdir $(DISTDIR)/doc - cp -p $(TOP_DIR)/license.terms $(TOP_DIR)/doc/*.[13n] \ + $(INSTALL_DATA_DIR) $(DISTDIR)/doc + $(DIST_INSTALL_DATA) $(TOP_DIR)/license.terms $(TOP_DIR)/doc/*.[13n] \ $(TOP_DIR)/doc/man.macros $(DISTDIR)/doc - @mkdir $(DISTDIR)/compat - cp -p $(TOP_DIR)/license.terms $(COMPAT_DIR)/*.[ch] \ + $(INSTALL_DATA_DIR) $(DISTDIR)/compat + $(DIST_INSTALL_DATA) $(TOP_DIR)/license.terms $(COMPAT_DIR)/*.[ch] \ $(COMPAT_DIR)/README $(DISTDIR)/compat - @mkdir $(DISTDIR)/compat/zlib + $(INSTALL_DATA_DIR) $(DISTDIR)/compat/zlib @echo cp -r $(COMPAT_DIR)/zlib $(DISTDIR)/compat/zlib @( cd $(COMPAT_DIR)/zlib; find . -type f -print ) \ | ( cd $(COMPAT_DIR)/zlib ; xargs tar cf - ) \ | ( cd $(DISTDIR)/compat/zlib ; tar xfp - ) - @mkdir $(DISTDIR)/libtommath + $(INSTALL_DATA_DIR) $(DISTDIR)/libtommath @echo cp -r $(TOP_DIR)/libtommath $(DISTDIR)/libtommath @( cd $(TOP_DIR)/libtommath; find . -type f -print ) \ | ( cd $(TOP_DIR)/libtommath ; xargs tar cf - ) \ | ( cd $(DISTDIR)/libtommath ; tar xfp - ) - @mkdir $(DISTDIR)/tests - cp -p $(TOP_DIR)/license.terms $(DISTDIR)/tests - cp -p $(TOP_DIR)/tests/*.test $(TOP_DIR)/tests/README \ + $(INSTALL_DATA_DIR) $(DISTDIR)/tests + $(DIST_INSTALL_DATA) $(TOP_DIR)/license.terms $(DISTDIR)/tests + $(DIST_INSTALL_DATA) $(TOP_DIR)/tests/*.test $(TOP_DIR)/tests/README \ $(TOP_DIR)/tests/httpd $(TOP_DIR)/tests/*.tcl \ $(TOP_DIR)/tests/auto-files.zip $(DISTDIR)/tests @mkdir $(DISTDIR)/tests/auto0 for i in auto1 auto2 ; \ do \ - mkdir $(DISTDIR)/tests/auto0/$$i ;\ - cp -p $(TOP_DIR)/tests/auto0/$$i/tclIndex $(TOP_DIR)/tests/auto0/$$i/*.tcl \ + $(INSTALL_DATA_DIR) $(DISTDIR)/tests/auto0/$$i ;\ + $(DIST_INSTALL_DATA) $(TOP_DIR)/tests/auto0/$$i/tclIndex $(TOP_DIR)/tests/auto0/$$i/*.tcl \ $(DISTDIR)/tests/auto0/$$i; \ done; for i in modules modules/mod1 modules/mod2 ; \ do \ - mkdir $(DISTDIR)/tests/auto0/$$i ;\ - cp -p $(TOP_DIR)/tests/auto0/$$i/*.tm \ + $(INSTALL_DATA_DIR) $(DISTDIR)/tests/auto0/$$i ;\ + $(DIST_INSTALL_DATA) $(TOP_DIR)/tests/auto0/$$i/*.tm \ $(DISTDIR)/tests/auto0/$$i; \ done; - @mkdir $(DISTDIR)/win - cp -p $(TOP_DIR)/win/Makefile.in $(DISTDIR)/win - cp -p $(TOP_DIR)/win/configure.ac $(TOP_DIR)/win/configure \ + $(INSTALL_DATA_DIR) $(DISTDIR)/win + $(DIST_INSTALL_DATA) $(TOP_DIR)/win/Makefile.in $(DISTDIR)/win + $(DIST_INSTALL_DATA) $(TOP_DIR)/win/configure.ac \ $(TOP_DIR)/win/tclConfig.sh.in $(TOP_DIR)/win/tclooConfig.sh \ $(TOP_DIR)/win/tcl.m4 $(TOP_DIR)/win/aclocal.m4 \ $(TOP_DIR)/win/tclsh.exe.manifest.in $(TOP_DIR)/win/tclUuid.h.in \ $(TOP_DIR)/win/gitmanifest.in $(TOP_DIR)/win/svnmanifest.in \ $(TOP_DIR)/win/x86_64-w64-mingw32-nmakehlp.exe $(DISTDIR)/win chmod 775 $(DISTDIR)/win/x86_64-w64-mingw32-nmakehlp.exe - cp -p $(TOP_DIR)/win/*.[ch] $(TOP_DIR)/win/*.ico $(TOP_DIR)/win/*.rc \ + $(DIST_INSTALL_SCRIPT) $(TOP_DIR)/win/configure $(DISTDIR)/win + $(DIST_INSTALL_DATA) $(TOP_DIR)/win/*.[ch] $(TOP_DIR)/win/*.ico $(TOP_DIR)/win/*.rc \ $(DISTDIR)/win - cp -p $(TOP_DIR)/win/*.bat $(DISTDIR)/win - cp -p $(TOP_DIR)/win/*.vc $(DISTDIR)/win - cp -p $(TOP_DIR)/win/tcl.ds* $(DISTDIR)/win - cp -p $(TOP_DIR)/win/README $(DISTDIR)/win - cp -p $(TOP_DIR)/license.terms $(DISTDIR)/win - @mkdir $(DISTDIR)/macosx - cp -p $(MAC_OSX_DIR)/GNUmakefile $(MAC_OSX_DIR)/README \ + $(DIST_INSTALL_DATA) $(TOP_DIR)/win/*.bat $(DISTDIR)/win + $(DIST_INSTALL_DATA) $(TOP_DIR)/win/*.vc $(DISTDIR)/win + $(DIST_INSTALL_DATA) $(TOP_DIR)/win/tcl.ds* $(DISTDIR)/win + $(DIST_INSTALL_DATA) $(TOP_DIR)/win/README $(DISTDIR)/win + $(DIST_INSTALL_DATA) $(TOP_DIR)/license.terms $(DISTDIR)/win + $(INSTALL_DATA_DIR) $(DISTDIR)/macosx + $(DIST_INSTALL_DATA) $(MAC_OSX_DIR)/GNUmakefile $(MAC_OSX_DIR)/README \ $(MAC_OSX_DIR)/*.c $(MAC_OSX_DIR)/*.in \ $(MAC_OSX_DIR)/*.ac $(MAC_OSX_DIR)/*.xcconfig \ - $(MAC_OSX_DIR)/configure $(DISTDIR)/macosx - cp -p $(TOP_DIR)/license.terms $(DISTDIR)/macosx - @mkdir $(DISTDIR)/macosx/Tcl.xcodeproj - cp -p $(MAC_OSX_DIR)/Tcl.xcodeproj/project.pbxproj \ + $(DISTDIR)/macosx + $(DIST_INSTALL_SCRIPT) $(MAC_OSX_DIR)/configure $(DISTDIR)/macosx + $(DIST_INSTALL_DATA) $(TOP_DIR)/license.terms $(DISTDIR)/macosx + $(INSTALL_DATA_DIR) $(DISTDIR)/macosx/Tcl.xcodeproj + $(DIST_INSTALL_DATA) $(MAC_OSX_DIR)/Tcl.xcodeproj/project.pbxproj \ $(MAC_OSX_DIR)/Tcl.xcodeproj/default.pbxuser \ $(DISTDIR)/macosx/Tcl.xcodeproj - @mkdir $(DISTDIR)/unix/dltest - cp -p $(UNIX_DIR)/dltest/*.c $(UNIX_DIR)/dltest/Makefile.in \ + $(INSTALL_DATA_DIR) $(DISTDIR)/unix/dltest + $(DIST_INSTALL_DATA) $(UNIX_DIR)/dltest/*.c $(UNIX_DIR)/dltest/Makefile.in \ $(UNIX_DIR)/dltest/README $(DISTDIR)/unix/dltest - @mkdir $(DISTDIR)/tools - cp -p $(TOOL_DIR)/README $(TOOL_DIR)/*.c $(TOOL_DIR)/*.svg \ + $(INSTALL_DATA_DIR) $(DISTDIR)/tools + $(DIST_INSTALL_DATA) $(TOOL_DIR)/README $(TOOL_DIR)/*.c $(TOOL_DIR)/*.svg \ $(TOOL_DIR)/*.tcl $(TOOL_DIR)/*.bmp \ $(TOOL_DIR)/valgrind_suppress $(DISTDIR)/tools - @mkdir $(DISTDIR)/pkgs - cp -p $(TOP_DIR)/pkgs/README $(DISTDIR)/pkgs - cp -p $(TOP_DIR)/pkgs/package.list.txt $(DISTDIR)/pkgs + chmod 755 $(DISTDIR)/tools/checkLibraryDoc.tcl \ + $(DISTDIR)/tools/findBadExternals.tcl \ + $(DISTDIR)/tools/loadICU.tcl \ + $(DISTDIR)/tools/makeTestCases.tcl $(DISTDIR)/tools/tclZIC.tcl \ + $(DISTDIR)/tools/tcltk-man2html.tcl + $(INSTALL_DATA_DIR) $(DISTDIR)/pkgs + $(DIST_INSTALL_DATA) $(TOP_DIR)/pkgs/README $(DISTDIR)/pkgs + $(DIST_INSTALL_DATA) $(TOP_DIR)/pkgs/package.list.txt $(DISTDIR)/pkgs for i in `ls $(DISTROOT)/pkgs/*.tar.gz 2> /dev/null`; do \ tar -C $(DISTDIR)/pkgs -xzf "$$i"; \ done - cp -p $(TOP_DIR)/.travis.yml $(DISTDIR) - mkdir -p $(DISTDIR)/.github/workflows - cp -p $(TOP_DIR)/.github/workflows/*.yml $(DISTDIR)/.github/workflows + $(DIST_INSTALL_DATA) $(TOP_DIR)/.travis.yml $(DISTDIR) + $(INSTALL_DATA_DIR) $(DISTDIR)/.github/workflows + $(DIST_INSTALL_DATA) $(TOP_DIR)/.github/workflows/*.yml $(DISTDIR)/.github/workflows alldist: dist rm -f $(DISTROOT)/$(DISTNAME)-src.tar.gz $(DISTROOT)/$(ZIPNAME) @@ -2399,7 +2400,7 @@ alldist: dist #-------------------------------------------------------------------------- # 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.* & +# workspace. It depends on the Tcl & Tk being in directories called tcl9.* & # tk8.* up two directories from the TOOL_DIR. # # Note that for platforms where this is important, it is more common to use a diff --git a/unix/configure b/unix/configure index c57ee40..4855fd3 100755 --- a/unix/configure +++ b/unix/configure @@ -1,6 +1,6 @@ #! /bin/sh # Guess values for system-dependent variables and create Makefiles. -# Generated by GNU Autoconf 2.71 for tcl 8.7. +# Generated by GNU Autoconf 2.71 for tcl 9.0. # # # Copyright (C) 1992-1996, 1998-2017, 2020-2021 Free Software Foundation, @@ -608,8 +608,8 @@ MAKEFLAGS= # Identity of this package. PACKAGE_NAME='tcl' PACKAGE_TARNAME='tcl' -PACKAGE_VERSION='8.7' -PACKAGE_STRING='tcl 8.7' +PACKAGE_VERSION='9.0' +PACKAGE_STRING='tcl 9.0' PACKAGE_BUGREPORT='' PACKAGE_URL='' @@ -1372,7 +1372,7 @@ if test "$ac_init_help" = "long"; then # Omit some internal or obsolete options to make the list less imposing. # This message is too long to be a string in the A/UX 3.1 sh. cat <<_ACEOF -\`configure' configures tcl 8.7 to adapt to many kinds of systems. +\`configure' configures tcl 9.0 to adapt to many kinds of systems. Usage: $0 [OPTION]... [VAR=VALUE]... @@ -1434,7 +1434,7 @@ fi if test -n "$ac_init_help"; then case $ac_init_help in - short | recursive ) echo "Configuration of tcl 8.7:";; + short | recursive ) echo "Configuration of tcl 9.0:";; esac cat <<\_ACEOF @@ -1551,7 +1551,7 @@ fi test -n "$ac_init_help" && exit $ac_status if $ac_init_version; then cat <<\_ACEOF -tcl configure 8.7 +tcl configure 9.0 generated by GNU Autoconf 2.71 Copyright (C) 2021 Free Software Foundation, Inc. @@ -2019,7 +2019,7 @@ cat >config.log <<_ACEOF This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. -It was created by tcl $as_me 8.7, which was +It was created by tcl $as_me 9.0, which was generated by GNU Autoconf 2.71. Invocation command line was $ $0$ac_configure_args_raw @@ -2681,10 +2681,10 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu -TCL_VERSION=8.7 -TCL_MAJOR_VERSION=8 -TCL_MINOR_VERSION=7 -TCL_PATCH_LEVEL="a6" +TCL_VERSION=9.0 +TCL_MAJOR_VERSION=9 +TCL_MINOR_VERSION=0 +TCL_PATCH_LEVEL="a4" VERSION=${TCL_VERSION} EXTRA_INSTALL_BINARIES=${EXTRA_INSTALL_BINARIES:-"@:"} @@ -10456,9 +10456,6 @@ fi printf "%s\n" "#define USE_VFORK 1" >>confdefs.h -printf "%s\n" "#define TCL_DEFAULT_ENCODING \"utf-8\"" >>confdefs.h - - printf "%s\n" "#define TCL_LOAD_FROM_MEMORY 1" >>confdefs.h @@ -11270,15 +11267,11 @@ fi # Replace ${VERSION} with contents of ${TCL_VERSION} # double-eval to account for TCL_TRIM_DOTS. # -eval "TCL_STUB_LIB_FILE=libtclstub${TCL_UNSHARED_LIB_SUFFIX}" +eval "TCL_STUB_LIB_FILE=libtclstub.a" eval "TCL_STUB_LIB_FILE=\"${TCL_STUB_LIB_FILE}\"" eval "TCL_STUB_LIB_DIR=\"${libdir}\"" -if test "${TCL_LIB_VERSIONS_OK}" = "ok"; then - TCL_STUB_LIB_FLAG="-ltclstub${TCL_VERSION}" -else - TCL_STUB_LIB_FLAG="-ltclstub`echo ${TCL_VERSION} | tr -d .`" -fi +TCL_STUB_LIB_FLAG="-ltclstub" TCL_BUILD_STUB_LIB_SPEC="-L`pwd | sed -e 's/ /\\\\ /g'` ${TCL_STUB_LIB_FLAG}" TCL_STUB_LIB_SPEC="-L${TCL_STUB_LIB_DIR} ${TCL_STUB_LIB_FLAG}" @@ -11878,7 +11871,7 @@ cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 # report actual input values of CONFIG_FILES etc. instead of their # values after options handling. ac_log=" -This file was extended by tcl $as_me 8.7, which was +This file was extended by tcl $as_me 9.0, which was generated by GNU Autoconf 2.71. Invocation command line was CONFIG_FILES = $CONFIG_FILES @@ -11937,7 +11930,7 @@ ac_cs_config_escaped=`printf "%s\n" "$ac_cs_config" | sed "s/^ //; s/'/'\\\\\\\\ cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ac_cs_config='$ac_cs_config_escaped' ac_cs_version="\\ -tcl config.status 8.7 +tcl config.status 9.0 configured by $0, generated by GNU Autoconf 2.71, with options \\"\$ac_cs_config\\" diff --git a/unix/configure.ac b/unix/configure.ac index de44ed7..109af38 100644 --- a/unix/configure.ac +++ b/unix/configure.ac @@ -3,7 +3,7 @@ dnl This file is an input file used by the GNU "autoconf" program to dnl generate the file "configure", which is run during Tcl installation dnl to configure the system for the local environment. -AC_INIT([tcl],[8.7]) +AC_INIT([tcl],[9.0]) AC_PREREQ([2.69]) dnl This is only used when included from macosx/configure.ac @@ -23,10 +23,10 @@ m4_ifdef([SC_USE_CONFIG_HEADERS], [ #endif /* _TCLCONFIG */]) ]) -TCL_VERSION=8.7 -TCL_MAJOR_VERSION=8 -TCL_MINOR_VERSION=7 -TCL_PATCH_LEVEL="a6" +TCL_VERSION=9.0 +TCL_MAJOR_VERSION=9 +TCL_MINOR_VERSION=0 +TCL_PATCH_LEVEL="a4" VERSION=${TCL_VERSION} EXTRA_INSTALL_BINARIES=${EXTRA_INSTALL_BINARIES:-"@:"} @@ -577,8 +577,6 @@ if test "`uname -s`" = "Darwin" ; then AC_CHECK_FUNCS(OSSpinLockLock) fi AC_DEFINE(USE_VFORK, 1, [Should we use vfork() instead of fork()?]) - AC_DEFINE(TCL_DEFAULT_ENCODING, "utf-8", - [Are we to override what our default encoding is?]) AC_DEFINE(TCL_LOAD_FROM_MEMORY, 1, [Can this platform load code from memory?]) AC_DEFINE(TCL_WIDE_CLICKS, 1, @@ -937,15 +935,11 @@ fi # Replace ${VERSION} with contents of ${TCL_VERSION} # double-eval to account for TCL_TRIM_DOTS. # -eval "TCL_STUB_LIB_FILE=libtclstub${TCL_UNSHARED_LIB_SUFFIX}" +eval "TCL_STUB_LIB_FILE=libtclstub.a" eval "TCL_STUB_LIB_FILE=\"${TCL_STUB_LIB_FILE}\"" eval "TCL_STUB_LIB_DIR=\"${libdir}\"" -if test "${TCL_LIB_VERSIONS_OK}" = "ok"; then - TCL_STUB_LIB_FLAG="-ltclstub${TCL_VERSION}" -else - TCL_STUB_LIB_FLAG="-ltclstub`echo ${TCL_VERSION} | tr -d .`" -fi +TCL_STUB_LIB_FLAG="-ltclstub" TCL_BUILD_STUB_LIB_SPEC="-L`pwd | sed -e 's/ /\\\\ /g'` ${TCL_STUB_LIB_FLAG}" TCL_STUB_LIB_SPEC="-L${TCL_STUB_LIB_DIR} ${TCL_STUB_LIB_FLAG}" diff --git a/unix/dltest/Makefile.in b/unix/dltest/Makefile.in index 500bf97..19b7d84 100644 --- a/unix/dltest/Makefile.in +++ b/unix/dltest/Makefile.in @@ -25,13 +25,23 @@ LDFLAGS = @LDFLAGS_DEFAULT@ @LDFLAGS@ CC_SWITCHES = $(CFLAGS) -I${SRC_DIR}/../../generic -DTCL_MEM_DEBUG \ ${SHLIB_CFLAGS} -DUSE_TCL_STUBS ${AC_FLAGS} -all: pkga${SHLIB_SUFFIX} pkgb${SHLIB_SUFFIX} pkgc${SHLIB_SUFFIX} pkgd${SHLIB_SUFFIX} pkge${SHLIB_SUFFIX} pkgua${SHLIB_SUFFIX} pkgooa${SHLIB_SUFFIX} +all: embtest tcl9pkga${SHLIB_SUFFIX} tcl9pkgb${SHLIB_SUFFIX} tcl9pkgc${SHLIB_SUFFIX} \ + tcl9pkgd${SHLIB_SUFFIX} tcl9pkge${SHLIB_SUFFIX} tcl9pkgua${SHLIB_SUFFIX} tcl9pkgooa${SHLIB_SUFFIX} \ + pkga${SHLIB_SUFFIX} pkgb${SHLIB_SUFFIX} pkgc${SHLIB_SUFFIX} @if test -n "$(DLTEST_SUFFIX)"; then $(MAKE) dltest_suffix; fi @touch ../dltest.marker -dltest_suffix: pkga${DLTEST_SUFFIX} pkgb${DLTEST_SUFFIX} pkgc${DLTEST_SUFFIX} pkgd${DLTEST_SUFFIX} pkge${DLTEST_SUFFIX} pkgua${DLTEST_SUFFIX} pkgooa${DLTEST_SUFFIX} +dltest_suffix: tcl9pkga${DLTEST_SUFFIX} tcl9pkgb${DLTEST_SUFFIX} tcl9pkgc${DLTEST_SUFFIX} \ + tcl9pkgd${DLTEST_SUFFIX} tcl9pkge${DLTEST_SUFFIX} tcl9pkgua${DLTEST_SUFFIX} tcl9pkgooa${DLTEST_SUFFIX} \ + pkga${DLTEST_SUFFIX} pkgb${DLTEST_SUFFIX} pkgc${DLTEST_SUFFIX} @touch ../dltest.marker +embtest.o: $(SRC_DIR)/embtest.c + $(CC) -c $(CC_SWITCHES) $(SRC_DIR)/embtest.c + +pkgπ.o: $(SRC_DIR)/pkgπ.c + $(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkgπ.c + pkga.o: $(SRC_DIR)/pkga.c $(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkga.c @@ -41,6 +51,15 @@ pkgb.o: $(SRC_DIR)/pkgb.c pkgc.o: $(SRC_DIR)/pkgc.c $(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkgc.c +tcl8pkga.o: $(SRC_DIR)/pkga.c + $(CC) -o $@ -c $(CC_SWITCHES) -DTCL_MAJOR_VERSION=8 $(SRC_DIR)/pkga.c + +tcl8pkgb.o: $(SRC_DIR)/pkgb.c + $(CC) -o $@ -c $(CC_SWITCHES) -DTCL_MAJOR_VERSION=8 $(SRC_DIR)/pkgb.c + +tcl8pkgc.o: $(SRC_DIR)/pkgc.c + $(CC) -o $@ -c $(CC_SWITCHES) -DTCL_MAJOR_VERSION=8 $(SRC_DIR)/pkgc.c + pkgd.o: $(SRC_DIR)/pkgd.c $(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkgd.c @@ -53,50 +72,77 @@ pkgua.o: $(SRC_DIR)/pkgua.c pkgooa.o: $(SRC_DIR)/pkgooa.c $(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkgooa.c -pkga${SHLIB_SUFFIX}: pkga.o - ${SHLIB_LD} -o pkga${SHLIB_SUFFIX} pkga.o ${SHLIB_LD_LIBS} +embtest: embtest.o + $(CC) -o $@ embtest.o ${SHLIB_LD_LIBS} + +tcl9pkgπ${SHLIB_SUFFIX}: pkgπ.o + ${SHLIB_LD} -o $@ pkgπ.o ${SHLIB_LD_LIBS} + +tcl9pkga${SHLIB_SUFFIX}: pkga.o + ${SHLIB_LD} -o $@ pkga.o ${SHLIB_LD_LIBS} + +tcl9pkgb${SHLIB_SUFFIX}: pkgb.o + ${SHLIB_LD} -o $@ pkgb.o ${SHLIB_LD_LIBS} + +tcl9pkgc${SHLIB_SUFFIX}: pkgc.o + ${SHLIB_LD} -o $@ pkgc.o ${SHLIB_LD_LIBS} + +pkga${SHLIB_SUFFIX}: tcl8pkga.o + ${SHLIB_LD} -o $@ tcl8pkga.o ${SHLIB_LD_LIBS} + +pkgb${SHLIB_SUFFIX}: tcl8pkgb.o + ${SHLIB_LD} -o $@ tcl8pkgb.o ${SHLIB_LD_LIBS} + +pkgc${SHLIB_SUFFIX}: tcl8pkgc.o + ${SHLIB_LD} -o $@ tcl8pkgc.o ${SHLIB_LD_LIBS} + +tcl9pkgd${SHLIB_SUFFIX}: pkgd.o + ${SHLIB_LD} -o $@ pkgd.o ${SHLIB_LD_LIBS} + +tcl9pkge${SHLIB_SUFFIX}: pkge.o + ${SHLIB_LD} -o $@ pkge.o ${SHLIB_LD_LIBS} -pkgb${SHLIB_SUFFIX}: pkgb.o - ${SHLIB_LD} -o pkgb${SHLIB_SUFFIX} pkgb.o ${SHLIB_LD_LIBS} +tcl9pkgua${SHLIB_SUFFIX}: pkgua.o + ${SHLIB_LD} -o $@ pkgua.o ${SHLIB_LD_LIBS} -pkgc${SHLIB_SUFFIX}: pkgc.o - ${SHLIB_LD} -o pkgc${SHLIB_SUFFIX} pkgc.o ${SHLIB_LD_LIBS} +tcl9pkgooa${SHLIB_SUFFIX}: pkgooa.o + ${SHLIB_LD} -o $@ pkgooa.o ${SHLIB_LD_LIBS} -pkgd${SHLIB_SUFFIX}: pkgd.o - ${SHLIB_LD} -o pkgd${SHLIB_SUFFIX} pkgd.o ${SHLIB_LD_LIBS} +tcl9pkgπ${DLTEST_SUFFIX}: pkgπ.o + ${DLTEST_LD} -o $@ pkgπ.o ${SHLIB_LD_LIBS} -pkge${SHLIB_SUFFIX}: pkge.o - ${SHLIB_LD} -o pkge${SHLIB_SUFFIX} pkge.o ${SHLIB_LD_LIBS} +tcl9pkga${DLTEST_SUFFIX}: pkga.o + ${DLTEST_LD} -o $@ pkga.o ${SHLIB_LD_LIBS} -pkgua${SHLIB_SUFFIX}: pkgua.o - ${SHLIB_LD} -o pkgua${SHLIB_SUFFIX} pkgua.o ${SHLIB_LD_LIBS} +tcl9pkgb${DLTEST_SUFFIX}: pkgb.o + ${DLTEST_LD} -o $@ pkgb.o ${SHLIB_LD_LIBS} -pkgooa${SHLIB_SUFFIX}: pkgooa.o - ${SHLIB_LD} -o pkgooa${SHLIB_SUFFIX} pkgooa.o ${SHLIB_LD_LIBS} +tcl9pkgc${DLTEST_SUFFIX}: pkgc.o + ${DLTEST_LD} -o $@ pkgc.o ${SHLIB_LD_LIBS} -pkga${DLTEST_SUFFIX}: pkga.o - ${DLTEST_LD} -o pkga${DLTEST_SUFFIX} pkga.o ${SHLIB_LD_LIBS} +pkga${DLTEST_SUFFIX}: tcl8pkga.o + ${DLTEST_LD} -o $@ tcl8pkga.o ${SHLIB_LD_LIBS} -pkgb${DLTEST_SUFFIX}: pkgb.o - ${DLTEST_LD} -o pkgb${DLTEST_SUFFIX} pkgb.o ${SHLIB_LD_LIBS} +pkgb${DLTEST_SUFFIX}: tcl8pkgb.o + ${DLTEST_LD} -o $@ tcl8pkgb.o ${SHLIB_LD_LIBS} -pkgc${DLTEST_SUFFIX}: pkgc.o - ${DLTEST_LD} -o pkgc${DLTEST_SUFFIX} pkgc.o ${SHLIB_LD_LIBS} +pkgc${DLTEST_SUFFIX}: tcl8pkgc.o + ${DLTEST_LD} -o $@ tcl8pkgc.o ${SHLIB_LD_LIBS} -pkgd${DLTEST_SUFFIX}: pkgd.o - ${DLTEST_LD} -o pkgd${DLTEST_SUFFIX} pkgd.o ${SHLIB_LD_LIBS} +tcl9pkgd${DLTEST_SUFFIX}: pkgd.o + ${DLTEST_LD} -o $@ pkgd.o ${SHLIB_LD_LIBS} -pkge${DLTEST_SUFFIX}: pkge.o - ${DLTEST_LD} -o pkge${DLTEST_SUFFIX} pkge.o ${SHLIB_LD_LIBS} +tcl9pkge${DLTEST_SUFFIX}: pkge.o + ${DLTEST_LD} -o $@ pkge.o ${SHLIB_LD_LIBS} -pkgua${DLTEST_SUFFIX}: pkgua.o - ${DLTEST_LD} -o pkgua${DLTEST_SUFFIX} pkgua.o ${SHLIB_LD_LIBS} +tcl9pkgua${DLTEST_SUFFIX}: pkgua.o + ${DLTEST_LD} -o $@ pkgua.o ${SHLIB_LD_LIBS} -pkgooa${DLTEST_SUFFIX}: pkgooa.o - ${DLTEST_LD} -o pkgooa${DLTEST_SUFFIX} pkgooa.o ${SHLIB_LD_LIBS} +tcl9pkgooa${DLTEST_SUFFIX}: pkgooa.o + ${DLTEST_LD} -o $@ pkgooa.o ${SHLIB_LD_LIBS} clean: - rm -f *.o lib.exp ../dltest.marker + rm -f embtest *.o lib.exp ../dltest.marker @if test "$(SHLIB_SUFFIX)" != ""; then \ echo "rm -f *${SHLIB_SUFFIX}" ; \ rm -f *${SHLIB_SUFFIX} ; \ diff --git a/unix/dltest/embtest.c b/unix/dltest/embtest.c new file mode 100644 index 0000000..1111268 --- /dev/null +++ b/unix/dltest/embtest.c @@ -0,0 +1,36 @@ +#include "tcl.h" +#include <stdio.h> + +MODULE_SCOPE const TclStubs *tclStubsPtr; + +int main(int argc, char **argv) { + const char *version; + int exitcode = 0; + + if (tclStubsPtr != NULL) { + printf("ERROR: stub table is already initialized"); + exitcode = 1; + } + tclStubsPtr = NULL; + version = Tcl_SetPanicProc(Tcl_ConsolePanic); + if (tclStubsPtr == NULL) { + printf("ERROR: Tcl_SetPanicProc does not initialize the stub table\n"); + exitcode = 1; + } + tclStubsPtr = NULL; + version = Tcl_InitSubsystems(); + if (tclStubsPtr == NULL) { + printf("ERROR: Tcl_InitSubsystems does not initialize the stub table\n"); + exitcode = 1; + } + tclStubsPtr = NULL; + version = Tcl_FindExecutable(argv[0]); + if (tclStubsPtr == NULL) { + printf("ERROR: Tcl_FindExecutable does not initialize the stub table\n"); + exitcode = 1; + } + if (!exitcode) { + printf("All OK!\n"); + } + return exitcode; +} diff --git a/unix/dltest/pkga.c b/unix/dltest/pkga.c index 579c323..aacb9cd 100644 --- a/unix/dltest/pkga.c +++ b/unix/dltest/pkga.c @@ -40,7 +40,7 @@ Pkga_EqObjCmd( { int result; const char *str1, *str2; - int len1, len2; + Tcl_Size len1, len2; (void)dummy; if (objc != 3) { diff --git a/unix/dltest/pkgb.c b/unix/dltest/pkgb.c index e9645a4..750d270 100644 --- a/unix/dltest/pkgb.c +++ b/unix/dltest/pkgb.c @@ -31,10 +31,6 @@ *---------------------------------------------------------------------- */ -#ifndef Tcl_GetErrorLine -# define Tcl_GetErrorLine(interp) ((interp)->errorLine) -#endif - static int Pkgb_SubObjCmd( void *dummy, /* Not used. */ @@ -88,7 +84,7 @@ Pkgb_UnsafeObjCmd( (void)objc; (void)objv; - return Tcl_EvalEx(interp, "list unsafe command invoked", -1, TCL_EVAL_GLOBAL); + return Tcl_EvalEx(interp, "list unsafe command invoked", TCL_INDEX_NONE, TCL_EVAL_GLOBAL); } static int diff --git a/unix/dltest/pkgc.c b/unix/dltest/pkgc.c index 8e9c829..582d457 100644 --- a/unix/dltest/pkgc.c +++ b/unix/dltest/pkgc.c @@ -81,7 +81,7 @@ Pkgc_UnsafeObjCmd( (void)objc; (void)objv; - Tcl_SetObjResult(interp, Tcl_NewStringObj("unsafe command invoked", -1)); + Tcl_SetObjResult(interp, Tcl_NewStringObj("unsafe command invoked", TCL_INDEX_NONE)); return TCL_OK; } diff --git a/unix/dltest/pkgd.c b/unix/dltest/pkgd.c index 1b97d4c..52ba968 100644 --- a/unix/dltest/pkgd.c +++ b/unix/dltest/pkgd.c @@ -81,7 +81,7 @@ Pkgd_UnsafeObjCmd( (void)objc; (void)objv; - Tcl_SetObjResult(interp, Tcl_NewStringObj("unsafe command invoked", -1)); + Tcl_SetObjResult(interp, Tcl_NewStringObj("unsafe command invoked", TCL_INDEX_NONE)); return TCL_OK; } diff --git a/unix/dltest/pkge.c b/unix/dltest/pkge.c index 26a4b79..5f0db9b 100644 --- a/unix/dltest/pkge.c +++ b/unix/dltest/pkge.c @@ -41,5 +41,5 @@ Pkge_Init( if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) { return TCL_ERROR; } - return Tcl_EvalEx(interp, script, -1, 0); + return Tcl_EvalEx(interp, script, TCL_INDEX_NONE, 0); } diff --git a/unix/dltest/pkgua.c b/unix/dltest/pkgua.c index 16684a8..b14fca8 100644 --- a/unix/dltest/pkgua.c +++ b/unix/dltest/pkgua.c @@ -127,7 +127,7 @@ PkguaEqObjCmd( { int result; const char *str1, *str2; - int len1, len2; + Tcl_Size len1, len2; (void)dummy; if (objc != 3) { diff --git a/unix/dltest/pkgπ.c b/unix/dltest/pkgπ.c new file mode 100644 index 0000000..58b36db --- /dev/null +++ b/unix/dltest/pkgπ.c @@ -0,0 +1,85 @@ +/* + * pkgπ.c -- + * + * This file contains a simple Tcl package "pkgπ" that is intended for + * testing the Tcl dynamic loading facilities. + * + * Copyright © 1995 Sun Microsystems, Inc. + * + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + +#undef STATIC_BUILD +#include "tcl.h" + +/* + *---------------------------------------------------------------------- + * + * Pkga_EqObjCmd -- + * + * This procedure is invoked to process the "pkga_eq" Tcl command. It + * expects two arguments and returns 1 if they are the same, 0 if they + * are different. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + +static int +Pkg\u03C0_\u03A0ObjCmd( + void *dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ +{ + (void)dummy; + + if (objc != 1) { + Tcl_WrongNumArgs(interp, 1, objv, ""); + return TCL_ERROR; + } + + Tcl_SetObjResult(interp, Tcl_NewDoubleObj(3.14159)); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * Pkgπ_Init -- + * + * This is a package initialization procedure, which is called by Tcl + * when this package is to be added to an interpreter. + * + * Results: + * None. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +DLLEXPORT int +Pkg\u03C0_Init( + Tcl_Interp *interp) /* Interpreter in which the package is to be + * made available. */ +{ + int code; + + if (Tcl_InitStubs(interp, "9.0", 0) == NULL) { + return TCL_ERROR; + } + code = Tcl_PkgProvide(interp, "pkgπ", "1.0"); + if (code != TCL_OK) { + return code; + } + Tcl_CreateObjCommand(interp, "π", Pkg\u03C0_\u03A0ObjCmd, NULL, NULL); + return TCL_OK; +} diff --git a/unix/tcl.m4 b/unix/tcl.m4 index b85bcdf..84436a3 100644 --- a/unix/tcl.m4 +++ b/unix/tcl.m4 @@ -93,11 +93,11 @@ AC_DEFUN([SC_PATH_TCLCONFIG], [ `ls -d /usr/local/lib 2>/dev/null` \ `ls -d /usr/contrib/lib 2>/dev/null` \ `ls -d /usr/pkg/lib 2>/dev/null` \ - `ls -d /usr/lib/tcl8.7 2>/dev/null` \ + `ls -d /usr/lib/tcl9.0 2>/dev/null` \ `ls -d /usr/lib 2>/dev/null` \ `ls -d /usr/lib64 2>/dev/null` \ - `ls -d /usr/local/lib/tcl8.7 2>/dev/null` \ - `ls -d /usr/local/lib/tcl/tcl8.7 2>/dev/null` \ + `ls -d /usr/local/lib/tcl9.0 2>/dev/null` \ + `ls -d /usr/local/lib/tcl/tcl9.0 2>/dev/null` \ ; do if test -f "$i/tclConfig.sh" ; then ac_cv_c_tclconfig="`(cd $i; pwd)`" diff --git a/unix/tcl.spec b/unix/tcl.spec index 3956126..f2d4bd5 100644 --- a/unix/tcl.spec +++ b/unix/tcl.spec @@ -4,7 +4,7 @@ Name: tcl Summary: Tcl scripting language development environment -Version: 8.7a6 +Version: 9.0a4 Release: 2 License: BSD Group: Development/Languages diff --git a/unix/tclAppInit.c b/unix/tclAppInit.c index 05d25de..e3d95bc 100644 --- a/unix/tclAppInit.c +++ b/unix/tclAppInit.c @@ -158,15 +158,16 @@ Tcl_AppInit( * is the name of the application. If this line is deleted then no * user-specific startup file will be run under any conditions. */ - #ifdef DJGPP - Tcl_ObjSetVar2(interp, Tcl_NewStringObj("tcl_rcFileName", TCL_INDEX_NONE), NULL, - Tcl_NewStringObj("~/tclsh.rc", TCL_INDEX_NONE), TCL_GLOBAL_ONLY); +#define INITFILENAME "tclshrc.tcl" #else - Tcl_ObjSetVar2(interp, Tcl_NewStringObj("tcl_rcFileName", TCL_INDEX_NONE), NULL, - Tcl_NewStringObj("~/.tclshrc", TCL_INDEX_NONE), TCL_GLOBAL_ONLY); +#define INITFILENAME ".tclshrc" #endif + (void)Tcl_EvalEx(interp, + "set tcl_rcFileName [file tildeexpand ~/" INITFILENAME "]", + -1, + TCL_EVAL_GLOBAL); return TCL_OK; } diff --git a/unix/tclConfig.h.in b/unix/tclConfig.h.in index 1396b69..0075804 100644 --- a/unix/tclConfig.h.in +++ b/unix/tclConfig.h.in @@ -426,9 +426,6 @@ /* Are bytecode statistics enabled? */ #undef TCL_COMPILE_STATS -/* Are we to override what our default encoding is? */ -#undef TCL_DEFAULT_ENCODING - /* Is Tcl built as a framework? */ #undef TCL_FRAMEWORK diff --git a/unix/tclConfig.sh.in b/unix/tclConfig.sh.in index f2ac768..30d0bda 100644 --- a/unix/tclConfig.sh.in +++ b/unix/tclConfig.sh.in @@ -21,11 +21,6 @@ TCL_CC='@CC@' # -D flags for use with the C compiler. TCL_DEFS='@DEFS@' -# TCL_DBGX used to be used to distinguish debug vs. non-debug builds. -# This was a righteous pain so the core doesn't do that any more. -# DEPRECATED, will be removed in Tcl 9! -TCL_DBGX='' - # Default flags used in an optimized and debuggable build, respectively. TCL_CFLAGS_DEBUG='@CFLAGS_DEBUG@' TCL_CFLAGS_OPTIMIZE='@CFLAGS_OPTIMIZE@' diff --git a/unix/tclEpollNotfy.c b/unix/tclEpollNotfy.c index 649c21b..659e659 100644 --- a/unix/tclEpollNotfy.c +++ b/unix/tclEpollNotfy.c @@ -42,7 +42,7 @@ typedef struct FileHandler { * for this file. */ Tcl_FileProc *proc; /* Function to call, in the style of * Tcl_CreateFileHandler. */ - ClientData clientData; /* Argument to pass to proc. */ + void *clientData; /* Argument to pass to proc. */ struct FileHandler *nextPtr;/* Next in list of all files we care about. */ LIST_ENTRY(FileHandler) readyNode; /* Next/previous in list of FileHandlers asso- @@ -150,7 +150,7 @@ static int PlatformEventsWait(struct epoll_event *events, *---------------------------------------------------------------------- */ -ClientData +void * TclpInitNotifier(void) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -208,7 +208,7 @@ PlatformEventsControl( } if (isNew) { newPedPtr = (struct PlatformEventData *) - ckalloc(sizeof(struct PlatformEventData)); + Tcl_Alloc(sizeof(struct PlatformEventData)); newPedPtr->filePtr = filePtr; newPedPtr->tsdPtr = tsdPtr; filePtr->pedPtr = newPedPtr; @@ -275,7 +275,7 @@ PlatformEventsControl( void TclpFinalizeNotifier( - TCL_UNUSED(ClientData)) + TCL_UNUSED(void *)) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -295,14 +295,14 @@ TclpFinalizeNotifier( tsdPtr->triggerPipe[1] = -1; } #endif /* HAVE_EVENTFD */ - ckfree(tsdPtr->triggerFilePtr->pedPtr); - ckfree(tsdPtr->triggerFilePtr); + Tcl_Free(tsdPtr->triggerFilePtr->pedPtr); + Tcl_Free(tsdPtr->triggerFilePtr); if (tsdPtr->eventsFd > 0) { close(tsdPtr->eventsFd); tsdPtr->eventsFd = 0; } if (tsdPtr->readyEvents) { - ckfree(tsdPtr->readyEvents); + Tcl_Free(tsdPtr->readyEvents); tsdPtr->maxReadyEvents = 0; } pthread_mutex_unlock(&tsdPtr->notifierMutex); @@ -347,7 +347,7 @@ PlatformEventsInit(void) if (errno) { Tcl_Panic("Tcl_InitNotifier: %s", "could not create mutex"); } - filePtr = (FileHandler *) ckalloc(sizeof(FileHandler)); + filePtr = (FileHandler *) Tcl_Alloc(sizeof(FileHandler)); #ifdef HAVE_EVENTFD tsdPtr->triggerEventFd = eventfd(0, EFD_CLOEXEC | EFD_NONBLOCK); if (tsdPtr->triggerEventFd <= 0) { @@ -368,7 +368,7 @@ PlatformEventsInit(void) PlatformEventsControl(filePtr, tsdPtr, EPOLL_CTL_ADD, 1); if (!tsdPtr->readyEvents) { tsdPtr->maxReadyEvents = 512; - tsdPtr->readyEvents = (struct epoll_event *) ckalloc( + tsdPtr->readyEvents = (struct epoll_event *) Tcl_Alloc( tsdPtr->maxReadyEvents * sizeof(tsdPtr->readyEvents[0])); } LIST_INIT(&tsdPtr->firstReadyFileHandlerPtr); @@ -513,14 +513,14 @@ TclpCreateFileHandler( * called. */ Tcl_FileProc *proc, /* Function to call for each selected * event. */ - ClientData clientData) /* Arbitrary data to pass to proc. */ + void *clientData) /* Arbitrary data to pass to proc. */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); FileHandler *filePtr = LookUpFileHandler(tsdPtr, fd, NULL); int isNew = (filePtr == NULL); if (isNew) { - filePtr = (FileHandler *) ckalloc(sizeof(FileHandler)); + filePtr = (FileHandler *) Tcl_Alloc(sizeof(FileHandler)); filePtr->fd = fd; filePtr->readyMask = 0; filePtr->nextPtr = tsdPtr->firstFileHandlerPtr; @@ -577,7 +577,7 @@ TclpDeleteFileHandler( PlatformEventsControl(filePtr, tsdPtr, EPOLL_CTL_DEL, 0); if (filePtr->pedPtr) { - ckfree(filePtr->pedPtr); + Tcl_Free(filePtr->pedPtr); } /* @@ -589,7 +589,7 @@ TclpDeleteFileHandler( } else { prevPtr->nextPtr = filePtr->nextPtr; } - ckfree(filePtr); + Tcl_Free(filePtr); } /* @@ -683,7 +683,7 @@ TclpWaitForEvent( if (filePtr->readyMask == 0) { FileHandlerEvent *fileEvPtr = (FileHandlerEvent *) - ckalloc(sizeof(FileHandlerEvent)); + Tcl_Alloc(sizeof(FileHandlerEvent)); fileEvPtr->header.proc = FileHandlerEventProc; fileEvPtr->fd = filePtr->fd; @@ -759,7 +759,7 @@ TclpWaitForEvent( if (filePtr->readyMask == 0) { FileHandlerEvent *fileEvPtr = (FileHandlerEvent *) - ckalloc(sizeof(FileHandlerEvent)); + Tcl_Alloc(sizeof(FileHandlerEvent)); fileEvPtr->header.proc = FileHandlerEventProc; fileEvPtr->fd = filePtr->fd; @@ -791,7 +791,7 @@ int TclAsyncNotifier( int sigNumber, /* Signal number. */ Tcl_ThreadId threadId, /* Target thread. */ - ClientData clientData, /* Notifier data. */ + void *clientData, /* Notifier data. */ int *flagPtr, /* Flag to mark. */ int value) /* Value of mark. */ { diff --git a/unix/tclKqueueNotfy.c b/unix/tclKqueueNotfy.c index 2f495bd..487af9c 100644 --- a/unix/tclKqueueNotfy.c +++ b/unix/tclKqueueNotfy.c @@ -40,7 +40,7 @@ typedef struct FileHandler { * for this file. */ Tcl_FileProc *proc; /* Function to call, in the style of * Tcl_CreateFileHandler. */ - ClientData clientData; /* Argument to pass to proc. */ + void *clientData; /* Argument to pass to proc. */ struct FileHandler *nextPtr;/* Next in list of all files we care about. */ LIST_ENTRY(FileHandler) readyNode; /* Next/previous in list of FileHandlers asso- @@ -167,7 +167,7 @@ PlatformEventsControl( if (isNew) { newPedPtr = (struct PlatformEventData *) - ckalloc(sizeof(struct PlatformEventData)); + Tcl_Alloc(sizeof(struct PlatformEventData)); newPedPtr->filePtr = filePtr; newPedPtr->tsdPtr = tsdPtr; filePtr->pedPtr = newPedPtr; @@ -274,7 +274,7 @@ PlatformEventsControl( void TclpFinalizeNotifier( - TCL_UNUSED(ClientData)) + TCL_UNUSED(void *)) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -292,7 +292,7 @@ TclpFinalizeNotifier( tsdPtr->eventsFd = 0; } if (tsdPtr->readyEvents) { - ckfree(tsdPtr->readyEvents); + Tcl_Free(tsdPtr->readyEvents); tsdPtr->maxReadyEvents = 0; } pthread_mutex_unlock(&tsdPtr->notifierMutex); @@ -330,7 +330,7 @@ TclpFinalizeNotifier( *---------------------------------------------------------------------- */ -ClientData +void * TclpInitNotifier(void) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -359,13 +359,13 @@ TclpInitNotifier(void) } else if (fcntl(tsdPtr->eventsFd, F_SETFD, FD_CLOEXEC) == -1) { Tcl_Panic("fcntl: %s", strerror(errno)); } - filePtr = (FileHandler *) ckalloc(sizeof(FileHandler)); + filePtr = (FileHandler *) Tcl_Alloc(sizeof(FileHandler)); filePtr->fd = tsdPtr->triggerPipe[0]; filePtr->mask = TCL_READABLE; PlatformEventsControl(filePtr, tsdPtr, EV_ADD, 1); if (!tsdPtr->readyEvents) { tsdPtr->maxReadyEvents = 512; - tsdPtr->readyEvents = (struct kevent *) ckalloc( + tsdPtr->readyEvents = (struct kevent *) Tcl_Alloc( tsdPtr->maxReadyEvents * sizeof(tsdPtr->readyEvents[0])); } LIST_INIT(&tsdPtr->firstReadyFileHandlerPtr); @@ -518,14 +518,14 @@ TclpCreateFileHandler( * called. */ Tcl_FileProc *proc, /* Function to call for each selected * event. */ - ClientData clientData) /* Arbitrary data to pass to proc. */ + void *clientData) /* Arbitrary data to pass to proc. */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); FileHandler *filePtr = LookUpFileHandler(tsdPtr, fd, NULL); int isNew = (filePtr == NULL); if (isNew) { - filePtr = (FileHandler *) ckalloc(sizeof(FileHandler)); + filePtr = (FileHandler *) Tcl_Alloc(sizeof(FileHandler)); filePtr->fd = fd; filePtr->readyMask = 0; filePtr->nextPtr = tsdPtr->firstFileHandlerPtr; @@ -581,7 +581,7 @@ TclpDeleteFileHandler( PlatformEventsControl(filePtr, tsdPtr, EV_DELETE, 0); if (filePtr->pedPtr) { - ckfree(filePtr->pedPtr); + Tcl_Free(filePtr->pedPtr); } /* @@ -593,7 +593,7 @@ TclpDeleteFileHandler( } else { prevPtr->nextPtr = filePtr->nextPtr; } - ckfree(filePtr); + Tcl_Free(filePtr); } /* @@ -695,7 +695,7 @@ TclpWaitForEvent( if (filePtr->readyMask == 0) { FileHandlerEvent *fileEvPtr = (FileHandlerEvent *) - ckalloc(sizeof(FileHandlerEvent)); + Tcl_Alloc(sizeof(FileHandlerEvent)); fileEvPtr->header.proc = FileHandlerEventProc; fileEvPtr->fd = filePtr->fd; @@ -755,7 +755,7 @@ TclpWaitForEvent( if (filePtr->readyMask == 0) { FileHandlerEvent *fileEvPtr = (FileHandlerEvent *) - ckalloc(sizeof(FileHandlerEvent)); + Tcl_Alloc(sizeof(FileHandlerEvent)); fileEvPtr->header.proc = FileHandlerEventProc; fileEvPtr->fd = filePtr->fd; @@ -787,7 +787,7 @@ int TclAsyncNotifier( int sigNumber, /* Signal number. */ Tcl_ThreadId threadId, /* Target thread. */ - ClientData clientData, /* Notifier data. */ + void *clientData, /* Notifier data. */ int *flagPtr, /* Flag to mark. */ int value) /* Value of mark. */ { diff --git a/unix/tclLoadDl.c b/unix/tclLoadDl.c index 5c19ea3..dd6c50e 100644 --- a/unix/tclLoadDl.c +++ b/unix/tclLoadDl.c @@ -106,7 +106,7 @@ TclpDlopen( */ Tcl_DString ds; - const char *fileName = Tcl_GetString(pathPtr); + const char *fileName = TclGetString(pathPtr); native = Tcl_UtfToExternalDString(NULL, fileName, TCL_INDEX_NONE, &ds); /* @@ -127,11 +127,11 @@ TclpDlopen( if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't load file \"%s\": %s", - Tcl_GetString(pathPtr), errorStr)); + TclGetString(pathPtr), errorStr)); } return TCL_ERROR; } - newHandle = (Tcl_LoadHandle)ckalloc(sizeof(*newHandle)); + newHandle = (Tcl_LoadHandle)Tcl_Alloc(sizeof(*newHandle)); newHandle->clientData = handle; newHandle->findSymbolProcPtr = &FindSymbol; newHandle->unloadFileProcPtr = &UnloadFile; @@ -191,7 +191,7 @@ FindSymbol( #ifdef __cplusplus if (proc == NULL) { char buf[32]; - sprintf(buf, "%d", Tcl_DStringLength(&ds)); + sprintf(buf, "%d", (int)Tcl_DStringLength(&ds)); Tcl_DStringInit(&newName); TclDStringAppendLiteral(&newName, "__Z"); Tcl_DStringAppend(&newName, buf, TCL_INDEX_NONE); @@ -256,7 +256,7 @@ UnloadFile( void *handle = loadHandle->clientData; dlclose(handle); - ckfree(loadHandle); + Tcl_Free(loadHandle); } /* diff --git a/unix/tclLoadDyld.c b/unix/tclLoadDyld.c index 854d4bd..cc3512d 100644 --- a/unix/tclLoadDyld.c +++ b/unix/tclLoadDyld.c @@ -106,7 +106,7 @@ static const char * DyldOFIErrorMsg( int err) { - switch(err) { + switch (err) { case NSObjectFileImageSuccess: return NULL; case NSObjectFileImageFailure: @@ -184,7 +184,7 @@ TclpDlopen( */ nativePath = (const char *)Tcl_FSGetNativePath(pathPtr); - nativeFileName = Tcl_UtfToExternalDString(NULL, Tcl_GetString(pathPtr), + nativeFileName = Tcl_UtfToExternalDString(NULL, TclGetString(pathPtr), TCL_INDEX_NONE, &ds); #if TCL_DYLD_USE_DLFCN @@ -258,7 +258,7 @@ TclpDlopen( module = NSLinkModule(dyldObjFileImage, nativePath, nsflags); NSDestroyObjectFileImage(dyldObjFileImage); if (module) { - modulePtr = (Tcl_DyldModuleHandle *)ckalloc(sizeof(Tcl_DyldModuleHandle)); + modulePtr = (Tcl_DyldModuleHandle *)Tcl_Alloc(sizeof(Tcl_DyldModuleHandle)); modulePtr->module = module; modulePtr->nextPtr = NULL; } else { @@ -278,13 +278,13 @@ TclpDlopen( || dyldLibHeader || modulePtr #endif /* TCL_DYLD_USE_NSMODULE */ ) { - dyldLoadHandle = (Tcl_DyldLoadHandle *)ckalloc(sizeof(Tcl_DyldLoadHandle)); + dyldLoadHandle = (Tcl_DyldLoadHandle *)Tcl_Alloc(sizeof(Tcl_DyldLoadHandle)); dyldLoadHandle->dlHandle = dlHandle; #if TCL_DYLD_USE_NSMODULE || defined(TCL_LOAD_FROM_MEMORY) dyldLoadHandle->dyldLibHeader = dyldLibHeader; dyldLoadHandle->modulePtr = modulePtr; #endif /* TCL_DYLD_USE_NSMODULE || TCL_LOAD_FROM_MEMORY */ - newHandle = (Tcl_LoadHandle)ckalloc(sizeof(*newHandle)); + newHandle = (Tcl_LoadHandle)Tcl_Alloc(sizeof(*newHandle)); newHandle->clientData = dyldLoadHandle; newHandle->findSymbolProcPtr = &FindSymbol; newHandle->unloadFileProcPtr = &UnloadFile; @@ -382,7 +382,7 @@ FindSymbol( modulePtr = modulePtr->nextPtr; } if (modulePtr == NULL) { - modulePtr = (Tcl_DyldModuleHandle *)ckalloc(sizeof(Tcl_DyldModuleHandle)); + modulePtr = (Tcl_DyldModuleHandle *)Tcl_Alloc(sizeof(Tcl_DyldModuleHandle)); modulePtr->module = module; modulePtr->nextPtr = dyldLoadHandle->modulePtr; dyldLoadHandle->modulePtr = modulePtr; @@ -457,12 +457,12 @@ UnloadFile( (void) NSUnLinkModule(modulePtr->module, NSUNLINKMODULE_OPTION_RESET_LAZY_REFERENCES); modulePtr = modulePtr->nextPtr; - ckfree(ptr); + Tcl_Free(ptr); } #endif /* TCL_DYLD_USE_NSMODULE */ } - ckfree(dyldLoadHandle); - ckfree(loadHandle); + Tcl_Free(dyldLoadHandle); + Tcl_Free(loadHandle); } /* @@ -583,7 +583,7 @@ TclpLoadMemory( if ((size_t) codeSize >= sizeof(struct fat_header) + fh_nfat_arch * sizeof(struct fat_arch)) { - void *fatarchs = (char*)buffer + sizeof(struct fat_header); + void *fatarchs = (char *)buffer + sizeof(struct fat_header); const NXArchInfo *arch = NXGetLocalArchInfo(); struct fat_arch *fa; @@ -664,14 +664,14 @@ TclpLoadMemory( * Stash the module reference within the load handle we create and return. */ - modulePtr = (Tcl_DyldModuleHandle *)ckalloc(sizeof(Tcl_DyldModuleHandle)); + modulePtr = (Tcl_DyldModuleHandle *)Tcl_Alloc(sizeof(Tcl_DyldModuleHandle)); modulePtr->module = module; modulePtr->nextPtr = NULL; - dyldLoadHandle = (Tcl_DyldLoadHandle *)ckalloc(sizeof(Tcl_DyldLoadHandle)); + dyldLoadHandle = (Tcl_DyldLoadHandle *)Tcl_Alloc(sizeof(Tcl_DyldLoadHandle)); dyldLoadHandle->dlHandle = NULL; dyldLoadHandle->dyldLibHeader = NULL; dyldLoadHandle->modulePtr = modulePtr; - newHandle = (Tcl_LoadHandle)ckalloc(sizeof(*newHandle)); + newHandle = (Tcl_LoadHandle)Tcl_Alloc(sizeof(*newHandle)); newHandle->clientData = dyldLoadHandle; newHandle->findSymbolProcPtr = &FindSymbol; newHandle->unloadFileProcPtr = &UnloadFile; diff --git a/unix/tclLoadNext.c b/unix/tclLoadNext.c index dc827fc..23de2c5 100644 --- a/unix/tclLoadNext.c +++ b/unix/tclLoadNext.c @@ -61,7 +61,7 @@ TclpDlopen( NXStream *errorStream = NXOpenMemory(0,0,NX_READWRITE); - fileName = Tcl_GetString(pathPtr); + fileName = TclGetString(pathPtr); /* * First try the full path the user gave us. This is particularly @@ -101,7 +101,7 @@ TclpDlopen( } NXCloseMemory(errorStream, NX_FREEBUFFER); - newHandle = (Tcl_LoadHandle) ckalloc(sizeof(*newHandle)); + newHandle = (Tcl_LoadHandle) Tcl_Alloc(sizeof(*newHandle)); newHandle->clientData = INT2PTR(1); newHandle->findSymbolProcPtr = &FindSymbol; newHandle->unloadFileProcPtr = &UnloadFile; @@ -175,7 +175,7 @@ UnloadFile( * TclpDlopen(). The loadHandle is a token * that represents the loaded file. */ { - ckfree(loadHandle); + Tcl_Free(loadHandle); } /* diff --git a/unix/tclLoadOSF.c b/unix/tclLoadOSF.c index 03698fa..852adca 100644 --- a/unix/tclLoadOSF.c +++ b/unix/tclLoadOSF.c @@ -79,7 +79,7 @@ TclpDlopen( Tcl_LoadHandle newHandle; ldr_module_t lm; char *pkg; - char *fileName = Tcl_GetString(pathPtr); + char *fileName = TclGetString(pathPtr); const char *native; /* @@ -128,7 +128,7 @@ TclpDlopen( } else { pkg++; } - newHandle = (Tcl_LoadHandle)ckalloc(sizeof(*newHandle)); + newHandle = (Tcl_LoadHandle)Tcl_Alloc(sizeof(*newHandle)); newHandle->clientData = pkg; newHandle->findSymbolProcPtr = &FindSymbol; newHandle->unloadFileProcPtr = &UnloadFile; @@ -193,7 +193,7 @@ UnloadFile( * TclpDlopen(). The loadHandle is a token * that represents the loaded file. */ { - ckfree(loadHandle); + Tcl_Free(loadHandle); } /* diff --git a/unix/tclLoadShl.c b/unix/tclLoadShl.c index 5cde183..0889c21 100644 --- a/unix/tclLoadShl.c +++ b/unix/tclLoadShl.c @@ -57,7 +57,7 @@ TclpDlopen( shl_t handle; Tcl_LoadHandle newHandle; const char *native; - char *fileName = Tcl_GetString(pathPtr); + char *fileName = TclGetString(pathPtr); /* * The flags below used to be BIND_IMMEDIATE; they were changed at the @@ -97,7 +97,7 @@ TclpDlopen( fileName, Tcl_PosixError(interp))); return TCL_ERROR; } - newHandle = (Tcl_LoadHandle)ckalloc(sizeof(*newHandle)); + newHandle = (Tcl_LoadHandle)Tcl_Alloc(sizeof(*newHandle)); newHandle->clientData = handle; newHandle->findSymbolProcPtr = &FindSymbol; newHandle->unloadFileProcPtr = *unloadProcPtr = &UnloadFile; @@ -182,7 +182,7 @@ UnloadFile( shl_t handle = (shl_t) loadHandle->clientData; shl_unload(handle); - ckfree(loadHandle); + Tcl_Free(loadHandle); } /* diff --git a/unix/tclSelectNotfy.c b/unix/tclSelectNotfy.c index fc77e77..feabfa8 100644 --- a/unix/tclSelectNotfy.c +++ b/unix/tclSelectNotfy.c @@ -32,7 +32,7 @@ typedef struct FileHandler { * for this file. */ Tcl_FileProc *proc; /* Function to call, in the style of * Tcl_CreateFileHandler. */ - ClientData clientData; /* Argument to pass to proc. */ + void *clientData; /* Argument to pass to proc. */ struct FileHandler *nextPtr;/* Next in list of all files we care about. */ } FileHandler; @@ -214,7 +214,7 @@ static sigset_t allSigMask; */ #if TCL_THREADS -static TCL_NORETURN void NotifierThreadProc(ClientData clientData); +static TCL_NORETURN void NotifierThreadProc(void *clientData); #if defined(HAVE_PTHREAD_ATFORK) static int atForkInit = 0; static void AtForkChild(void); @@ -313,7 +313,7 @@ static unsigned int __stdcall NotifierProc(void *hwnd, unsigned int message, *---------------------------------------------------------------------- */ -ClientData +void * TclpInitNotifier(void) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -480,13 +480,13 @@ TclpCreateFileHandler( * called. */ Tcl_FileProc *proc, /* Function to call for each selected * event. */ - ClientData clientData) /* Arbitrary data to pass to proc. */ + void *clientData) /* Arbitrary data to pass to proc. */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); FileHandler *filePtr = LookUpFileHandler(tsdPtr, fd, NULL); if (filePtr == NULL) { - filePtr = (FileHandler *) ckalloc(sizeof(FileHandler)); + filePtr = (FileHandler *) Tcl_Alloc(sizeof(FileHandler)); filePtr->fd = fd; filePtr->readyMask = 0; filePtr->nextPtr = tsdPtr->firstFileHandlerPtr; @@ -595,7 +595,7 @@ TclpDeleteFileHandler( } else { prevPtr->nextPtr = filePtr->nextPtr; } - ckfree(filePtr); + Tcl_Free(filePtr); } #if TCL_THREADS && defined(__CYGWIN__) @@ -885,7 +885,7 @@ TclpWaitForEvent( if (filePtr->readyMask == 0) { FileHandlerEvent *fileEvPtr = - (FileHandlerEvent *) ckalloc(sizeof(FileHandlerEvent)); + (FileHandlerEvent *) Tcl_Alloc(sizeof(FileHandlerEvent)); fileEvPtr->header.proc = FileHandlerEventProc; fileEvPtr->fd = filePtr->fd; @@ -921,7 +921,7 @@ int TclAsyncNotifier( int sigNumber, /* Signal number. */ TCL_UNUSED(Tcl_ThreadId), /* Target thread. */ - TCL_UNUSED(ClientData), /* Notifier data. */ + TCL_UNUSED(void *), /* Notifier data. */ int *flagPtr, /* Flag to mark. */ int value) /* Value of mark. */ { @@ -989,7 +989,7 @@ TclAsyncNotifier( #if TCL_THREADS static TCL_NORETURN void NotifierThreadProc( - TCL_UNUSED(ClientData)) + TCL_UNUSED(void *)) { ThreadSpecificData *tsdPtr; fd_set readableMask; @@ -1179,7 +1179,7 @@ NotifierThreadProc( */ do { - i = read(receivePipe, buf, 1); + i = (int)read(receivePipe, buf, 1); if (i <= 0) { break; } else if ((i == 0) || ((i == 1) && (buf[0] == 'q'))) { diff --git a/unix/tclUnixChan.c b/unix/tclUnixChan.c index 22e9876..c41cdd9 100644 --- a/unix/tclUnixChan.c +++ b/unix/tclUnixChan.c @@ -128,10 +128,6 @@ static int FileInputProc(void *instanceData, char *buf, int toRead, int *errorCode); static int FileOutputProc(void *instanceData, const char *buf, int toWrite, int *errorCode); -#ifndef TCL_NO_DEPRECATED -static int FileSeekProc(void *instanceData, long offset, - int mode, int *errorCode); -#endif static int FileTruncateProc(void *instanceData, long long length); static long long FileWideSeekProc(void *instanceData, @@ -163,14 +159,10 @@ static int TtySetOptionProc(void *instanceData, static const Tcl_ChannelType fileChannelType = { "file", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ - TCL_CLOSE2PROC, /* Close proc. */ + NULL, /* Close proc. */ FileInputProc, /* Input proc. */ FileOutputProc, /* Output proc. */ -#ifndef TCL_NO_DEPRECATED - FileSeekProc, /* Seek proc. */ -#else NULL, -#endif NULL, /* Set option proc. */ NULL, /* Get option proc. */ FileWatchProc, /* Initialize notifier. */ @@ -193,7 +185,7 @@ static const Tcl_ChannelType fileChannelType = { static const Tcl_ChannelType ttyChannelType = { "tty", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ - TCL_CLOSE2PROC, /* Close proc. */ + NULL, /* Close proc. */ FileInputProc, /* Input proc. */ FileOutputProc, /* Output proc. */ NULL, /* Seek proc. */ @@ -283,7 +275,7 @@ FileInputProc( */ do { - bytesRead = read(fsPtr->fd, buf, (size_t) toRead); + bytesRead = read(fsPtr->fd, buf, toRead); } while ((bytesRead < 0) && (errno == EINTR)); if (bytesRead < 0) { @@ -332,7 +324,7 @@ FileOutputProc( return 0; } - written = write(fsPtr->fd, buf, (size_t) toWrite); + written = write(fsPtr->fd, buf, toWrite); if (written >= 0) { return written; } @@ -383,7 +375,7 @@ FileCloseProc( errorCode = errno; } } - ckfree(fsPtr); + Tcl_Free(fsPtr); return errorCode; } @@ -434,67 +426,6 @@ TtyCloseProc( /* *---------------------------------------------------------------------- * - * FileSeekProc -- - * - * This function is called by the generic IO level to move the access - * point in a file based channel. - * - * Results: - * -1 if failed, the new position if successful. An output argument - * contains the POSIX error code if an error occurred, or zero. - * - * Side effects: - * Moves the location at which the channel will be accessed in future - * operations. - * - *---------------------------------------------------------------------- - */ -#ifndef TCL_NO_DEPRECATED -static int -FileSeekProc( - void *instanceData, /* File state. */ - long offset, /* Offset to seek to. */ - int mode, /* Relative to where should we seek? Can be - * one of SEEK_START, SEEK_SET or SEEK_END. */ - int *errorCodePtr) /* To store error code. */ -{ - FileState *fsPtr = (FileState *)instanceData; - long long oldLoc, newLoc; - - /* - * Save our current place in case we need to roll-back the seek. - */ - - oldLoc = TclOSseek(fsPtr->fd, (Tcl_SeekOffset) 0, SEEK_CUR); - if (oldLoc == -1) { - /* - * Bad things are happening. Error out... - */ - - *errorCodePtr = errno; - return -1; - } - - newLoc = TclOSseek(fsPtr->fd, (Tcl_SeekOffset) offset, mode); - - /* - * Check for expressability in our return type, and roll-back otherwise. - */ - - if (newLoc > INT_MAX) { - *errorCodePtr = EOVERFLOW; - TclOSseek(fsPtr->fd, (Tcl_SeekOffset) oldLoc, SEEK_SET); - return -1; - } else { - *errorCodePtr = (newLoc == -1) ? errno : 0; - } - return (int) newLoc; -} -#endif - -/* - *---------------------------------------------------------------------- - * * FileWideSeekProc -- * * This function is called by the generic IO level to move the access @@ -663,9 +594,9 @@ TtySetOptionProc( const char *value) /* New value for option. */ { TtyState *fsPtr = (TtyState *)instanceData; - unsigned int len, vlen; + size_t len, vlen; TtyAttrs tty; - int argc; + size_t argc; const char **argv; struct termios iostate; @@ -748,7 +679,7 @@ TtySetOptionProc( " two elements with each a single 8-bit character", -1)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "XCHAR", NULL); } - ckfree(argv); + Tcl_Free(argv); return TCL_ERROR; } @@ -771,7 +702,7 @@ TtySetOptionProc( } iostate.c_cc[VSTOP] = character; } - ckfree(argv); + Tcl_Free(argv); tcsetattr(fsPtr->fileState.fd, TCSADRAIN, &iostate); return TCL_OK; @@ -800,7 +731,8 @@ TtySetOptionProc( if ((len > 4) && (strncmp(optionName, "-ttycontrol", len) == 0)) { #if defined(TIOCMGET) && defined(TIOCMSET) - int i, control, flag; + int control, flag; + size_t i; if (Tcl_SplitList(interp, value, &argc, &argv) == TCL_ERROR) { return TCL_ERROR; @@ -813,14 +745,14 @@ TtySetOptionProc( Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FCONFIGURE", "VALUE", NULL); } - ckfree(argv); + Tcl_Free(argv); return TCL_ERROR; } ioctl(fsPtr->fileState.fd, TIOCMGET, &control); for (i = 0; i < argc-1; i += 2) { if (Tcl_GetBoolean(interp, argv[i+1], &flag) == TCL_ERROR) { - ckfree(argv); + Tcl_Free(argv); return TCL_ERROR; } if (Tcl_UtfNcasecmp(argv[i], "DTR", strlen(argv[i])) == 0) { @@ -844,7 +776,7 @@ TtySetOptionProc( } #else /* TIOCSBRK & TIOCCBRK */ UNSUPPORTED_OPTION("-ttycontrol BREAK"); - ckfree(argv); + Tcl_Free(argv); return TCL_ERROR; #endif /* TIOCSBRK & TIOCCBRK */ } else { @@ -855,13 +787,13 @@ TtySetOptionProc( Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FCONFIGURE", "VALUE", NULL); } - ckfree(argv); + Tcl_Free(argv); return TCL_ERROR; } } /* -ttycontrol options loop */ ioctl(fsPtr->fileState.fd, TIOCMSET, &control); - ckfree(argv); + Tcl_Free(argv); return TCL_OK; #else /* TIOCMGET&TIOCMSET */ UNSUPPORTED_OPTION("-ttycontrol"); @@ -1002,7 +934,7 @@ TtyGetOptionProc( Tcl_DString *dsPtr) /* Where to store value(s). */ { TtyState *fsPtr = (TtyState *)instanceData; - unsigned int len; + size_t len; char buf[3*TCL_INTEGER_SPACE + 16]; int valid = 0; /* Flag if valid option parsed. */ struct termios iostate; @@ -1096,11 +1028,11 @@ TtyGetOptionProc( tcgetattr(fsPtr->fileState.fd, &iostate); Tcl_DStringInit(&ds); - Tcl_ExternalToUtfDString(NULL, (char *) &iostate.c_cc[VSTART], 1, &ds); + Tcl_ExternalToUtfDStringEx(NULL, (char *) &iostate.c_cc[VSTART], 1, TCL_ENCODING_NOCOMPLAIN, &ds); Tcl_DStringAppendElement(dsPtr, Tcl_DStringValue(&ds)); TclDStringClear(&ds); - Tcl_ExternalToUtfDString(NULL, (char *) &iostate.c_cc[VSTOP], 1, &ds); + Tcl_ExternalToUtfDStringEx(NULL, (char *) &iostate.c_cc[VSTOP], 1, TCL_ENCODING_NOCOMPLAIN, &ds); Tcl_DStringAppendElement(dsPtr, Tcl_DStringValue(&ds)); Tcl_DStringFree(&ds); } @@ -1730,7 +1662,7 @@ TclpOpenFileChannel( sprintf(channelName, "file%d", fd); } - fsPtr = (TtyState *)ckalloc(sizeof(TtyState)); + fsPtr = (TtyState *)Tcl_Alloc(sizeof(TtyState)); fsPtr->fileState.validMask = channelPermissions | TCL_EXCEPTION; fsPtr->fileState.fd = fd; #ifdef SUPPORTS_TTY @@ -1755,7 +1687,7 @@ TclpOpenFileChannel( if (Tcl_SetChannelOption(interp, fsPtr->fileState.channel, "-translation", translation) != TCL_OK) { - Tcl_Close(NULL, fsPtr->fileState.channel); + Tcl_CloseEx(NULL, fsPtr->fileState.channel, 0); return NULL; } } @@ -1789,32 +1721,37 @@ Tcl_MakeFileChannel( char channelName[16 + TCL_INTEGER_SPACE]; int fd = PTR2INT(handle); const Tcl_ChannelType *channelTypePtr; - struct sockaddr sockaddr; - socklen_t sockaddrLen = sizeof(sockaddr); + struct stat buf; if (mode == 0) { return NULL; } - sockaddr.sa_family = AF_UNSPEC; - #ifdef SUPPORTS_TTY if (isatty(fd)) { channelTypePtr = &ttyChannelType; sprintf(channelName, "serial%d", fd); } else #endif /* SUPPORTS_TTY */ - if ((getsockname(fd, (struct sockaddr *) &sockaddr, &sockaddrLen) == 0) - && (sockaddrLen > 0) - && (sockaddr.sa_family == AF_INET - || sockaddr.sa_family == AF_INET6)) { - return (Tcl_Channel)TclpMakeTcpClientChannelMode(INT2PTR(fd), mode); + if (fstat(fd, &buf) == 0 && S_ISSOCK(buf.st_mode)) { + struct sockaddr sockaddr; + socklen_t sockaddrLen = sizeof(sockaddr); + + sockaddr.sa_family = AF_UNSPEC; + if ((getsockname(fd, (struct sockaddr *)&sockaddr, &sockaddrLen) == 0) + && (sockaddrLen > 0) + && (sockaddr.sa_family == AF_INET + || sockaddr.sa_family == AF_INET6)) { + return (Tcl_Channel)TclpMakeTcpClientChannelMode(INT2PTR(fd), mode); + } + goto normalChannelAfterAll; } else { + normalChannelAfterAll: channelTypePtr = &fileChannelType; sprintf(channelName, "file%d", fd); } - fsPtr = (TtyState *)ckalloc(sizeof(TtyState)); + fsPtr = (TtyState *)Tcl_Alloc(sizeof(TtyState)); fsPtr->fileState.fd = fd; fsPtr->fileState.validMask = mode | TCL_EXCEPTION; fsPtr->fileState.channel = Tcl_CreateChannel(channelTypePtr, channelName, diff --git a/unix/tclUnixCompat.c b/unix/tclUnixCompat.c index 7bd840a..8aff976 100644 --- a/unix/tclUnixCompat.c +++ b/unix/tclUnixCompat.c @@ -8,8 +8,6 @@ */ #include "tclInt.h" -#include <pwd.h> -#include <grp.h> #include <errno.h> #include <string.h> @@ -118,10 +116,10 @@ static int CopyString(const char *src, char *buf, int buflen); #endif #ifdef NEED_PW_CLEANER -static void FreePwBuf(ClientData dummy); +static void FreePwBuf(void *dummy); #endif #ifdef NEED_GR_CLEANER -static void FreeGrBuf(ClientData dummy); +static void FreeGrBuf(void *dummy); #endif #endif /* TCL_THREADS */ @@ -201,7 +199,7 @@ TclpGetPwNam( if (tsdPtr->pbuflen < 1) { tsdPtr->pbuflen = 1024; } - tsdPtr->pbuf = (char *)ckalloc(tsdPtr->pbuflen); + tsdPtr->pbuf = (char *)Tcl_Alloc(tsdPtr->pbuflen); Tcl_CreateThreadExitHandler(FreePwBuf, NULL); } while (1) { @@ -214,7 +212,7 @@ TclpGetPwNam( return NULL; } tsdPtr->pbuflen *= 2; - tsdPtr->pbuf = (char *)ckrealloc(tsdPtr->pbuf, tsdPtr->pbuflen); + tsdPtr->pbuf = (char *)Tcl_Realloc(tsdPtr->pbuf, tsdPtr->pbuflen); } return (pwPtr != NULL ? &tsdPtr->pwd : NULL); @@ -281,7 +279,7 @@ TclpGetPwUid( if (tsdPtr->pbuflen < 1) { tsdPtr->pbuflen = 1024; } - tsdPtr->pbuf = (char *)ckalloc(tsdPtr->pbuflen); + tsdPtr->pbuf = (char *)Tcl_Alloc(tsdPtr->pbuflen); Tcl_CreateThreadExitHandler(FreePwBuf, NULL); } while (1) { @@ -294,7 +292,7 @@ TclpGetPwUid( return NULL; } tsdPtr->pbuflen *= 2; - tsdPtr->pbuf = (char *)ckrealloc(tsdPtr->pbuf, tsdPtr->pbuflen); + tsdPtr->pbuf = (char *)Tcl_Realloc(tsdPtr->pbuf, tsdPtr->pbuflen); } return (pwPtr != NULL ? &tsdPtr->pwd : NULL); @@ -336,11 +334,11 @@ TclpGetPwUid( #ifdef NEED_PW_CLEANER static void FreePwBuf( - TCL_UNUSED(ClientData)) + TCL_UNUSED(void *)) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - ckfree(tsdPtr->pbuf); + Tcl_Free(tsdPtr->pbuf); } #endif /* NEED_PW_CLEANER */ @@ -384,7 +382,7 @@ TclpGetGrNam( if (tsdPtr->gbuflen < 1) { tsdPtr->gbuflen = 1024; } - tsdPtr->gbuf = (char *)ckalloc(tsdPtr->gbuflen); + tsdPtr->gbuf = (char *)Tcl_Alloc(tsdPtr->gbuflen); Tcl_CreateThreadExitHandler(FreeGrBuf, NULL); } while (1) { @@ -397,7 +395,7 @@ TclpGetGrNam( return NULL; } tsdPtr->gbuflen *= 2; - tsdPtr->gbuf = (char *)ckrealloc(tsdPtr->gbuf, tsdPtr->gbuflen); + tsdPtr->gbuf = (char *)Tcl_Realloc(tsdPtr->gbuf, tsdPtr->gbuflen); } return (grPtr != NULL ? &tsdPtr->grp : NULL); @@ -464,7 +462,7 @@ TclpGetGrGid( if (tsdPtr->gbuflen < 1) { tsdPtr->gbuflen = 1024; } - tsdPtr->gbuf = (char *)ckalloc(tsdPtr->gbuflen); + tsdPtr->gbuf = (char *)Tcl_Alloc(tsdPtr->gbuflen); Tcl_CreateThreadExitHandler(FreeGrBuf, NULL); } while (1) { @@ -477,7 +475,7 @@ TclpGetGrGid( return NULL; } tsdPtr->gbuflen *= 2; - tsdPtr->gbuf = (char *)ckrealloc(tsdPtr->gbuf, tsdPtr->gbuflen); + tsdPtr->gbuf = (char *)Tcl_Realloc(tsdPtr->gbuf, tsdPtr->gbuflen); } return (grPtr != NULL ? &tsdPtr->grp : NULL); @@ -519,11 +517,11 @@ TclpGetGrGid( #ifdef NEED_GR_CLEANER static void FreeGrBuf( - TCL_UNUSED(ClientData)) + TCL_UNUSED(void *)) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - ckfree(tsdPtr->gbuf); + Tcl_Free(tsdPtr->gbuf); } #endif /* NEED_GR_CLEANER */ diff --git a/unix/tclUnixFCmd.c b/unix/tclUnixFCmd.c index ed6a6e0..c9d7c45 100644 --- a/unix/tclUnixFCmd.c +++ b/unix/tclUnixFCmd.c @@ -41,8 +41,6 @@ */ #include "tclInt.h" -#include <utime.h> -#include <grp.h> #ifndef HAVE_STRUCT_STAT_ST_BLKSIZE #ifndef NO_FSTATFS #include <sys/statfs.h> @@ -260,6 +258,11 @@ MODULE_SCOPE long tclMacOSXDarwinRelease; #else # define haveRealpath 1 #endif +#else /* NO_REALPATH */ +/* + * At least TclpObjNormalizedPath now requires REALPATH +*/ +#error NO_REALPATH is not supported #endif /* NO_REALPATH */ #ifdef HAVE_FTS @@ -544,7 +547,7 @@ TclUnixCopyFile( int dontCopyAtts) /* If flag set, don't copy attributes. */ { int srcFd, dstFd; - unsigned blockSize; /* Optimal I/O blocksize for filesystem */ + size_t blockSize; /* Optimal I/O blocksize for filesystem */ char *buffer; /* Data buffer for copy */ size_t nread; @@ -600,21 +603,21 @@ TclUnixCopyFile( if (blockSize <= 0) { blockSize = DEFAULT_COPY_BLOCK_SIZE; } - buffer = (char *)ckalloc(blockSize); + buffer = (char *)Tcl_Alloc(blockSize); while (1) { - nread = (size_t) read(srcFd, buffer, blockSize); - if ((nread == (size_t) -1) || (nread == 0)) { + nread = read(srcFd, buffer, blockSize); + if ((nread == TCL_IO_FAILURE) || (nread == 0)) { break; } if ((size_t) write(dstFd, buffer, nread) != nread) { - nread = (size_t) -1; + nread = TCL_IO_FAILURE; break; } } - ckfree(buffer); + Tcl_Free(buffer); close(srcFd); - if ((close(dstFd) != 0) || (nread == (size_t) -1)) { + if ((close(dstFd) != 0) || (nread == TCL_IO_FAILURE)) { unlink(dst); /* INTL: Native. */ return TCL_ERROR; } @@ -759,16 +762,16 @@ TclpObjCopyDirectory( Tcl_Obj *transPtr; transPtr = Tcl_FSGetTranslatedPath(NULL,srcPathPtr); - Tcl_UtfToExternalDString(NULL, + Tcl_UtfToExternalDStringEx(NULL, (transPtr != NULL ? TclGetString(transPtr) : NULL), - -1, &srcString); + -1, TCL_ENCODING_NOCOMPLAIN, &srcString); if (transPtr != NULL) { Tcl_DecrRefCount(transPtr); } transPtr = Tcl_FSGetTranslatedPath(NULL,destPathPtr); - Tcl_UtfToExternalDString(NULL, + Tcl_UtfToExternalDStringEx(NULL, (transPtr != NULL ? TclGetString(transPtr) : NULL), - -1, &dstString); + -1, TCL_ENCODING_NOCOMPLAIN, &dstString); if (transPtr != NULL) { Tcl_DecrRefCount(transPtr); } @@ -823,9 +826,9 @@ TclpObjRemoveDirectory( int ret; Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr); - Tcl_UtfToExternalDString(NULL, + Tcl_UtfToExternalDStringEx(NULL, (transPtr != NULL ? TclGetString(transPtr) : NULL), - -1, &pathString); + -1, TCL_ENCODING_NOCOMPLAIN, &pathString); if (transPtr != NULL) { Tcl_DecrRefCount(transPtr); } @@ -883,7 +886,7 @@ DoRemoveDirectory( result = TCL_OK; if ((errno != EEXIST) || (recursive == 0)) { if (errorPtr != NULL) { - Tcl_ExternalToUtfDString(NULL, path, TCL_INDEX_NONE, errorPtr); + Tcl_ExternalToUtfDStringEx(NULL, path, TCL_INDEX_NONE, TCL_ENCODING_NOCOMPLAIN, errorPtr); } result = TCL_ERROR; } @@ -950,8 +953,8 @@ TraverseUnixTree( { Tcl_StatBuf statBuf; const char *source, *errfile; - int result, sourceLen; - int targetLen; + int result; + size_t targetLen, sourceLen; #ifndef HAVE_FTS int numProcessed = 0; Tcl_DirEntry *dirEntPtr; @@ -1132,7 +1135,7 @@ TraverseUnixTree( end: if (errfile != NULL) { if (errorPtr != NULL) { - Tcl_ExternalToUtfDString(NULL, errfile, TCL_INDEX_NONE, errorPtr); + Tcl_ExternalToUtfDStringEx(NULL, errfile, TCL_INDEX_NONE, TCL_ENCODING_NOCOMPLAIN, errorPtr); } result = TCL_ERROR; } @@ -1202,8 +1205,8 @@ TraversalCopy( */ if (errorPtr != NULL) { - Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(dstPtr), - Tcl_DStringLength(dstPtr), errorPtr); + Tcl_ExternalToUtfDStringEx(NULL, Tcl_DStringValue(dstPtr), + Tcl_DStringLength(dstPtr), TCL_ENCODING_NOCOMPLAIN, errorPtr); } return TCL_ERROR; } @@ -1253,8 +1256,8 @@ TraversalDelete( break; } if (errorPtr != NULL) { - Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(srcPtr), - Tcl_DStringLength(srcPtr), errorPtr); + Tcl_ExternalToUtfDStringEx(NULL, Tcl_DStringValue(srcPtr), + Tcl_DStringLength(srcPtr), TCL_ENCODING_NOCOMPLAIN, errorPtr); } return TCL_ERROR; } @@ -1421,7 +1424,7 @@ GetOwnerAttribute( } else { Tcl_DString ds; - (void) Tcl_ExternalToUtfDString(NULL, pwPtr->pw_name, TCL_INDEX_NONE, &ds); + Tcl_ExternalToUtfDStringEx(NULL, pwPtr->pw_name, TCL_INDEX_NONE, TCL_ENCODING_NOCOMPLAIN, &ds); *attributePtrPtr = Tcl_DStringToObj(&ds); } return TCL_OK; @@ -1501,10 +1504,11 @@ SetGroupAttribute( Tcl_DString ds; struct group *groupPtr = NULL; const char *string; + size_t length; - string = TclGetString(attributePtr); + string = Tcl_GetStringFromObj(attributePtr, &length); - native = Tcl_UtfToExternalDString(NULL, string, attributePtr->length, &ds); + native = Tcl_UtfToExternalDString(NULL, string, length, &ds); groupPtr = TclpGetGrNam(native); /* INTL: Native. */ Tcl_DStringFree(&ds); @@ -1567,10 +1571,11 @@ SetOwnerAttribute( Tcl_DString ds; struct passwd *pwPtr = NULL; const char *string; + size_t length; - string = TclGetString(attributePtr); + string = Tcl_GetStringFromObj(attributePtr, &length); - native = Tcl_UtfToExternalDString(NULL, string, attributePtr->length, &ds); + native = Tcl_UtfToExternalDString(NULL, string, length, &ds); pwPtr = TclpGetPwNam(native); /* INTL: Native. */ Tcl_DStringFree(&ds); @@ -1643,7 +1648,7 @@ SetPermissionsAttribute( Tcl_Obj *modeObj; TclNewLiteralStringObj(modeObj, "0o"); - Tcl_AppendToObj(modeObj, modeStringPtr+scanned+1, -1); + Tcl_AppendToObj(modeObj, modeStringPtr+scanned+1, TCL_INDEX_NONE); result = Tcl_GetWideIntFromObj(NULL, modeObj, &mode); Tcl_DecrRefCount(modeObj); } @@ -1942,8 +1947,8 @@ TclpObjNormalizePath( { const char *currentPathEndPosition; char cur; - const char *path = TclGetString(pathPtr); - size_t pathLen = pathPtr->length; + size_t pathLen; + const char *path = Tcl_GetStringFromObj(pathPtr, &pathLen); Tcl_DString ds; const char *nativePath; #ifndef NO_REALPATH @@ -2047,7 +2052,7 @@ TclpObjNormalizePath( nativePath = Tcl_UtfToExternalDString(NULL, path,nextCheckpoint, &ds); if (Realpath(nativePath, normPath) != NULL) { - int newNormLen; + size_t newNormLen; wholeStringOk: newNormLen = strlen(normPath); @@ -2081,7 +2086,7 @@ TclpObjNormalizePath( */ Tcl_DStringFree(&ds); - Tcl_ExternalToUtfDString(NULL, normPath, (int) newNormLen, &ds); + Tcl_ExternalToUtfDStringEx(NULL, normPath, newNormLen, TCL_ENCODING_NOCOMPLAIN, &ds); if (path[nextCheckpoint] != '\0') { /* @@ -2166,14 +2171,15 @@ TclUnixOpenTemporaryFile( Tcl_DString templ, tmp; const char *string; int fd; + size_t length; /* * We should also check against making more then TMP_MAX of these. */ if (dirObj) { - string = TclGetString(dirObj); - Tcl_UtfToExternalDString(NULL, string, dirObj->length, &templ); + string = Tcl_GetStringFromObj(dirObj, &length); + Tcl_UtfToExternalDStringEx(NULL, string, length, TCL_ENCODING_NOCOMPLAIN, &templ); } else { Tcl_DStringInit(&templ); Tcl_DStringAppend(&templ, DefaultTempDir(), TCL_INDEX_NONE); /* INTL: native */ @@ -2182,8 +2188,8 @@ TclUnixOpenTemporaryFile( TclDStringAppendLiteral(&templ, "/"); if (basenameObj) { - string = TclGetString(basenameObj); - Tcl_UtfToExternalDString(NULL, string, basenameObj->length, &tmp); + string = Tcl_GetStringFromObj(basenameObj, &length); + Tcl_UtfToExternalDStringEx(NULL, string, length, TCL_ENCODING_NOCOMPLAIN, &tmp); TclDStringAppendDString(&templ, &tmp); Tcl_DStringFree(&tmp); } else { @@ -2194,8 +2200,8 @@ TclUnixOpenTemporaryFile( #ifdef HAVE_MKSTEMPS if (extensionObj) { - string = TclGetString(extensionObj); - Tcl_UtfToExternalDString(NULL, string, extensionObj->length, &tmp); + string = Tcl_GetStringFromObj(extensionObj, &length); + Tcl_UtfToExternalDStringEx(NULL, string, length, TCL_ENCODING_NOCOMPLAIN, &tmp); TclDStringAppendDString(&templ, &tmp); fd = mkstemps(Tcl_DStringValue(&templ), Tcl_DStringLength(&tmp)); Tcl_DStringFree(&tmp); @@ -2211,8 +2217,8 @@ TclUnixOpenTemporaryFile( } if (resultingNameObj) { - Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(&templ), - Tcl_DStringLength(&templ), &tmp); + Tcl_ExternalToUtfDStringEx(NULL, Tcl_DStringValue(&templ), + Tcl_DStringLength(&templ), TCL_ENCODING_NOCOMPLAIN, &tmp); Tcl_SetStringObj(resultingNameObj, Tcl_DStringValue(&tmp), Tcl_DStringLength(&tmp)); Tcl_DStringFree(&tmp); @@ -2298,7 +2304,7 @@ TclpCreateTemporaryDirectory( if (dirObj) { string = TclGetString(dirObj); - Tcl_UtfToExternalDString(NULL, string, dirObj->length, &templ); + Tcl_UtfToExternalDStringEx(NULL, string, dirObj->length, TCL_ENCODING_NOCOMPLAIN, &templ); } else { Tcl_DStringInit(&templ); Tcl_DStringAppend(&templ, DefaultTempDir(), TCL_INDEX_NONE); /* INTL: native */ @@ -2311,7 +2317,7 @@ TclpCreateTemporaryDirectory( if (basenameObj) { string = TclGetString(basenameObj); if (basenameObj->length) { - Tcl_UtfToExternalDString(NULL, string, basenameObj->length, &tmp); + Tcl_UtfToExternalDStringEx(NULL, string, basenameObj->length, TCL_ENCODING_NOCOMPLAIN, &tmp); TclDStringAppendDString(&templ, &tmp); Tcl_DStringFree(&tmp); } else { @@ -2336,8 +2342,8 @@ TclpCreateTemporaryDirectory( * The template has been updated. Tell the caller what it was. */ - Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(&templ), - Tcl_DStringLength(&templ), &tmp); + Tcl_ExternalToUtfDStringEx(NULL, Tcl_DStringValue(&templ), + Tcl_DStringLength(&templ), TCL_ENCODING_NOCOMPLAIN, &tmp); Tcl_DStringFree(&templ); return Tcl_DStringToObj(&tmp); } @@ -2359,12 +2365,12 @@ static WCHAR * winPathFromObj( Tcl_Obj *fileName) { - int size; + size_t size; const char *native = (const char *)Tcl_FSGetNativePath(fileName); WCHAR *winPath; size = cygwin_conv_path(1, native, NULL, 0); - winPath = (WCHAR *)ckalloc(size); + winPath = (WCHAR *)Tcl_Alloc(size); cygwin_conv_path(1, native, winPath, size); return winPath; @@ -2404,7 +2410,7 @@ GetUnixFileAttributes( WCHAR *winPath = winPathFromObj(fileName); fileAttributes = GetFileAttributesW(winPath); - ckfree(winPath); + Tcl_Free(winPath); if (fileAttributes == -1) { StatError(interp, fileName); @@ -2451,7 +2457,7 @@ SetUnixFileAttributes( fileAttributes = old = GetFileAttributesW(winPath); if (fileAttributes == -1) { - ckfree(winPath); + Tcl_Free(winPath); StatError(interp, fileName); return TCL_ERROR; } @@ -2464,12 +2470,12 @@ SetUnixFileAttributes( if ((fileAttributes != old) && !SetFileAttributesW(winPath, fileAttributes)) { - ckfree(winPath); + Tcl_Free(winPath); StatError(interp, fileName); return TCL_ERROR; } - ckfree(winPath); + Tcl_Free(winPath); return TCL_OK; } #elif defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE) diff --git a/unix/tclUnixFile.c b/unix/tclUnixFile.c index c1fb7da..673aa72 100644 --- a/unix/tclUnixFile.c +++ b/unix/tclUnixFile.c @@ -153,7 +153,7 @@ TclpFindExecutable( #endif { encoding = Tcl_GetEncoding(NULL, NULL); - Tcl_ExternalToUtfDString(encoding, name, TCL_INDEX_NONE, &utfName); + Tcl_ExternalToUtfDStringEx(encoding, name, TCL_INDEX_NONE, TCL_ENCODING_NOCOMPLAIN, &utfName); TclSetObjNameOfExecutable( Tcl_NewStringObj(Tcl_DStringValue(&utfName), TCL_INDEX_NONE), encoding); Tcl_DStringFree(&utfName); @@ -179,8 +179,8 @@ TclpFindExecutable( Tcl_DStringAppend(&nameString, name, TCL_INDEX_NONE); Tcl_DStringFree(&buffer); - Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&cwd), - Tcl_DStringLength(&cwd), &buffer); + Tcl_UtfToExternalDStringEx(NULL, Tcl_DStringValue(&cwd), + Tcl_DStringLength(&cwd), TCL_ENCODING_NOCOMPLAIN, &buffer); if (Tcl_DStringValue(&cwd)[Tcl_DStringLength(&cwd) -1] != '/') { TclDStringAppendLiteral(&buffer, "/"); } @@ -189,8 +189,8 @@ TclpFindExecutable( Tcl_DStringFree(&nameString); encoding = Tcl_GetEncoding(NULL, NULL); - Tcl_ExternalToUtfDString(encoding, Tcl_DStringValue(&buffer), TCL_INDEX_NONE, - &utfName); + Tcl_ExternalToUtfDStringEx(encoding, Tcl_DStringValue(&buffer), TCL_INDEX_NONE, + TCL_ENCODING_NOCOMPLAIN, &utfName); TclSetObjNameOfExecutable( Tcl_NewStringObj(Tcl_DStringValue(&utfName), TCL_INDEX_NONE), encoding); Tcl_DStringFree(&utfName); @@ -604,8 +604,7 @@ TclpGetUserHome( if (pwPtr == NULL) { return NULL; } - Tcl_ExternalToUtfDString(NULL, pwPtr->pw_dir, TCL_INDEX_NONE, bufferPtr); - return Tcl_DStringValue(bufferPtr); + return Tcl_ExternalToUtfDString(NULL, pwPtr->pw_dir, TCL_INDEX_NONE, bufferPtr); } /* @@ -710,9 +709,9 @@ TclpObjLstat( *---------------------------------------------------------------------- */ -ClientData +void * TclpGetNativeCwd( - ClientData clientData) + void *clientData) { char buffer[MAXPATHLEN+1]; @@ -727,7 +726,7 @@ TclpGetNativeCwd( #endif /* USEGETWD */ if ((clientData == NULL) || strcmp(buffer, (const char *) clientData)) { - char *newCd = (char*)ckalloc(strlen(buffer) + 1); + char *newCd = (char *)Tcl_Alloc(strlen(buffer) + 1); strcpy(newCd, buffer); return newCd; @@ -814,7 +813,7 @@ TclpReadlink( { #ifndef DJGPP char link[MAXPATHLEN]; - int length; + ssize_t length; const char *native; Tcl_DString ds; @@ -826,7 +825,7 @@ TclpReadlink( return NULL; } - Tcl_ExternalToUtfDString(NULL, link, length, linkPtr); + Tcl_ExternalToUtfDStringEx(NULL, link, (size_t)length, TCL_ENCODING_NOCOMPLAIN, linkPtr); return Tcl_DStringValue(linkPtr); #else return NULL; @@ -947,6 +946,7 @@ TclpObjLink( if (linkAction & TCL_CREATE_SYMBOLIC_LINK) { Tcl_DString ds; Tcl_Obj *transPtr; + size_t length; /* * Now we don't want to link to the absolute, normalized path. @@ -958,8 +958,8 @@ TclpObjLink( if (transPtr == NULL) { return NULL; } - target = TclGetString(transPtr); - target = Tcl_UtfToExternalDString(NULL, target, transPtr->length, &ds); + target = Tcl_GetStringFromObj(transPtr, &length); + target = Tcl_UtfToExternalDString(NULL, target, length, &ds); Tcl_DecrRefCount(transPtr); if (symlink(target, src) != 0) { @@ -979,7 +979,7 @@ TclpObjLink( Tcl_Obj *linkPtr = NULL; char link[MAXPATHLEN]; - int length; + ssize_t length; Tcl_DString ds; Tcl_Obj *transPtr; @@ -994,7 +994,7 @@ TclpObjLink( return NULL; } - Tcl_ExternalToUtfDString(NULL, link, length, &ds); + Tcl_ExternalToUtfDStringEx(NULL, link, (size_t)length, TCL_ENCODING_NOCOMPLAIN, &ds); linkPtr = Tcl_DStringToObj(&ds); Tcl_IncrRefCount(linkPtr); return linkPtr; @@ -1055,11 +1055,11 @@ TclpFilesystemPathType( Tcl_Obj * TclpNativeToNormalized( - ClientData clientData) + void *clientData) { Tcl_DString ds; - Tcl_ExternalToUtfDString(NULL, (const char *) clientData, TCL_INDEX_NONE, &ds); + Tcl_ExternalToUtfDStringEx(NULL, (const char *) clientData, TCL_INDEX_NONE, TCL_ENCODING_NOCOMPLAIN, &ds); return Tcl_DStringToObj(&ds); } @@ -1079,7 +1079,7 @@ TclpNativeToNormalized( *--------------------------------------------------------------------------- */ -ClientData +void * TclNativeCreateNativeRep( Tcl_Obj *pathPtr) { @@ -1112,9 +1112,8 @@ TclNativeCreateNativeRep( Tcl_IncrRefCount(validPathPtr); } - str = TclGetString(validPathPtr); - len = validPathPtr->length; - Tcl_UtfToExternalDString(NULL, str, len, &ds); + str = Tcl_GetStringFromObj(validPathPtr, &len); + Tcl_UtfToExternalDStringEx(NULL, str, len, TCL_ENCODING_NOCOMPLAIN, &ds); len = Tcl_DStringLength(&ds) + sizeof(char); if (strlen(Tcl_DStringValue(&ds)) < len - sizeof(char)) { /* See bug [3118489]: NUL in filenames */ @@ -1123,7 +1122,7 @@ TclNativeCreateNativeRep( return NULL; } Tcl_DecrRefCount(validPathPtr); - nativePathPtr = (char *)ckalloc(len); + nativePathPtr = (char *)Tcl_Alloc(len); memcpy(nativePathPtr, Tcl_DStringValue(&ds), len); Tcl_DStringFree(&ds); @@ -1147,9 +1146,9 @@ TclNativeCreateNativeRep( *--------------------------------------------------------------------------- */ -ClientData +void * TclNativeDupInternalRep( - ClientData clientData) + void *clientData) { char *copy; size_t len; @@ -1164,7 +1163,7 @@ TclNativeDupInternalRep( len = (strlen((const char*) clientData) + 1) * sizeof(char); - copy = (char *)ckalloc(len); + copy = (char *)Tcl_Alloc(len); memcpy(copy, clientData, len); return copy; } diff --git a/unix/tclUnixInit.c b/unix/tclUnixInit.c index 7396258..8f7a737 100644 --- a/unix/tclUnixInit.c +++ b/unix/tclUnixInit.c @@ -92,7 +92,7 @@ typedef struct { */ #ifndef TCL_DEFAULT_ENCODING -#define TCL_DEFAULT_ENCODING "iso8859-1" +#define TCL_DEFAULT_ENCODING "utf-8" #endif /* @@ -455,7 +455,7 @@ TclpInitPlatform(void) void TclpInitLibraryPath( char **valuePtr, - unsigned int *lengthPtr, + size_t *lengthPtr, Tcl_Encoding *encodingPtr) { #define LIBRARY_SIZE 32 @@ -473,12 +473,12 @@ TclpInitLibraryPath( */ str = getenv("TCL_LIBRARY"); /* INTL: Native. */ - Tcl_ExternalToUtfDString(NULL, str, TCL_INDEX_NONE, &buffer); + Tcl_ExternalToUtfDStringEx(NULL, str, TCL_INDEX_NONE, TCL_ENCODING_NOCOMPLAIN, &buffer); str = Tcl_DStringValue(&buffer); if ((str != NULL) && (str[0] != '\0')) { Tcl_DString ds; - int pathc; + size_t pathc; const char **pathv; char installLib[LIBRARY_SIZE]; @@ -512,7 +512,7 @@ TclpInitLibraryPath( str = Tcl_JoinPath(pathc, pathv, &ds); Tcl_ListObjAppendElement(NULL, pathPtr, Tcl_DStringToObj(&ds)); } - ckfree(pathv); + Tcl_Free(pathv); } /* @@ -544,9 +544,8 @@ TclpInitLibraryPath( Tcl_DStringFree(&buffer); *encodingPtr = Tcl_GetEncoding(NULL, NULL); - str = TclGetString(pathPtr); - *lengthPtr = pathPtr->length; - *valuePtr = (char *)ckalloc(*lengthPtr + 1); + str = Tcl_GetStringFromObj(pathPtr, lengthPtr); + *valuePtr = (char *)Tcl_Alloc(*lengthPtr + 1); memcpy(*valuePtr, str, *lengthPtr + 1); Tcl_DecrRefCount(pathPtr); } @@ -864,6 +863,18 @@ TclpSetVariables( Tcl_SetVar2(interp, "tcl_pkgPath", NULL, pkgPath, TCL_GLOBAL_ONLY); } + { + /* Some platforms build configure scripts expect ~ expansion so do that */ + Tcl_Obj *origPaths; + Tcl_Obj *resolvedPaths; + origPaths = Tcl_GetVar2Ex(interp, "tcl_pkgPath", NULL, TCL_GLOBAL_ONLY); + resolvedPaths = TclResolveTildePathList(origPaths); + if (resolvedPaths != origPaths && resolvedPaths != NULL) { + Tcl_SetVar2Ex(interp, "tcl_pkgPath", NULL, + resolvedPaths, TCL_GLOBAL_ONLY); + } + } + #ifdef DJGPP Tcl_SetVar2(interp, "tcl_platform", "platform", "dos", TCL_GLOBAL_ONLY); #else @@ -991,7 +1002,7 @@ TclpSetVariables( * * Results: * The return value is the index in environ of an entry with the name - * "name", or -1 if there is no such entry. The integer at *lengthPtr is + * "name", or TCL_INDEX_NONE if there is no such entry. The integer at *lengthPtr is * filled in with the length of name (if a matching entry is found) or * the length of the environ array (if no matching entry is found). * @@ -1001,16 +1012,16 @@ TclpSetVariables( *---------------------------------------------------------------------- */ -int +size_t TclpFindVariable( const char *name, /* Name of desired environment variable * (native). */ - int *lengthPtr) /* Used to return length of name (for + size_t *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 i, result = TCL_INDEX_NONE; const char *env, *p1, *p2; Tcl_DString envString; diff --git a/unix/tclUnixNotfy.c b/unix/tclUnixNotfy.c index 943e7d7..6ecde5d 100644 --- a/unix/tclUnixNotfy.c +++ b/unix/tclUnixNotfy.c @@ -27,7 +27,7 @@ static int FileHandlerEventProc(Tcl_Event *evPtr, int flags); # define NOTIFIER_SELECT #elif !defined(NOTIFIER_EPOLL) && !defined(NOTIFIER_KQUEUE) # define NOTIFIER_SELECT -static TCL_NORETURN void NotifierThreadProc(ClientData clientData); +static TCL_NORETURN void NotifierThreadProc(void *clientData); # if defined(HAVE_PTHREAD_ATFORK) static void AtForkChild(void); # endif /* HAVE_PTHREAD_ATFORK */ @@ -497,13 +497,13 @@ AtForkChild(void) *---------------------------------------------------------------------- */ -ClientData +void * TclpNotifierData(void) { #if defined(NOTIFIER_EPOLL) || defined(NOTIFIER_KQUEUE) ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - return (ClientData) tsdPtr; + return (void *) tsdPtr; #else return NULL; #endif diff --git a/unix/tclUnixPipe.c b/unix/tclUnixPipe.c index c53360a..0692df5 100644 --- a/unix/tclUnixPipe.c +++ b/unix/tclUnixPipe.c @@ -35,7 +35,7 @@ typedef struct { TclFile inFile; /* Output from pipe. */ TclFile outFile; /* Input to pipe. */ TclFile errorFile; /* Error output from pipe. */ - int numPids; /* How many processes are attached to this + size_t numPids; /* How many processes are attached to this * pipe? */ Tcl_Pid *pidPtr; /* The process IDs themselves. Allocated by * the creator of the pipe. */ @@ -69,7 +69,7 @@ static int SetupStdFile(TclFile file, int type); static const Tcl_ChannelType pipeChannelType = { "pipe", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ - TCL_CLOSE2PROC, /* Close proc. */ + NULL, /* Close proc. */ PipeInputProc, /* Input proc. */ PipeOutputProc, /* Output proc. */ NULL, /* Seek proc. */ @@ -381,7 +381,7 @@ TclpCreateProcess( * occurred when creating the child process. * Error messages from the child process * itself are sent to errorFile. */ - int argc, /* Number of arguments in following array. */ + size_t argc, /* Number of arguments in following array. */ const char **argv, /* Array of argument strings in UTF-8. * argv[0] contains the name of the executable * translated using Tcl_TranslateFileName @@ -410,7 +410,8 @@ TclpCreateProcess( char errSpace[200 + TCL_INTEGER_SPACE]; Tcl_DString *dsArray; char **newArgv; - int pid, i; + int pid; + size_t i; errPipeIn = NULL; errPipeOut = NULL; @@ -524,7 +525,7 @@ TclpCreateProcess( errPipeOut = NULL; fd = GetFd(errPipeIn); - count = read(fd, errSpace, (size_t) (sizeof(errSpace) - 1)); + count = read(fd, errSpace, sizeof(errSpace) - 1); if (count > 0) { char *end; @@ -736,7 +737,7 @@ TclpCreateCommandChannel( TclFile writeFile, /* If non-null, gives the file for writing. */ TclFile errorFile, /* If non-null, gives the file where errors * can be read. */ - int numPids, /* The number of pids in the pid array. */ + size_t numPids, /* The number of pids in the pid array. */ Tcl_Pid *pidPtr) /* An array of process identifiers. Allocated * by the caller, freed when the channel is * closed or the processes are detached (in a @@ -744,7 +745,7 @@ TclpCreateCommandChannel( { char channelName[16 + TCL_INTEGER_SPACE]; int channelId; - PipeState *statePtr = (PipeState *)ckalloc(sizeof(PipeState)); + PipeState *statePtr = (PipeState *)Tcl_Alloc(sizeof(PipeState)); int mode; statePtr->inFile = readFile; @@ -858,7 +859,7 @@ TclGetAndDetachPids( PipeState *pipePtr; const Tcl_ChannelType *chanTypePtr; Tcl_Obj *pidsObj; - int i; + size_t i; /* * Punt if the channel is not a command channel. @@ -878,7 +879,7 @@ TclGetAndDetachPids( } Tcl_SetObjResult(interp, pidsObj); if (pipePtr->numPids > 0) { - ckfree(pipePtr->pidPtr); + Tcl_Free(pipePtr->pidPtr); pipePtr->numPids = 0; } } @@ -1008,9 +1009,9 @@ PipeClose2Proc( } if (pipePtr->numPids != 0) { - ckfree(pipePtr->pidPtr); + Tcl_Free(pipePtr->pidPtr); } - ckfree(pipePtr); + Tcl_Free(pipePtr); if (errorCode == 0) { return result; } @@ -1058,7 +1059,7 @@ PipeInputProc( */ do { - bytesRead = read(GetFd(psPtr->inFile), buf, (size_t) toRead); + bytesRead = read(GetFd(psPtr->inFile), buf, toRead); } while ((bytesRead < 0) && (errno == EINTR)); if (bytesRead < 0) { @@ -1104,7 +1105,7 @@ PipeOutputProc( */ do { - written = write(GetFd(psPtr->outFile), buf, (size_t) toWrite); + written = write(GetFd(psPtr->outFile), buf, toWrite); } while ((written < 0) && (errno == EINTR)); if (written < 0) { @@ -1250,14 +1251,14 @@ Tcl_WaitPid( int Tcl_PidObjCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* Argument strings. */ { Tcl_Channel chan; PipeState *pipePtr; - int i; + size_t i; Tcl_Obj *resultPtr; if (objc > 2) { @@ -1272,7 +1273,7 @@ Tcl_PidObjCmd( * Get the channel and make sure that it refers to a pipe. */ - chan = Tcl_GetChannel(interp, Tcl_GetString(objv[1]), NULL); + chan = Tcl_GetChannel(interp, TclGetString(objv[1]), NULL); if (chan == NULL) { return TCL_ERROR; } @@ -1288,7 +1289,7 @@ Tcl_PidObjCmd( TclNewObj(resultPtr); for (i = 0; i < pipePtr->numPids; i++) { Tcl_ListObjAppendElement(NULL, resultPtr, - Tcl_NewWideIntObj(PTR2INT(TclpGetPid(pipePtr->pidPtr[i])))); + Tcl_NewWideIntObj(TclpGetPid(pipePtr->pidPtr[i]))); } Tcl_SetObjResult(interp, resultPtr); } diff --git a/unix/tclUnixPort.h b/unix/tclUnixPort.h index 791c2a3..54f98c8 100644 --- a/unix/tclUnixPort.h +++ b/unix/tclUnixPort.h @@ -90,11 +90,8 @@ typedef off_t Tcl_SeekOffset; extern "C" { #endif /* Make some symbols available without including <windows.h> */ -# define DWORD unsigned int # define CP_UTF8 65001 # define GET_MODULE_HANDLE_EX_FLAG_FROM_ADDRESS 0x00000004 -# define HANDLE void * -# define HINSTANCE void * # define HMODULE void * # define MAX_PATH 260 # define SOCKET unsigned int @@ -678,9 +675,9 @@ typedef int socklen_t; *--------------------------------------------------------------------------- */ -#define TclpSysAlloc(size, isBin) malloc((size_t)(size)) -#define TclpSysFree(ptr) free((char *)(ptr)) -#define TclpSysRealloc(ptr, size) realloc((char *)(ptr), (size_t)(size)) +#define TclpSysAlloc(size) malloc(size) +#define TclpSysFree(ptr) free(ptr) +#define TclpSysRealloc(ptr, size) realloc(ptr, size) /* *--------------------------------------------------------------------------- diff --git a/unix/tclUnixSock.c b/unix/tclUnixSock.c index 0be10ad..c16b081 100644 --- a/unix/tclUnixSock.c +++ b/unix/tclUnixSock.c @@ -156,11 +156,7 @@ static void WrapNotify(void *clientData, int mask); static const Tcl_ChannelType tcpChannelType = { "tcp", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ -#ifndef TCL_NO_DEPRECATED - TcpCloseProc, /* Close proc. */ -#else - TCL_CLOSE2PROC, /* Close proc. */ -#endif + NULL, /* Close proc. */ TcpInputProc, /* Input proc. */ TcpOutputProc, /* Output proc. */ NULL, /* Seek proc. */ @@ -220,7 +216,7 @@ printaddrinfo( static void InitializeHostName( char **valuePtr, - unsigned int *lengthPtr, + size_t *lengthPtr, Tcl_Encoding *encodingPtr) { const char *native = NULL; @@ -242,12 +238,12 @@ InitializeHostName( char *dot = strchr(u.nodename, '.'); if (dot != NULL) { - char *node = (char *)ckalloc(dot - u.nodename + 1); + char *node = (char *)Tcl_Alloc(dot - u.nodename + 1); memcpy(node, u.nodename, dot - u.nodename); node[dot - u.nodename] = '\0'; hp = TclpGetHostByName(node); - ckfree(node); + Tcl_Free(node); } } if (hp != NULL) { @@ -286,11 +282,11 @@ InitializeHostName( *encodingPtr = Tcl_GetEncoding(NULL, NULL); if (native) { *lengthPtr = strlen(native); - *valuePtr = (char *)ckalloc(*lengthPtr + 1); + *valuePtr = (char *)Tcl_Alloc(*lengthPtr + 1); memcpy(*valuePtr, native, *lengthPtr + 1); } else { *lengthPtr = 0; - *valuePtr = (char *)ckalloc(1); + *valuePtr = (char *)Tcl_Alloc(1); *valuePtr[0] = '\0'; } } @@ -316,7 +312,8 @@ InitializeHostName( const char * Tcl_GetHostName(void) { - return Tcl_GetString(TclGetProcessGlobalValue(&hostName)); + Tcl_Obj *tclObj = TclGetProcessGlobalValue(&hostName); + return TclGetString(tclObj); } /* @@ -626,7 +623,7 @@ TcpCloseProc( while (fds != NULL) { TcpFdList *next = fds->next; - ckfree(fds); + Tcl_Free(fds); fds = next; } if (statePtr->addrlist != NULL) { @@ -635,7 +632,7 @@ TcpCloseProc( if (statePtr->myaddrlist != NULL) { freeaddrinfo(statePtr->myaddrlist); } - ckfree(statePtr); + Tcl_Free(statePtr); return errorCode; } @@ -1531,7 +1528,7 @@ Tcl_OpenTcpClient( * Allocate a new TcpState for this socket. */ - statePtr = (TcpState *)ckalloc(sizeof(TcpState)); + statePtr = (TcpState *)Tcl_Alloc(sizeof(TcpState)); memset(statePtr, 0, sizeof(TcpState)); statePtr->flags = async ? TCP_ASYNC_CONNECT : 0; statePtr->cachedBlocking = TCL_MODE_BLOCKING; @@ -1554,7 +1551,7 @@ Tcl_OpenTcpClient( statePtr, TCL_READABLE | TCL_WRITABLE); if (Tcl_SetChannelOption(interp, statePtr->channel, "-translation", "auto crlf") == TCL_ERROR) { - Tcl_Close(NULL, statePtr->channel); + Tcl_CloseEx(NULL, statePtr->channel, 0); return NULL; } return statePtr->channel; @@ -1610,7 +1607,7 @@ TclpMakeTcpClientChannelMode( TcpState *statePtr; char channelName[SOCK_CHAN_LENGTH]; - statePtr = (TcpState *)ckalloc(sizeof(TcpState)); + statePtr = (TcpState *)Tcl_Alloc(sizeof(TcpState)); memset(statePtr, 0, sizeof(TcpState)); statePtr->fds.fd = PTR2INT(sock); statePtr->flags = 0; @@ -1621,7 +1618,7 @@ TclpMakeTcpClientChannelMode( statePtr, mode); if (Tcl_SetChannelOption(NULL, statePtr->channel, "-translation", "auto crlf") == TCL_ERROR) { - Tcl_Close(NULL, statePtr->channel); + Tcl_CloseEx(NULL, statePtr->channel, 0); return NULL; } return statePtr->channel; @@ -1837,14 +1834,14 @@ Tcl_OpenTcpServerEx( * Allocate a new TcpState for this socket. */ - statePtr = (TcpState *)ckalloc(sizeof(TcpState)); + statePtr = (TcpState *)Tcl_Alloc(sizeof(TcpState)); memset(statePtr, 0, sizeof(TcpState)); statePtr->acceptProc = acceptProc; statePtr->acceptProcData = acceptProcData; sprintf(channelName, SOCK_TEMPLATE, PTR2INT(statePtr)); newfds = &statePtr->fds; } else { - newfds = (TcpFdList *)ckalloc(sizeof(TcpFdList)); + newfds = (TcpFdList *)Tcl_Alloc(sizeof(TcpFdList)); memset(newfds, (int) 0, sizeof(TcpFdList)); fds->next = newfds; } @@ -1928,7 +1925,7 @@ TcpAccept( (void) fcntl(newsock, F_SETFD, FD_CLOEXEC); - newSockState = (TcpState *)ckalloc(sizeof(TcpState)); + newSockState = (TcpState *)Tcl_Alloc(sizeof(TcpState)); memset(newSockState, 0, sizeof(TcpState)); newSockState->flags = 0; newSockState->fds.fd = newsock; diff --git a/unix/tclUnixTest.c b/unix/tclUnixTest.c index 80e8081..ccb9105 100644 --- a/unix/tclUnixTest.c +++ b/unix/tclUnixTest.c @@ -129,7 +129,7 @@ TclplatformtestInit( static int TestfilehandlerCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* Argument strings. */ @@ -310,7 +310,7 @@ TestfilehandlerCmd( static void TestFileHandlerProc( - ClientData clientData, /* Points to a Pipe structure. */ + void *clientData, /* Points to a Pipe structure. */ int mask) /* Indicates which events happened: * TCL_READABLE or TCL_WRITABLE. */ { @@ -343,7 +343,7 @@ TestFileHandlerProc( static int TestfilewaitCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* Argument strings. */ @@ -351,7 +351,7 @@ TestfilewaitCmd( int mask, result, timeout; Tcl_Channel channel; int fd; - ClientData data; + void *data; if (objc != 4) { Tcl_WrongNumArgs(interp, 2, objv, "file readable|writable|both timeout"); @@ -374,7 +374,7 @@ TestfilewaitCmd( } if (Tcl_GetChannelHandle(channel, (mask & TCL_READABLE) ? TCL_READABLE : TCL_WRITABLE, - (ClientData*) &data) != TCL_OK) { + (void **) &data) != TCL_OK) { Tcl_AppendResult(interp, "couldn't get channel file", NULL); return TCL_ERROR; } @@ -411,7 +411,7 @@ TestfilewaitCmd( static int TestfindexecutableCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* Argument strings. */ @@ -453,7 +453,7 @@ TestfindexecutableCmd( static int TestforkCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* Argument strings. */ @@ -499,7 +499,7 @@ TestforkCmd( static int TestalarmCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* Argument strings. */ @@ -577,7 +577,7 @@ AlarmHandler( static int TestgotsigCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ TCL_UNUSED(int) /*objc*/, TCL_UNUSED(Tcl_Obj *const *)) @@ -608,7 +608,7 @@ TestgotsigCmd( static int TestchmodCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* Argument strings. */ diff --git a/unix/tclUnixThrd.c b/unix/tclUnixThrd.c index aa5926e..cf3b7a1 100644 --- a/unix/tclUnixThrd.c +++ b/unix/tclUnixThrd.c @@ -160,14 +160,6 @@ PCondTimedWait( } #endif /* HAVE_PTHREAD_MUTEX_RECURSIVE */ -#ifndef TCL_NO_DEPRECATED -typedef struct { - char nabuf[16]; -} ThreadSpecificData; - -static Tcl_ThreadDataKey dataKey; -#endif /* TCL_NO_DEPRECATED */ - /* * globalLock is used to serialize creation of mutexes, condition variables, * and thread local storage. This is the only place that can count on the @@ -221,8 +213,8 @@ int TclpThreadCreate( Tcl_ThreadId *idPtr, /* Return, the ID of the thread */ Tcl_ThreadCreateProc *proc, /* Main() function of the thread */ - ClientData clientData, /* The one argument to Main() */ - int stackSize, /* Size of stack for the new thread */ + void *clientData, /* The one argument to Main() */ + size_t stackSize, /* Size of stack for the new thread */ int flags) /* Flags controlling behaviour of the new * thread. */ { @@ -585,7 +577,7 @@ Tcl_MutexLock( * Double inside global lock check to avoid a race condition. */ - pmutexPtr = (PMutex *)ckalloc(sizeof(PMutex)); + pmutexPtr = (PMutex *)Tcl_Alloc(sizeof(PMutex)); PMutexInit(pmutexPtr); *mutexPtr = (Tcl_Mutex) pmutexPtr; TclRememberMutex(mutexPtr); @@ -649,7 +641,7 @@ TclpFinalizeMutex( if (pmutexPtr != NULL) { PMutexDestroy(pmutexPtr); - ckfree(pmutexPtr); + Tcl_Free(pmutexPtr); *mutexPtr = NULL; } } @@ -695,7 +687,7 @@ Tcl_ConditionWait( */ if (*condPtr == NULL) { - pcondPtr = (pthread_cond_t *)ckalloc(sizeof(pthread_cond_t)); + pcondPtr = (pthread_cond_t *)Tcl_Alloc(sizeof(pthread_cond_t)); pthread_cond_init(pcondPtr, NULL); *condPtr = (Tcl_Condition) pcondPtr; TclRememberCondition(condPtr); @@ -783,59 +775,11 @@ TclpFinalizeCondition( if (pcondPtr != NULL) { pthread_cond_destroy(pcondPtr); - ckfree(pcondPtr); + Tcl_Free(pcondPtr); *condPtr = NULL; } } -#endif /* TCL_THREADS */ - -/* - *---------------------------------------------------------------------- - * - * TclpReaddir, TclpInetNtoa -- - * - * These procedures replace core C versions to be used in a threaded - * environment. - * - * Results: - * See documentation of C functions. - * - * Side effects: - * See documentation of C functions. - * - * Notes: - * TclpReaddir is no longer used by the core (see 1095909), but it - * appears in the internal stubs table (see #589526). - * - *---------------------------------------------------------------------- - */ - -#ifndef TCL_NO_DEPRECATED -Tcl_DirEntry * -TclpReaddir( - TclDIR * dir) -{ - return TclOSreaddir(dir); -} - -#undef TclpInetNtoa -char * -TclpInetNtoa( - struct in_addr addr) -{ -#if TCL_THREADS - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - unsigned char *b = (unsigned char*) &addr.s_addr; - - sprintf(tsdPtr->nabuf, "%u.%u.%u.%u", b[0], b[1], b[2], b[3]); - return tsdPtr->nabuf; -#else - return inet_ntoa(addr); -#endif -} -#endif /* TCL_NO_DEPRECATED */ -#if TCL_THREADS /* * Additions by AOL for specialized thread memory allocator. */ @@ -925,7 +869,7 @@ TclpThreadCreateKey(void) { pthread_key_t *ptkeyPtr; - ptkeyPtr = (pthread_key_t *)TclpSysAlloc(sizeof(pthread_key_t), 0); + ptkeyPtr = (pthread_key_t *)TclpSysAlloc(sizeof(pthread_key_t)); if (NULL == ptkeyPtr) { Tcl_Panic("unable to allocate thread key!"); } diff --git a/unix/tclUnixTime.c b/unix/tclUnixTime.c index 6ca641d..7830dc8 100644 --- a/unix/tclUnixTime.c +++ b/unix/tclUnixTime.c @@ -16,41 +16,13 @@ #endif /* - * TclpGetDate is coded to return a pointer to a 'struct tm'. For thread - * safety, this structure must be in thread-specific data. The 'tmKey' - * variable is the key to this buffer. - */ - -#ifndef TCL_NO_DEPRECATED -static Tcl_ThreadDataKey tmKey; -typedef struct { - struct tm gmtime_buf; - struct tm localtime_buf; -} ThreadSpecificData; - -/* - * If we fall back on the thread-unsafe versions of gmtime and localtime, use - * this mutex to try to protect them. - */ - -TCL_DECLARE_MUTEX(tmMutex) - -static char *lastTZ = NULL; /* Holds the last setting of the TZ - * environment variable, or an empty string if - * the variable was not set. */ - -/* * Static functions declared in this file. */ -static void SetTZIfNecessary(void); -static void CleanupMemory(ClientData clientData); -#endif /* TCL_NO_DEPRECATED */ - static void NativeScaleTime(Tcl_Time *timebuf, - ClientData clientData); + void *clientData); static void NativeGetTime(Tcl_Time *timebuf, - ClientData clientData); + void *clientData); /* * TIP #233 (Virtualized Time): Data for the time hooks, if any. @@ -94,10 +66,10 @@ IsTimeNative(void) *---------------------------------------------------------------------- */ -unsigned long +unsigned long long TclpGetSeconds(void) { - return time(NULL); + return (unsigned long long) time(NULL); } /* @@ -123,7 +95,7 @@ TclpGetMicroseconds(void) Tcl_Time time; GetTime(&time); - return ((long long) time.sec)*1000000 + time.usec; + return ((long long)(unsigned long) time.sec)*1000000 + time.usec; } /* @@ -145,30 +117,32 @@ TclpGetMicroseconds(void) *---------------------------------------------------------------------- */ -unsigned long +unsigned long long TclpGetClicks(void) { - unsigned long now; + unsigned long long now; #ifdef NO_GETTOD if (!IsTimeNative()) { Tcl_Time time; GetTime(&time); - now = ((unsigned long)(time.sec)*1000000UL) + (unsigned long)(time.usec); + now = ((unsigned long long)(time.sec)*1000000ULL) + + (unsigned long long)(time.usec); } else { /* * A semi-NativeGetTime, specialized to clicks. */ struct tms dummy; - now = (unsigned long) times(&dummy); + now = (unsigned long long) times(&dummy); } #else /* !NO_GETTOD */ Tcl_Time time; GetTime(&time); - now = ((unsigned long)(time.sec)*1000000UL) + (unsigned long)(time.usec); + now = ((unsigned long long)(time.sec)*1000000ULL) + + (unsigned long long)(time.usec); #endif /* NO_GETTOD */ return now; @@ -181,7 +155,7 @@ TclpGetClicks(void) * TclpGetWideClicks -- * * This procedure returns a WideInt value that represents the highest - * resolution clock available on the system. There are no garantees on + * resolution clock available on the system. There are no guarantees on * what the resolution will be. In Tcl we will call this value a "click". * The start time is also system dependent. * @@ -290,17 +264,15 @@ TclpWideClickInMicrosec(void) static int initialized = 0; static double scale = 0.0; - if (initialized) { - return scale; - } else { + if (!initialized) { mach_timebase_info_data_t tb; mach_timebase_info(&tb); /* value of tb.numer / tb.denom = 1 click in nanoseconds */ - scale = ((double)tb.numer) / tb.denom / 1000; + scale = ((double) tb.numer) / tb.denom / 1000; initialized = 1; - return scale; } + return scale; #else #error Wide high-resolution clicks not implemented on this platform #endif /* MAC_OSX_TCL */ @@ -338,116 +310,6 @@ Tcl_GetTime( /* *---------------------------------------------------------------------- * - * 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. - * - *---------------------------------------------------------------------- - */ - -#ifndef TCL_NO_DEPRECATED -struct tm * -TclpGetDate( - const time_t *time, - int useGMT) -{ - if (useGMT) { - return TclpGmtime(time); - } else { - return TclpLocaltime(time); - } -} - -/* - *---------------------------------------------------------------------- - * - * 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 */ -{ - /* - * Get a thread-local buffer to hold the returned time. - */ - - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tmKey); - -#ifdef HAVE_GMTIME_R - gmtime_r(timePtr, &tsdPtr->gmtime_buf); -#else - Tcl_MutexLock(&tmMutex); - memcpy(&tsdPtr->gmtime_buf, gmtime(timePtr), sizeof(struct tm)); - Tcl_MutexUnlock(&tmMutex); -#endif - - return &tsdPtr->gmtime_buf; -} - -/* - *---------------------------------------------------------------------- - * - * 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 */ -{ - /* - * Get a thread-local buffer to hold the returned time. - */ - - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tmKey); - - SetTZIfNecessary(); -#ifdef HAVE_LOCALTIME_R - localtime_r(timePtr, &tsdPtr->localtime_buf); -#else - Tcl_MutexLock(&tmMutex); - memcpy(&tsdPtr->localtime_buf, localtime(timePtr), sizeof(struct tm)); - Tcl_MutexUnlock(&tmMutex); -#endif - - return &tsdPtr->localtime_buf; -} -#endif /* TCL_NO_DEPRECATED */ - -/* - *---------------------------------------------------------------------- - * * Tcl_SetTimeProc -- * * TIP #233 (Virtualized Time): Registers two handlers for the @@ -466,7 +328,7 @@ void Tcl_SetTimeProc( Tcl_GetTimeProc *getProc, Tcl_ScaleTimeProc *scaleProc, - ClientData clientData) + void *clientData) { tclGetTimeProcPtr = getProc; tclScaleTimeProcPtr = scaleProc; @@ -493,7 +355,7 @@ void Tcl_QueryTimeProc( Tcl_GetTimeProc **getProc, Tcl_ScaleTimeProc **scaleProc, - ClientData *clientData) + void **clientData) { if (getProc) { *getProc = tclGetTimeProcPtr; @@ -526,7 +388,7 @@ Tcl_QueryTimeProc( static void NativeScaleTime( TCL_UNUSED(Tcl_Time *), - TCL_UNUSED(ClientData)) + TCL_UNUSED(void *)) { /* Native scale is 1:1. Nothing is done */ } @@ -551,7 +413,7 @@ NativeScaleTime( static void NativeGetTime( Tcl_Time *timePtr, - TCL_UNUSED(ClientData)) + TCL_UNUSED(void *)) { struct timeval tv; @@ -559,72 +421,6 @@ NativeGetTime( timePtr->sec = tv.tv_sec; timePtr->usec = tv.tv_usec; } -/* - *---------------------------------------------------------------------- - * - * SetTZIfNecessary -- - * - * Determines whether a call to 'tzset' is needed prior to the next call - * to 'localtime' or examination of the 'timezone' variable. - * - * Results: - * None. - * - * Side effects: - * If 'tzset' has never been called in the current process, or if the - * value of the environment variable TZ has changed since the last call - * to 'tzset', then 'tzset' is called again. - * - *---------------------------------------------------------------------- - */ - -#ifndef TCL_NO_DEPRECATED -static void -SetTZIfNecessary(void) -{ - const char *newTZ = getenv("TZ"); - - Tcl_MutexLock(&tmMutex); - if (newTZ == NULL) { - newTZ = ""; - } - if (lastTZ == NULL || strcmp(lastTZ, newTZ)) { - tzset(); - if (lastTZ == NULL) { - Tcl_CreateExitHandler(CleanupMemory, NULL); - } else { - ckfree(lastTZ); - } - lastTZ = (char *) ckalloc(strlen(newTZ) + 1); - strcpy(lastTZ, newTZ); - } - Tcl_MutexUnlock(&tmMutex); -} - -/* - *---------------------------------------------------------------------- - * - * CleanupMemory -- - * - * Releases the private copy of the TZ environment variable upon exit - * from Tcl. - * - * Results: - * None. - * - * Side effects: - * Frees allocated memory. - * - *---------------------------------------------------------------------- - */ - -static void -CleanupMemory( - TCL_UNUSED(ClientData)) -{ - ckfree(lastTZ); -} -#endif /* TCL_NO_DEPRECATED */ /* * Local Variables: diff --git a/unix/tclXtNotify.c b/unix/tclXtNotify.c index 45bda3e..ab1bfee 100644 --- a/unix/tclXtNotify.c +++ b/unix/tclXtNotify.c @@ -33,7 +33,7 @@ typedef struct FileHandler { XtInputId except; /* Xt exception callback handle. */ Tcl_FileProc *proc; /* Procedure to call, in the style of * Tcl_CreateFileHandler. */ - ClientData clientData; /* Argument to pass to proc. */ + void *clientData; /* Argument to pass to proc. */ struct FileHandler *nextPtr;/* Next in list of all files we care about. */ } FileHandler; @@ -79,10 +79,10 @@ static int initialized = 0; static int FileHandlerEventProc(Tcl_Event *evPtr, int flags); static void FileProc(XtPointer clientData, int *source, XtInputId *id); -static void NotifierExitHandler(ClientData clientData); +static void NotifierExitHandler(void *clientData); static void TimerProc(XtPointer clientData, XtIntervalId *id); static void CreateFileHandler(int fd, int mask, - Tcl_FileProc *proc, ClientData clientData); + Tcl_FileProc *proc, void *clientData); static void DeleteFileHandler(int fd); static void SetTimer(const Tcl_Time * timePtr); static int WaitForEvent(const Tcl_Time * timePtr); @@ -229,7 +229,7 @@ InitNotifier(void) static void NotifierExitHandler( - TCL_UNUSED(ClientData)) + TCL_UNUSED(void *)) { if (notifier.currentTimeout != 0) { XtRemoveTimeOut(notifier.currentTimeout); @@ -265,7 +265,7 @@ static void SetTimer( const Tcl_Time *timePtr) /* Timeout value, may be NULL. */ { - long timeout; + unsigned long timeout; if (!initialized) { InitNotifier(); @@ -278,7 +278,7 @@ SetTimer( if (timePtr) { timeout = timePtr->sec * 1000 + timePtr->usec / 1000; notifier.currentTimeout = XtAppAddTimeOut(notifier.appContext, - (unsigned long) timeout, TimerProc, NULL); + timeout, TimerProc, NULL); } else { notifier.currentTimeout = 0; } @@ -339,7 +339,7 @@ CreateFileHandler( * called. */ Tcl_FileProc *proc, /* Procedure to call for each selected * event. */ - ClientData clientData) /* Arbitrary data to pass to proc. */ + void *clientData) /* Arbitrary data to pass to proc. */ { FileHandler *filePtr; @@ -356,7 +356,7 @@ CreateFileHandler( } } if (filePtr == NULL) { - filePtr = (FileHandler *) ckalloc(sizeof(FileHandler)); + filePtr = (FileHandler *) Tcl_Alloc(sizeof(FileHandler)); filePtr->fd = fd; filePtr->read = 0; filePtr->write = 0; @@ -467,7 +467,7 @@ DeleteFileHandler( if (filePtr->mask & TCL_EXCEPTION) { XtRemoveInput(filePtr->except); } - ckfree(filePtr); + Tcl_Free(filePtr); } /* @@ -522,7 +522,7 @@ FileProc( */ filePtr->readyMask |= mask; - fileEvPtr = (FileHandlerEvent *) ckalloc(sizeof(FileHandlerEvent)); + fileEvPtr = (FileHandlerEvent *) Tcl_Alloc(sizeof(FileHandlerEvent)); fileEvPtr->header.proc = FileHandlerEventProc; fileEvPtr->fd = filePtr->fd; Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL); diff --git a/unix/tclXtTest.c b/unix/tclXtTest.c index 882f497..09b16c5 100644 --- a/unix/tclXtTest.c +++ b/unix/tclXtTest.c @@ -77,7 +77,7 @@ Tclxttest_Init( static int TesteventloopCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ |