diff options
Diffstat (limited to 'generic/tclProc.c')
-rw-r--r-- | generic/tclProc.c | 78 |
1 files changed, 38 insertions, 40 deletions
diff --git a/generic/tclProc.c b/generic/tclProc.c index 1ed48ac..b4192c0 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -263,11 +263,11 @@ Tcl_ProcObjCmd( && (contextPtr->nline >= 4) && (contextPtr->line[3] >= 0)) { int isNew; Tcl_HashEntry *hePtr; - CmdFrame *cfPtr = ckalloc(sizeof(CmdFrame)); + CmdFrame *cfPtr = Tcl_Alloc(sizeof(CmdFrame)); cfPtr->level = -1; cfPtr->type = contextPtr->type; - cfPtr->line = ckalloc(sizeof(int)); + cfPtr->line = Tcl_Alloc(sizeof(int)); cfPtr->line[0] = contextPtr->line[3]; cfPtr->nline = 1; cfPtr->framePtr = NULL; @@ -295,9 +295,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); } @@ -329,7 +329,7 @@ Tcl_ProcObjCmd( * of all procs whose argument list is just _args_ */ - if (TclHasIntRep(objv[3], &tclProcBodyType)) { + if (objv[3]->typePtr == &tclProcBodyType) { goto done; } @@ -340,7 +340,7 @@ Tcl_ProcObjCmd( } if ((procArgs[0] == 'a') && (strncmp(procArgs, "args", 4) == 0)) { - int numBytes; + size_t numBytes; procArgs +=4; while (*procArgs != '\0') { @@ -446,7 +446,7 @@ TclCreateProc( if (Tcl_IsShared(bodyPtr)) { const char *bytes; - int length; + size_t length; Tcl_Obj *sharedBodyPtr = bodyPtr; bytes = TclGetStringFromObj(bodyPtr, &length); @@ -469,7 +469,7 @@ TclCreateProc( Tcl_IncrRefCount(bodyPtr); - procPtr = ckalloc(sizeof(Proc)); + procPtr = Tcl_Alloc(sizeof(Proc)); procPtr->iPtr = iPtr; procPtr->refCount = 1; procPtr->bodyPtr = bodyPtr; @@ -509,7 +509,8 @@ TclCreateProc( for (i = 0; i < numArgs; i++) { const char *argname, *argnamei, *argnamelast; - int fieldCount, nameLength; + int fieldCount; + size_t nameLength; Tcl_Obj **fieldValues; /* @@ -539,7 +540,7 @@ TclCreateProc( goto procError; } - argname = Tcl_GetStringFromObj(fieldValues[0], &nameLength); + argname = TclGetStringFromObj(fieldValues[0], &nameLength); /* * Check that the formal parameter name is a scalar. @@ -552,7 +553,7 @@ TclCreateProc( if (*argnamelast == ')') { /* We have an array element. */ Tcl_SetObjResult(interp, Tcl_ObjPrintf( "formal parameter \"%s\" is an array element", - Tcl_GetString(fieldValues[0]))); + TclGetString(fieldValues[0]))); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC", "FORMALARGUMENTFORMAT", NULL); goto procError; @@ -601,10 +602,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; + size_t tmpLength, valueLength; + const char *tmpPtr = TclGetStringFromObj(localPtr->defValuePtr, &tmpLength); + const char *value = TclGetStringFromObj(fieldValues[1], &valueLength); if ((valueLength != tmpLength) || memcmp(value, tmpPtr, tmpLength) != 0 @@ -634,7 +634,7 @@ TclCreateProc( * local variables for the argument. */ - localPtr = ckalloc(offsetof(CompiledLocal, name) + fieldValues[0]->length +1); + localPtr = Tcl_Alloc(offsetof(CompiledLocal, name) + fieldValues[0]->length +1); if (procPtr->firstLocalPtr == NULL) { procPtr->firstLocalPtr = procPtr->lastLocalPtr = localPtr; } else { @@ -679,9 +679,9 @@ TclCreateProc( Tcl_DecrRefCount(localPtr->defValuePtr); } - ckfree(localPtr); + Tcl_Free(localPtr); } - ckfree(procPtr); + Tcl_Free(procPtr); } return TCL_ERROR; } @@ -1054,11 +1054,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]); @@ -1198,7 +1194,7 @@ InitResolvedLocals( if (localPtr->resolveInfo->deleteProc) { localPtr->resolveInfo->deleteProc(localPtr->resolveInfo); } else { - ckfree(localPtr->resolveInfo); + Tcl_Free(localPtr->resolveInfo); } localPtr->resolveInfo = NULL; } @@ -1284,7 +1280,7 @@ TclFreeLocalCache( TclReleaseLiteral(interp, objPtr); } } - ckfree(localCachePtr); + Tcl_Free(localCachePtr); } static void @@ -1310,7 +1306,7 @@ InitLocalCache( * for future calls. */ - localCachePtr = ckalloc(sizeof(LocalCache) + localCachePtr = Tcl_Alloc(sizeof(LocalCache) + (localCt - 1) * sizeof(Tcl_Obj *) + numArgs * sizeof(Var)); @@ -1322,7 +1318,7 @@ InitLocalCache( *namePtr = NULL; } else { *namePtr = TclCreateLiteral(iPtr, localPtr->name, - localPtr->nameLength, /* hash */ (unsigned int) -1, + localPtr->nameLength, /* hash */ -1, &isNew, /* nsPtr */ NULL, 0, NULL); Tcl_IncrRefCount(*namePtr); } @@ -1995,10 +1991,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; } @@ -2059,13 +2055,14 @@ MakeProcError( Tcl_Obj *procNameObj) /* Name of the procedure. Used for error * messages and trace information. */ { - int overflow, limit = 60, nameLen; + unsigned int overflow, limit = 60; + size_t 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, + (int)(overflow ? limit :nameLen), procName, (overflow ? "..." : ""), Tcl_GetErrorLine(interp))); } @@ -2140,7 +2137,7 @@ TclProcCleanupProc( if (resVarInfo->deleteProc) { resVarInfo->deleteProc(resVarInfo); } else { - ckfree(resVarInfo); + Tcl_Free(resVarInfo); } } @@ -2148,10 +2145,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 @@ -2175,9 +2172,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); } @@ -2425,7 +2422,7 @@ SetLambdaFromAny( if ((result != TCL_OK) || ((objc != 2) && (objc != 3))) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "can't interpret \"%s\" as a lambda expression", - Tcl_GetString(objPtr))); + TclGetString(objPtr))); Tcl_SetErrorCode(interp, "TCL", "VALUE", "LAMBDA", NULL); return TCL_ERROR; } @@ -2511,12 +2508,12 @@ SetLambdaFromAny( * location (line of 2nd list element). */ - cfPtr = ckalloc(sizeof(CmdFrame)); + cfPtr = Tcl_Alloc(sizeof(CmdFrame)); TclListLines(objPtr, contextPtr->line[1], 2, buf, NULL); cfPtr->level = -1; cfPtr->type = contextPtr->type; - cfPtr->line = ckalloc(sizeof(int)); + cfPtr->line = Tcl_Alloc(sizeof(int)); cfPtr->line[0] = buf[1]; cfPtr->nline = 1; cfPtr->framePtr = NULL; @@ -2729,13 +2726,14 @@ MakeLambdaError( Tcl_Obj *procNameObj) /* Name of the procedure. Used for error * messages and trace information. */ { - int overflow, limit = 60, nameLen; + unsigned int overflow, limit = 60; + size_t 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, + (int)(overflow ? limit : nameLen), procName, (overflow ? "..." : ""), Tcl_GetErrorLine(interp))); } |