TIP#121 (app exit proc API) implementation from Joe Mistachkin

5 files changed, 648 insertions, 13 deletions

diff --git a/generic/tcl.decls b/generic/tcl.decls
index 1e0edf4..084aed6 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.decls
@@ -11,7 +11,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 # 
-# RCS: @(#) $Id: tcl.decls,v 1.100 2003/09/05 21:52:11 dgp Exp $
+# RCS: @(#) $Id: tcl.decls,v 1.101 2003/09/29 21:38:49 dkf Exp $
 
 library tcl
 
@@ -1854,6 +1854,12 @@ declare 518 generic {
     int Tcl_FSEvalFileEx(Tcl_Interp *interp, Tcl_Obj *fileName,
             CONST char *encodingName)
 }
+
+# New export due to TIP#121
+declare 519 generic {
+    Tcl_ExitProc *Tcl_SetExitProc(Tcl_ExitProc *proc)
+}
+
 ##############################################################################
 
 # Define the platform specific public Tcl interface.  These functions are
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 8c1b739..71d0874 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -13,7 +13,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclBasic.c,v 1.87 2003/09/29 14:37:14 dkf Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.88 2003/09/29 21:38:49 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -384,6 +384,19 @@ Tcl_CreateInterp()
     iPtr->execEnvPtr = TclCreateExecEnv(interp);
 
     /*
+     * Initialise the resource limiting framework.
+     */
+
+    iPtr->limitCheckCounter = 0;
+    iPtr->limits = 0;
+    iPtr->timeGranularity = 0;
+    iPtr->timeLimit = 0;
+    iPtr->timeLimitHandlers = NULL;
+    iPtr->cmdcountGranularity = 0;
+    iPtr->cmdcountLimit = 0;
+    iPtr->cmdcountLimitHandlers = NULL;
+
+    /*
      * Initialize the compilation and execution statistics kept for this
      * interpreter.
      */
@@ -969,6 +982,7 @@ DeleteInterpProc(interp)
     Tcl_HashSearch search;
     Tcl_HashTable *hTablePtr;
     ResolverScheme *resPtr, *nextResPtr;
