summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2004-06-23 00:24:31 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2004-06-23 00:24:31 (GMT)
commit32d847fdb1dab403a2db715367cceadad9f9e467 (patch)
tree5a154848a1901797f909f029933e19ccdb283c63
parent02be87df7fbd313cca35b5461372f13152ac7131 (diff)
downloadtcl-32d847fdb1dab403a2db715367cceadad9f9e467.zip
tcl-32d847fdb1dab403a2db715367cceadad9f9e467.tar.gz
tcl-32d847fdb1dab403a2db715367cceadad9f9e467.tar.bz2
Version of [Patch 746578] that works with Linux and is likely to work elsewhere
-rw-r--r--ChangeLog7
-rw-r--r--generic/tclInt.h3
-rw-r--r--tests/stack.test44
-rw-r--r--unix/tcl.m410
-rw-r--r--unix/tclUnixInit.c321
-rw-r--r--unix/tclUnixPort.h37
-rw-r--r--unix/tclUnixThrd.c49
7 files changed, 390 insertions, 81 deletions
diff --git a/ChangeLog b/ChangeLog
index 93fad1b..1b7494c 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,10 @@
+2004-06-23 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * unix/tclUnixInit.c (GetStackSize, TclpCheckStackSpace):
+ * unix/tclUnixThrd.c (TclpThreadGetStackSize): Added code to check
+ whether the C stack is about to be exceeded, from [Patch 746378]
+ by Joe Mistachkin but with substantial revisions.
+
2004-06-22 Kevin Kenny <kennykb@acm.org>
* generic/tclEvent.c (NewThreadProc): Fixed broken build on
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 6b16f7b..f7d2026 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -12,7 +12,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclInt.h,v 1.166 2004/06/22 13:08:59 vasiljevic Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.167 2004/06/23 00:24:42 dkf Exp $
*/
#ifndef _TCLINT
@@ -1901,6 +1901,7 @@ EXTERN void TclpThreadDataKeyInit _ANSI_ARGS_((
EXTERN void TclpThreadDataKeySet _ANSI_ARGS_((
Tcl_ThreadDataKey *keyPtr, VOID *data));
EXTERN void TclpThreadExit _ANSI_ARGS_((int status));
+EXTERN int TclpThreadGetStackSize _ANSI_ARGS_((void));
EXTERN void TclRememberCondition _ANSI_ARGS_((Tcl_Condition *mutex));
EXTERN void TclRememberDataKey _ANSI_ARGS_((Tcl_ThreadDataKey *mutex));
EXTERN VOID TclRememberJoinableThread _ANSI_ARGS_((Tcl_ThreadId id));
diff --git a/tests/stack.test b/tests/stack.test
index 362133b..64b669a 100644
--- a/tests/stack.test
+++ b/tests/stack.test
@@ -9,7 +9,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: stack.test,v 1.17 2004/06/22 19:41:25 kennykb Exp $
+# RCS: @(#) $Id: stack.test,v 1.18 2004/06/23 00:24:43 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -56,30 +56,26 @@ test stack-2.1 {maxNestingDepth reached on infinite recursion} {minStack2400} {
} {too many nested evaluations (infinite loop?)}
# Make sure that there is enough stack to run regexp even if we're
-# close to the recursion limit. [Bug 947070]
-
-test stack-3.1 {enough room for regexp near recursion limit} \
- -constraints { win } \
- -setup {
- set ::limit [interp recursionlimit {} 10000]
- proc a { max } {
- if { [info level] < $max } {
- set ::depth [info level]
- a $max
- } else {
- regexp {^ ?} x
- }
+# close to the recursion limit. [Bug 947070] [Patch 746378]
+test stack-3.1 {enough room for regexp near recursion limit} -setup {
+ set limit [interp recursionlimit {} 10000]
+ set depth 0
+ proc a { max } {
+ if { [info level] < $max } {
+ set ::depth [info level]
+ a $max
+ } else {
+ regexp {^ ?} x
}
- } -body {
- set ::depth 0
- catch { a 10001 }
- set depth2 $depth
- catch { a $::depth }
- expr { $depth2 - $depth }
- } -cleanup {
- interp recursionlimit {} $::limit
- rename a {}
- } -result {1}
+ }
+} -body {
+ catch { a 10001 }
+ set depth2 $depth
+ list [a $depth] [expr { $depth2 - $depth }]
+} -cleanup {
+ interp recursionlimit {} $limit
+ rename a {}
+} -result {1 1}
# cleanup
::tcltest::cleanupTests
diff --git a/unix/tcl.m4 b/unix/tcl.m4
index 08f33e7..37bc2d8 100644
--- a/unix/tcl.m4
+++ b/unix/tcl.m4
@@ -469,6 +469,16 @@ AC_DEFUN(SC_ENABLE_THREADS, [
ac_saved_libs=$LIBS
LIBS="$LIBS $THREADS_LIBS"
AC_CHECK_FUNCS(pthread_attr_setstacksize)
+ AC_CHECK_FUNCS(pthread_attr_get_np pthread_getattr_np)
+ AC_MSG_CHECKING([for pthread_getattr_np declaration])
+ AC_CACHE_VAL(tcl_cv_grep_pthread_getattr_np,
+ AC_EGREP_HEADER(pthread_getattr_np, pthread.h,
+ tcl_cv_grep_pthread_getattr_np=present,
+ tcl_cv_grep_pthread_getattr_np=missing))
+ AC_MSG_RESULT($tcl_cv_grep_pthread_getattr_np)
+ if test $tcl_cv_grep_pthread_getattr_np = missing ; then
+ AC_DEFINE(GETATTRNP_NOT_DECLARED)
+ fi
LIBS=$ac_saved_libs
AC_CHECK_FUNCS(readdir_r)
else
diff --git a/unix/tclUnixInit.c b/unix/tclUnixInit.c
index a62f0fc..51e40a2 100644
--- a/unix/tclUnixInit.c
+++ b/unix/tclUnixInit.c
@@ -1,4 +1,4 @@
-/*
+/*
* tclUnixInit.c --
*
* Contains the Unix-specific interpreter initialization functions.
@@ -7,17 +7,19 @@
* Copyright (c) 1999 by Scriptics Corporation.
* All rights reserved.
*
- * RCS: @(#) $Id: tclUnixInit.c,v 1.45 2004/06/18 15:26:00 dkf Exp $
+ * RCS: @(#) $Id: tclUnixInit.c,v 1.46 2004/06/23 00:24:41 dkf Exp $
*/
#if defined(HAVE_CFBUNDLE)
#include <CoreFoundation/CoreFoundation.h>
#endif
#include "tclInt.h"
+#include <stddef.h>
#include <locale.h>
#ifdef HAVE_LANGINFO
#include <langinfo.h>
#endif
+#include <sys/resource.h>
#if defined(__FreeBSD__)
# include <floatingpoint.h>
#endif
@@ -28,6 +30,69 @@
# endif
#endif
+/*
+ * Define this if you want to revert to the old behavior of
+ * never checking the stack.
+ */
+#undef TCL_NO_STACK_CHECK
+
+/*
+ * Define this if you want to see a lot of output regarding
+ * stack checking.
+ */
+#undef TCL_DEBUG_STACK_CHECK
+
+/*
+ * Values used to compute how much space is really available for Tcl's
+ * use for the stack.
+ *
+ * NOTE: Now I have some idea why the maximum stack size must be
+ * divided by 64 on FreeBSD with threads enabled to get a reasonably
+ * correct value.
+ *
+ * The getrlimit() function is documented to return the maximum stack
+ * size in bytes. However, with threads enabled, the pthread library
+ * does bad things to the stack size limits. First, the limits cannot
+ * be changed. Second, they appear to be reported incorrectly by a
+ * factor of about 64.
+ *
+ * The defines below may need to be adjusted if more platforms have
+ * this broken behavior with threads enabled.
+ */
+
+#if defined(__FreeBSD__)
+# define TCL_MAGIC_STACK_DIVISOR 64
+# define TCL_RESERVED_STACK_PAGES 3
+#endif
+
+#ifndef TCL_MAGIC_STACK_DIVISOR
+#define TCL_MAGIC_STACK_DIVISOR 1
+#endif
+#ifndef TCL_RESERVED_STACK_PAGES
+#define TCL_RESERVED_STACK_PAGES 8
+#endif
+
+/*
+ * Thread specific data for stack checking.
+ */
+
+#ifndef TCL_NO_STACK_CHECK
+typedef struct ThreadSpecificData {
+ int *outerVarPtr; /* The "outermost" stack frame pointer for
+ * this thread. */
+ int initialised; /* Have we found what the stack size was? */
+ int stackDetermineResult; /* What happened when we did that? */
+ size_t stackSize; /* The size of the current stack. */
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
+#endif /* TCL_NO_STACK_CHECK */
+
+#ifdef TCL_DEBUG_STACK_CHECK
+#define STACK_DEBUG(args) printf args
+#else
+#define STACK_DEBUG(args) (void)0
+#endif /* TCL_DEBUG_STACK_CHECK */
+
/* Used to store the encoding used for binary files */
static Tcl_Encoding binaryEncoding = NULL;
/* Has the basic library path encoding issue been fixed */
@@ -106,8 +171,8 @@ static CONST LocaleTable localeTable[] = {
{"Jp_JP", "shiftjis"},
{"japan", "euc-jp"},
#ifdef hpux
- {"japanese", "shiftjis"},
- {"ja", "shiftjis"},
+ {"japanese", "shiftjis"},
+ {"ja", "shiftjis"},
#else
{"japanese", "euc-jp"},
{"ja", "euc-jp"},
@@ -124,9 +189,9 @@ static CONST LocaleTable localeTable[] = {
{"ko_KR.eucKR", "euc-kr"},
{"korean", "euc-kr"},
- {"ru", "iso8859-5"},
- {"ru_RU", "iso8859-5"},
- {"ru_SU", "iso8859-5"},
+ {"ru", "iso8859-5"},
+ {"ru_RU", "iso8859-5"},
+ {"ru_SU", "iso8859-5"},
{"zh", "cp936"},
{"zh_CN.gb2312", "euc-cn"},
@@ -138,8 +203,13 @@ static CONST LocaleTable localeTable[] = {
{NULL, NULL}
};
+#ifndef TCL_NO_STACK_CHECK
+static int GetStackSize _ANSI_ARGS_((size_t *stackSizePtr));
+#endif /* TCL_NO_STACK_CHECK */
#ifdef HAVE_CFBUNDLE
-static int Tcl_MacOSXGetLibraryPath(Tcl_Interp *interp, int maxPathLen, char *tclLibPath);
+static int MacOSXGetLibraryPath _ANSI_ARGS((
+ Tcl_Interp *interp, int maxPathLen,
+ char *tclLibPath));
#endif /* HAVE_CFBUNDLE */
@@ -167,7 +237,7 @@ TclpInitPlatform()
{
#ifdef DJGPP
tclPlatform = TCL_PLATFORM_WINDOWS;
-#else
+#else
tclPlatform = TCL_PLATFORM_UNIX;
#endif
@@ -201,7 +271,7 @@ TclpInitPlatform()
#ifdef __FreeBSD__
fpsetround(FP_RN);
- fpsetmask(0L);
+ (void) fpsetmask(0L);
#endif
#if defined(__bsdi__) && (_BSDI_VERSION > 199501)
@@ -256,7 +326,7 @@ TclpInitPlatform()
int
TclpInitLibraryPath(path)
-CONST char *path; /* Path to the executable in native
+CONST char *path; /* Path to the executable in native
* multi-byte encoding. */
{
#define LIBRARY_SIZE 32
@@ -276,7 +346,7 @@ CONST char *path; /* Path to the executable in native
* is installed. The developLib computes the path as though the
* executable is run from a develpment directory.
*/
-
+
sprintf(installLib, "lib/tcl%s", TCL_VERSION);
sprintf(developLib, "tcl%s/library", TCL_PATCH_LEVEL);
@@ -305,7 +375,7 @@ CONST char *path; /* Path to the executable in native
/*
* If TCL_LIBRARY is set, search there.
*/
-
+
objPtr = Tcl_NewStringObj(str, -1);
Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
@@ -318,7 +388,7 @@ CONST char *path; /* Path to the executable in native
* removing the old "tclX.Y" and substituting the current
* version string.
*/
-
+
pathv[pathc - 1] = installLib + 4;
str = Tcl_JoinPath(pathc, pathv, &ds);
objPtr = Tcl_NewStringObj(str, Tcl_DStringLength(&ds));
@@ -347,7 +417,6 @@ CONST char *path; /* Path to the executable in native
* <bindir>/../../../<developLib>
* (e.g. /usr/src/tcl8.4.0/unix/solaris-sparc/../../../tcl8.4.0/library)
*/
-
/*
* The variable path holds an absolute path. Take care not to
@@ -437,12 +506,12 @@ CONST char *path; /* Path to the executable in native
* This is needed when users install Tcl with an exec-prefix that
* is different from the prtefix.
*/
-
+
{
#ifdef HAVE_CFBUNDLE
char tclLibPath[MAXPATHLEN + 1];
-
- if (Tcl_MacOSXGetLibraryPath(NULL, MAXPATHLEN, tclLibPath) == TCL_OK) {
+
+ if (MacOSXGetLibraryPath(NULL, MAXPATHLEN, tclLibPath) == TCL_OK) {
str = tclLibPath;
} else
#endif /* HAVE_CFBUNDLE */
@@ -455,7 +524,7 @@ CONST char *path; /* Path to the executable in native
}
}
- TclSetLibraryPath(pathPtr);
+ TclSetLibraryPath(pathPtr);
Tcl_DStringFree(&buffer);
return 1; /* 1 indicates that pathPtr may be dirty utf (needs cleaning) */
@@ -657,9 +726,9 @@ TclpSetInitialEncodings()
* actually in the native multi-byte encoding, and not really UTF-8
* as advertised. We cheated as follows:
*
- * 1. It was safe to allow the Tcl_SetSystemEncoding() call to
- * append the ASCII chars that make up the encoding's filename to
- * the names (in the native encoding) of directories in the library
+ * 1. It was safe to allow the Tcl_SetSystemEncoding() call to
+ * append the ASCII chars that make up the encoding's filename to
+ * the names (in the native encoding) of directories in the library
* path, since all Unix multi-byte encodings have ASCII in the
* beginning.
*
@@ -669,8 +738,8 @@ TclpSetInitialEncodings()
*
* Now that the system encoding was actually successfully set,
* translate all the names in the library path to UTF-8. That way,
- * next time we search the library path, we'll translate the names
- * from UTF-8 to the system encoding which will be the native
+ * next time we search the library path, we'll translate the names
+ * from UTF-8 to the system encoding which will be the native
* encoding.
*/
@@ -678,7 +747,7 @@ TclpSetInitialEncodings()
if (pathPtr != NULL) {
int objc;
Tcl_Obj **objv;
-
+
objc = 0;
Tcl_ListObjGetElements(NULL, pathPtr, &objc, &objv);
for (i = 0; i < objc; i++) {
@@ -688,7 +757,7 @@ TclpSetInitialEncodings()
string = Tcl_GetStringFromObj(objv[i], &length);
Tcl_ExternalToUtfDString(NULL, string, length, &ds);
- Tcl_SetStringObj(objv[i], Tcl_DStringValue(&ds),
+ Tcl_SetStringObj(objv[i], Tcl_DStringValue(&ds),
Tcl_DStringLength(&ds));
Tcl_DStringFree(&ds);
}
@@ -696,7 +765,7 @@ TclpSetInitialEncodings()
libraryPathEncodingFixed = 1;
}
-
+
/* This is only ever called from the startup thread */
if (binaryEncoding == NULL) {
/*
@@ -739,13 +808,13 @@ TclpSetVariables(interp)
#ifdef HAVE_CFBUNDLE
char tclLibPath[MAXPATHLEN + 1];
-
- if (Tcl_MacOSXGetLibraryPath(interp, MAXPATHLEN, tclLibPath) == TCL_OK) {
+
+ if (MacOSXGetLibraryPath(interp, MAXPATHLEN, tclLibPath) == TCL_OK) {
CONST char *str;
Tcl_DString ds;
CFBundleRef bundleRef;
- Tcl_SetVar(interp, "tclDefaultLibrary", tclLibPath,
+ Tcl_SetVar(interp, "tclDefaultLibrary", tclLibPath,
TCL_GLOBAL_ONLY);
Tcl_SetVar(interp, "tcl_pkgPath", tclLibPath,
TCL_GLOBAL_ONLY);
@@ -809,13 +878,13 @@ TclpSetVariables(interp)
#ifndef NO_UNAME
if (uname(&name) >= 0) {
CONST char *native;
-
+
unameOK = 1;
native = Tcl_ExternalToUtfDString(NULL, name.sysname, -1, &ds);
Tcl_SetVar2(interp, "tcl_platform", "os", native, TCL_GLOBAL_ONLY);
Tcl_DStringFree(&ds);
-
+
/*
* The following code is a special hack to handle differences in
* the way version information is returned by uname. On most
@@ -829,7 +898,7 @@ TclpSetVariables(interp)
Tcl_SetVar2(interp, "tcl_platform", "osVersion", name.release,
TCL_GLOBAL_ONLY);
} else {
-#ifdef DJGPP
+#ifdef DJGPP
/* For some obscure reason DJGPP puts major version into
* name.release and minor into name.version. As of DJGPP 2.04
* this is documented in djgpp libc.info file*/
@@ -881,7 +950,7 @@ TclpSetVariables(interp)
*
* TclpFindVariable --
*
- * Locate the entry in environ for a given name. On Unix this
+ * Locate the entry in environ for a given name. On Unix this
* routine is case sensetive, on Windows this matches mixed case.
*
* Results:
@@ -923,10 +992,10 @@ TclpFindVariable(name, lengthPtr)
result = i;
goto done;
}
-
+
Tcl_DStringFree(&envString);
}
-
+
*lengthPtr = i;
done:
@@ -939,7 +1008,7 @@ TclpFindVariable(name, lengthPtr)
*
* TclpCheckStackSpace --
*
- * Detect if we are about to blow the stack. Called before an
+ * Detect if we are about to blow the stack. Called before an
* evaluation can happen when nesting depth is checked.
*
* Results:
@@ -954,18 +1023,182 @@ TclpFindVariable(name, lengthPtr)
int
TclpCheckStackSpace()
{
+#ifdef TCL_NO_STACK_CHECK
+
/*
- * This function is unimplemented on Unix platforms.
+ * This function was normally unimplemented on Unix platforms and
+ * this implements old behavior, i.e. no stack checking performed.
*/
return 1;
+
+#else
+
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ /* Most variables are actually in a
+ * thread-specific data block to minimise the
+ * impact on the stack. */
+ register ptrdiff_t stackUsed;
+ int localVar; /* Reference to somewhere on the local stack.
+ * This is declared last so it's as "deep" as
+ * possible. */
+
+ if (tsdPtr == NULL) {
+ /* this should probably be a panic(). */
+ Tcl_Panic("failed to get thread specific stack check data");
+ }
+
+ /*
+ * The first time through, we record the "outermost" stack frame.
+ */
+
+ if (tsdPtr->outerVarPtr == NULL) {
+ tsdPtr->outerVarPtr = &localVar;
+ }
+
+ if (tsdPtr->initialised == 0) {
+ /*
+ * We appear to have not computed the stack size before.
+ * Attempt to retrieve it from either the current thread or,
+ * failing that, the process accounting limit. Note that we
+ * assume that stack sizes do not change throughout the
+ * lifespan of the thread/process; this is almost always true.
+ */
+
+ tsdPtr->stackDetermineResult = GetStackSize(&tsdPtr->stackSize);
+ tsdPtr->initialised = 1;
+ }
+
+ switch (tsdPtr->stackDetermineResult) {
+ case TCL_BREAK:
+ STACK_DEBUG(("skipping stack check with failure\n"));
+ return 0;
+ case TCL_CONTINUE:
+ STACK_DEBUG(("skipping stack check with success\n"));
+ return 1;
+ }
+
+ /*
+ * Sanity check to see if somehow the stack started going the
+ * other way.
+ */
+
+ if (&localVar > tsdPtr->outerVarPtr) {
+ stackUsed = (char *)&localVar - (char *)tsdPtr->outerVarPtr;
+ } else {
+ stackUsed = (char *)tsdPtr->outerVarPtr - (char *)&localVar;
+ }
+
+ /*
+ * Now we perform the actual check. Are we about to blow
+ * our stack frame?
+ */
+
+ if (stackUsed < (ptrdiff_t) tsdPtr->stackSize) {
+ STACK_DEBUG(("stack OK\tin:%p\tout:%p\tuse:%04X\tmax:%04X\n",
+ &localVar, tsdPtr->outerVarPtr, stackUsed, tsdPtr->stackSize));
+ return 1;
+ } else {
+ STACK_DEBUG(("stack OVERFLOW\tin:%p\tout:%p\tuse:%04X\tmax:%04X\n",
+ &localVar, tsdPtr->outerVarPtr, stackUsed, tsdPtr->stackSize));
+ return 0;
+ }
+#endif /* TCL_NO_STACK_CHECK */
}
-#ifdef HAVE_CFBUNDLE
/*
*----------------------------------------------------------------------
*
- * Tcl_MacOSXGetLibraryPath --
+ * GetStackSize --
+ *
+ * Discover what the stack size for the current thread/process
+ * actually is. Expects to only ever be called once per thread
+ * and then only at a point when there is a reasonable amount of
+ * space left on the current stack; TclpCheckStackSpace is called
+ * sufficiently frequently that that is true.
+ *
+ * Results:
+ * TCL_OK if the stack space was discovered, TCL_BREAK if the
+ * stack space was undiscoverable in a way that stack checks
+ * should fail, and TCL_CONTINUE if the stack space was
+ * undiscoverable in a way that stack checks should succeed.
+ *
+ * Side effects:
+ * None
+ *
+ *----------------------------------------------------------------------
+ */
+
+#ifndef TCL_NO_STACK_CHECK
+static int
+GetStackSize(stackSizePtr)
+ size_t *stackSizePtr;
+{
+ size_t rawStackSize;
+ struct rlimit rLimit; /* The result from getrlimit(). */
+
+#ifdef TCL_THREADS
+ rawStackSize = (size_t) TclpThreadGetStackSize();
+ if (rawStackSize == (size_t) -1) {
+ /*
+ * Some kind of confirmed error?!
+ */
+ return TCL_BREAK;
+ }
+ if (rawStackSize > 0) {
+ goto finalSanityCheck;
+ }
+
+ /*
+ * If we have zero or an error, try the system limits
+ * instead. After all, the pthread documentation states that
+ * threads should always be bound by the system stack size limit
+ * in any case.
+ */
+#endif /* TCL_THREADS */
+
+ if (getrlimit(RLIMIT_STACK, &rLimit) != 0) {
+ /*
+ * getrlimit() failed, just fail the whole thing.
+ */
+ return TCL_BREAK;
+ }
+ if (rLimit.rlim_cur == RLIM_INFINITY) {
+ /*
+ * Limit is "infinite"; there is no stack limit.
+ */
+ return TCL_CONTINUE;
+ }
+ rawStackSize = rLimit.rlim_cur;
+
+ /*
+ * Final sanity check on the determined stack size. If we fail
+ * this, assume there are bogus values about and that we can't
+ * actually figure out what the stack size really is.
+ */
+
+#ifdef TCL_THREADS /* Stop warning... */
+ finalSanityCheck:
+#endif
+ if (rawStackSize <= 0) {
+ return TCL_CONTINUE;
+ }
+
+ /*
+ * Calculate a stack size with a safety margin.
+ */
+
+ *stackSizePtr = (rawStackSize / TCL_MAGIC_STACK_DIVISOR)
+ - (getpagesize() * TCL_RESERVED_STACK_PAGES);
+
+ return TCL_OK;
+}
+#endif /* TCL_NO_STACK_CHECK */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MacOSXGetLibraryPath --
*
* If we have a bundle structure for the Tcl installation,
* then check there first to see if we can find the libraries
@@ -979,14 +1212,16 @@ TclpCheckStackSpace()
*
*----------------------------------------------------------------------
*/
-static int Tcl_MacOSXGetLibraryPath(Tcl_Interp *interp, int maxPathLen, char *tclLibPath)
+
+#ifdef HAVE_CFBUNDLE
+static int
+MacOSXGetLibraryPath(Tcl_Interp *interp, int maxPathLen, char *tclLibPath)
{
int foundInFramework = TCL_ERROR;
if (strcmp(defaultLibraryDir, "@TCL_IN_FRAMEWORK@") == 0) {
- foundInFramework = Tcl_MacOSXOpenVersionedBundleResources(interp,
+ foundInFramework = Tcl_MacOSXOpenVersionedBundleResources(interp,
"com.tcltk.tcllibrary", TCL_VERSION, 0, maxPathLen, tclLibPath);
}
return foundInFramework;
}
#endif /* HAVE_CFBUNDLE */
-
diff --git a/unix/tclUnixPort.h b/unix/tclUnixPort.h
index 4000de6..93a9285 100644
--- a/unix/tclUnixPort.h
+++ b/unix/tclUnixPort.h
@@ -19,7 +19,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclUnixPort.h,v 1.37 2004/05/27 13:18:55 dkf Exp $
+ * RCS: @(#) $Id: tclUnixPort.h,v 1.38 2004/06/23 00:24:42 dkf Exp $
*/
#ifndef _TCLUNIXPORT
@@ -553,7 +553,7 @@ typedef int socklen_t;
*/
#ifdef TCL_THREADS
-#include <pthread.h>
+# include <pthread.h>
typedef pthread_mutex_t TclpMutex;
EXTERN void TclpMutexInit _ANSI_ARGS_((TclpMutex *mPtr));
EXTERN void TclpMutexLock _ANSI_ARGS_((TclpMutex *mPtr));
@@ -562,25 +562,36 @@ EXTERN Tcl_DirEntry * TclpReaddir(DIR *);
EXTERN struct tm * TclpLocaltime(CONST time_t *);
EXTERN struct tm * TclpGmtime(CONST time_t *);
EXTERN char * TclpInetNtoa(struct in_addr);
-#define readdir(x) TclpReaddir(x)
+# define readdir(x) TclpReaddir(x)
/* #define localtime(x) TclpLocaltime(x)
* #define gmtime(x) TclpGmtime(x) */
-#undef inet_ntoa
-#define inet_ntoa(x) TclpInetNtoa(x)
-#undef TclOSreaddir
-#define TclOSreaddir(x) TclpReaddir(x)
-#ifdef MAC_OSX_TCL
+# undef inet_ntoa
+# define inet_ntoa(x) TclpInetNtoa(x)
+# undef TclOSreaddir
+# define TclOSreaddir(x) TclpReaddir(x)
+# ifdef MAC_OSX_TCL
/*
* On Mac OS X, realpath is currently not
* thread safe, c.f. SF bug # 711232.
*/
-#define NO_REALPATH
-#endif
+# define NO_REALPATH
+# endif
+# ifdef HAVE_PTHREAD_ATTR_GET_NP
+# include <pthread_np.h>
+# define TclpPthreadGetAttrs pthread_attr_get_np
+# else
+# ifdef HAVE_PTHREAD_GETATTR_NP
+# define TclpPthreadGetAttrs pthread_getattr_np
+# ifdef GETATTRNP_NOT_DECLARED
+EXTERN int pthread_getattr_np _ANSI_ARGS_((pthread_t, pthread_attr_t *));
+# endif
+# endif /* HAVE_PTHREAD_GETATTR_NP */
+# endif /* HAVE_PTHREAD_ATTR_GET_NP */
#else
typedef int TclpMutex;
-#define TclpMutexInit(a)
-#define TclpMutexLock(a)
-#define TclpMutexUnlock(a)
+# define TclpMutexInit(a)
+# define TclpMutexLock(a)
+# define TclpMutexUnlock(a)
#endif /* TCL_THREADS */
#endif /* _TCLUNIXPORT */
diff --git a/unix/tclUnixThrd.c b/unix/tclUnixThrd.c
index 297fc3b..ef06dee 100644
--- a/unix/tclUnixThrd.c
+++ b/unix/tclUnixThrd.c
@@ -199,6 +199,55 @@ TclpThreadExit(status)
}
#endif /* TCL_THREADS */
+#ifdef TCL_THREADS
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpThreadGetStackSize --
+ *
+ * This procedure returns the size of the current thread's stack.
+ *
+ * Results:
+ * Stack size (in bytes?) or -1 for error or 0 for undeterminable.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclpThreadGetStackSize()
+{
+#if defined(HAVE_PTHREAD_SETSTACKSIZE) && defined(TclpPthreadGetAttrs)
+ pthread_attr_t threadAttr; /* This will hold the thread attributes for
+ * the current thread. */
+ size_t stackSize;
+
+ if (pthread_attr_init(&threadAttr) != 0) {
+ return -1;
+ }
+ if (TclpPthreadGetAttrs(pthread_self(), &threadAttr) != 0) {
+ pthread_attr_destroy(&threadAttr);
+ return -1;
+ }
+ if (pthread_attr_getstacksize(&threadAttr, &stackSize) != 0) {
+ pthread_attr_destroy(&threadAttr);
+ return -1;
+ }
+ pthread_attr_destroy(&threadAttr);
+ return (int) stackSize;
+#else
+ /*
+ * Cannot determine the real stack size of this thread. The
+ * caller might want to try looking at the process accounting
+ * limits instead.
+ */
+ return 0;
+#endif
+}
+#endif /* TCL_THREADS */
+
/*
*----------------------------------------------------------------------
*