summaryrefslogtreecommitdiffstats
path: root/generic/tclInterp.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclInterp.c')
-rw-r--r--generic/tclInterp.c101
1 files changed, 56 insertions, 45 deletions
diff --git a/generic/tclInterp.c b/generic/tclInterp.c
index e590775..adf113d 100644
--- a/generic/tclInterp.c
+++ b/generic/tclInterp.c
@@ -25,14 +25,14 @@ static const char *tclPreInitScript = NULL;
struct Target;
/*
- * struct Alias:
+ * Alias:
*
* Stores information about an alias. Is stored in the child interpreter and
* used by the source command to find the target command in the parent when
* the source command is invoked.
*/
-typedef struct Alias {
+typedef struct {
Tcl_Obj *token; /* Token for the alias command in the child
* interp. This used to be the command name in
* the child when the alias was first
@@ -66,14 +66,14 @@ typedef struct Alias {
/*
*
- * struct Child:
+ * Child:
*
* Used by the "interp" command to record and find information about child
* interpreters. Maps from a command name in the parent to information about a
* child interpreter, e.g. what aliases are defined in it.
*/
-typedef struct Child {
+typedef struct {
Tcl_Interp *parentInterp; /* Parent interpreter for this child. */
Tcl_HashEntry *childEntryPtr;
/* Hash entry in parents child table for this
@@ -112,7 +112,7 @@ typedef struct Target {
} Target;
/*
- * struct Parent:
+ * Parent:
*
* This record is used for two purposes: First, childTable (a hashtable) maps
* from names of commands to child interpreters. This hashtable is used to
@@ -127,7 +127,7 @@ typedef struct Target {
* only load safe extensions.
*/
-typedef struct Parent {
+typedef struct {
Tcl_HashTable childTable; /* Hash table for child interpreters. Maps
* from command names to Child records. */
Target *targetsPtr; /* The head of a doubly-linked list of all the
@@ -144,7 +144,7 @@ typedef struct Parent {
* on a per-interp basis.
*/
-typedef struct InterpInfo {
+typedef struct {
Parent parent; /* Keeps track of all interps for which this
* interp is the Parent. */
Child child; /* Information necessary for this interp to
@@ -158,7 +158,7 @@ typedef struct InterpInfo {
* likely to work properly on 64-bit architectures.
*/
-typedef struct ScriptLimitCallback {
+typedef struct {
Tcl_Interp *interp; /* The interpreter in which to execute the
* callback. */
Tcl_Obj *scriptObj; /* The script to execute to perform the
@@ -171,7 +171,7 @@ typedef struct ScriptLimitCallback {
* table. */
} ScriptLimitCallback;
-typedef struct ScriptLimitCallbackKey {
+typedef struct {
Tcl_Interp *interp; /* The interpreter that the limit callback was
* attached to. This is not the interpreter
* that the callback runs in! */
@@ -482,7 +482,7 @@ TclInterpInit(
Parent *parentPtr;
Child *childPtr;
- interpInfoPtr = (InterpInfo *)ckalloc(sizeof(InterpInfo));
+ interpInfoPtr = (InterpInfo *)Tcl_Alloc(sizeof(InterpInfo));
((Interp *) interp)->interpInfo = interpInfoPtr;
parentPtr = &interpInfoPtr->parent;
@@ -579,7 +579,7 @@ InterpInfoDeleteProc(
}
Tcl_DeleteHashTable(&childPtr->aliasTable);
- ckfree(interpInfoPtr);
+ Tcl_Free(interpInfoPtr);
}
/*
@@ -624,8 +624,11 @@ NRInterpCmd(
"eval", "exists", "expose", "hide",
"hidden", "issafe", "invokehidden",
"limit", "marktrusted", "recursionlimit",
- "share", "slaves", "target", "transfer",
- NULL
+ "share",
+#ifndef TCL_NO_DEPRECATED
+ "slaves",
+#endif
+ "target", "transfer", NULL
};
static const char *const optionsNoSlaves[] = {
"alias", "aliases", "bgerror", "cancel",
@@ -633,15 +636,19 @@ NRInterpCmd(
"eval", "exists", "expose",
"hide", "hidden", "issafe",
"invokehidden", "limit", "marktrusted", "recursionlimit",
- "share", "target", "transfer", NULL
+ "share", "target", "transfer",
+ NULL
};
enum interpOptionEnum {
OPT_ALIAS, OPT_ALIASES, OPT_BGERROR, OPT_CANCEL,
OPT_CHILDREN, OPT_CREATE, OPT_DEBUG, OPT_DELETE,
OPT_EVAL, OPT_EXISTS, OPT_EXPOSE, OPT_HIDE,
OPT_HIDDEN, OPT_ISSAFE, OPT_INVOKEHID,
- OPT_LIMIT, OPT_MARKTRUSTED,OPT_RECLIMIT,
- OPT_SHARE, OPT_SLAVES, OPT_TARGET, OPT_TRANSFER
+ OPT_LIMIT, OPT_MARKTRUSTED, OPT_RECLIMIT, OPT_SHARE,
+#ifndef TCL_NO_DEPRECATED
+ OPT_SLAVES,
+#endif
+ OPT_TARGET, OPT_TRANSFER
};
if (objc < 2) {
@@ -794,7 +801,7 @@ NRInterpCmd(
childPtr = NULL;
last = 0;
for (i = 2; i < objc; i++) {
- if ((last == 0) && (Tcl_GetString(objv[i])[0] == '-')) {
+ if ((last == 0) && (TclGetString(objv[i])[0] == '-')) {
if (Tcl_GetIndexFromObj(interp, objv[i], createOptions,
"option", 0, &index) != TCL_OK) {
return TCL_ERROR;
@@ -1028,8 +1035,10 @@ NRInterpCmd(
return TCL_ERROR;
}
return ChildRecursionLimit(interp, childInterp, objc - 3, objv + 3);
- case OPT_CHILDREN:
- case OPT_SLAVES: {
+#ifndef TCL_NO_DEPRECATED
+ case OPT_SLAVES:
+#endif
+ case OPT_CHILDREN: {
InterpInfo *iiPtr;
Tcl_Obj *resultPtr;
Tcl_HashEntry *hPtr;
@@ -1110,7 +1119,7 @@ NRInterpCmd(
if (hPtr == NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"alias \"%s\" in path \"%s\" not found",
- aliasName, Tcl_GetString(objv[2])));
+ aliasName, TclGetString(objv[2])));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ALIAS", aliasName,
NULL);
return TCL_ERROR;
@@ -1119,7 +1128,7 @@ NRInterpCmd(
if (Tcl_GetInterpPath(interp, aliasPtr->targetInterp) != TCL_OK) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"target interpreter for alias \"%s\" in path \"%s\" is "
- "not my descendant", aliasName, Tcl_GetString(objv[2])));
+ "not my descendant", aliasName, TclGetString(objv[2])));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
"TARGETSHROUDED", NULL);
return TCL_ERROR;
@@ -1319,7 +1328,7 @@ Tcl_GetAlias(
}
if (argvPtr != NULL) {
*argvPtr = (const char **)
- ckalloc(sizeof(const char *) * (objc - 1));
+ Tcl_Alloc(sizeof(const char *) * (objc - 1));
for (i = 1; i < objc; i++) {
(*argvPtr)[i - 1] = TclGetString(objv[i]);
}
@@ -1525,7 +1534,7 @@ AliasCreate(
Tcl_Obj **prefv;
int isNew, i;
- aliasPtr = (Alias *)ckalloc(sizeof(Alias) + objc * sizeof(Tcl_Obj *));
+ aliasPtr = (Alias *)Tcl_Alloc(sizeof(Alias) + objc * sizeof(Tcl_Obj *));
aliasPtr->token = namePtr;
Tcl_IncrRefCount(aliasPtr->token);
aliasPtr->targetInterp = parentInterp;
@@ -1576,7 +1585,7 @@ AliasCreate(
cmdPtr->deleteData = NULL;
Tcl_DeleteCommandFromToken(childInterp, aliasPtr->childCmd);
- ckfree(aliasPtr);
+ Tcl_Free(aliasPtr);
/*
* The result was already set by TclPreventAliasLoop.
@@ -1633,7 +1642,7 @@ AliasCreate(
* interp alias {} foo {} zop # Now recreate "foo"...
*/
- targetPtr = (Target *)ckalloc(sizeof(Target));
+ targetPtr = (Target *)Tcl_Alloc(sizeof(Target));
targetPtr->childCmd = aliasPtr->childCmd;
targetPtr->childInterp = childInterp;
@@ -1735,7 +1744,7 @@ AliasDescribe(
*/
childPtr = &((InterpInfo *) ((Interp *) childInterp)->interpInfo)->child;
- hPtr = Tcl_FindHashEntry(&childPtr->aliasTable, Tcl_GetString(namePtr));
+ hPtr = Tcl_FindHashEntry(&childPtr->aliasTable, TclGetString(namePtr));
if (hPtr == NULL) {
return TCL_OK;
}
@@ -1840,8 +1849,8 @@ AliasNRCmd(
cmdv = &listRep->elements;
prefv = &aliasPtr->objPtr;
- memcpy(cmdv, prefv, prefc * sizeof(Tcl_Obj *));
- memcpy(cmdv+prefc, objv+1, (objc-1) * sizeof(Tcl_Obj *));
+ memcpy(cmdv, prefv, (prefc * sizeof(Tcl_Obj *)));
+ memcpy(cmdv+prefc, objv+1, ((objc-1) * sizeof(Tcl_Obj *)));
for (i=0; i<cmdc; i++) {
Tcl_IncrRefCount(cmdv[i]);
@@ -2068,8 +2077,8 @@ AliasObjCmdDeleteProc(
targetPtr->nextPtr->prevPtr = targetPtr->prevPtr;
}
- ckfree(targetPtr);
- ckfree(aliasPtr);
+ Tcl_Free(targetPtr);
+ Tcl_Free(aliasPtr);
}
/*
@@ -3571,7 +3580,7 @@ RunLimitHandlers(
if (handlerPtr->deleteProc != NULL) {
handlerPtr->deleteProc(handlerPtr->clientData);
}
- ckfree(handlerPtr);
+ Tcl_Free(handlerPtr);
}
}
}
@@ -3608,14 +3617,14 @@ Tcl_LimitAddHandler(
*/
if (deleteProc == (Tcl_LimitHandlerDeleteProc *) TCL_DYNAMIC) {
- deleteProc = (Tcl_LimitHandlerDeleteProc *) Tcl_Free;
+ deleteProc = (Tcl_LimitHandlerDeleteProc *) TclpFree;
}
/*
* Allocate a handler record.
*/
- handlerPtr = (LimitHandler *)ckalloc(sizeof(LimitHandler));
+ handlerPtr = (LimitHandler *)Tcl_Alloc(sizeof(LimitHandler));
handlerPtr->flags = 0;
handlerPtr->handlerProc = handlerProc;
handlerPtr->clientData = clientData;
@@ -3734,7 +3743,7 @@ Tcl_LimitRemoveHandler(
if (handlerPtr->deleteProc != NULL) {
handlerPtr->deleteProc(handlerPtr->clientData);
}
- ckfree(handlerPtr);
+ Tcl_Free(handlerPtr);
}
return;
}
@@ -3794,7 +3803,7 @@ TclLimitRemoveAllHandlers(
if (handlerPtr->deleteProc != NULL) {
handlerPtr->deleteProc(handlerPtr->clientData);
}
- ckfree(handlerPtr);
+ Tcl_Free(handlerPtr);
}
}
@@ -3827,7 +3836,7 @@ TclLimitRemoveAllHandlers(
if (handlerPtr->deleteProc != NULL) {
handlerPtr->deleteProc(handlerPtr->clientData);
}
- ckfree(handlerPtr);
+ Tcl_Free(handlerPtr);
}
}
@@ -4222,7 +4231,7 @@ DeleteScriptLimitCallback(
if (limitCBPtr->entryPtr != NULL) {
Tcl_DeleteHashEntry(limitCBPtr->entryPtr);
}
- ckfree(limitCBPtr);
+ Tcl_Free(limitCBPtr);
}
/*
@@ -4322,7 +4331,7 @@ SetScriptLimitCallback(
limitCBPtr);
}
- limitCBPtr = (ScriptLimitCallback *)ckalloc(sizeof(ScriptLimitCallback));
+ limitCBPtr = (ScriptLimitCallback *)Tcl_Alloc(sizeof(ScriptLimitCallback));
limitCBPtr->interp = interp;
limitCBPtr->scriptObj = scriptObj;
limitCBPtr->entryPtr = hashPtr;
@@ -4575,7 +4584,8 @@ ChildCommandLimitCmd(
Tcl_WrongNumArgs(interp, consumedObjc, objv, "?-option value ...?");
return TCL_ERROR;
} else {
- int i, scriptLen = 0, limitLen = 0;
+ int i;
+ size_t scriptLen = 0, limitLen = 0;
Tcl_Obj *scriptObj = NULL, *granObj = NULL, *limitObj = NULL;
int gran = 0, limit = 0;
@@ -4587,7 +4597,7 @@ ChildCommandLimitCmd(
switch ((enum Options) index) {
case OPT_CMD:
scriptObj = objv[i+1];
- (void) TclGetStringFromObj(scriptObj, &scriptLen);
+ (void) Tcl_GetStringFromObj(scriptObj, &scriptLen);
break;
case OPT_GRAN:
granObj = objv[i+1];
@@ -4604,7 +4614,7 @@ ChildCommandLimitCmd(
break;
case OPT_VAL:
limitObj = objv[i+1];
- (void) TclGetStringFromObj(objv[i+1], &limitLen);
+ (void) Tcl_GetStringFromObj(objv[i+1], &limitLen);
if (limitLen == 0) {
break;
}
@@ -4780,7 +4790,8 @@ ChildTimeLimitCmd(
Tcl_WrongNumArgs(interp, consumedObjc, objv, "?-option value ...?");
return TCL_ERROR;
} else {
- int i, scriptLen = 0, milliLen = 0, secLen = 0;
+ int i;
+ size_t scriptLen = 0, milliLen = 0, secLen = 0;
Tcl_Obj *scriptObj = NULL, *granObj = NULL;
Tcl_Obj *milliObj = NULL, *secObj = NULL;
int gran = 0;
@@ -4796,7 +4807,7 @@ ChildTimeLimitCmd(
switch ((enum Options) index) {
case OPT_CMD:
scriptObj = objv[i+1];
- (void) TclGetStringFromObj(objv[i+1], &scriptLen);
+ (void) Tcl_GetStringFromObj(objv[i+1], &scriptLen);
break;
case OPT_GRAN:
granObj = objv[i+1];
@@ -4813,7 +4824,7 @@ ChildTimeLimitCmd(
break;
case OPT_MILLI:
milliObj = objv[i+1];
- (void) TclGetStringFromObj(objv[i+1], &milliLen);
+ (void) Tcl_GetStringFromObj(objv[i+1], &milliLen);
if (milliLen == 0) {
break;
}
@@ -4831,7 +4842,7 @@ ChildTimeLimitCmd(
break;
case OPT_SEC:
secObj = objv[i+1];
- (void) TclGetStringFromObj(objv[i+1], &secLen);
+ (void) Tcl_GetStringFromObj(objv[i+1], &secLen);
if (secLen == 0) {
break;
}
generated by cgit v0.12 at 2024-11-16 12:58:24 (GMT)