+    LimitHandler *lhPtr, *nextLhPtr;
 
     /*
      * Punt if there is an error in the Tcl_Release/Tcl_Preserve matchup.
@@ -990,6 +1004,26 @@ DeleteInterpProc(interp)
     TclHandleFree(iPtr->handle);
 
     /*
+     * Destroy any resource limiting handlers that this interpreter
+     * has; we're on our way out now, so failing because of resource
+     * limits now would be very silly indeed.
+     */
+
+    iPtr->limits = 0;
+    for (lhPtr=iPtr->timeLimitHandlers ; lhPtr!=NULL ; lhPtr=nextLhPtr) {
+	nextLhPtr = lhPtr->next;
+	Tcl_DecrRefCount(lhPtr->handlerObj);
+	lhPtr->handlerObj = NULL;
+	Tcl_EventuallyFree((char *) lhPtr, TCL_DYNAMIC);
+    }
+    for (lhPtr=iPtr->cmdcountLimitHandlers ; lhPtr!=NULL ; lhPtr=nextLhPtr) {
+	nextLhPtr = lhPtr->next;
+	Tcl_DecrRefCount(lhPtr->handlerObj);
+	lhPtr->handlerObj = NULL;
+	Tcl_EventuallyFree((char *) lhPtr, TCL_DYNAMIC);
+    }
+
+    /*
      * Dismantle everything in the global namespace except for the
      * "errorInfo" and "errorCode" variables. These remain until the
      * namespace is actually destroyed, in case any errors occur.
diff --git a/generic/tclEvent.c b/generic/tclEvent.c
index 003e5a2..3449db1 100644
--- a/generic/tclEvent.c
+++ b/generic/tclEvent.c
@@ -11,7 +11,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclEvent.c,v 1.29 2003/05/13 12:39:50 dkf Exp $
+ * RCS: @(#) $Id: tclEvent.c,v 1.30 2003/09/29 21:38:49 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -88,6 +88,14 @@ TCL_DECLARE_MUTEX(exitMutex)
 static int inFinalize = 0;
 static int subsystemsInitialized = 0;
 
+/*
+ * This variable contains the application wide exit handler.  It will be
+ * called by Tcl_Exit instead of the C-runtime exit if this variable is set
+ * to a non-NULL value.
+ */
+
+static Tcl_ExitProc *appExitPtr = NULL;
+
 typedef struct ThreadSpecificData {
     ExitHandler *firstExitPtr;  /* First in list of all exit handlers for
 				 * this thread. */
@@ -542,6 +550,44 @@ Tcl_DeleteThreadExitHandler(proc, clientData)
 /*
  *----------------------------------------------------------------------
  *
+ * Tcl_SetExitProc --
+ *
+ *	This procedure sets the application wide exit handler that
+ *	will be called by Tcl_Exit in place of the C-runtime exit.  If
+ *	the application wide exit handler is NULL, the C-runtime exit
+ *	will be used instead.
+ *
+ * Results:
+ *	The previously set application wide exit handler.
+ *
+ * Side effects:
+ *	Sets the application wide exit handler to the specified value.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_ExitProc *
+Tcl_SetExitProc(proc)
+    Tcl_ExitProc *proc; /* new exit handler for app or NULL */
+{
+    Tcl_ExitProc *prevExitProc;
+
+    /*
+     * Swap the old exit proc for the new one, saving the old one for
+     * our return value.
+     */
+
+    Tcl_MutexLock(&exitMutex);
+    prevExitProc = appExitPtr;
+    appExitPtr = proc;
+    Tcl_MutexUnlock(&exitMutex);
+
+    return prevExitProc;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * Tcl_Exit --
  *
  *	This procedure is called to terminate the application.
@@ -561,8 +607,26 @@ Tcl_Exit(status)
     int status;			/* Exit status for application;  typically
 				 * 0 for normal return, 1 for error return. */
 {
-    Tcl_Finalize();
-    TclpExit(status);
+    Tcl_ExitProc *currentAppExitPtr;
+
+    Tcl_MutexLock(&exitMutex);
+    currentAppExitPtr = appExitPtr;
+    Tcl_MutexUnlock(&exitMutex);
+
+    if (currentAppExitPtr) {
+	/*
+	 * Warning: this code SHOULD NOT return, as there is code that
+	 * depends on Tcl_Exit never returning.  In fact, we will
+	 * panic if anyone returns, so critical is this dependcy.
+	 */
+	currentAppExitPtr((ClientData) status);
+	Tcl_Panic("AppExitProc returned unexpectedly");
+    } else {
+	/* use default handling */
+	Tcl_Finalize();
+	TclpExit(status);
+	Tcl_Panic("OS exit failed!");
+    }
 }
 
 /*
diff --git a/generic/tclInt.h b/generic/tclInt.h
index d60429b..acf4ae5 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.133 2003/09/29 14:37:14 dkf Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.134 2003/09/29 21:38:49 dkf Exp $
  */
 
 #ifndef _TCLINT
@@ -1094,6 +1094,14 @@ typedef struct Command {
 #define CMD_HAS_EXEC_TRACES	0x4
 
 /*
+ * Flag bits for saying what limits are enabled on an interpreter, as
+ * defined in TIP #143.
+ */
+
+#define LIMIT_COMMAND_COUNTS	0x1
+#define LIMIT_WALL_TIME		0x2
+
+/*
  *----------------------------------------------------------------
  * Data structures related to name resolution procedures.
  *----------------------------------------------------------------
@@ -1127,6 +1135,21 @@ typedef struct ResolverScheme {
 
 /*
  *----------------------------------------------------------------
+ * This structure defines a list of interpreter/handler script pairs
+ * that will be called when a particular limit is exceeded in some
+ * interpreter.
+ *----------------------------------------------------------------
+ */
+
+typedef struct LimitHandler {
+    Tcl_Interp *interp;		/* Which interpreter to execute the handler
+				 * in. */
+    Tcl_Obj *handlerObj;	/* The handler script itself. */
+    struct LimitHandler *next;	/* Pointer to next handler in linked list. */
+} LimitHandler;
+
+/*
+ *----------------------------------------------------------------
  * This structure defines an interpreter, which is a collection of
  * commands plus other state information related to interpreting
  * commands, such as variable storage. Primary responsibility for
@@ -1325,6 +1348,26 @@ typedef struct Interp {
     Tcl_Obj *returnOptionsKey;	/* holds "-options" */
 
     /*
+     * Resource limit control fields (TIP #143)
+     */
+
+    long limitCheckCounter;	/* Counter used to constrain the frequency
+				 * of limit checks. */
+    int  limits;		/* Which limits are to be checked. */
+    long timeGranularity;	/* Modulus for the limit check counter to
+				 * determine when to apply the time limit
+				 * checks. */
+    long timeLimit;		/* When the time limit expires. */
+    LimitHandler *timeLimitHandlers;
+				/* Linked list of time limit handlers. */
+    long cmdcountGranularity;	/* As with timeLimitGranularity except
+				 * for being for command count limits. */
+    int  cmdcountLimit;		/* The maximum number of commands that this
+				 * interpreter may execute. */
+    LimitHandler *cmdcountLimitHandlers;
+				/* Linked list of cmdcount limit handlers. */
+
+    /*
      * Statistical information about the bytecode compiler and interpreter's
      * operation.
      */
diff --git a/generic/tclInterp.c b/generic/tclInterp.c
index 8159855..524529f 100644
--- a/generic/tclInterp.c
+++ b/generic/tclInterp.c
@@ -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: tclInterp.c,v 1.22 2003/05/12 22:44:24 dgp Exp $
+ * RCS: @(#) $Id: tclInterp.c,v 1.23 2003/09/29 21:38:49 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -146,6 +146,13 @@ typedef struct InterpInfo {
 } InterpInfo;
 
 /*
+ * Default granularities for various limits.
+ */
+
+#define DEFAULT_CMDCOUNT_GRANULARITY	100
+#define DEFAULT_TIME_GRANULARITY	1000
+
+/*
  * Prototypes for local static procedures:
  */
 
@@ -358,17 +365,17 @@ Tcl_InterpObjCmd(clientData, interp, objc, objv)
     static CONST char *options[] = {
         "alias",	"aliases",	"create",	"delete", 
 	"eval",		"exists",	"expose",	"hide", 
-	"hidden",	"issafe",	"invokehidden",	"marktrusted", 
-	"recursionlimit",		"slaves",	"share",
-	"target",	"transfer",
+	"hidden",	"issafe",	"invokehidden",	"limit",
+	"marktrusted",	"recursionlimit",		"slaves",
+	"share",	"target",	"transfer",
         NULL
     };
     enum option {
 	OPT_ALIAS,	OPT_ALIASES,	OPT_CREATE,	OPT_DELETE,
 	OPT_EVAL,	OPT_EXISTS,	OPT_EXPOSE,	OPT_HIDE,
-	OPT_HIDDEN,	OPT_ISSAFE,	OPT_INVOKEHID,	OPT_MARKTRUSTED,
-	OPT_RECLIMIT,			OPT_SLAVES,	OPT_SHARE,
-	OPT_TARGET,	OPT_TRANSFER
+	OPT_HIDDEN,	OPT_ISSAFE,	OPT_INVOKEHID,	OPT_LIMIT,
+	OPT_MARKTRUSTED,		OPT_RECLIMIT,	OPT_SLAVES,
+	OPT_SHARE,	OPT_TARGET,	OPT_TRANSFER
     };
 
 
@@ -772,6 +779,47 @@ Tcl_InterpObjCmd(clientData, interp, objc, objv)
 	    }
 	    return TCL_OK;
 	}
+	case OPT_LIMIT: {
+	    static CONST char *limits[] = {
+		"command", "time", NULL
+	    };
+	    enum LimitTypes {
+		LIMIT_CMD, LIMIT_TIME
+	    };
+	    Tcl_Interp *limitedInterp;
+
+	    if (objc < 4 || (objc & 1 && objc > 5)) {
+		Tcl_WrongNumArgs(interp, 2, objv, "path type ?opt? ?val? ...");
+		return TCL_ERROR;
+	    }
+	    limitedInterp = GetInterp(interp, objv[2]);
+	    if (limitedInterp == NULL) {
+		return TCL_ERROR;
+	    }
+	    if (Tcl_GetIndexFromObj(interp, objv[3], limits, "limit-type", 0,
+		    &index) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    switch ((enum LimitTypes) index) {
+	    case LIMIT_CMD:
+		if (objc == 4) {
+		    return ReadLimitCmdCount(interp, limitedInterp, NULL);
+		} else if (objc == 5) {
+		    return ReadLimitCmdCount(interp, limitedInterp, objv[4]);
+		} else {
+		    return SetLimitCmdCount(interp, limitedInterp,
+			    objc-4, objv+4);
+		}
+	    case LIMIT_TIME:
+		if (objc == 4) {
+		    return ReadLimitTime(interp, limitedInterp, NULL);
+		} else if (objc == 5) {
+		    return ReadLimitTime(interp, limitedInterp, objv[4]);
+		} else {
+		    return SetLimitTime(interp, limitedInterp, objc-4, objv+4);
+		}
+	    }
+	}
     }
     return TCL_OK;
 }
