summaryrefslogtreecommitdiffstats
path: root/generic/tclProc.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclProc.c')
-rw-r--r--generic/tclProc.c96
1 files changed, 51 insertions, 45 deletions
diff --git a/generic/tclProc.c b/generic/tclProc.c
index 1644376..b8c324e 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.c
@@ -84,7 +84,7 @@ const Tcl_ObjType tclProcBodyType = {
} while (0)
/*
- * The [upvar]/[uplevel] level reference type. Uses the longValue field
+ * The [upvar]/[uplevel] level reference type. Uses the wideValue field
* to remember the integer value of a parsed #<integer> format.
*
* Uses the default behaviour throughout, and never disposes of the string
@@ -151,9 +151,9 @@ static const Tcl_ObjType lambdaType = {
#undef TclObjInterpProc
int
Tcl_ProcObjCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
- int objc, /* Number of arguments. */
+ Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Interp *iPtr = (Interp *) interp;
@@ -339,7 +339,7 @@ Tcl_ProcObjCmd(
}
if ((procArgs[0] == 'a') && (strncmp(procArgs, "args", 4) == 0)) {
- int numBytes;
+ Tcl_Size numBytes;
procArgs +=4;
while (*procArgs != '\0') {
@@ -405,10 +405,10 @@ TclCreateProc(
Interp *iPtr = (Interp *) interp;
Proc *procPtr = NULL;
- int i, result, numArgs;
+ Tcl_Size i, numArgs;
CompiledLocal *localPtr = NULL;
Tcl_Obj **argArray;
- int precompiled = 0;
+ int precompiled = 0, result;
ProcGetInternalRep(bodyPtr, procPtr);
if (procPtr != NULL) {
@@ -445,7 +445,7 @@ TclCreateProc(
if (Tcl_IsShared(bodyPtr)) {
const char *bytes;
- int length;
+ Tcl_Size length;
Tcl_Obj *sharedBodyPtr = bodyPtr;
bytes = TclGetStringFromObj(bodyPtr, &length);
@@ -508,7 +508,7 @@ TclCreateProc(
for (i = 0; i < numArgs; i++) {
const char *argname, *argnamei, *argnamelast;
- int fieldCount, nameLength;
+ Tcl_Size fieldCount, nameLength;
Tcl_Obj **fieldValues;
/*
@@ -600,10 +600,9 @@ TclCreateProc(
*/
if (localPtr->defValuePtr != NULL) {
- const char *tmpPtr = TclGetString(localPtr->defValuePtr);
- size_t tmpLength = localPtr->defValuePtr->length;
- const char *value = TclGetString(fieldValues[1]);
- size_t valueLength = fieldValues[1]->length;
+ Tcl_Size tmpLength, valueLength;
+ const char *tmpPtr = TclGetStringFromObj(localPtr->defValuePtr, &tmpLength);
+ const char *value = TclGetStringFromObj(fieldValues[1], &valueLength);
if ((valueLength != tmpLength)
|| memcmp(value, tmpPtr, tmpLength) != 0
@@ -866,7 +865,7 @@ badLevel:
static int
Uplevel_Callback(
- ClientData data[],
+ void *data[],
Tcl_Interp *interp,
int result)
{
@@ -887,7 +886,7 @@ Uplevel_Callback(
int
Tcl_UplevelObjCmd(
- ClientData clientData,
+ void *clientData,
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
@@ -897,7 +896,7 @@ Tcl_UplevelObjCmd(
int
TclNRUplevelObjCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
@@ -920,7 +919,8 @@ TclNRUplevelObjCmd(
Tcl_WrongNumArgs(interp, 1, objv, "?level? command ?arg ...?");
return TCL_ERROR;
} else if (!TclHasStringRep(objv[1]) && objc == 2) {
- int status ,llength;
+ int status;
+ Tcl_Size llength;
status = TclListObjLengthM(interp, objv[1], &llength);
if (status == TCL_OK && llength > 1) {
/* the first argument can't interpreted as a level. Avoid
@@ -1141,6 +1141,7 @@ ProcWrongNumArgs(
*----------------------------------------------------------------------
*/
+#ifndef TCL_NO_DEPRECATED
void
TclInitCompiledLocals(
Tcl_Interp *interp, /* Current interpreter. */
@@ -1167,6 +1168,7 @@ TclInitCompiledLocals(
InitResolvedLocals(interp, codePtr, varPtr, nsPtr);
}
+#endif /* TCL_NO_DEPRECATED */
/*
*----------------------------------------------------------------------
@@ -1299,7 +1301,7 @@ TclFreeLocalCache(
Tcl_Interp *interp,
LocalCache *localCachePtr)
{
- int i;
+ Tcl_Size i;
Tcl_Obj **namePtrPtr = &localCachePtr->varName0;
for (i = 0; i < localCachePtr->numVars; i++, namePtrPtr++) {
@@ -1319,8 +1321,8 @@ InitLocalCache(
{
Interp *iPtr = procPtr->iPtr;
ByteCode *codePtr;
- int localCt = procPtr->numCompiledLocals;
- int numArgs = procPtr->numArgs, i = 0;
+ Tcl_Size localCt = procPtr->numCompiledLocals;
+ Tcl_Size numArgs = procPtr->numArgs, i = 0;
Tcl_Obj **namePtr;
Var *varPtr;
@@ -1483,7 +1485,7 @@ InitArgsAndLocals(
varPtr->flags = 0;
if (defPtr && defPtr->flags & VAR_IS_ARGS) {
- Tcl_Obj *listPtr = Tcl_NewListObj(argCt-i, argObjs+i);
+ Tcl_Obj *listPtr = Tcl_NewListObj((argCt>i)? argCt-i : 0, argObjs+i);
varPtr->value.objPtr = listPtr;
Tcl_IncrRefCount(listPtr); /* Local var is a reference. */
@@ -1553,11 +1555,11 @@ InitArgsAndLocals(
int
TclPushProcCallFrame(
- ClientData clientData, /* Record describing procedure to be
+ 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
+ Tcl_Size objc, /* Count of number of arguments to this
* procedure. */
Tcl_Obj *const objv[], /* Argument value objects. */
int isLambda) /* 1 if this is a call by ApplyObjCmd: it
@@ -1648,7 +1650,7 @@ TclPushProcCallFrame(
int
TclObjInterpProc(
- ClientData clientData, /* Record describing procedure to be
+ void *clientData, /* Record describing procedure to be
* interpreted. */
Tcl_Interp *interp,/* Interpreter in which procedure was
* invoked. */
@@ -1665,7 +1667,7 @@ TclObjInterpProc(
int
TclNRInterpProc(
- ClientData clientData, /* Record describing procedure to be
+ void *clientData, /* Record describing procedure to be
* interpreted. */
Tcl_Interp *interp,/* Interpreter in which procedure was
* invoked. */
@@ -1684,7 +1686,7 @@ TclNRInterpProc(
static int
NRInterpProc2(
- ClientData clientData, /* Record describing procedure to be
+ void *clientData, /* Record describing procedure to be
* interpreted. */
Tcl_Interp *interp,/* Interpreter in which procedure was
* invoked. */
@@ -1703,7 +1705,7 @@ NRInterpProc2(
static int
ObjInterpProc2(
- ClientData clientData, /* Record describing procedure to be
+ void *clientData, /* Record describing procedure to be
* interpreted. */
Tcl_Interp *interp,/* Interpreter in which procedure was
* invoked. */
@@ -1742,7 +1744,7 @@ TclNRInterpProcCore(
Tcl_Interp *interp,/* Interpreter in which procedure was
* invoked. */
Tcl_Obj *procNameObj, /* Procedure name for error reporting. */
- int 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. */
@@ -1766,7 +1768,7 @@ TclNRInterpProcCore(
#if defined(TCL_COMPILE_DEBUG)
if (tclTraceExec >= 1) {
CallFrame *framePtr = iPtr->varFramePtr;
- int i;
+ Tcl_Size i;
if (framePtr->isProcCallFrame & FRAME_IS_LAMBDA) {
fprintf(stdout, "Calling lambda ");
@@ -1784,9 +1786,9 @@ TclNRInterpProcCore(
#ifdef USE_DTRACE
if (TCL_DTRACE_PROC_ARGS_ENABLED()) {
- int l = iPtr->varFramePtr->isProcCallFrame & FRAME_IS_LAMBDA ? 1 : 0;
+ Tcl_Size l = iPtr->varFramePtr->isProcCallFrame & FRAME_IS_LAMBDA ? 1 : 0;
const char *a[10];
- int i;
+ Tcl_Size i;
for (i = 0 ; i < 10 ; i++) {
a[i] = (l < iPtr->varFramePtr->objc ?
@@ -1805,7 +1807,7 @@ TclNRInterpProcCore(
TclDecrRefCount(info);
}
if (TCL_DTRACE_PROC_ENTRY_ENABLED()) {
- int l = iPtr->varFramePtr->isProcCallFrame & FRAME_IS_LAMBDA ? 1 : 0;
+ Tcl_Size l = iPtr->varFramePtr->isProcCallFrame & FRAME_IS_LAMBDA ? 1 : 0;
TCL_DTRACE_PROC_ENTRY(l < iPtr->varFramePtr->objc ?
TclGetString(iPtr->varFramePtr->objv[l]) : NULL,
@@ -1813,7 +1815,7 @@ TclNRInterpProcCore(
(Tcl_Obj **)(iPtr->varFramePtr->objv + l + 1));
}
if (TCL_DTRACE_PROC_ENTRY_ENABLED()) {
- int l = iPtr->varFramePtr->isProcCallFrame & FRAME_IS_LAMBDA ? 1 : 0;
+ Tcl_Size l = iPtr->varFramePtr->isProcCallFrame & FRAME_IS_LAMBDA ? 1 : 0;
TCL_DTRACE_PROC_ENTRY(l < iPtr->varFramePtr->objc ?
TclGetString(iPtr->varFramePtr->objv[l]) : NULL,
@@ -1836,7 +1838,7 @@ TclNRInterpProcCore(
static int
InterpProcNR2(
- ClientData data[],
+ void *data[],
Tcl_Interp *interp,
int result)
{
@@ -1847,7 +1849,7 @@ InterpProcNR2(
ProcErrorProc *errorProc = (ProcErrorProc *)data[1];
if (TCL_DTRACE_PROC_RETURN_ENABLED()) {
- int l = iPtr->varFramePtr->isProcCallFrame & FRAME_IS_LAMBDA ? 1 : 0;
+ Tcl_Size l = iPtr->varFramePtr->isProcCallFrame & FRAME_IS_LAMBDA ? 1 : 0;
TCL_DTRACE_PROC_RETURN(l < iPtr->varFramePtr->objc ?
TclGetString(iPtr->varFramePtr->objv[l]) : NULL, result);
@@ -1870,7 +1872,7 @@ InterpProcNR2(
done:
if (TCL_DTRACE_PROC_RESULT_ENABLED()) {
- int l = iPtr->varFramePtr->isProcCallFrame & FRAME_IS_LAMBDA ? 1 : 0;
+ Tcl_Size l = iPtr->varFramePtr->isProcCallFrame & FRAME_IS_LAMBDA ? 1 : 0;
Tcl_Obj *r = Tcl_GetObjResult(interp);
TCL_DTRACE_PROC_RESULT(l < iPtr->varFramePtr->objc ?
@@ -2128,13 +2130,14 @@ MakeProcError(
Tcl_Obj *procNameObj) /* Name of the procedure. Used for error
* messages and trace information. */
{
- int overflow, limit = 60, nameLen;
+ int overflow, limit = 60;
+ Tcl_Size nameLen;
const char *procName = TclGetStringFromObj(procNameObj, &nameLen);
overflow = (nameLen > limit);
Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
"\n (procedure \"%.*s%s\" line %d)",
- (overflow ? limit : nameLen), procName,
+ (overflow ? limit : (int)nameLen), procName,
(overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
}
@@ -2160,7 +2163,7 @@ MakeProcError(
void
TclProcDeleteProc(
- ClientData clientData) /* Procedure to be deleted. */
+ void *clientData) /* Procedure to be deleted. */
{
Proc *procPtr = (Proc *)clientData;
@@ -2317,7 +2320,8 @@ TclUpdateReturnInfo(
* of a function exported by a DLL exist.
*
* Results:
- * Returns the internal address of the TclObjInterpProc function.
+ * Returns the internal address of the TclObjInterpProc/ObjInterpProc2
+ * functions.
*
* Side effects:
* None.
@@ -2490,7 +2494,8 @@ SetLambdaFromAny(
Interp *iPtr = (Interp *) interp;
const char *name;
Tcl_Obj *argsPtr, *bodyPtr, *nsObjPtr, **objv;
- int isNew, objc, result;
+ int isNew, result;
+ Tcl_Size objc;
CmdFrame *cfPtr = NULL;
Proc *procPtr;
@@ -2697,7 +2702,7 @@ TclGetLambdaFromObj(
int
Tcl_ApplyObjCmd(
- ClientData clientData,
+ void *clientData,
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
@@ -2707,7 +2712,7 @@ Tcl_ApplyObjCmd(
int
TclNRApplyObjCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
@@ -2776,7 +2781,7 @@ TclNRApplyObjCmd(
static int
ApplyNR2(
- ClientData data[],
+ void *data[],
Tcl_Interp *interp,
int result)
{
@@ -2811,13 +2816,14 @@ MakeLambdaError(
Tcl_Obj *procNameObj) /* Name of the procedure. Used for error
* messages and trace information. */
{
- int overflow, limit = 60, nameLen;
+ int overflow, limit = 60;
+ Tcl_Size nameLen;
const char *procName = TclGetStringFromObj(procNameObj, &nameLen);
overflow = (nameLen > limit);
Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
"\n (lambda term \"%.*s%s\" line %d)",
- (overflow ? limit : nameLen), procName,
+ (overflow ? limit : (int)nameLen), procName,
(overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
}
generated by cgit v0.12 at 2025-10-17 22:26:16 (GMT)