diff options
| -rw-r--r-- | unix/Makefile.in | 16 | ||||
| -rw-r--r-- | unix/configure.in | 26 | ||||
| -rw-r--r-- | unix/tcl.m4 | 44 | ||||
| -rw-r--r-- | unix/tclUnixFCmd.c | 230 | ||||
| -rw-r--r-- | unix/tclUnixThrd.c | 22 |
5 files changed, 293 insertions, 45 deletions
diff --git a/unix/Makefile.in b/unix/Makefile.in index e59ce25..01e17b6 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -5,7 +5,7 @@ # "autoconf" program (constructs like "@foo@" will get replaced in the # actual Makefile. # -# RCS: @(#) $Id: Makefile.in,v 1.52 2000/01/11 22:09:18 hobbs Exp $ +# RCS: @(#) $Id: Makefile.in,v 1.53 2000/01/12 11:13:54 hobbs Exp $ VERSION = @TCL_VERSION@ @@ -460,7 +460,7 @@ topDirName: gendate: yacc -l $(GENERIC_DIR)/tclGetDate.y sed -e 's/yy/TclDate/g' -e '/^#include <values.h>/d' \ - -e 's?SCCSID?RCS: @(#) $$Id: Makefile.in,v 1.52 2000/01/11 22:09:18 hobbs Exp $$?' \ + -e 's?SCCSID?RCS: @(#) $$Id: Makefile.in,v 1.53 2000/01/12 11:13:54 hobbs Exp $$?' \ -e '/#ifdef __STDC__/,/#endif/d' -e '/TclDateerrlab:/d' \ -e '/TclDatenewstate:/d' -e '/#pragma/d' \ -e '/#include <inttypes.h>/d' -e 's/const /CONST /g' \ @@ -502,7 +502,9 @@ install-binaries: binaries fi; \ done; @echo "Installing $(TCL_LIB_FILE)" - chmod +x $(SRC_DIR)/install-sh + @if test ! -x $(SRC_DIR)/install-sh; then \ + chmod +x $(SRC_DIR)/install-sh; \ + fi @$(INSTALL_DATA) $(TCL_LIB_FILE) $(LIB_INSTALL_DIR)/$(TCL_LIB_FILE) @(cd $(LIB_INSTALL_DIR); $(RANLIB) $(TCL_LIB_FILE)) @chmod 555 $(LIB_INSTALL_DIR)/$(TCL_LIB_FILE) @@ -541,7 +543,9 @@ install-libraries: libraries else true; \ fi; \ done; - chmod +x $(SRC_DIR)/install-sh + @if test ! -x $(SRC_DIR)/install-sh; then \ + chmod +x $(SRC_DIR)/install-sh; \ + fi @for i in $(GENERIC_DIR)/tcl.h $(GENERIC_DIR)/tclDecls.h ; \ do \ echo "Installing $$i"; \ @@ -566,7 +570,9 @@ install-libraries: libraries done; install-doc: doc - @chmod +x $(UNIX_DIR)/mkLinks + @if test ! -x $(UNIX_DIR)/mkLinks; then \ + chmod +x $(UNIX_DIR)/mkLinks; \ + fi @for i in $(MAN_INSTALL_DIR) $(MAN1_INSTALL_DIR) $(MAN3_INSTALL_DIR) $(MANN_INSTALL_DIR) ; \ do \ if [ ! -d $$i ] ; then \ diff --git a/unix/configure.in b/unix/configure.in index 922676f..fd0e84e 100644 --- a/unix/configure.in +++ b/unix/configure.in @@ -2,7 +2,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(../generic/tcl.h) -# RCS: @(#) $Id: configure.in,v 1.52 1999/12/21 23:59:49 hobbs Exp $ +# RCS: @(#) $Id: configure.in,v 1.53 2000/01/12 11:13:55 hobbs Exp $ TCL_VERSION=8.3 TCL_MAJOR_VERSION=8 @@ -254,29 +254,7 @@ fi # "fixstrtod" that corrects the error. #-------------------------------------------------------------------- -AC_CHECK_FUNC(strtod, tcl_strtod=1, tcl_strtod=0) -if test "$tcl_strtod" = 1; then - AC_MSG_CHECKING([for Solaris strtod bug]) - AC_TRY_RUN([ -extern double strtod(); -int main() -{ - char *string = "NaN"; - char *term; - strtod(string, &term); - if ((term != string) && (term[-1] == 0)) { - exit(1); - } - exit(0); -}], tcl_ok=1, tcl_ok=0, tcl_ok=0) - if test $tcl_ok = 1; then - AC_MSG_RESULT(ok) - else - AC_MSG_RESULT(buggy) - LIBOBJS="$LIBOBJS fixstrtod.o" - AC_DEFINE(strtod, fixstrtod) - fi -fi +SC_BUGGY_STRTOD #-------------------------------------------------------------------- # Check for various typedefs and provide substitutes if diff --git a/unix/tcl.m4 b/unix/tcl.m4 index 4c59293..91d2141 100644 --- a/unix/tcl.m4 +++ b/unix/tcl.m4 @@ -584,7 +584,9 @@ AC_DEFUN(SC_CONFIG_CFLAGS, [ AIX-4.[[2-9]]) if test "${TCL_THREADS}" = "1" -a "$using_gcc" = "no" ; then # AIX requires the _r compiler when gcc isn't being used - CC=${CC}_r + if test "${CC}" != "cc_r" ; then + CC=${CC}_r + fi AC_MSG_RESULT(Using $CC for compiling with threads) fi SHLIB_CFLAGS="" @@ -601,7 +603,9 @@ AC_DEFUN(SC_CONFIG_CFLAGS, [ AIX-*) if test "${TCL_THREADS}" = "1" -a "$using_gcc" = "no" ; then # AIX requires the _r compiler when gcc isn't being used - CC=${CC}_r + if test "${CC}" != "cc_r" ; then + CC=${CC}_r + fi AC_MSG_RESULT(Using $CC for compiling with threads) fi SHLIB_CFLAGS="" @@ -853,6 +857,15 @@ AC_DEFUN(SC_CONFIG_CFLAGS, [ DL_LIBS="" LDFLAGS="" LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' + # see pthread_intro(3) for pthread support on osf1, k.furukawa + if test "${TCL_THREADS}" = "1" ; then + if test "$using_gcc" = "no" ; then + EXTRA_CFLAGS="-std1 -pthread" + LDFLAGS="-pthread" + else + THREADS_LIBS=" -lpthread -lmach -lexc -lc" + fi + fi ;; RISCos-*) SHLIB_CFLAGS="-G 0" @@ -1544,6 +1557,8 @@ AC_DEFUN(SC_TIME_HANDLER, [ # terminating character under some conditions. Check for this # and if the problem exists use a substitute procedure # "fixstrtod" (provided by Tcl) that corrects the error. +# Also, on Compaq's Tru64 Unix 5.0, +# strtod(" ") returns 0.0 instead of a failure to convert. # # Arguments: # none @@ -1556,25 +1571,31 @@ AC_DEFUN(SC_TIME_HANDLER, [ #-------------------------------------------------------------------- AC_DEFUN(SC_BUGGY_STRTOD, [ - AC_CHECK_FUNC(strtod, tk_strtod=1, tk_strtod=0) - if test "$tk_strtod" = 1; then - AC_MSG_CHECKING([for Solaris 2.4 strtod bug]) + AC_CHECK_FUNC(strtod, tcl_strtod=1, tcl_strtod=0) + if test "$tcl_strtod" = 1; then + AC_MSG_CHECKING([for Solaris2.4/Tru64 strtod bugs]) AC_TRY_RUN([ extern double strtod(); int main() { - char *string = "NaN"; + char *string = "NaN", *spaceString = " "; char *term; - strtod(string, &term); + double value; + value = strtod(string, &term); if ((term != string) && (term[-1] == 0)) { exit(1); } + value = strtod(string, &term); + if (term == (string+1)) { + exit(1); + } exit(0); - }], tk_ok=1, tk_ok=0, tk_ok=0) - if test "$tk_ok" = 1; then + }], tcl_ok=1, tcl_ok=0, tcl_ok=0) + if test "$tcl_ok" = 1; then AC_MSG_RESULT(ok) else AC_MSG_RESULT(buggy) + LIBOBJS="$LIBOBJS fixstrtod.o" AC_DEFINE(strtod, fixstrtod) fi fi @@ -1664,14 +1685,15 @@ AC_DEFUN(SC_TCL_LINK_LIBS, [ tcl_checkBoth=0 AC_CHECK_FUNC(connect, tcl_checkSocket=0, tcl_checkSocket=1) if test "$tcl_checkSocket" = 1; then - AC_CHECK_LIB(socket, main, LIBS="$LIBS -lsocket", tcl_checkBoth=1) + AC_CHECK_FUNC(setsockopt, , AC_CHECK_LIB(socket, setsockopt, + LIBS="$LIBS -lsocket", tcl_checkBoth=1)) fi if test "$tcl_checkBoth" = 1; then tk_oldLibs=$LIBS LIBS="$LIBS -lsocket -lnsl" AC_CHECK_FUNC(accept, tcl_checkNsl=0, [LIBS=$tk_oldLibs]) fi - AC_CHECK_FUNC(gethostbyname, , AC_CHECK_LIB(nsl, main, + AC_CHECK_FUNC(gethostbyname, , AC_CHECK_LIB(nsl, gethostbyname, [LIBS="$LIBS -lnsl"])) # Don't perform the eval of the libraries here because DL_LIBS diff --git a/unix/tclUnixFCmd.c b/unix/tclUnixFCmd.c index c8b35eb..f396d45 100644 --- a/unix/tclUnixFCmd.c +++ b/unix/tclUnixFCmd.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclUnixFCmd.c,v 1.4 1999/04/16 00:48:04 stanton Exp $ + * RCS: @(#) $Id: tclUnixFCmd.c,v 1.5 2000/01/12 11:13:55 hobbs Exp $ * * Portions of this code were derived from NetBSD source code which has * the following copyright notice: @@ -88,7 +88,10 @@ static int SetOwnerAttribute _ANSI_ARGS_((Tcl_Interp *interp, static int SetPermissionsAttribute _ANSI_ARGS_(( Tcl_Interp *interp, int objIndex, CONST char *fileName, Tcl_Obj *attributePtr)); - +static int GetModeFromPermString _ANSI_ARGS_(( + Tcl_Interp *interp, char *modeStringPtr, + mode_t *modePtr)); + /* * Prototype for the TraverseUnixTree callback function. */ @@ -1340,16 +1343,44 @@ SetPermissionsAttribute(interp, objIndex, fileName, attributePtr) Tcl_Obj *attributePtr; /* The attribute to set. */ { long mode; + mode_t newMode; int result; CONST char *native; Tcl_DString ds; - if (Tcl_GetLongFromObj(interp, attributePtr, &mode) != TCL_OK) { - return TCL_ERROR; + /* + * First try if the string is a number + */ + if (Tcl_GetLongFromObj(NULL, attributePtr, &mode) == TCL_OK) { + newMode = (mode_t) (mode & 0x00007FFF); + } else { + struct stat buf; + char *modeStringPtr = Tcl_GetString(attributePtr); + + /* + * Try the forms "rwxrwxrwx" and "ugo=rwx" + * + * We get the current mode of the file, in order to allow for + * ug+-=rwx style chmod strings. + */ + result = TclStat(fileName, &buf); + if (result != 0) { + Tcl_AppendResult(interp, "could not read \"", fileName, "\": ", + Tcl_PosixError(interp), (char *) NULL); + return TCL_ERROR; + } + newMode = (mode_t) (buf.st_mode & 0x00007FFF); + + if (GetModeFromPermString(NULL, modeStringPtr, &newMode) != TCL_OK) { + Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), + "unknown permission string format \"", + modeStringPtr, "\"", (char *) NULL); + return TCL_ERROR; + } } native = Tcl_UtfToExternalDString(NULL, fileName, -1, &ds); - result = chmod(native, (mode_t) mode); /* INTL: Native. */ + result = chmod(native, newMode); /* INTL: Native. */ Tcl_DStringFree(&ds); if (result != 0) { Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), @@ -1359,6 +1390,7 @@ SetPermissionsAttribute(interp, objIndex, fileName, attributePtr) } return TCL_OK; } + /* *--------------------------------------------------------------------------- * @@ -1388,4 +1420,192 @@ TclpListVolumes(interp) Tcl_SetStringObj(resultPtr, "/", 1); return TCL_OK; } + +/* + *---------------------------------------------------------------------- + * + * GetModeFromPermString -- + * + * This procedure is invoked to process the "file permissions" + * Tcl command, to check for a "rwxrwxrwx" or "ugoa+-=rwxst" string. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + +static int +GetModeFromPermString(interp, modeStringPtr, modePtr) + Tcl_Interp *interp; /* The interp we are using for errors. */ + char *modeStringPtr; /* Permissions string */ + mode_t *modePtr; /* pointer to the mode value */ +{ + mode_t newMode; + mode_t oldMode; /* Storage for the value of the old mode + * (that is passed in), to allow for the + * chmod style manipulation */ + int i,n, who, op, what, op_found, who_found; + /* + * We start off checking for an "rwxrwxrwx" style permissions string + */ + if (strlen(modeStringPtr) != 9) { + goto chmodStyleCheck; + } + + newMode = 0; + for (i = 0; i < 9; i++) { + switch (*(modeStringPtr+i)) { + case 'r': + if ((i%3) != 0) { + goto chmodStyleCheck; + } + newMode |= (1<<(8-i)); + break; + case 'w': + if ((i%3) != 1) { + goto chmodStyleCheck; + } + newMode |= (1<<(8-i)); + break; + case 'x': + if ((i%3) != 2) { + goto chmodStyleCheck; + } + newMode |= (1<<(8-i)); + break; + case 's': + if (((i%3) != 2) || (i > 5)) { + goto chmodStyleCheck; + } + newMode |= (1<<(8-i)); + newMode |= (1<<(11-(i/3))); + break; + case 'S': + if (((i%3) != 2) || (i > 5)) { + goto chmodStyleCheck; + } + newMode |= (1<<(11-(i/3))); + break; + case 't': + if (i != 8) { + goto chmodStyleCheck; + } + newMode |= (1<<(8-i)); + newMode |= (1<<9); + break; + case 'T': + if (i != 8) { + goto chmodStyleCheck; + } + newMode |= (1<<9); + break; + case '-': + break; + default: + /* + * Oops, not what we thought it was, so go on + */ + goto chmodStyleCheck; + } + } + *modePtr = newMode; + return TCL_OK; + + chmodStyleCheck: + /* + * We now check for an "ugoa+-=rwxst" style permissions string + */ + + for (n = 0 ; *(modeStringPtr+n) != '\0' ; n = n + i) { + oldMode = *modePtr; + who = op = what = op_found = who_found = 0; + for (i = 0 ; *(modeStringPtr+n+i) != '\0' ; i++ ) { + if (!who_found) { + /* who */ + switch (*(modeStringPtr+n+i)) { + case 'u' : + who |= 0x9c0; + continue; + case 'g' : + who |= 0x438; + continue; + case 'o' : + who |= 0x207; + continue; + case 'a' : + who |= 0xfff; + continue; + } + } + who_found = 1; + if (who == 0) { + who = 0xfff; + } + if (!op_found) { + /* op */ + switch (*(modeStringPtr+n+i)) { + case '+' : + op = 1; + op_found = 1; + continue; + case '-' : + op = 2; + op_found = 1; + continue; + case '=' : + op = 3; + op_found = 1; + continue; + default : + return TCL_ERROR; + break; + } + } + /* what */ + switch (*(modeStringPtr+n+i)) { + case 'r' : + what |= 0x124; + continue; + case 'w' : + what |= 0x92; + continue; + case 'x' : + what |= 0x49; + continue; + case 's' : + what |= 0xc00; + continue; + case 't' : + what |= 0x200; + continue; + case ',' : + break; + default : + return TCL_ERROR; + break; + } + if (*(modeStringPtr+n+i) == ',') { + i++; + break; + } + } + switch (op) { + case 1 : + *modePtr = oldMode | (who & what); + continue; + case 2 : + *modePtr = oldMode & ~(who & what); + continue; + case 3 : + *modePtr = (oldMode & ~who) | (who & what); + continue; + } + } + return TCL_OK; +} diff --git a/unix/tclUnixThrd.c b/unix/tclUnixThrd.c index 47e56d7..53489bc 100644 --- a/unix/tclUnixThrd.c +++ b/unix/tclUnixThrd.c @@ -81,9 +81,31 @@ TclpThreadCreate(idPtr, proc, clientData) { pthread_attr_t attr; int result; +#ifdef TCL_THREAD_STACK_MIN + size_t size; +#endif pthread_attr_init(&attr); pthread_attr_setscope(&attr, PTHREAD_SCOPE_SYSTEM); + +#ifdef TCL_THREAD_STACK_MIN + /* + * Certain systems define a thread stack size that by default is + * too small for many operations. The user has the option of + * defining TCL_THREAD_STACK_MIN to a value large enough to work + * for their needs. This would look like (for 128K min stack): + * make MEM_DEBUG_FLAGS=-DTCL_THREAD_STACK_MIN=131072L + * + * This solution is not optimal, as we should allow the user to + * specify a size at runtime, but we don't want to slow this function + * down, and that would still leave the main thread at the default. + */ + result = pthread_attr_getstacksize(&attr, &size); + if (!result && (size < TCL_THREAD_STACK_MIN)) { + pthread_attr_setstacksize(&attr, (size_t) TCL_THREAD_STACK_MIN); + } +#endif + if (pthread_create((pthread_t *)idPtr, &attr, (void * (*)())proc, (void *)clientData) && pthread_create((pthread_t *)idPtr, NULL, |