@@ -1809,6 +1857,18 @@ SlaveCreate(interp, pathPtr, safe)
     }
 
     slaveInterp = Tcl_CreateInterp();
+    if (((Interp *) masterInterp)->limits & LIMIT_COMMAND_COUNT) {
+	Interp *sPtr = (Interp *) slaveInterp;
+	sPtr->limits |= LIMIT_COMMAND_COUNT;
+	sPtr->cmdcountGranularity = DEFAULT_CMDCOUNT_GRANULARITY;
+	sPtr->cmdcountLimit = 0;
+    }
+    if (((Interp *) masterInterp)->limits & LIMIT_WALL_TIME) {
+	Interp *sPtr = (Interp *) slaveInterp;
+	sPtr->limits |= LIMIT_WALL_TIME;
+	sPtr->timeGranularity = DEFAULT_TIME_GRANULARITY;
+	sPtr->timeLimit = ((Interp *) masterInterp)->timeLimit;
+    }
     slavePtr = &((InterpInfo *) ((Interp *) slaveInterp)->interpInfo)->slave;
     slavePtr->masterInterp = masterInterp;
     slavePtr->slaveEntryPtr = hPtr;
@@ -2007,6 +2067,42 @@ SlaveObjCmd(clientData, interp, objc, objv)
 	    }
 	    return SlaveRecursionLimit(interp, slaveInterp, objc - 2, objv + 2);
 	}
