summaryrefslogtreecommitdiffstats
path: root/generic/tclProc.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclProc.c')
-rw-r--r--generic/tclProc.c280
1 files changed, 134 insertions, 146 deletions
diff --git a/generic/tclProc.c b/generic/tclProc.c
index 31566da..17f3c06 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.c
@@ -34,14 +34,14 @@ typedef struct {
static void DupLambdaInternalRep(Tcl_Obj *objPtr,
Tcl_Obj *copyPtr);
static void FreeLambdaInternalRep(Tcl_Obj *objPtr);
-static int InitArgsAndLocals(Tcl_Interp *interp, Tcl_Size skip);
+static int InitArgsAndLocals(Tcl_Interp *interp, int skip);
static void InitResolvedLocals(Tcl_Interp *interp,
ByteCode *codePtr, Var *defPtr,
Namespace *nsPtr);
static void InitLocalCache(Proc *procPtr);
static void ProcBodyDup(Tcl_Obj *srcPtr, Tcl_Obj *dupPtr);
static void ProcBodyFree(Tcl_Obj *objPtr);
-static int ProcWrongNumArgs(Tcl_Interp *interp, Tcl_Size skip);
+static int ProcWrongNumArgs(Tcl_Interp *interp, int skip);
static void MakeProcError(Tcl_Interp *interp,
Tcl_Obj *procNameObj);
static void MakeLambdaError(Tcl_Interp *interp,
@@ -51,6 +51,7 @@ static int SetLambdaFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
static Tcl_NRPostProc ApplyNR2;
static Tcl_NRPostProc InterpProcNR2;
static Tcl_NRPostProc Uplevel_Callback;
+static Tcl_ObjCmdProc NRInterpProc;
/*
* The ProcBodyObjType type
@@ -63,11 +64,12 @@ const Tcl_ObjType tclProcBodyType = {
NULL, /* UpdateString function; Tcl_GetString and
* Tcl_GetStringFromObj should panic
* instead. */
- NULL /* SetFromAny function; Tcl_ConvertToType
+ NULL, /* SetFromAny function; Tcl_ConvertToType
* should panic instead. */
+ TCL_OBJTYPE_V0
};
-#define ProcSetInternalRep(objPtr, procPtr) \
+#define ProcSetInternalRep(objPtr, procPtr) \
do { \
Tcl_ObjInternalRep ir; \
(procPtr)->refCount++; \
@@ -76,11 +78,11 @@ const Tcl_ObjType tclProcBodyType = {
Tcl_StoreInternalRep((objPtr), &tclProcBodyType, &ir); \
} while (0)
-#define ProcGetInternalRep(objPtr, procPtr) \
+#define ProcGetInternalRep(objPtr, procPtr) \
do { \
- const Tcl_ObjInternalRep *irPtr; \
- irPtr = TclFetchInternalRep((objPtr), &tclProcBodyType); \
- (procPtr) = irPtr ? (Proc *)irPtr->twoPtrValue.ptr1 : NULL; \
+ const Tcl_ObjInternalRep *irPtr; \
+ irPtr = TclFetchInternalRep((objPtr), &tclProcBodyType); \
+ (procPtr) = irPtr ? (Proc *)irPtr->twoPtrValue.ptr1 : NULL; \
} while (0)
/*
@@ -93,7 +95,7 @@ const Tcl_ObjType tclProcBodyType = {
static const Tcl_ObjType levelReferenceType = {
"levelReference",
- NULL, NULL, NULL, NULL
+ NULL, NULL, NULL, NULL, TCL_OBJTYPE_V0
};
/*
@@ -110,26 +112,26 @@ static const Tcl_ObjType lambdaType = {
FreeLambdaInternalRep, /* freeIntRepProc */
DupLambdaInternalRep, /* dupIntRepProc */
NULL, /* updateStringProc */
- SetLambdaFromAny /* setFromAnyProc */
+ SetLambdaFromAny, /* setFromAnyProc */
+ TCL_OBJTYPE_V0
};
-#define LambdaSetInternalRep(objPtr, procPtr, nsObjPtr) \
+#define LambdaSetInternalRep(objPtr, procPtr, nsObjPtr) \
do { \
Tcl_ObjInternalRep ir; \
ir.twoPtrValue.ptr1 = (procPtr); \
ir.twoPtrValue.ptr2 = (nsObjPtr); \
Tcl_IncrRefCount((nsObjPtr)); \
- Tcl_StoreInternalRep((objPtr), &lambdaType, &ir); \
+ Tcl_StoreInternalRep((objPtr), &lambdaType, &ir); \
} while (0)
-#define LambdaGetInternalRep(objPtr, procPtr, nsObjPtr) \
+#define LambdaGetInternalRep(objPtr, procPtr, nsObjPtr) \
do { \
- const Tcl_ObjInternalRep *irPtr; \
- irPtr = TclFetchInternalRep((objPtr), &lambdaType); \
- (procPtr) = irPtr ? (Proc *)irPtr->twoPtrValue.ptr1 : NULL; \
- (nsObjPtr) = irPtr ? (Tcl_Obj *)irPtr->twoPtrValue.ptr2 : NULL; \
+ const Tcl_ObjInternalRep *irPtr; \
+ irPtr = TclFetchInternalRep((objPtr), &lambdaType); \
+ (procPtr) = irPtr ? (Proc *)irPtr->twoPtrValue.ptr1 : NULL; \
+ (nsObjPtr) = irPtr ? (Tcl_Obj *)irPtr->twoPtrValue.ptr2 : NULL; \
} while (0)
-
/*
*----------------------------------------------------------------------
@@ -153,7 +155,7 @@ int
Tcl_ProcObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
- Tcl_Size objc, /* Number of arguments. */
+ Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Interp *iPtr = (Interp *) interp;
@@ -182,14 +184,14 @@ Tcl_ProcObjCmd(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"can't create procedure \"%s\": unknown namespace",
procName));
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", (char *)NULL);
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", (void *)NULL);
return TCL_ERROR;
}
if (simpleName == NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"can't create procedure \"%s\": bad procedure name",
procName));
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", (char *)NULL);
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", (void *)NULL);
return TCL_ERROR;
}
@@ -206,7 +208,7 @@ Tcl_ProcObjCmd(
}
cmd = TclNRCreateCommandInNs(interp, simpleName, (Tcl_Namespace *) nsPtr,
- TclObjInterpProc, TclNRInterpProc, procPtr, TclProcDeleteProc);
+ TclObjInterpProc, NRInterpProc, procPtr, TclProcDeleteProc);
/*
* Now initialize the new procedure's cmdPtr field. This will be used
@@ -262,11 +264,11 @@ Tcl_ProcObjCmd(
&& (contextPtr->nline >= 4) && (contextPtr->line[3] >= 0)) {
int isNew;
Tcl_HashEntry *hePtr;
- CmdFrame *cfPtr = (CmdFrame *)ckalloc(sizeof(CmdFrame));
+ CmdFrame *cfPtr = (CmdFrame *)Tcl_Alloc(sizeof(CmdFrame));
cfPtr->level = -1;
cfPtr->type = contextPtr->type;
- cfPtr->line = (Tcl_Size *)ckalloc(sizeof(Tcl_Size));
+ cfPtr->line = (Tcl_Size *)Tcl_Alloc(sizeof(Tcl_Size));
cfPtr->line[0] = contextPtr->line[3];
cfPtr->nline = 1;
cfPtr->framePtr = NULL;
@@ -294,9 +296,9 @@ Tcl_ProcObjCmd(
Tcl_DecrRefCount(cfOldPtr->data.eval.path);
cfOldPtr->data.eval.path = NULL;
}
- ckfree(cfOldPtr->line);
+ Tcl_Free(cfOldPtr->line);
cfOldPtr->line = NULL;
- ckfree(cfOldPtr);
+ Tcl_Free(cfOldPtr);
}
Tcl_SetHashValue(hePtr, cfPtr);
}
@@ -468,7 +470,7 @@ TclCreateProc(
Tcl_IncrRefCount(bodyPtr);
- procPtr = (Proc *)ckalloc(sizeof(Proc));
+ procPtr = (Proc *)Tcl_Alloc(sizeof(Proc));
procPtr->iPtr = iPtr;
procPtr->refCount = 1;
procPtr->bodyPtr = bodyPtr;
@@ -497,7 +499,7 @@ TclCreateProc(
"precompiled header expects %" TCL_SIZE_MODIFIER "d", procName, numArgs,
procPtr->numArgs));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
- "BYTECODELIES", (char *)NULL);
+ "BYTECODELIES", (void *)NULL);
goto procError;
}
localPtr = procPtr->firstLocalPtr;
@@ -527,14 +529,14 @@ TclCreateProc(
Tcl_AppendToObj(errorObj, "\"", -1);
Tcl_SetObjResult(interp, errorObj);
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
- "FORMALARGUMENTFORMAT", (char *)NULL);
+ "FORMALARGUMENTFORMAT", (void *)NULL);
goto procError;
}
- if ((fieldCount == 0) || (TclGetCharLength(fieldValues[0]) == 0)) {
+ if ((fieldCount == 0) || (Tcl_GetCharLength(fieldValues[0]) == 0)) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"argument with no name", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
- "FORMALARGUMENTFORMAT", (char *)NULL);
+ "FORMALARGUMENTFORMAT", (void *)NULL);
goto procError;
}
@@ -553,17 +555,17 @@ TclCreateProc(
"formal parameter \"%s\" is an array element",
TclGetString(fieldValues[0])));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
- "FORMALARGUMENTFORMAT", (char *)NULL);
+ "FORMALARGUMENTFORMAT", (void *)NULL);
goto procError;
}
- } else if (*argnamei == ':' && *(argnamei+1) == ':') {
+ } else if (argnamei[0] == ':' && argnamei[1] == ':') {
Tcl_Obj *errorObj = Tcl_NewStringObj(
- "formal parameter \"", -1);
+ "formal parameter \"", -1);
Tcl_AppendObjToObj(errorObj, fieldValues[0]);
Tcl_AppendToObj(errorObj, "\" is not a simple name", -1);
Tcl_SetObjResult(interp, errorObj);
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
- "FORMALARGUMENTFORMAT", (char *)NULL);
+ "FORMALARGUMENTFORMAT", (void *)NULL);
goto procError;
}
argnamei++;
@@ -591,7 +593,7 @@ TclCreateProc(
"procedure \"%s\": formal parameter %" TCL_SIZE_MODIFIER "d is "
"inconsistent with precompiled body", procName, i));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
- "BYTECODELIES", (char *)NULL);
+ "BYTECODELIES", (void *)NULL);
goto procError;
}
@@ -605,8 +607,7 @@ TclCreateProc(
const char *value = TclGetStringFromObj(fieldValues[1], &valueLength);
if ((valueLength != tmpLength)
- || memcmp(value, tmpPtr, tmpLength) != 0
- ) {
+ || memcmp(value, tmpPtr, tmpLength) != 0) {
Tcl_Obj *errorObj = Tcl_ObjPrintf(
"procedure \"%s\": formal parameter \"", procName);
Tcl_AppendObjToObj(errorObj, fieldValues[0]);
@@ -614,7 +615,7 @@ TclCreateProc(
"default value inconsistent with precompiled body", -1);
Tcl_SetObjResult(interp, errorObj);
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
- "BYTECODELIES", (char *)NULL);
+ "BYTECODELIES", (void *)NULL);
goto procError;
}
}
@@ -632,7 +633,7 @@ TclCreateProc(
* local variables for the argument.
*/
- localPtr = (CompiledLocal *)ckalloc(
+ localPtr = (CompiledLocal *)Tcl_Alloc(
offsetof(CompiledLocal, name) + 1U + fieldValues[0]->length);
if (procPtr->firstLocalPtr == NULL) {
procPtr->firstLocalPtr = procPtr->lastLocalPtr = localPtr;
@@ -678,9 +679,9 @@ TclCreateProc(
Tcl_DecrRefCount(localPtr->defValuePtr);
}
- ckfree(localPtr);
+ Tcl_Free(localPtr);
}
- ckfree(procPtr);
+ Tcl_Free(procPtr);
}
return TCL_ERROR;
}
@@ -781,7 +782,7 @@ TclObjGetFrame(
if (objPtr == NULL) {
/* Do nothing */
} else if (TCL_OK == Tcl_GetIntFromObj(NULL, objPtr, &level)) {
- Tcl_GetWideIntFromObj(NULL, objPtr, &w);
+ TclGetWideIntFromObj(NULL, objPtr, &w);
if (w < 0 || w > INT_MAX || curLevel > w + INT_MAX) {
result = -1;
} else {
@@ -830,7 +831,7 @@ TclObjGetFrame(
CallFrame *framePtr;
for (framePtr = iPtr->varFramePtr; framePtr != NULL;
framePtr = framePtr->callerVarPtr) {
- if (framePtr->level == level) {
+ if ((int)framePtr->level == level) {
*framePtrPtr = framePtr;
return result;
}
@@ -842,7 +843,7 @@ badLevel:
name = objPtr ? TclGetString(objPtr) : "1" ;
}
Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad level \"%s\"", name));
- Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LEVEL", name, (char *)NULL);
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LEVEL", name, (void *)NULL);
return -1;
}
@@ -1061,7 +1062,7 @@ TclIsProc(
static int
ProcWrongNumArgs(
Tcl_Interp *interp,
- Tcl_Size skip)
+ int skip)
{
CallFrame *framePtr = ((Interp *)interp)->varFramePtr;
Proc *procPtr = framePtr->procPtr;
@@ -1080,11 +1081,7 @@ ProcWrongNumArgs(
if (framePtr->isProcCallFrame & FRAME_IS_LAMBDA) {
desiredObjs[0] = Tcl_NewStringObj("lambdaExpr", -1);
} else {
-#ifdef AVOID_HACKS_FOR_ITCL
desiredObjs[0] = framePtr->objv[skip-1];
-#else
- desiredObjs[0] = Tcl_NewListObj(1, framePtr->objv + skip - 1);
-#endif /* AVOID_HACKS_FOR_ITCL */
}
Tcl_IncrRefCount(desiredObjs[0]);
@@ -1097,7 +1094,8 @@ ProcWrongNumArgs(
if (defPtr->value.objPtr != NULL) {
TclNewObj(argObj);
- Tcl_AppendStringsToObj(argObj, "?", TclGetString(namePtr), "?", (char *)NULL);
+ Tcl_AppendStringsToObj(argObj, "?", TclGetString(namePtr), "?",
+ (void *)NULL);
} else if (defPtr->flags & VAR_IS_ARGS) {
numArgs--;
final = "?arg ...?";
@@ -1123,56 +1121,6 @@ ProcWrongNumArgs(
/*
*----------------------------------------------------------------------
*
- * TclInitCompiledLocals --
- *
- * This routine is invoked in order to initialize the compiled locals
- * table for a new call frame.
- *
- * DEPRECATED: functionality has been inlined elsewhere; this function
- * remains to insure binary compatibility with Itcl.
- *
- * Results:
- * None.
- *
- * Side effects:
- * May invoke various name resolvers in order to determine which
- * variables are being referenced at runtime.
- *
- *----------------------------------------------------------------------
- */
-
-#ifndef TCL_NO_DEPRECATED
-void
-TclInitCompiledLocals(
- Tcl_Interp *interp, /* Current interpreter. */
- CallFrame *framePtr, /* Call frame to initialize. */
- Namespace *nsPtr) /* Pointer to current namespace. */
-{
- Var *varPtr = framePtr->compiledLocals;
- Tcl_Obj *bodyPtr;
- ByteCode *codePtr;
-
- bodyPtr = framePtr->procPtr->bodyPtr;
- ByteCodeGetInternalRep(bodyPtr, &tclByteCodeType, codePtr);
- if (codePtr == NULL) {
- Tcl_Panic("body object for proc attached to frame is not a byte code type");
- }
-
- if (framePtr->numCompiledLocals) {
- if (!codePtr->localCachePtr) {
- InitLocalCache(framePtr->procPtr) ;
- }
- framePtr->localCachePtr = codePtr->localCachePtr;
- framePtr->localCachePtr->refCount++;
- }
-
- InitResolvedLocals(interp, codePtr, varPtr, nsPtr);
-}
-#endif /* TCL_NO_DEPRECATED */
-
-/*
- *----------------------------------------------------------------------
- *
* InitResolvedLocals --
*
* This routine is invoked in order to initialize the compiled locals
@@ -1226,7 +1174,7 @@ InitResolvedLocals(
if (localPtr->resolveInfo->deleteProc) {
localPtr->resolveInfo->deleteProc(localPtr->resolveInfo);
} else {
- ckfree(localPtr->resolveInfo);
+ Tcl_Free(localPtr->resolveInfo);
}
localPtr->resolveInfo = NULL;
}
@@ -1312,7 +1260,7 @@ TclFreeLocalCache(
TclReleaseLiteral(interp, objPtr);
}
}
- ckfree(localCachePtr);
+ Tcl_Free(localCachePtr);
}
static void
@@ -1338,7 +1286,7 @@ InitLocalCache(
* for future calls.
*/
- localCachePtr = (LocalCache *)ckalloc(offsetof(LocalCache, varName0)
+ localCachePtr = (LocalCache *)Tcl_Alloc(offsetof(LocalCache, varName0)
+ localCt * sizeof(Tcl_Obj *)
+ numArgs * sizeof(Var));
@@ -1350,7 +1298,7 @@ InitLocalCache(
*namePtr = NULL;
} else {
*namePtr = TclCreateLiteral(iPtr, localPtr->name,
- localPtr->nameLength, /* hash */ (unsigned int) -1,
+ localPtr->nameLength, /* hash */ TCL_INDEX_NONE,
&isNew, /* nsPtr */ NULL, 0, NULL);
Tcl_IncrRefCount(*namePtr);
}
@@ -1391,9 +1339,9 @@ InitLocalCache(
static int
InitArgsAndLocals(
- Tcl_Interp *interp,/* Interpreter in which procedure was
+ Tcl_Interp *interp, /* Interpreter in which procedure was
* invoked. */
- Tcl_Size skip) /* Number of initial arguments to be skipped,
+ int skip) /* Number of initial arguments to be skipped,
* i.e., words in the "command name". */
{
CallFrame *framePtr = ((Interp *)interp)->varFramePtr;
@@ -1555,9 +1503,9 @@ InitArgsAndLocals(
int
TclPushProcCallFrame(
- void *clientData, /* Record describing procedure to be
+ void *clientData, /* Record describing procedure to be
* interpreted. */
- Tcl_Interp *interp,/* Interpreter in which procedure was
+ Tcl_Interp *interp, /* Interpreter in which procedure was
* invoked. */
Tcl_Size objc, /* Count of number of arguments to this
* procedure. */
@@ -1597,8 +1545,7 @@ TclPushProcCallFrame(
|| (codePtr->compileEpoch != iPtr->compileEpoch)
|| (codePtr->nsPtr != nsPtr)
|| (codePtr->nsEpoch != nsPtr->resolverEpoch)
- || ((codePtr->procPtr != procPtr) && procPtr->bodyPtr->bytes)
- ) {
+ || ((codePtr->procPtr != procPtr) && procPtr->bodyPtr->bytes)) {
goto doCompilation;
}
} else {
@@ -1650,9 +1597,9 @@ TclPushProcCallFrame(
int
TclObjInterpProc(
- void *clientData, /* Record describing procedure to be
+ void *clientData, /* Record describing procedure to be
* interpreted. */
- Tcl_Interp *interp,/* Interpreter in which procedure was
+ Tcl_Interp *interp, /* Interpreter in which procedure was
* invoked. */
int objc, /* Count of number of arguments to this
* procedure. */
@@ -1662,14 +1609,14 @@ TclObjInterpProc(
* Not used much in the core; external interface for iTcl
*/
- return Tcl_NRCallObjProc(interp, TclNRInterpProc, clientData, objc, objv);
+ return Tcl_NRCallObjProc(interp, NRInterpProc, clientData, objc, objv);
}
int
TclNRInterpProc(
- void *clientData, /* Record describing procedure to be
+ void *clientData, /* Record describing procedure to be
* interpreted. */
- Tcl_Interp *interp,/* Interpreter in which procedure was
+ Tcl_Interp *interp, /* Interpreter in which procedure was
* invoked. */
Tcl_Size objc, /* Count of number of arguments to this
* procedure. */
@@ -1683,6 +1630,42 @@ TclNRInterpProc(
}
return TclNRInterpProcCore(interp, objv[0], 1, &MakeProcError);
}
+
+static int
+NRInterpProc(
+ void *clientData, /* Record describing procedure to be
+ * interpreted. */
+ Tcl_Interp *interp, /* Interpreter in which procedure was
+ * invoked. */
+ int objc, /* Count of number of arguments to this
+ * procedure. */
+ Tcl_Obj *const objv[]) /* Argument value objects. */
+{
+ int result = TclPushProcCallFrame(clientData, interp, objc, objv,
+ /*isLambda*/ 0);
+
+ if (result != TCL_OK) {
+ return TCL_ERROR;
+ }
+ return TclNRInterpProcCore(interp, objv[0], 1, &MakeProcError);
+}
+
+static int
+ObjInterpProc2(
+ void *clientData, /* Record describing procedure to be
+ * interpreted. */
+ Tcl_Interp *interp, /* Interpreter in which procedure was
+ * invoked. */
+ Tcl_Size objc, /* Count of number of arguments to this
+ * procedure. */
+ Tcl_Obj *const objv[]) /* Argument value objects. */
+{
+ /*
+ * Not used much in the core; external interface for iTcl
+ */
+
+ return Tcl_NRCallObjProc2(interp, TclNRInterpProc, clientData, objc, objv);
+}
/*
*----------------------------------------------------------------------
@@ -1704,10 +1687,10 @@ TclNRInterpProc(
int
TclNRInterpProcCore(
- Tcl_Interp *interp,/* Interpreter in which procedure was
+ Tcl_Interp *interp, /* Interpreter in which procedure was
* invoked. */
Tcl_Obj *procNameObj, /* Procedure name for error reporting. */
- Tcl_Size skip, /* Number of initial arguments to be skipped,
+ Tcl_Size skip, /* Number of initial arguments to be skipped,
* i.e., words in the "command name". */
ProcErrorProc *errorProc) /* How to convert results from the script into
* results of the overall procedure. */
@@ -1874,7 +1857,7 @@ InterpProcNR2(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"invoked \"%s\" outside of a loop",
((result == TCL_BREAK) ? "break" : "continue")));
- Tcl_SetErrorCode(interp, "TCL", "RESULT", "UNEXPECTED", (char *)NULL);
+ Tcl_SetErrorCode(interp, "TCL", "RESULT", "UNEXPECTED", (void *)NULL);
result = TCL_ERROR;
/* FALLTHRU */
@@ -1948,8 +1931,7 @@ TclProcCompileProc(
&& (codePtr->compileEpoch == iPtr->compileEpoch)
&& (codePtr->nsPtr == nsPtr)
&& (codePtr->nsEpoch == nsPtr->resolverEpoch)
- && ((codePtr->procPtr == procPtr) || !bodyPtr->bytes)
- ) {
+ && ((codePtr->procPtr == procPtr) || !bodyPtr->bytes)) {
return TCL_OK;
}
@@ -1958,7 +1940,7 @@ TclProcCompileProc(
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"a precompiled script jumped interps", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
- "CROSSINTERPBYTECODE", (char *)NULL);
+ "CROSSINTERPBYTECODE", (void *)NULL);
return TCL_ERROR;
}
codePtr->compileEpoch = iPtr->compileEpoch;
@@ -1983,7 +1965,7 @@ TclProcCompileProc(
TclNewLiteralStringObj(message, "Compiling ");
Tcl_IncrRefCount(message);
- Tcl_AppendStringsToObj(message, description, " \"", (char *)NULL);
+ Tcl_AppendStringsToObj(message, description, " \"", (void *)NULL);
Tcl_AppendLimitedToObj(message, procName, TCL_INDEX_NONE, 50, NULL);
fprintf(stdout, "%s\"\n", TclGetString(message));
Tcl_DecrRefCount(message);
@@ -2029,10 +2011,10 @@ TclProcCompileProc(
if (toFree->resolveInfo->deleteProc) {
toFree->resolveInfo->deleteProc(toFree->resolveInfo);
} else {
- ckfree(toFree->resolveInfo);
+ Tcl_Free(toFree->resolveInfo);
}
}
- ckfree(toFree);
+ Tcl_Free(toFree);
}
procPtr->numCompiledLocals = procPtr->numArgs;
}
@@ -2097,7 +2079,7 @@ MakeProcError(
Tcl_Size nameLen;
const char *procName = TclGetStringFromObj(procNameObj, &nameLen);
- overflow = (nameLen > limit);
+ overflow = (nameLen > (Tcl_Size)limit);
Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
"\n (procedure \"%.*s%s\" line %d)",
(overflow ? limit : (int)nameLen), procName,
@@ -2126,7 +2108,7 @@ MakeProcError(
void
TclProcDeleteProc(
- void *clientData) /* Procedure to be deleted. */
+ void *clientData) /* Procedure to be deleted. */
{
Proc *procPtr = (Proc *)clientData;
@@ -2154,7 +2136,7 @@ TclProcDeleteProc(
void
TclProcCleanupProc(
- Proc *procPtr) /* Procedure to be deleted. */
+ Proc *procPtr) /* Procedure to be deleted. */
{
CompiledLocal *localPtr;
Tcl_Obj *bodyPtr = procPtr->bodyPtr;
@@ -2182,7 +2164,7 @@ TclProcCleanupProc(
if (resVarInfo->deleteProc) {
resVarInfo->deleteProc(resVarInfo);
} else {
- ckfree(resVarInfo);
+ Tcl_Free(resVarInfo);
}
}
@@ -2190,10 +2172,10 @@ TclProcCleanupProc(
defPtr = localPtr->defValuePtr;
Tcl_DecrRefCount(defPtr);
}
- ckfree(localPtr);
+ Tcl_Free(localPtr);
localPtr = nextPtr;
}
- ckfree(procPtr);
+ Tcl_Free(procPtr);
/*
* TIP #280: Release the location data associated with this Proc
@@ -2217,9 +2199,9 @@ TclProcCleanupProc(
Tcl_DecrRefCount(cfPtr->data.eval.path);
cfPtr->data.eval.path = NULL;
}
- ckfree(cfPtr->line);
+ Tcl_Free(cfPtr->line);
cfPtr->line = NULL;
- ckfree(cfPtr);
+ Tcl_Free(cfPtr);
}
Tcl_DeleteHashEntry(hePtr);
}
@@ -2275,15 +2257,15 @@ TclUpdateReturnInfo(
/*
*----------------------------------------------------------------------
*
- * TclGetObjInterpProc --
+ * TclGetObjInterpProc/TclGetObjInterpProc2 --
*
- * Returns a pointer to the TclObjInterpProc function;
+ * Returns a pointer to the TclObjInterpProc/ObjInterpProc2 functions;
* this is different from the value obtained from the TclObjInterpProc
* reference on systems like Windows where import and export versions
* of a function exported by a DLL exist.
*
* Results:
- * Returns the internal address of the TclObjInterpProc
+ * Returns the internal address of the TclObjInterpProc/ObjInterpProc2
* functions.
*
* Side effects:
@@ -2297,6 +2279,12 @@ TclGetObjInterpProc(void)
{
return TclObjInterpProc;
}
+
+Tcl_ObjCmdProc2 *
+TclGetObjInterpProc2(void)
+{
+ return ObjInterpProc2;
+}
/*
*----------------------------------------------------------------------
@@ -2413,7 +2401,7 @@ ProcBodyFree(
static void
DupLambdaInternalRep(
Tcl_Obj *srcPtr, /* Object with internal rep to copy. */
- Tcl_Obj *copyPtr) /* Object with internal rep to set. */
+ Tcl_Obj *copyPtr) /* Object with internal rep to set. */
{
Proc *procPtr;
Tcl_Obj *nsObjPtr;
@@ -2428,7 +2416,7 @@ DupLambdaInternalRep(
static void
FreeLambdaInternalRep(
- Tcl_Obj *objPtr) /* CmdName object with internal representation
+ Tcl_Obj *objPtr) /* CmdName object with internal representation
* to free. */
{
Proc *procPtr;
@@ -2446,7 +2434,7 @@ FreeLambdaInternalRep(
static int
SetLambdaFromAny(
Tcl_Interp *interp, /* Used for error reporting if not NULL. */
- Tcl_Obj *objPtr) /* The object to convert. */
+ Tcl_Obj *objPtr) /* The object to convert. */
{
Interp *iPtr = (Interp *) interp;
const char *name;
@@ -2469,8 +2457,8 @@ SetLambdaFromAny(
if ((result != TCL_OK) || ((objc != 2) && (objc != 3))) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"can't interpret \"%s\" as a lambda expression",
- TclGetString(objPtr)));
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "LAMBDA", (char *)NULL);
+ Tcl_GetString(objPtr)));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "LAMBDA", (void *)NULL);
return TCL_ERROR;
}
result = TclListObjGetElements(NULL, objPtr, &objc, &objv);
@@ -2478,7 +2466,7 @@ SetLambdaFromAny(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"can't interpret \"%s\" as a lambda expression",
TclGetString(objPtr)));
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "LAMBDA", (char *)NULL);
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "LAMBDA", (void *)NULL);
return TCL_ERROR;
}
@@ -2563,12 +2551,12 @@ SetLambdaFromAny(
* location (line of 2nd list element).
*/
- cfPtr = (CmdFrame *)ckalloc(sizeof(CmdFrame));
+ cfPtr = (CmdFrame *)Tcl_Alloc(sizeof(CmdFrame));
TclListLines(objPtr, contextPtr->line[1], 2, buf, NULL);
cfPtr->level = -1;
cfPtr->type = contextPtr->type;
- cfPtr->line = (Tcl_Size *)ckalloc(sizeof(Tcl_Size));
+ cfPtr->line = (Tcl_Size *)Tcl_Alloc(sizeof(Tcl_Size));
cfPtr->line[0] = buf[1];
cfPtr->nline = 1;
cfPtr->framePtr = NULL;
@@ -2603,7 +2591,7 @@ SetLambdaFromAny(
} else {
const char *nsName = TclGetString(objv[2]);
- if ((*nsName != ':') || (*(nsName+1) != ':')) {
+ if ((nsName[0] != ':') || (nsName[1] != ':')) {
TclNewLiteralStringObj(nsObjPtr, "::");
Tcl_AppendObjToObj(nsObjPtr, objv[2]);
} else {
@@ -2785,7 +2773,7 @@ MakeLambdaError(
Tcl_Size nameLen;
const char *procName = TclGetStringFromObj(procNameObj, &nameLen);
- overflow = (nameLen > limit);
+ overflow = (nameLen > (Tcl_Size)limit);
Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
"\n (lambda term \"%.*s%s\" line %d)",
(overflow ? limit : (int)nameLen), procName,
generated by cgit v0.12 at 2024-11-16 23:25:09 (GMT)