summaryrefslogtreecommitdiffstats
path: root/generic/tclInterp.c
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2003-09-29 22:11:11 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2003-09-29 22:11:11 (GMT)
commitc6d77be71d20d811ddf04702ae5fd428aa7e0b47 (patch)
tree00bd31e960602c00bfa4453916cb6aceeac13640 /generic/tclInterp.c
parentae8b2781ec0977262031b44204398025d09efb74 (diff)
downloadtcl-c6d77be71d20d811ddf04702ae5fd428aa7e0b47.zip
tcl-c6d77be71d20d811ddf04702ae5fd428aa7e0b47.tar.gz
tcl-c6d77be71d20d811ddf04702ae5fd428aa7e0b47.tar.bz2
Undo mistaken commit of work-in-progress
Diffstat (limited to 'generic/tclInterp.c')
-rw-r--r--generic/tclInterp.c502
1 files changed, 7 insertions, 495 deletions
diff --git a/generic/tclInterp.c b/generic/tclInterp.c
index 524529f..2333907 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.23 2003/09/29 21:38:49 dkf Exp $
+ * RCS: @(#) $Id: tclInterp.c,v 1.24 2003/09/29 22:11:11 dkf Exp $
*/
#include "tclInt.h"
@@ -146,13 +146,6 @@ typedef struct InterpInfo {
} InterpInfo;
/*
- * Default granularities for various limits.
- */
-
-#define DEFAULT_CMDCOUNT_GRANULARITY 100
-#define DEFAULT_TIME_GRANULARITY 1000
-
-/*
* Prototypes for local static procedures:
*/
@@ -365,17 +358,17 @@ Tcl_InterpObjCmd(clientData, interp, objc, objv)
static CONST char *options[] = {
"alias", "aliases", "create", "delete",
"eval", "exists", "expose", "hide",
- "hidden", "issafe", "invokehidden", "limit",
- "marktrusted", "recursionlimit", "slaves",
- "share", "target", "transfer",
+ "hidden", "issafe", "invokehidden", "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_LIMIT,
- OPT_MARKTRUSTED, OPT_RECLIMIT, OPT_SLAVES,
- OPT_SHARE, OPT_TARGET, OPT_TRANSFER
+ OPT_HIDDEN, OPT_ISSAFE, OPT_INVOKEHID, OPT_MARKTRUSTED,
+ OPT_RECLIMIT, OPT_SLAVES, OPT_SHARE,
+ OPT_TARGET, OPT_TRANSFER
};
@@ -779,47 +772,6 @@ 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;
}
@@ -1857,18 +1809,6 @@ 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;
@@ -2067,42 +2007,6 @@ 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;
@@ -2583,395 +2487,3 @@ 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;
-}