+	case OPT_LIMIT: {
+	    static CONST char *limits[] = {
+		"command", "time", NULL
+	    };
+	    enum LimitTypes {
+		LIMIT_CMD, LIMIT_TIME
+	    };
+
+	    if (objc < 3 || (objc > 4 && !(objc & 1))) {
+		Tcl_WrongNumArgs(interp, 2, objv, "type ?opt? ?val? ...");
+		return TCL_ERROR;
+	    }
+	    if (Tcl_GetIndexFromObj(interp, objv[2], limits, "limit-type", 0,
+		    &index) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    switch ((enum LimitTypes) index) {
+	    case LIMIT_CMD:
+		if (objc == 4) {
+		    return ReadLimitCmdCount(interp, slaveInterp, NULL);
+		} else if (objc == 5) {
+		    return ReadLimitCmdCount(interp, slaveInterp, objv[3]);
+		} else {
+		    return SetLimitCmdCount(interp, slaveInterp,
+			    objc-3, objv+3);
+		}
+	    case LIMIT_TIME:
+		if (objc == 4) {
+		    return ReadLimitTime(interp, slaveInterp, NULL);
+		} else if (objc == 5) {
+		    return ReadLimitTime(interp, slaveInterp, objv[3]);
+		} else {
+		    return SetLimitTime(interp, slaveInterp, objc-3, objv+3);
+		}
+	    }
+	}
     }
 
     return TCL_ERROR;
@@ -2487,3 +2583,395 @@ Tcl_MakeSafe(interp)
 
     return TCL_OK;
 }
