summaryrefslogtreecommitdiffstats
path: root/generic/tclProc.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclProc.c')
-rw-r--r--generic/tclProc.c136
1 files changed, 55 insertions, 81 deletions
diff --git a/generic/tclProc.c b/generic/tclProc.c
index 212b680..32c3b2e 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.c
@@ -505,10 +505,11 @@ TclCreateProc(
goto procError;
}
- nameLength = Tcl_NumUtfChars(Tcl_GetString(fieldValues[0]), fieldValues[0]->length);
+ argname = Tcl_GetStringFromObj(fieldValues[0], &plen);
+ nameLength = Tcl_NumUtfChars(argname, plen);
if (fieldCount == 2) {
- valueLength = Tcl_NumUtfChars(Tcl_GetString(fieldValues[1]),
- fieldValues[1]->length);
+ const char * value = TclGetString(fieldValues[1]);
+ valueLength = Tcl_NumUtfChars(value, fieldValues[1]->length);
} else {
valueLength = 0;
}
@@ -517,7 +518,6 @@ TclCreateProc(
* Check that the formal parameter name is a scalar.
*/
- argname = Tcl_GetStringFromObj(fieldValues[0], &plen);
argnamei = argname;
argnamelast = argname[plen-1];
while (plen--) {
@@ -611,7 +611,7 @@ TclCreateProc(
procPtr->lastLocalPtr = localPtr;
}
localPtr->nextPtr = NULL;
- localPtr->nameLength = Tcl_NumUtfChars(argname, fieldValues[0]->length);
+ localPtr->nameLength = nameLength;
localPtr->frameIndex = i;
localPtr->flags = VAR_ARGUMENT;
localPtr->resolveInfo = NULL;
@@ -688,51 +688,15 @@ TclGetFrame(
CallFrame **framePtrPtr) /* Store pointer to frame here (or NULL if
* global frame indicated). */
{
- register Interp *iPtr = (Interp *) interp;
- int curLevel, level, result;
- CallFrame *framePtr;
-
- /*
- * Parse string to figure out which level number to go to.
- */
-
- result = 1;
- curLevel = iPtr->varFramePtr->level;
- if (*name== '#') {
- if (Tcl_GetInt(interp, name+1, &level) != TCL_OK || level < 0) {
- goto levelError;
- }
- } else if (isdigit(UCHAR(*name))) { /* INTL: digit */
- if (Tcl_GetInt(interp, name, &level) != TCL_OK) {
- goto levelError;
- }
- level = curLevel - level;
- } else {
- level = curLevel - 1;
- result = 0;
- }
-
- /*
- * Figure out which frame to use, and return it to the caller.
- */
-
- for (framePtr = iPtr->varFramePtr; framePtr != NULL;
- framePtr = framePtr->callerVarPtr) {
- if (framePtr->level == level) {
- break;
- }
- }
- if (framePtr == NULL) {
- goto levelError;
- }
-
- *framePtrPtr = framePtr;
- return result;
-
- levelError:
- Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad level \"%s\"", name));
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "STACKLEVEL", NULL);
- return -1;
+ int result;
+ Tcl_Obj obj;
+
+ obj.bytes = (char *) name;
+ obj.length = strlen(name);
+ obj.typePtr = NULL;
+ result = TclObjGetFrame(interp, &obj, framePtrPtr);
+ TclFreeIntRep(&obj);
+ return result;
}
/*
@@ -770,6 +734,7 @@ TclObjGetFrame(
register Interp *iPtr = (Interp *) interp;
int curLevel, level, result;
const char *name = NULL;
+ Tcl_WideInt w;
/*
* Parse object to figure out which level number to go to.
@@ -785,25 +750,33 @@ TclObjGetFrame(
if (objPtr == NULL) {
/* Do nothing */
- } else if (TCL_OK == Tcl_GetIntFromObj(NULL, objPtr, &level)
- && (level >= 0)) {
- level = curLevel - level;
- result = 1;
+ } else if (TCL_OK == Tcl_GetIntFromObj(NULL, objPtr, &level)) {
+ Tcl_GetWideIntFromObj(NULL, objPtr, &w);
+ if (w < 0 || w > INT_MAX || curLevel > w + INT_MAX) {
+ result = -1;
+ } else {
+ level = curLevel - level;
+ result = 1;
+ }
} else if (objPtr->typePtr == &levelReferenceType) {
level = (int) objPtr->internalRep.wideValue;
result = 1;
} else {
name = TclGetString(objPtr);
if (name[0] == '#') {
- if (TCL_OK == Tcl_GetInt(NULL, name+1, &level) && level >= 0) {
- TclFreeIntRep(objPtr);
- objPtr->typePtr = &levelReferenceType;
- objPtr->internalRep.wideValue = level;
- result = 1;
+ if (TCL_OK == Tcl_GetInt(NULL, name+1, &level)) {
+ if (level < 0 || (level > 0 && name[1] == '-')) {
+ result = -1;
+ } else {
+ TclFreeIntRep(objPtr);
+ objPtr->typePtr = &levelReferenceType;
+ objPtr->internalRep.wideValue = level;
+ result = 1;
+ }
} else {
result = -1;
}
- } else if (isdigit(UCHAR(name[0]))) { /* INTL: digit */
+ } else if (TclGetWideBitsFromObj(interp, objPtr, &w) == TCL_OK) {
/*
* If this were an integer, we'd have succeeded already.
* Docs say we have to treat this as a 'bad level' error.
@@ -814,7 +787,6 @@ TclObjGetFrame(
if (result == 0) {
level = curLevel - 1;
- name = "1";
}
if (result != -1) {
if (level >= 0) {
@@ -827,11 +799,11 @@ TclObjGetFrame(
}
}
}
- if (name == NULL) {
- name = TclGetString(objPtr);
- }
}
+ if (name == NULL) {
+ name = TclGetString(objPtr);
+ }
Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad level \"%s\"", name));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LEVEL", name, NULL);
return -1;
@@ -1035,7 +1007,6 @@ ProcWrongNumArgs(
{
CallFrame *framePtr = ((Interp *)interp)->varFramePtr;
register Proc *procPtr = framePtr->procPtr;
- register Var *defPtr;
int localCt = procPtr->numCompiledLocals, numArgs, i;
Tcl_Obj **desiredObjs;
const char *final = NULL;
@@ -1059,23 +1030,26 @@ ProcWrongNumArgs(
}
Tcl_IncrRefCount(desiredObjs[0]);
- defPtr = (Var *) (&framePtr->localCachePtr->varName0 + localCt);
- for (i=1 ; i<=numArgs ; i++, defPtr++) {
- Tcl_Obj *argObj;
- Tcl_Obj *namePtr = localName(framePtr, i-1);
-
- if (defPtr->value.objPtr != NULL) {
- TclNewObj(argObj);
- Tcl_AppendStringsToObj(argObj, "?", TclGetString(namePtr), "?", NULL);
- } else if (defPtr->flags & VAR_IS_ARGS) {
- numArgs--;
- final = "?arg ...?";
- break;
- } else {
- argObj = namePtr;
- Tcl_IncrRefCount(namePtr);
+ if (localCt > 0) {
+ register Var *defPtr = (Var *) (&framePtr->localCachePtr->varName0 + localCt);
+
+ for (i=1 ; i<=numArgs ; i++, defPtr++) {
+ Tcl_Obj *argObj;
+ Tcl_Obj *namePtr = localName(framePtr, i-1);
+
+ if (defPtr->value.objPtr != NULL) {
+ TclNewObj(argObj);
+ Tcl_AppendStringsToObj(argObj, "?", TclGetString(namePtr), "?", NULL);
+ } else if (defPtr->flags & VAR_IS_ARGS) {
+ numArgs--;
+ final = "?arg ...?";
+ break;
+ } else {
+ argObj = namePtr;
+ Tcl_IncrRefCount(namePtr);
+ }
+ desiredObjs[i] = argObj;
}
- desiredObjs[i] = argObj;
}
Tcl_ResetResult(interp);
generated by cgit v0.12 at 2025-12-04 17:31:22 (GMT)