diff options
Diffstat (limited to 'unix')
40 files changed, 726 insertions, 772 deletions
diff --git a/unix/Makefile.in b/unix/Makefile.in index 29a28eb..83728bd 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@ @@ -293,10 +293,11 @@ DEPEND_SWITCHES = ${CFLAGS} -I${UNIX_DIR} -I${GENERIC_DIR} \ TCLSH_OBJS = tclAppInit.o TCLTEST_OBJS = tclTestInit.o tclTest.o tclTestObj.o tclTestProcBodyObj.o \ - tclThreadTest.o tclUnixTest.o + tclThreadTest.o tclUnixTest.o tclTestABSList.o XTTEST_OBJS = xtTestInit.o tclTest.o tclTestObj.o tclTestProcBodyObj.o \ - tclThreadTest.o tclUnixTest.o tclXtNotify.o tclXtTest.o + tclThreadTest.o tclUnixTest.o tclXtNotify.o tclXtTest.o \ + tclTestABSList.o GENERIC_OBJS = regcomp.o regexec.o regfree.o regerror.o tclAlloc.o \ tclArithSeries.o tclAssembly.o tclAsync.o tclBasic.o tclBinary.o \ @@ -347,6 +348,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} @@ -465,6 +468,7 @@ GENERIC_SRCS = \ $(GENERIC_DIR)/tclStringObj.c \ $(GENERIC_DIR)/tclStrToD.c \ $(GENERIC_DIR)/tclTest.c \ + $(GENERIC_DIR)/tclTestABSList.c \ $(GENERIC_DIR)/tclTestObj.c \ $(GENERIC_DIR)/tclTestProcBodyObj.c \ $(GENERIC_DIR)/tclThread.c \ @@ -490,6 +494,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 @@ -1052,7 +1058,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"; \ @@ -1072,23 +1078,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"; \ @@ -1563,6 +1569,9 @@ tclZipfs.o: $(GENERIC_DIR)/tclZipfs.c tclTest.o: $(GENERIC_DIR)/tclTest.c $(IOHDR) $(TCLREHDRS) tclUuid.h $(CC) -c $(APP_CC_SWITCHES) $(GENERIC_DIR)/tclTest.c +tclTestABSList.o: $(GENERIC_DIR)/tclTestABSList.c $(MATHHDRS) + $(CC) -c $(APP_CC_SWITCHES) $(GENERIC_DIR)/tclTestABSList.c + tclTestObj.o: $(GENERIC_DIR)/tclTestObj.c $(MATHHDRS) $(CC) -c $(APP_CC_SWITCHES) $(GENERIC_DIR)/tclTestObj.c @@ -1933,6 +1942,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 @@ -2399,7 +2418,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 ce98b3b..87c7948 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='' @@ -1375,7 +1375,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]... @@ -1437,7 +1437,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 @@ -1554,7 +1554,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. @@ -2022,7 +2022,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 @@ -2684,10 +2684,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:-"@:"} @@ -7517,6 +7517,56 @@ printf "%s\n" "#define _ISOC99_SOURCE 1" >>confdefs.h fi + if test ${tcl_cv_flag__file_offset_bits+y} +then : + printf %s "(cached) " >&6 +else $as_nop + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <sys/stat.h> +int +main (void) +{ +switch (0) { case 0: case (sizeof(off_t)==sizeof(long long)): ; } + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO" +then : + tcl_cv_flag__file_offset_bits=no +else $as_nop + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#define _FILE_OFFSET_BITS 64 +#include <sys/stat.h> +int +main (void) +{ +switch (0) { case 0: case (sizeof(off_t)==sizeof(long long)): ; } + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO" +then : + tcl_cv_flag__file_offset_bits=yes +else $as_nop + tcl_cv_flag__file_offset_bits=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + + if test "x${tcl_cv_flag__file_offset_bits}" = "xyes" ; then + +printf "%s\n" "#define _FILE_OFFSET_BITS 64" >>confdefs.h + + tcl_flags="$tcl_flags _FILE_OFFSET_BITS" + fi + + if test ${tcl_cv_flag__largefile64_source+y} then : printf %s "(cached) " >&6 @@ -7617,9 +7667,9 @@ printf "%s\n" "yes" >&6; } { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } # Now check for auxiliary declarations - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for struct dirent64" >&5 -printf %s "checking for struct dirent64... " >&6; } -if test ${tcl_cv_struct_dirent64+y} + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for 64-bit time_t" >&5 +printf %s "checking for 64-bit time_t... " >&6; } +if test ${tcl_cv_time_t_64+y} then : printf %s "(cached) " >&6 else $as_nop @@ -7627,34 +7677,66 @@ else $as_nop cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include <sys/types.h> -#include <dirent.h> int main (void) { -struct dirent64 p; +switch (0) {case 0: case (sizeof(time_t)==sizeof(long long)): ;} ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : - tcl_cv_struct_dirent64=yes + tcl_cv_time_t_64=yes else $as_nop - tcl_cv_struct_dirent64=no + tcl_cv_time_t_64=no fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext fi -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_struct_dirent64" >&5 -printf "%s\n" "$tcl_cv_struct_dirent64" >&6; } - if test "x${tcl_cv_struct_dirent64}" = "xyes" ; then +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_time_t_64" >&5 +printf "%s\n" "$tcl_cv_time_t_64" >&6; } + if test "x${tcl_cv_time_t_64}" = "xno" ; then + # Note that _TIME_BITS=64 requires _FILE_OFFSET_BITS=64 + # which SC_TCL_EARLY_FLAGS has defined if necessary. + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking if _TIME_BITS=64 enables 64-bit time_t" >&5 +printf %s "checking if _TIME_BITS=64 enables 64-bit time_t... " >&6; } +if test ${tcl_cv__time_bits+y} +then : + printf %s "(cached) " >&6 +else $as_nop -printf "%s\n" "#define HAVE_STRUCT_DIRENT64 1" >>confdefs.h + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#define _TIME_BITS 64 +#include <sys/types.h> +int +main (void) +{ +switch (0) {case 0: case (sizeof(time_t)==sizeof(long long)): ;} + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO" +then : + tcl_cv__time_bits=yes +else $as_nop + tcl_cv__time_bits=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext +fi +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv__time_bits" >&5 +printf "%s\n" "$tcl_cv__time_bits" >&6; } + if test "x${tcl_cv__time_bits}" = "xyes" ; then +printf "%s\n" "#define _TIME_BITS 64" >>confdefs.h + + fi fi - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for DIR64" >&5 -printf %s "checking for DIR64... " >&6; } -if test ${tcl_cv_DIR64+y} + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for struct dirent64" >&5 +printf %s "checking for struct dirent64... " >&6; } +if test ${tcl_cv_struct_dirent64+y} then : printf %s "(cached) " >&6 else $as_nop @@ -7666,60 +7748,60 @@ else $as_nop int main (void) { -struct dirent64 *p; DIR64 d = opendir64("."); - p = readdir64(d); rewinddir64(d); closedir64(d); +struct dirent64 p; ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : - tcl_cv_DIR64=yes + tcl_cv_struct_dirent64=yes else $as_nop - tcl_cv_DIR64=no + tcl_cv_struct_dirent64=no fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext fi -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_DIR64" >&5 -printf "%s\n" "$tcl_cv_DIR64" >&6; } - if test "x${tcl_cv_DIR64}" = "xyes" ; then +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_struct_dirent64" >&5 +printf "%s\n" "$tcl_cv_struct_dirent64" >&6; } + if test "x${tcl_cv_struct_dirent64}" = "xyes" ; then -printf "%s\n" "#define HAVE_DIR64 1" >>confdefs.h +printf "%s\n" "#define HAVE_STRUCT_DIRENT64 1" >>confdefs.h fi - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for struct stat64" >&5 -printf %s "checking for struct stat64... " >&6; } -if test ${tcl_cv_struct_stat64+y} + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for DIR64" >&5 +printf %s "checking for DIR64... " >&6; } +if test ${tcl_cv_DIR64+y} then : printf %s "(cached) " >&6 else $as_nop cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ -#include <sys/stat.h> +#include <sys/types.h> +#include <dirent.h> int main (void) { -struct stat64 p; - +struct dirent64 *p; DIR64 d = opendir64("."); + p = readdir64(d); rewinddir64(d); closedir64(d); ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : - tcl_cv_struct_stat64=yes + tcl_cv_DIR64=yes else $as_nop - tcl_cv_struct_stat64=no + tcl_cv_DIR64=no fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext fi -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_struct_stat64" >&5 -printf "%s\n" "$tcl_cv_struct_stat64" >&6; } - if test "x${tcl_cv_struct_stat64}" = "xyes" ; then +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_DIR64" >&5 +printf "%s\n" "$tcl_cv_DIR64" >&6; } + if test "x${tcl_cv_DIR64}" = "xyes" ; then -printf "%s\n" "#define HAVE_STRUCT_STAT64 1" >>confdefs.h +printf "%s\n" "#define HAVE_DIR64 1" >>confdefs.h fi @@ -10103,9 +10185,6 @@ fi fi -printf "%s\n" "#define TCL_DEFAULT_ENCODING \"utf-8\"" >>confdefs.h - - printf "%s\n" "#define TCL_LOAD_FROM_MEMORY 1" >>confdefs.h @@ -10923,15 +11002,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}" @@ -11531,7 +11606,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 @@ -11590,7 +11665,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 99a096e..33e7a32 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:-"@:"} @@ -542,8 +542,6 @@ if test "`uname -s`" = "Darwin" ; then AC_CHECK_HEADERS(libkern/OSAtomic.h) AC_CHECK_FUNCS(OSSpinLockLock) fi - 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, @@ -908,15 +906,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 9a01875..06d0e30 100644 --- a/unix/dltest/Makefile.in +++ b/unix/dltest/Makefile.in @@ -25,17 +25,23 @@ LDFLAGS = @LDFLAGS_DEFAULT@ @LDFLAGS@ CC_SWITCHES = $(CFLAGS) -I${SRC_DIR}/../../generic \ ${SHLIB_CFLAGS} -DUSE_TCL_STUBS ${AC_FLAGS} -all: pkga${SHLIB_SUFFIX} pkgb${SHLIB_SUFFIX} pkgc${SHLIB_SUFFIX} \ - pkgd${SHLIB_SUFFIX} pkge${SHLIB_SUFFIX} pkgt${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} tcl9pkgt${SHLIB_SUFFIX} tcl9pkgua${SHLIB_SUFFIX} \ + tcl9pkgooa${SHLIB_SUFFIX} pkga${SHLIB_SUFFIX} pkgb${SHLIB_SUFFIX} pkgc${SHLIB_SUFFIX} pkgt${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} pkgt${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} tcl9pkgt${DLTEST_SUFFIX} tcl9pkgua${DLTEST_SUFFIX} \ + tcl9pkgooa${DLTEST_SUFFIX} pkga${DLTEST_SUFFIX} pkgb${DLTEST_SUFFIX} pkgc${DLTEST_SUFFIX} pkgt${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 @@ -45,67 +51,112 @@ pkgb.o: $(SRC_DIR)/pkgb.c pkgc.o: $(SRC_DIR)/pkgc.c $(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkgc.c +pkgt.o: $(SRC_DIR)/pkgt.c + $(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkgt.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 + +tcl8pkgt.o: $(SRC_DIR)/pkgt.c + $(CC) -o $@ -c $(CC_SWITCHES) -DTCL_MAJOR_VERSION=8 $(SRC_DIR)/pkgt.c + pkgd.o: $(SRC_DIR)/pkgd.c $(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkgd.c pkge.o: $(SRC_DIR)/pkge.c $(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkge.c -pkgt.o: $(SRC_DIR)/pkgt.c - $(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkgt.c - pkgua.o: $(SRC_DIR)/pkgua.c $(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkgua.c pkgooa.o: $(SRC_DIR)/pkgooa.c $(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkgooa.c -pkga${SHLIB_SUFFIX}: pkga.o +embtest: embtest.o + $(CC) $(CC_SWITCHES) -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} -pkgb${SHLIB_SUFFIX}: pkgb.o +tcl9pkgb${SHLIB_SUFFIX}: pkgb.o ${SHLIB_LD} -o $@ pkgb.o ${SHLIB_LD_LIBS} -pkgc${SHLIB_SUFFIX}: pkgc.o +tcl9pkgc${SHLIB_SUFFIX}: pkgc.o ${SHLIB_LD} -o $@ pkgc.o ${SHLIB_LD_LIBS} -pkgd${SHLIB_SUFFIX}: pkgd.o +tcl9pkgt${SHLIB_SUFFIX}: pkgt.o + ${SHLIB_LD} -o $@ pkgt.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} + +pkgt${SHLIB_SUFFIX}: tcl8pkgt.o + ${SHLIB_LD} -o $@ tcl8pkgt.o ${SHLIB_LD_LIBS} + +tcl9pkgd${SHLIB_SUFFIX}: pkgd.o ${SHLIB_LD} -o $@ pkgd.o ${SHLIB_LD_LIBS} -pkge${SHLIB_SUFFIX}: pkge.o +tcl9pkge${SHLIB_SUFFIX}: pkge.o ${SHLIB_LD} -o $@ pkge.o ${SHLIB_LD_LIBS} -pkgt${SHLIB_SUFFIX}: pkgt.o - ${SHLIB_LD} -o $@ pkgt.o ${SHLIB_LD_LIBS} - -pkgua${SHLIB_SUFFIX}: pkgua.o +tcl9pkgua${SHLIB_SUFFIX}: pkgua.o ${SHLIB_LD} -o $@ pkgua.o ${SHLIB_LD_LIBS} -pkgooa${SHLIB_SUFFIX}: pkgooa.o +tcl9pkgooa${SHLIB_SUFFIX}: pkgooa.o ${SHLIB_LD} -o $@ pkgooa.o ${SHLIB_LD_LIBS} -pkga${DLTEST_SUFFIX}: pkga.o +tcl9pkgπ${DLTEST_SUFFIX}: pkgπ.o + ${DLTEST_LD} -o $@ pkgπ.o ${SHLIB_LD_LIBS} + +tcl9pkga${DLTEST_SUFFIX}: pkga.o ${DLTEST_LD} -o $@ pkga.o ${SHLIB_LD_LIBS} -pkgb${DLTEST_SUFFIX}: pkgb.o +tcl9pkgb${DLTEST_SUFFIX}: pkgb.o ${DLTEST_LD} -o $@ pkgb.o ${SHLIB_LD_LIBS} -pkgc${DLTEST_SUFFIX}: pkgc.o +tcl9pkgc${DLTEST_SUFFIX}: pkgc.o ${DLTEST_LD} -o $@ pkgc.o ${SHLIB_LD_LIBS} -pkgd${DLTEST_SUFFIX}: pkgd.o +tcl9pkgt${DLTEST_SUFFIX}: pkgt.o + ${DLTEST_LD} -o $@ pkgt.o ${SHLIB_LD_LIBS} + +pkga${DLTEST_SUFFIX}: tcl8pkga.o + ${DLTEST_LD} -o $@ tcl8pkga.o ${SHLIB_LD_LIBS} + +pkgb${DLTEST_SUFFIX}: tcl8pkgb.o + ${DLTEST_LD} -o $@ tcl8pkgb.o ${SHLIB_LD_LIBS} + +pkgc${DLTEST_SUFFIX}: tcl8pkgc.o + ${DLTEST_LD} -o $@ tcl8pkgc.o ${SHLIB_LD_LIBS} + +pkgt${DLTEST_SUFFIX}: tcl8pkgt.o + ${DLTEST_LD} -o $@ tcl8pkgt.o ${SHLIB_LD_LIBS} + +tcl9pkgd${DLTEST_SUFFIX}: pkgd.o ${DLTEST_LD} -o $@ pkgd.o ${SHLIB_LD_LIBS} -pkge${DLTEST_SUFFIX}: pkge.o +tcl9pkge${DLTEST_SUFFIX}: pkge.o ${DLTEST_LD} -o $@ pkge.o ${SHLIB_LD_LIBS} -pkgt${DLTEST_SUFFIX}: pkgt.o - ${DLTEST_LD} -o $@ pkgt.o ${SHLIB_LD_LIBS} - -pkgua${DLTEST_SUFFIX}: pkgua.o +tcl9pkgua${DLTEST_SUFFIX}: pkgua.o ${DLTEST_LD} -o $@ pkgua.o ${SHLIB_LD_LIBS} -pkgooa${DLTEST_SUFFIX}: pkgooa.o +tcl9pkgooa${DLTEST_SUFFIX}: pkgooa.o ${DLTEST_LD} -o $@ pkgooa.o ${SHLIB_LD_LIBS} clean: diff --git a/unix/dltest/embtest.c b/unix/dltest/embtest.c new file mode 100644 index 0000000..ff58cc4 --- /dev/null +++ b/unix/dltest/embtest.c @@ -0,0 +1,40 @@ +#include "tcl.h" +#include <stdio.h> + +MODULE_SCOPE const TclStubs *tclStubsPtr; + +int main(int argc, char **argv) { + const char *version; + int exitcode = 0; + (void)argc; + + 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 (version != NULL) { + printf("Tcl_FindExecutable gives version %s\n", version); + } + 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 d24a23e..be0a492 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 9e9f64f..be4c680 100644 --- a/unix/dltest/pkgb.c +++ b/unix/dltest/pkgb.c @@ -34,10 +34,6 @@ *---------------------------------------------------------------------- */ -#ifndef Tcl_GetErrorLine -# define Tcl_GetErrorLine(interp) ((interp)->errorLine) -#endif - static int Pkgb_SubObjCmd( void *dummy, /* Not used. */ @@ -91,7 +87,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 172d579..e713b23 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/pkgt.c b/unix/dltest/pkgt.c index 522f4db..1f326f5 100644 --- a/unix/dltest/pkgt.c +++ b/unix/dltest/pkgt.c @@ -71,7 +71,7 @@ Pkgt_EqObjCmd2( str1 = Tcl_GetStringFromObj(objv[1], &len1); str2 = Tcl_GetStringFromObj(objv[2], &len2); if (len1 == len2) { - result = (Tcl_UtfNcmp(str1, str2, (size_t)len1) == 0); + result = (Tcl_UtfNcmp(str1, str2, (size_t) len1) == 0); } else { result = 0; } diff --git a/unix/dltest/pkgua.c b/unix/dltest/pkgua.c index 409d7c1..92d3cc9 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) { @@ -138,7 +138,7 @@ PkguaEqObjCmd( str1 = Tcl_GetStringFromObj(objv[1], &len1); str2 = Tcl_GetStringFromObj(objv[2], &len2); if (len1 == len2) { - result = (Tcl_UtfNcmp(str1, str2, (size_t)len1) == 0); + result = (Tcl_UtfNcmp(str1, str2, (size_t) len1) == 0); } else { result = 0; } 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 68048f4..850b922 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)`" @@ -2294,6 +2294,7 @@ AC_DEFUN([SC_TCL_LINK_LIBS], [ # # Might define the following vars: # _ISOC99_SOURCE +# _FILE_OFFSET_BITS # _LARGEFILE64_SOURCE # #-------------------------------------------------------------------- @@ -2316,6 +2317,8 @@ AC_DEFUN([SC_TCL_EARLY_FLAGS],[ tcl_flags="" SC_TCL_EARLY_FLAG(_ISOC99_SOURCE,[#include <stdlib.h>], [char *p = (char *)strtoll; char *q = (char *)strtoull;]) + SC_TCL_EARLY_FLAG(_FILE_OFFSET_BITS,[#include <sys/stat.h>], + [switch (0) { case 0: case (sizeof(off_t)==sizeof(long long)): ; }],64) SC_TCL_EARLY_FLAG(_LARGEFILE64_SOURCE,[#include <sys/stat.h>], [struct stat64 buf; int i = stat64("/", &buf);]) if test "x${tcl_flags}" = "x" ; then @@ -2338,8 +2341,8 @@ AC_DEFUN([SC_TCL_EARLY_FLAGS],[ # Might define the following vars: # TCL_WIDE_INT_IS_LONG # HAVE_STRUCT_DIRENT64, HAVE_DIR64 -# HAVE_STRUCT_STAT64 # HAVE_TYPE_OFF64_T +# _TIME_BITS # #-------------------------------------------------------------------- @@ -2359,6 +2362,23 @@ AC_DEFUN([SC_TCL_64BIT_FLAGS], [ else AC_MSG_RESULT([no]) # Now check for auxiliary declarations + AC_CACHE_CHECK([for 64-bit time_t], tcl_cv_time_t_64,[ + AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include <sys/types.h>]], + [[switch (0) {case 0: case (sizeof(time_t)==sizeof(long long)): ;}]])], + [tcl_cv_time_t_64=yes],[tcl_cv_time_t_64=no])]) + if test "x${tcl_cv_time_t_64}" = "xno" ; then + # Note that _TIME_BITS=64 requires _FILE_OFFSET_BITS=64 + # which SC_TCL_EARLY_FLAGS has defined if necessary. + AC_CACHE_CHECK([if _TIME_BITS=64 enables 64-bit time_t], tcl_cv__time_bits,[ + AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#define _TIME_BITS 64 +#include <sys/types.h>]], + [[switch (0) {case 0: case (sizeof(time_t)==sizeof(long long)): ;}]])], + [tcl_cv__time_bits=yes],[tcl_cv__time_bits=no])]) + if test "x${tcl_cv__time_bits}" = "xyes" ; then + AC_DEFINE(_TIME_BITS, 64, [_TIME_BITS=64 enables 64-bit time_t.]) + fi + fi + AC_CACHE_CHECK([for struct dirent64], tcl_cv_struct_dirent64,[ AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include <sys/types.h> #include <dirent.h>]], [[struct dirent64 p;]])], @@ -2376,14 +2396,6 @@ AC_DEFUN([SC_TCL_64BIT_FLAGS], [ AC_DEFINE(HAVE_DIR64, 1, [Is 'DIR64' in <sys/types.h>?]) fi - AC_CACHE_CHECK([for struct stat64], tcl_cv_struct_stat64,[ - AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include <sys/stat.h>]], [[struct stat64 p; -]])], - [tcl_cv_struct_stat64=yes], [tcl_cv_struct_stat64=no])]) - if test "x${tcl_cv_struct_stat64}" = "xyes" ; then - AC_DEFINE(HAVE_STRUCT_STAT64, 1, [Is 'struct stat64' in <sys/stat.h>?]) - fi - AC_CHECK_FUNCS(open64 lseek64) AC_MSG_CHECKING([for off64_t]) AC_CACHE_VAL(tcl_cv_type_off64_t,[ 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 b203487..cbb937f 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 560d564..8500afb 100644 --- a/unix/tclConfig.h.in +++ b/unix/tclConfig.h.in @@ -238,9 +238,6 @@ /* Define to 1 if the system has the type `struct sockaddr_storage'. */ #undef HAVE_STRUCT_SOCKADDR_STORAGE -/* Is 'struct stat64' in <sys/stat.h>? */ -#undef HAVE_STRUCT_STAT64 - /* Define to 1 if `st_blksize' is a member of `struct stat'. */ #undef HAVE_STRUCT_STAT_ST_BLKSIZE @@ -429,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 @@ -483,6 +477,9 @@ /* Are Darwin SUSv3 extensions available? */ #undef _DARWIN_C_SOURCE +/* Add the _FILE_OFFSET_BITS flag when building */ +#undef _FILE_OFFSET_BITS + /* Add the _ISOC99_SOURCE flag when building */ #undef _ISOC99_SOURCE @@ -501,6 +498,9 @@ /* Do we want the thread-safe OS API? */ #undef _THREAD_SAFE +/* _TIME_BITS=64 enables 64-bit time_t. */ +#undef _TIME_BITS + /* Do we want to use the XOPEN network library? */ #undef _XOPEN_SOURCE 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 afceafd..0913698 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]; - snprintf(buf, sizeof(buf), "%d", Tcl_DStringLength(&ds)); + snprintf(buf, sizeof(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 696d938..0d4acf2 100644 --- a/unix/tclUnixChan.c +++ b/unix/tclUnixChan.c @@ -131,10 +131,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, @@ -166,14 +162,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. */ FileGetOptionProc, /* Get option proc. */ FileWatchProc, /* Initialize notifier. */ @@ -196,7 +188,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. */ @@ -386,7 +378,7 @@ FileCloseProc( errorCode = errno; } } - ckfree(fsPtr); + Tcl_Free(fsPtr); return errorCode; } @@ -437,67 +429,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 @@ -933,7 +864,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; } @@ -956,7 +887,7 @@ TtySetOptionProc( } iostate.c_cc[VSTOP] = character; } - ckfree(argv); + Tcl_Free(argv); tcsetattr(fsPtr->fileState.fd, TCSADRAIN, &iostate); return TCL_OK; @@ -999,14 +930,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) { @@ -1030,7 +961,7 @@ TtySetOptionProc( } #else /* TIOCSBRK & TIOCCBRK */ UNSUPPORTED_OPTION("-ttycontrol BREAK"); - ckfree(argv); + Tcl_Free(argv); return TCL_ERROR; #endif /* TIOCSBRK & TIOCCBRK */ } else { @@ -1041,13 +972,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"); @@ -1282,11 +1213,11 @@ TtyGetOptionProc( tcgetattr(fsPtr->fileState.fd, &iostate); Tcl_DStringInit(&ds); - Tcl_ExternalToUtfDString(NULL, (char *) &iostate.c_cc[VSTART], 1, &ds); + Tcl_ExternalToUtfDStringEx(NULL, NULL, (char *) &iostate.c_cc[VSTART], 1, TCL_ENCODING_PROFILE_TCL8, &ds, NULL); Tcl_DStringAppendElement(dsPtr, Tcl_DStringValue(&ds)); TclDStringClear(&ds); - Tcl_ExternalToUtfDString(NULL, (char *) &iostate.c_cc[VSTOP], 1, &ds); + Tcl_ExternalToUtfDStringEx(NULL, NULL, (char *) &iostate.c_cc[VSTOP], 1, TCL_ENCODING_PROFILE_TCL8, &ds, NULL); Tcl_DStringAppendElement(dsPtr, Tcl_DStringValue(&ds)); Tcl_DStringFree(&ds); } @@ -1916,7 +1847,7 @@ TclpOpenFileChannel( snprintf(channelName, sizeof(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 @@ -1941,7 +1872,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; } } @@ -1975,32 +1906,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; snprintf(channelName, sizeof(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; snprintf(channelName, sizeof(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 3a7778e..30ddb71 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 f8eaeb5..dce71c4 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,13 +258,15 @@ 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 -#if defined(HAVE_STRUCT_STAT64) && !defined(__APPLE__) -/* fts doesn't do stat64 */ -# define noFtsStat 1 -#elif defined(__APPLE__) && defined(__LP64__) && \ +#if defined(__APPLE__) && defined(__LP64__) && \ defined(MAC_OS_X_VERSION_MIN_REQUIRED) && \ MAC_OS_X_VERSION_MIN_REQUIRED < 1050 /* @@ -544,9 +544,9 @@ 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; + ssize_t nread; #ifdef DJGPP #define BINMODE |O_BINARY @@ -600,21 +600,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 == -1) || (nread == 0)) { break; } - if ((size_t) write(dstFd, buffer, nread) != nread) { - nread = (size_t) -1; + if (write(dstFd, buffer, nread) != nread) { + nread = -1; break; } } - ckfree(buffer); + Tcl_Free(buffer); close(srcFd); - if ((close(dstFd) != 0) || (nread == (size_t) -1)) { + if ((close(dstFd) != 0) || (nread == -1)) { unlink(dst); /* INTL: Native. */ return TCL_ERROR; } @@ -759,16 +759,16 @@ TclpObjCopyDirectory( Tcl_Obj *transPtr; transPtr = Tcl_FSGetTranslatedPath(NULL,srcPathPtr); - Tcl_UtfToExternalDString(NULL, + Tcl_UtfToExternalDStringEx(NULL, NULL, (transPtr != NULL ? TclGetString(transPtr) : NULL), - -1, &srcString); + -1, TCL_ENCODING_PROFILE_TCL8, &srcString, NULL); if (transPtr != NULL) { Tcl_DecrRefCount(transPtr); } transPtr = Tcl_FSGetTranslatedPath(NULL,destPathPtr); - Tcl_UtfToExternalDString(NULL, + Tcl_UtfToExternalDStringEx(NULL, NULL, (transPtr != NULL ? TclGetString(transPtr) : NULL), - -1, &dstString); + -1, TCL_ENCODING_PROFILE_TCL8, &dstString, NULL); if (transPtr != NULL) { Tcl_DecrRefCount(transPtr); } @@ -823,9 +823,9 @@ TclpObjRemoveDirectory( int ret; Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr); - Tcl_UtfToExternalDString(NULL, + Tcl_UtfToExternalDStringEx(NULL, NULL, (transPtr != NULL ? TclGetString(transPtr) : NULL), - -1, &pathString); + -1, TCL_ENCODING_PROFILE_TCL8, &pathString, NULL); if (transPtr != NULL) { Tcl_DecrRefCount(transPtr); } @@ -883,7 +883,7 @@ DoRemoveDirectory( result = TCL_OK; if ((errno != EEXIST) || (recursive == 0)) { if (errorPtr != NULL) { - Tcl_ExternalToUtfDString(NULL, path, TCL_INDEX_NONE, errorPtr); + Tcl_ExternalToUtfDStringEx(NULL, NULL, path, TCL_INDEX_NONE, TCL_ENCODING_PROFILE_TCL8, errorPtr, NULL); } result = TCL_ERROR; } @@ -950,8 +950,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 +1132,7 @@ TraverseUnixTree( end: if (errfile != NULL) { if (errorPtr != NULL) { - Tcl_ExternalToUtfDString(NULL, errfile, TCL_INDEX_NONE, errorPtr); + Tcl_ExternalToUtfDStringEx(NULL, NULL, errfile, TCL_INDEX_NONE, TCL_ENCODING_PROFILE_TCL8, errorPtr, NULL); } result = TCL_ERROR; } @@ -1202,8 +1202,8 @@ TraversalCopy( */ if (errorPtr != NULL) { - Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(dstPtr), - Tcl_DStringLength(dstPtr), errorPtr); + Tcl_ExternalToUtfDStringEx(NULL, NULL, Tcl_DStringValue(dstPtr), + Tcl_DStringLength(dstPtr), TCL_ENCODING_PROFILE_TCL8, errorPtr, NULL); } return TCL_ERROR; } @@ -1253,8 +1253,8 @@ TraversalDelete( break; } if (errorPtr != NULL) { - Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(srcPtr), - Tcl_DStringLength(srcPtr), errorPtr); + Tcl_ExternalToUtfDStringEx(NULL, NULL, Tcl_DStringValue(srcPtr), + Tcl_DStringLength(srcPtr), TCL_ENCODING_PROFILE_TCL8, errorPtr, NULL); } return TCL_ERROR; } @@ -1421,7 +1421,7 @@ GetOwnerAttribute( } else { Tcl_DString ds; - (void) Tcl_ExternalToUtfDString(NULL, pwPtr->pw_name, TCL_INDEX_NONE, &ds); + Tcl_ExternalToUtfDStringEx(NULL, NULL, pwPtr->pw_name, TCL_INDEX_NONE, TCL_ENCODING_PROFILE_TCL8, &ds, NULL); *attributePtrPtr = Tcl_DStringToObj(&ds); } return TCL_OK; @@ -1501,10 +1501,11 @@ SetGroupAttribute( Tcl_DString ds; struct group *groupPtr = NULL; const char *string; + Tcl_Size 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 +1568,11 @@ SetOwnerAttribute( Tcl_DString ds; struct passwd *pwPtr = NULL; const char *string; + Tcl_Size 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 +1645,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 +1944,8 @@ TclpObjNormalizePath( { const char *currentPathEndPosition; char cur; - const char *path = TclGetString(pathPtr); - size_t pathLen = pathPtr->length; + Tcl_Size pathLen; + const char *path = Tcl_GetStringFromObj(pathPtr, &pathLen); Tcl_DString ds; const char *nativePath; #ifndef NO_REALPATH @@ -2047,7 +2049,7 @@ TclpObjNormalizePath( nativePath = Tcl_UtfToExternalDString(NULL, path,nextCheckpoint, &ds); if (Realpath(nativePath, normPath) != NULL) { - int newNormLen; + Tcl_Size newNormLen; wholeStringOk: newNormLen = strlen(normPath); @@ -2081,7 +2083,7 @@ TclpObjNormalizePath( */ Tcl_DStringFree(&ds); - Tcl_ExternalToUtfDString(NULL, normPath, (int) newNormLen, &ds); + Tcl_ExternalToUtfDStringEx(NULL, NULL, normPath, newNormLen, TCL_ENCODING_PROFILE_TCL8, &ds, NULL); if (path[nextCheckpoint] != '\0') { /* @@ -2166,14 +2168,15 @@ TclUnixOpenTemporaryFile( Tcl_DString templ, tmp; const char *string; int fd; + Tcl_Size 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, NULL, string, length, TCL_ENCODING_PROFILE_TCL8, &templ, NULL); } else { Tcl_DStringInit(&templ); Tcl_DStringAppend(&templ, DefaultTempDir(), TCL_INDEX_NONE); /* INTL: native */ @@ -2182,8 +2185,8 @@ TclUnixOpenTemporaryFile( TclDStringAppendLiteral(&templ, "/"); if (basenameObj) { - string = TclGetString(basenameObj); - Tcl_UtfToExternalDString(NULL, string, basenameObj->length, &tmp); + string = Tcl_GetStringFromObj(basenameObj, &length); + Tcl_UtfToExternalDStringEx(NULL, NULL, string, length, TCL_ENCODING_PROFILE_TCL8, &tmp, NULL); TclDStringAppendDString(&templ, &tmp); Tcl_DStringFree(&tmp); } else { @@ -2194,8 +2197,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, NULL, string, length, TCL_ENCODING_PROFILE_TCL8, &tmp, NULL); TclDStringAppendDString(&templ, &tmp); fd = mkstemps(Tcl_DStringValue(&templ), Tcl_DStringLength(&tmp)); Tcl_DStringFree(&tmp); @@ -2211,8 +2214,8 @@ TclUnixOpenTemporaryFile( } if (resultingNameObj) { - Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(&templ), - Tcl_DStringLength(&templ), &tmp); + Tcl_ExternalToUtfDStringEx(NULL, NULL, Tcl_DStringValue(&templ), + Tcl_DStringLength(&templ), TCL_ENCODING_PROFILE_TCL8, &tmp, NULL); Tcl_SetStringObj(resultingNameObj, Tcl_DStringValue(&tmp), Tcl_DStringLength(&tmp)); Tcl_DStringFree(&tmp); @@ -2298,7 +2301,7 @@ TclpCreateTemporaryDirectory( if (dirObj) { string = TclGetString(dirObj); - Tcl_UtfToExternalDString(NULL, string, dirObj->length, &templ); + Tcl_UtfToExternalDStringEx(NULL, NULL, string, dirObj->length, TCL_ENCODING_PROFILE_TCL8, &templ, NULL); } else { Tcl_DStringInit(&templ); Tcl_DStringAppend(&templ, DefaultTempDir(), TCL_INDEX_NONE); /* INTL: native */ @@ -2311,7 +2314,7 @@ TclpCreateTemporaryDirectory( if (basenameObj) { string = TclGetString(basenameObj); if (basenameObj->length) { - Tcl_UtfToExternalDString(NULL, string, basenameObj->length, &tmp); + Tcl_UtfToExternalDStringEx(NULL, NULL, string, basenameObj->length, TCL_ENCODING_PROFILE_TCL8, &tmp, NULL); TclDStringAppendDString(&templ, &tmp); Tcl_DStringFree(&tmp); } else { @@ -2336,8 +2339,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, NULL, Tcl_DStringValue(&templ), + Tcl_DStringLength(&templ), TCL_ENCODING_PROFILE_TCL8, &tmp, NULL); Tcl_DStringFree(&templ); return Tcl_DStringToObj(&tmp); } @@ -2359,12 +2362,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 +2407,7 @@ GetUnixFileAttributes( WCHAR *winPath = winPathFromObj(fileName); fileAttributes = GetFileAttributesW(winPath); - ckfree(winPath); + Tcl_Free(winPath); if (fileAttributes == -1) { StatError(interp, fileName); @@ -2451,7 +2454,7 @@ SetUnixFileAttributes( fileAttributes = old = GetFileAttributesW(winPath); if (fileAttributes == -1) { - ckfree(winPath); + Tcl_Free(winPath); StatError(interp, fileName); return TCL_ERROR; } @@ -2464,12 +2467,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 fc3adab..8606960 100644 --- a/unix/tclUnixFile.c +++ b/unix/tclUnixFile.c @@ -155,7 +155,7 @@ TclpFindExecutable( #endif { encoding = Tcl_GetEncoding(NULL, NULL); - Tcl_ExternalToUtfDString(encoding, name, TCL_INDEX_NONE, &utfName); + Tcl_ExternalToUtfDStringEx(NULL, encoding, name, TCL_INDEX_NONE, TCL_ENCODING_PROFILE_TCL8, &utfName, NULL); TclSetObjNameOfExecutable( Tcl_NewStringObj(Tcl_DStringValue(&utfName), TCL_INDEX_NONE), encoding); Tcl_DStringFree(&utfName); @@ -182,8 +182,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, NULL, Tcl_DStringValue(&cwd), + Tcl_DStringLength(&cwd), TCL_ENCODING_PROFILE_TCL8, &buffer, NULL); if (Tcl_DStringValue(&cwd)[Tcl_DStringLength(&cwd) -1] != '/') { TclDStringAppendLiteral(&buffer, "/"); } @@ -192,8 +192,8 @@ TclpFindExecutable( Tcl_DStringFree(&nameString); encoding = Tcl_GetEncoding(NULL, NULL); - Tcl_ExternalToUtfDString(encoding, Tcl_DStringValue(&buffer), TCL_INDEX_NONE, - &utfName); + Tcl_ExternalToUtfDStringEx(NULL, encoding, Tcl_DStringValue(&buffer), TCL_INDEX_NONE, + TCL_ENCODING_PROFILE_TCL8, &utfName, NULL); TclSetObjNameOfExecutable( Tcl_NewStringObj(Tcl_DStringValue(&utfName), TCL_INDEX_NONE), encoding); Tcl_DStringFree(&utfName); @@ -712,9 +712,9 @@ TclpObjLstat( *---------------------------------------------------------------------- */ -ClientData +void * TclpGetNativeCwd( - ClientData clientData) + void *clientData) { char buffer[MAXPATHLEN+1]; @@ -729,7 +729,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; @@ -816,7 +816,7 @@ TclpReadlink( { #ifndef DJGPP char link[MAXPATHLEN]; - Tcl_Size length; + ssize_t length; const char *native; Tcl_DString ds; @@ -828,7 +828,7 @@ TclpReadlink( return NULL; } - Tcl_ExternalToUtfDString(NULL, link, length, linkPtr); + Tcl_ExternalToUtfDStringEx(NULL, NULL, link, (size_t)length, TCL_ENCODING_PROFILE_TCL8, linkPtr, NULL); return Tcl_DStringValue(linkPtr); #else return NULL; @@ -961,7 +961,7 @@ TclpObjLink( if (transPtr == NULL) { return NULL; } - target = TclGetStringFromObj(transPtr, &length); + target = Tcl_GetStringFromObj(transPtr, &length); target = Tcl_UtfToExternalDString(NULL, target, length, &ds); Tcl_DecrRefCount(transPtr); @@ -982,7 +982,7 @@ TclpObjLink( Tcl_Obj *linkPtr = NULL; char link[MAXPATHLEN]; - Tcl_Size length; + ssize_t length; Tcl_DString ds; Tcl_Obj *transPtr; @@ -997,7 +997,7 @@ TclpObjLink( return NULL; } - Tcl_ExternalToUtfDString(NULL, link, length, &ds); + Tcl_ExternalToUtfDStringEx(NULL, NULL, link, (size_t)length, TCL_ENCODING_PROFILE_TCL8, &ds, NULL); linkPtr = Tcl_DStringToObj(&ds); Tcl_IncrRefCount(linkPtr); return linkPtr; @@ -1058,11 +1058,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, NULL, (const char *) clientData, TCL_INDEX_NONE, TCL_ENCODING_PROFILE_TCL8, &ds, NULL); return Tcl_DStringToObj(&ds); } @@ -1082,7 +1082,7 @@ TclpNativeToNormalized( *--------------------------------------------------------------------------- */ -ClientData +void * TclNativeCreateNativeRep( Tcl_Obj *pathPtr) { @@ -1115,8 +1115,8 @@ TclNativeCreateNativeRep( Tcl_IncrRefCount(validPathPtr); } - str = TclGetStringFromObj(validPathPtr, &len); - Tcl_UtfToExternalDString(NULL, str, len, &ds); + str = Tcl_GetStringFromObj(validPathPtr, &len); + Tcl_UtfToExternalDStringEx(NULL, NULL, str, len, TCL_ENCODING_PROFILE_TCL8, &ds, NULL); len = Tcl_DStringLength(&ds) + sizeof(char); if (strlen(Tcl_DStringValue(&ds)) < len - sizeof(char)) { /* See bug [3118489]: NUL in filenames */ @@ -1125,7 +1125,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); @@ -1149,9 +1149,9 @@ TclNativeCreateNativeRep( *--------------------------------------------------------------------------- */ -ClientData +void * TclNativeDupInternalRep( - ClientData clientData) + void *clientData) { char *copy; size_t len; @@ -1166,7 +1166,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 ce08425..982c36b 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, NULL, str, TCL_INDEX_NONE, TCL_ENCODING_PROFILE_TCL8, &buffer, NULL); str = Tcl_DStringValue(&buffer); if ((str != NULL) && (str[0] != '\0')) { Tcl_DString ds; - int pathc; + Tcl_Size 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,10 +544,17 @@ TclpInitLibraryPath( Tcl_DStringFree(&buffer); *encodingPtr = Tcl_GetEncoding(NULL, NULL); - str = TclGetString(pathPtr); - *lengthPtr = pathPtr->length; - *valuePtr = (char *)ckalloc(*lengthPtr + 1); - memcpy(*valuePtr, str, *lengthPtr + 1); + + /* + * Note lengthPtr is (size_t *) which is unsigned so cannot + * pass directly to Tcl_GetStringFromObj. + * TODO - why is the type size_t anyways? + */ + Tcl_Size length; + str = Tcl_GetStringFromObj(pathPtr, &length); + *lengthPtr = length; + *valuePtr = (char *)Tcl_Alloc(length + 1); + memcpy(*valuePtr, str, length + 1); Tcl_DecrRefCount(pathPtr); } @@ -864,6 +871,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 @@ -1001,16 +1020,16 @@ TclpSetVariables( *---------------------------------------------------------------------- */ -int +Tcl_Size TclpFindVariable( const char *name, /* Name of desired environment variable * (native). */ - int *lengthPtr) /* Used to return length of name (for + Tcl_Size *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; + Tcl_Size i, result = -1; const char *env, *p1, *p2; Tcl_DString envString; diff --git a/unix/tclUnixNotfy.c b/unix/tclUnixNotfy.c index 0a2b695..402e04f 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 63e576b..1e2f3b0 100644 --- a/unix/tclUnixPipe.c +++ b/unix/tclUnixPipe.c @@ -46,7 +46,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. */ @@ -80,7 +80,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. */ @@ -392,7 +392,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 @@ -422,7 +422,7 @@ TclpCreateProcess( Tcl_DString *dsArray; char **newArgv; int pid; - int i; + size_t i; #if defined(HAVE_POSIX_SPAWNP) int childErrno; static int use_spawn = -1; @@ -821,7 +821,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 @@ -829,7 +829,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; @@ -943,7 +943,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. @@ -963,7 +963,7 @@ TclGetAndDetachPids( } Tcl_SetObjResult(interp, pidsObj); if (pipePtr->numPids > 0) { - ckfree(pipePtr->pidPtr); + Tcl_Free(pipePtr->pidPtr); pipePtr->numPids = 0; } } @@ -1093,9 +1093,9 @@ PipeClose2Proc( } if (pipePtr->numPids != 0) { - ckfree(pipePtr->pidPtr); + Tcl_Free(pipePtr->pidPtr); } - ckfree(pipePtr); + Tcl_Free(pipePtr); if (errorCode == 0) { return result; } @@ -1349,14 +1349,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) { @@ -1371,7 +1371,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; } @@ -1387,7 +1387,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 f9fd702..cdc67d2 100644 --- a/unix/tclUnixPort.h +++ b/unix/tclUnixPort.h @@ -82,11 +82,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 @@ -118,10 +115,6 @@ extern "C" { #ifdef __cplusplus } #endif -#elif defined(HAVE_STRUCT_STAT64) && !defined(__APPLE__) -# define TclOSfstat(fd, buf) fstat64(fd, (struct stat64 *)buf) -# define TclOSstat(name, buf) stat64(name, (struct stat64 *)buf) -# define TclOSlstat(name,buf) lstat64(name, (struct stat64 *)buf) #else # define TclOSfstat(fd, buf) fstat(fd, (struct stat *)buf) # define TclOSstat(name, buf) stat(name, (struct stat *)buf) @@ -655,9 +648,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 d6e5386..36ed409 100644 --- a/unix/tclUnixSock.c +++ b/unix/tclUnixSock.c @@ -156,11 +156,7 @@ static Tcl_FileProc WrapNotify; 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; snprintf(channelName, sizeof(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 ee1229b..0f73b57 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 c67495e..71e451f 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() */ - TCL_HASH_TYPE 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. */ { @@ -236,7 +228,7 @@ TclpThreadCreate( #ifdef HAVE_PTHREAD_ATTR_SETSTACKSIZE if (stackSize != TCL_THREAD_STACK_DEFAULT) { - pthread_attr_setstacksize(&attr, (size_t)stackSize); + pthread_attr_setstacksize(&attr, stackSize); #ifdef TCL_THREAD_STACK_MIN } else { /* @@ -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; - - snprintf(tsdPtr->nabuf, sizeof(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 f242cf4..20b9a67 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 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; @@ -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 4388009..aa88760 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. */ |