+
+static CONST char *limitOpts[] = {
+    "-command", "-granularity", "-value", NULL
+};
+enum LimitOpts {
+    LIM_CMD, LIM_GRAN, LIM_VAL
+};
+
+static int
+ReadLimitCmdCount(interp, targetInterp, propertyName)
+    Tcl_Interp *interp, *targetInterp;
+    Tcl_Obj *propertyName;
+{
+    Interp *tPtr = (Interp *) targetInterp;
+
+    if (propertyName == NULL) {
+	Tcl_Obj *resultObj, *emptyObj;
+	int limited = tPtr->limits & LIMIT_COMMAND_COUNT;
+
+	/*
+	 * We do not know how many times we will need the emptyObj;
+	 * could be zero to three times.
+	 */
+
+	TclNewObj(resultObj);
+	TclNewObj(emptyObj);
+	Tcl_IncrRefCount(emptyObj);
+
+	if (limited) {
+	    LimitHandler *lh = tPtr->cmdcountLimitHandlers;
+	    for (; lh!=NULL ; lh=lh->next) {
+		if (lh->interp == interp) {
+		    break;
+		}
+	    }
+	    Tcl_DictObjPut(NULL, resultObj, Tcl_NewStringObj(limitOpts[0], -1),
+		    lh ? lh->handlerObj : emptyObj);
+	} else {
+	    Tcl_DictObjPut(NULL, resultObj, Tcl_NewStringObj(limitOpts[0], -1),
+		    emptyObj);
+	}
+	Tcl_DictObjPut(NULL, resultObj, Tcl_NewStringObj(limitOpts[1], -1),
+		limited? Tcl_NewLongObj(tPtr->cmdcountGranularity) : emptyObj);
+	Tcl_DictObjPut(NULL, resultObj, Tcl_NewStringObj(limitOpts[2], -1),
+		limited? Tcl_NewIntObj(tPtr->cmdcountLimit) : emptyObj);
+
+	Tcl_DecrRefCount(emptyObj);
+	Tcl_SetObjResult(interp, resultObj);
+	return TCL_OK;
+    } else {
+	int index;
+
+	if (Tcl_GetIndexFromObj(interp, propertyName, limitOpts, "option", 0,
+		&index) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	if (!(tPtr->limits & LIMIT_COMMAND_COUNT)) {
+	    return TCL_OK;
+	}
+
+	switch ((enum LimitOpts) index) {
+	case LIM_CMD: {
+	    LimitHandler *lh = tPtr->cmdcountLimitHandlers;
+	    for (; lh!=NULL ; lh=lh->next) {
+		if (lh->interp == interp) {
+		    Tcl_SetObjResult(interp, lh->handlerObj);
+		    break;
+		}
+	    }
+	    break;
+	}
+	case LIM_GRAN:
+	    Tcl_SetObjResult(Tcl_NewLongObj(tPtr->cmdcountGranularity));
+	    break;
+	case LIM_VAL:
+	    Tcl_SetObjResult(Tcl_NewIntObj(tPtr->cmdcountLimit));
+	    break;
+	}
+	return TCL_OK;
+    }
+}
+
+static int
+SetLimitCmdCount(interp, targetInterp, objc, objv)
+    Tcl_Interp *interp, *targetInterp;
+    int objc;
+    Tcl_Obj *CONST objv[];
+{
+    Interp *tPtr = (Interp *) targetInterp;
+    int i, index, value, setFlag;
+    long gran;
+    Tcl_Obj *newCmd, *newGran, *newVal;
+    LimitHandler *lh, *lh2;
+
+    /*
+     * Parse the options to set.
+     */
+
+    newCmd = newGran = newVal = NULL;
+    setFlag = 1;
+    for (i=0 ; i<objc ; i+=2) {
+	if (Tcl_GetIndexFromObj(interp, objv[i], limitOpts, "option", 0,
+		&index) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	switch ((enum LimitOpts) index) {
+	case LIM_CMD:
+	    newCmd = objv[i+1];
+	    break;
+	case LIM_GRAN:
+	    if (Tcl_GetLongFromObj(interp, objv[i+1], &gran) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    if (gran < 1) {
+		Tcl_AppendResult(interp,"granularities must be positive",NULL);
+		return TCL_ERROR;
+	    }
+	    newGran = objv[i+1];
+	    break;
+	case LIM_VAL:
+	    /*
+	     * If we have these numeric types, we know that we will
+	     * not have an empty string rep.
+	     */
+	    if (objv[i+1]->typePtr != &tclIntType &&
+		    objv[i+1]->typePtr != &tclDoubleType &&
+		    objv[i+1]->typePtr != &tclWideIntType) {
+		Tcl_GetString(objv[i+1]);
+		setFlag = (objv[i+1]->length > 0);
+	    }
+	    if (Tcl_GetIntFromObj(interp, objv[i+1], &value) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    newVal = objv[i+1];
+	    break;
+	}
+    }
+
+    if (!setFlag) {
+	/*
+	 * Remove limit on interpreter.
+	 */
+	tPtr->limits &= ~LIMIT_COMMAND_COUNTS;
+	for (lh=tPtr->cmdcountLimitHandlers ; lh!=NULL ; lh=lh2) {
+	    lh2 = lh->next;
+	    Tcl_DecrRefCount(lh->handlerObj);
+	    Tcl_EventuallyFree(lh, TCL_DYNAMIC);
+	}
+	tPtr->cmdcountLimitHandlers = NULL;
+    } else if (tPtr->limits & LIMIT_COMMAND_COUNTS) {
+	/*
+	 * Modify limit on interpreter.
+	 */
+
+	if (newGran != NULL) {
+	    tPtr->cmdcountGranularity = gran;
+	}
+	if (newVal != NULL) {
+	    tPtr->cmdcountLimit = value;
+	}
+	if (newCmd != NULL) {
+	    for (lh=tPtr->cmdcountLimitHandlers ; lh!=NULL ; lh=lh->next) {
+		if (lh->interp == interp) {
+		    break;
+		}
+	    }
+	    if (lh == NULL) {
+		lh = (LimitHandler *) ckalloc(sizeof(LimitHandler));
+		lh->interp = interp;
+		lh->next = tPtr->cmdcountLimitHandlers;
+		tPtr->cmdcountLimitHandlers = lh;
+	    } else {
+		Tcl_DecrRefCount(lh->handlerObj);
+	    }
+	    lh->handlerObj = newCmd;
+	    Tcl_IncrRefCount(newCmd);
+	}
+    } else {
+	/*
+	 * Install limit on interpreter; value must have been set.
+	 */
+
+	if (newGran == NULL) {
+	    gran = DEFAULT_CMDCOUNT_GRANULARITY;
+	}
+	tPtr->limits |= LIMIT_COMMAND_COUNTS;
+	tPtr->cmdcountGranularity = gran;
+	tPtr->cmdcountValue = value;
+	if (newCmd != NULL) {
+	    lh = (LimitHandler *) ckalloc(sizeof(LimitHandler));
+	    lh->interp = interp;
+	    lh->handlerObj = newCmd;
+	    Tcl_IncrRefCount(newCmd);
+	    lh->next = NULL;
+	    tPtr->cmdcountLimitHandlers = lh;
+	}
+    }
+
+    return TCL_OK;
+}
+
+static int
+ReadLimitTime(interp, targetInterp, propertyName)
+    Tcl_Interp *interp, *targetInterp;
+    Tcl_Obj *propertyName;
+{
+    Interp *tPtr = (Interp *) targetInterp;
+
+    if (propertyName == NULL) {
+	Tcl_Obj *resultObj, *emptyObj;
+	int limited = tPtr->limits & LIMIT_COMMAND_COUNT;
+
+	/*
+	 * We do not know how many times we will need the emptyObj;
+	 * could be zero to three times.
+	 */
+
+	TclNewObj(resultObj);
+	TclNewObj(emptyObj);
+	Tcl_IncrRefCount(emptyObj);
+
+	if (limited) {
+	    LimitHandler *lh = tPtr->timeLimitHandlers;
+	    for (; lh!=NULL ; lh=lh->next) {
+		if (lh->interp == interp) {
+		    break;
+		}
+	    }
+	    Tcl_DictObjPut(NULL, resultObj, Tcl_NewStringObj(limitOpts[0], -1),
+		    lh ? lh->handlerObj : emptyObj);
+	} else {
+	    Tcl_DictObjPut(NULL, resultObj, Tcl_NewStringObj(limitOpts[0], -1),
+		    emptyObj);
+	}
+	Tcl_DictObjPut(NULL, resultObj, Tcl_NewStringObj(limitOpts[1], -1),
+		limited ? Tcl_NewLongObj(tPtr->timeGranularity) : emptyObj);
+	Tcl_DictObjPut(NULL, resultObj, Tcl_NewStringObj(limitOpts[2], -1),
+		limited ? Tcl_NewIntObj(tPtr->timeLimit) : emptyObj);
+
+	Tcl_DecrRefCount(emptyObj);
+	Tcl_SetObjResult(interp, resultObj);
+	return TCL_OK;
+    } else {
+	int index;
+
+	if (Tcl_GetIndexFromObj(interp, propertyName, limitOpts, "option", 0,
+		&index) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	if (!(tPtr->limits & LIMIT_COMMAND_COUNT)) {
+	    return TCL_OK;
+	}
+	switch ((enum LimitOpts) index) {
+	case LIM_CMD: {
+	    LimitHandler *lh = tPtr->timeLimitHandlers;
+	    for (; lh!=NULL ; lh=lh->next) {
+		if (lh->interp == interp) {
+		    Tcl_SetObjResult(interp, lh->handlerObj);
+		    break;
+		}
+	    }
+	    break;
+	}
+	case LIM_GRAN:
+	    Tcl_SetObjResult(Tcl_NewLongObj(tPtr->timeGranularity));
+	    break;
+	case LIM_VAL:
+	    Tcl_SetObjResult(Tcl_NewIntObj(tPtr->timeLimit));
+	    break;
+	}
+	return TCL_OK;
+    }
+}
+
+static int
+SetLimitTime(interp, targetInterp, objc, objv)
+    Tcl_Interp *interp, *targetInterp;
+    int objc;
+    Tcl_Obj *CONST objv[];
+{
+    Interp *tPtr = (Interp *) targetInterp;
+    int i, index, value, setFlag;
+    long gran;
+    Tcl_Obj *newCmd, *newGran, *newVal;
+    LimitHandler *lh, *lh2;
+
+    /*
+     * Parse the options to set.
+     */
+
+    newCmd = newGran = newVal = NULL;
+    setFlag = 1;
+    for (i=0 ; i<objc ; i+=2) {
+	if (Tcl_GetIndexFromObj(interp, objv[i], limitOpts, "option", 0,
+		&index) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	switch ((enum LimitOpts) index) {
+	case LIM_CMD:
+	    newCmd = objv[i+1];
+	    break;
+	case LIM_GRAN:
+	    if (Tcl_GetLongFromObj(interp, objv[i+1], &gran) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    if (gran < 1) {
+		Tcl_AppendResult(interp,"granularities must be positive",NULL);
+		return TCL_ERROR;
+	    }
+	    newGran = objv[i+1];
+	    break;
+	case LIM_VAL:
+	    /*
+	     * If we have these numeric types, we know that we will
+	     * not have an empty string rep.
+	     */
+	    if (objv[i+1]->typePtr != &tclIntType &&
+		    objv[i+1]->typePtr != &tclDoubleType &&
+		    objv[i+1]->typePtr != &tclWideIntType) {
+		Tcl_GetString(objv[i+1]);
+		setFlag = (objv[i+1]->length > 0);
+	    }
+	    if (Tcl_GetIntFromObj(interp, objv[i+1], &value) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    newVal = objv[i+1];
+	    break;
+	}
+    }
+
+    if (!setFlag) {
+	/*
+	 * Remove limit on interpreter.
+	 */
+	tPtr->limits &= ~LIMIT_COMMAND_COUNTS;
+	for (lh=tPtr->timeLimitHandlers ; lh!=NULL ; lh=lh2) {
+	    lh2 = lh->next;
+	    Tcl_DecrRefCount(lh->handlerObj);
+	    Tcl_EventuallyFree(lh, TCL_DYNAMIC);
+	}
+	tPtr->timeLimitHandlers = NULL;
+    } else if (tPtr->limits & LIMIT_COMMAND_COUNTS) {
+	/*
+	 * Modify limit on interpreter.
+	 */
+
+	if (newGran != NULL) {
+	    tPtr->timeGranularity = gran;
+	}
+	if (newVal != NULL) {
+	    tPtr->timeLimit = value;
+	}
+	if (newCmd != NULL) {
+	    for (lh=tPtr->timeLimitHandlers ; lh!=NULL ; lh=lh->next) {
+		if (lh->interp == interp) {
+		    break;
+		}
+	    }
+	    if (lh == NULL) {
+		lh = (LimitHandler *) ckalloc(sizeof(LimitHandler));
+		lh->interp = interp;
+		lh->next = tPtr->timeLimitHandlers;
+		tPtr->timeLimitHandlers = lh;
+	    } else {
+		Tcl_DecrRefCount(lh->handlerObj);
+	    }
+	    lh->handlerObj = newCmd;
+	    Tcl_IncrRefCount(newCmd);
+	}
+    } else {
+	/*
+	 * Install limit on interpreter; value must have been set.
+	 */
+
+	if (newGran == NULL) {
+	    gran = DEFAULT_TIME_GRANULARITY;
+	}
+	tPtr->limits |= LIMIT_COMMAND_COUNTS;
+	tPtr->timeGranularity = gran;
+	tPtr->timeValue = value;
+	if (newCmd != NULL) {
+	    lh = (LimitHandler *) ckalloc(sizeof(LimitHandler));
+	    lh->interp = interp;
+	    lh->handlerObj = newCmd;
+	    Tcl_IncrRefCount(newCmd);
+	    lh->next = NULL;
+	    tPtr->timeLimitHandlers = lh;
+	}
+    }
+
+    return TCL_OK;
+}